ROUTINE DIDH: Difference between revisions
From VistApedia
Jump to navigationJump to search
DavidWhitten (talk | contribs) No edit summary |
DavidWhitten (talk | contribs) No edit summary |
||
Line 54: | Line 54: | ||
::: GOTO out of double loop to Q^DIDH | ::: GOTO out of double loop to Q^DIDH | ||
=== | === Entryref PD^DIDH === | ||
==== Code ==== | ==== 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 | : 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 | : S %=X,%F=DG | ||
: ; fallsthru to WR^DIDH | : ; fallsthru to WR^DIDH | ||
==== TAG PD^DIDH ==== | |||
==== TAG PD+1^DIDH ==== | |||
=== Entryref WR^DIDH === | |||
==== 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 ==== | |||
==== TAG WR+1^DIDH ==== | |||
==== TAG WR+2^DIDH ==== | |||
=== Entryref UP^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 | |||
==== TAG UP^DIDH ==== | |||
==== TAG UP+1^DIDH ==== | |||
==== TAG UP+2^DIDH ==== | |||
==== TAG UP+3^DIDH ==== | |||
=== Entryref 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 |
Revision as of 16:37, 25 June 2019
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
- 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
- AND lvn M == U == "^"
Entryref PD^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
TAG PD+1^DIDH
Entryref WR^DIDH
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
TAG WR+1^DIDH
TAG WR+2^DIDH
Entryref UP^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
TAG UP^DIDH
TAG UP+1^DIDH
TAG UP+2^DIDH
TAG UP+3^DIDH
Entryref 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