ROUTINE DIDH

Entryref POINT^DIDH

 * CALLED BY ^DD(1,.01,"DEL",.5,0) -- "DEL" node of FILE of FILEs (File#1) field NAME (field#.01)
 * lvn DIC == "^DIC"
 * CALLED FROM PAGE1+34^DIDH1
 * lvn DIC == global root of file or subfile
 * when double loop active
 * sometimes WRITE text
 * when loop finishes
 * sometimes init lvn DG == -1
 * sometimes init lvn X == -1
 * sometimes KILLs lvn W1
 * sometimes KILLs lvn DOPT
 * when loop stopped by undef lvn DIU
 * sometimes KILLs DDV
 * sometimes KILLs %F
 * sometimes KILLs M1
 * QUIT

Code

 * POINT ; CALLED BY ^DD(1,.01,"DEL",.5,0)
 * S W1="W:$Y ! W !,""POINTED TO BY: "",?15" I $O(^DD(DA,0,"PT",""))'="" S DDPT=1
 * S X="" F S X=$O(^DD(DA,0,"PT",X)) Q:X=""  S DG=0 F  S DG=$O(^DD(DA,0,"PT",X,DG)) Q:DG=""  D PD W:$D(^DD(DA,0,"PT",X,DG)) !?15 I '$D(DIU) D H G Q:M=U
 * S (DG,X)=-1 K W1,DDPT Q

TAG POINT^DIDH

 * FALLSTHRU none
 * INPUT VARS
 * lvn DA == DDnumber
 * $ORDER(^DD(DA,0,"PT","")) -- what files point at this one.


 * OUTPUT VARS
 * sometimes inits lvn DDPT=1
 * always inits lvn W1 == XECUTE-able code with WRITE

TAG POINT^DIDH

 * FALLSTHRU from POINT^DIDH
 * INPUT VARS
 * lvn DA
 * $ORDER(^DD(DA,0,"PT",
 * always evals $ORDER(^DD(DA,0,"PT",X))


 * OUTPUT VARS
 * lvn X
 * always inits to ""
 * always exits line ==""
 * after command=5 then == subscript of ^DD(DA,0,"PT", ...
 * LOOP start with X over $ORDER(^DD(DA,0,"PT",X))
 * lvn DG
 * always inits to 0
 * always exits line == 0
 * after command=8 then == subscript of ^DD(DA,0,"PT",X, ...
 * DOUBLE LOOP start with DG over $ORDER(^DD(DA,0,"PT",X,DG))
 * Calls PD^DIDH
 * sometimes WRITEs
 * sometimes calls H^DIDH
 * IF undef lvn DIU
 * AND lvn M == U == "^"
 * GOTO out of double loop to Q^DIDH

Code

 * PD I $S('$D(^DD(X,DG,0)):1,$P(^(0),U,2)["V":0,1:$P($P(^(0),U,2),"P",2)-DA) K ^DD(DA,0,"PT",X,DG) Q
 * S %=X,%F=DG
 * ; fallsthru to WR^DIDH

TAG PD^DIDH

 * CALLED from POINT^DIDH
 * INPUT VARS
 * lvn DA == DDnumber
 * lvn X == subscript of ^DD(DA,0,"PT", ...
 * lvn DA == subscript of ^DD(DA,0,"PT",X ...
 * checks if not $D(^DD(X,DG,0))
 * -- if field DG of file X is undefined
 * then KILL ^DD(DA,0,X,DG) ;; kill off this reference
 * then QUIT               ;; process no more
 * skips if $P(^DD(X,DG,0),U,2)["V"
 * -- if datatype of field is VARIABLE POINTER
 * otherwise if $P($P(^DD(X,DG,0),U,2),"P",2)-DA)


 * -- if datatype is a pointer and does not points to current DDnumber

TAG PD+1^DIDH

 * FALLSTHRU from PD^DIDH
 * init lvn % to lvn X
 * init lvn %F to lvn DG

Entryref WR^DIDH

 * INPUT VARS
 * lvn IOM
 * lvn DDPT
 * lvn W1
 * lvn % == DD number
 * lvn %F == Field number
 * lvn U == "^"
 * OUTPUT VARS
 * lvn X1

Code

 * WR I '$D(IOM) S IOP="HOME" N %X D ^%ZIS Q:POP
 * I $D(DDPT) X W1 K DDPT
 * S X1=$P(^DD(%,%F,0),U)_" field (#"_%F_")"
 * ; fallsthru to UP^DIDH

TAG WR^DIDH

 * FALLSTRU from PD+1^DIDH
 * if unknown right margin in lvn IOM
 * then force default I/O device as IOP == "HOME"
 * then call ^%ZIS
 * if POP is true
 * ie fails to init home device
 * then QUIT subroutine

TAG WR+1^DIDH

 * FALLS THRU from WR^DIDH
 * IF lvn DDPT is defined (setup in POINT+1^DIDH)
 * then assume W1 is defined (also setup in POINT+1^DIDH)
 * then XECUTE W1 (setup as a WRITE)
 * then KILL lvn DDPT flag variable


 * FALLSTHRU to WR+1^DIDH

TAG WR+2^DIDH

 * FALLSTHRU from WR+1^DIDH

Code

 * UP I $L(X1)+$L(%)+$L($O(^DD(%,0,"NM",0)))>225 S X1=X1_" etc... ^" G L1
 * S X1=X1_" of the "_$O(^(0))
 * I $D(^DD(%,0,"UP")) S X1=X1_" sub-field (#"_%_")",%=^("UP") G UP
 * S X1=X1_" File (#"_%_") ^"
 * : ; fallsthru to L1^DIDH

Code

 * L1 F DDC=1:1 S DDV=$P(X1," ",DDC)_" " Q:DDV["^" W:$L(DDV)+$X>IOM !,?19 W DDV
 * K DDC,DDV,X1 Q

TAG L1^DIDH

 * loop thru each piece of X1
 * if next word will go past right margin (as lvn IOM)
 * WRITE linefeed and tab to column 19
 * WRITE current piece of X1 as lvn DDV

TAG L1+1^DIDH

 * KILL lvn DDC
 * KILL lvn DDV
 * KILL lvn X1
 * QUIT subroutine