| 1 | DIWW ;SFISC/GFT-OUTPUT WP LINE ;02:59 PM 18 Apr 2002
|
|---|
| 2 | ;;22.0;VA FileMan;**64,144**;Mar 30, 1999;Build 5
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | F I=0:1 G:$D(DN) QQ:'DN Q:$D(^UTILITY($J,"W"))<9 D T G:$D(DN) QQ:'DN D 0
|
|---|
| 5 | T W:$X !
|
|---|
| 6 | B Q:$S($D(DN):'DN,1:0) I '$D(DIWF) S DIWF=""
|
|---|
| 7 | I '$D(DIOT(2)),$D(IOSL),$Y+$S($P(DIWF,"B",2):$P(DIWF,"B",2),1:2)'<IOSL,$D(^UTILITY($J,1))#2,^(1)?1U1P1E.E X ^(1) I $D(DN),'DN S D0="zzzzzz",W=9999999 Q
|
|---|
| 8 | F I=$Y+2:1:+$P(DIWF,"T",2) W !
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | A ;
|
|---|
| 12 | D 0 G DIWW
|
|---|
| 13 | ;
|
|---|
| 14 | NX ;
|
|---|
| 15 | W:$X+1>DIWL ! D B G:$D(DN) Q:'DN
|
|---|
| 16 | 0 ;
|
|---|
| 17 | S I=999999,%="" F S %=$O(^UTILITY($J,"W",%)) Q:%="" S:$O(^(%,""))<I I=$O(^(""))
|
|---|
| 18 | 1 S %="" F S %=$O(^UTILITY($J,"W",%)) Q:%="" I $D(^(%,I)) D W I $D(^UTILITY($J,"W",%))<9 K ^(%) I $O(^(""))="" K DIWI,DIWX,DIWTC
|
|---|
| 19 | S:%="" %=-1 G Q
|
|---|
| 20 | ;
|
|---|
| 21 | W G X:^(I,0)="",O:'$D(DIWF) I DIWF[" " S DIWF=$P(DIWF," ",1)_$P(DIWF," ",2) G X:^(0)?." "
|
|---|
| 22 | W:$X+(%>0)>% ! I DIWF["L",$D(^("L")) W $E(^("L")_" ",1,4)
|
|---|
| 23 | O W ?%-1,^(0)
|
|---|
| 24 | X D U:$D(^("U")) I $D(^("X")) S Y=^("X") D K X Y Q
|
|---|
| 25 | K K ^UTILITY($J,"W",%,I) Q
|
|---|
| 26 | ;
|
|---|
| 27 | U Q:'$D(IOST) Q:IOST'?1"P".E W $C(13) F DE=1:1:$S($D(^("L")):%+3,1:%-1) W " "
|
|---|
| 28 | S DE=1
|
|---|
| 29 | UU S %Y=$O(^UTILITY($J,"W",%,I,"U","")) I %Y="" S %Y=$L(^UTILITY($J,"W",%,I,0))+1 S:'$D(DIWFWU) DIWFWU=" " D UUU K DIWFWU Q
|
|---|
| 30 | S Y=^(%Y) K ^(%Y) I Y="" D UUU K DIWFWU G UU
|
|---|
| 31 | S DIWFWU=Y F DE=DE:1 G UU:DE'<%Y W " "
|
|---|
| 32 | UUU I $D(DIWFWU) F DE=DE:1 Q:DE'<%Y W DIWFWU
|
|---|
| 33 | Q Q
|
|---|
| 34 | QQ K DIWI,DIWX,DIWTC Q
|
|---|
| 35 | ;
|
|---|
| 36 | RCR ;
|
|---|
| 37 | N DA,M,DQI,DA
|
|---|
| 38 | F M="DIWX","DICMX","DIC","D","D0","D1","D2","D3","D4","D5","D6","D7","Y","I","J" M %=@M N @M M @M=%
|
|---|
| 39 | S DQI="Y(",DA="X(",DICMX="X DICMX",DICOMP="ST" S:$D(DIA("P"))#2 J(0)=DIA("P") D EN1^DICOMP
|
|---|
| 40 | I '$D(X) Q:DIWF'["?"!(IO(0)=IO)!$D(IO("C")) U IO(0) W $C(7),!,$P(@(I(0)_"D0,0)"),U),"---",!?4,$P(DIWX,DIW)_": " R X:DTIME,! U IO G BACK
|
|---|
| 41 | I Y["m" S DICMX=$S(Y["w":"D ^DIWP",1:"S DIWX=X,DIWTC=1 D DIW^DIWP S DIWI=$J("""","_$L(DIWI)_")") X X S X="" G BACK
|
|---|
| 42 | I Y["X" S X=DIW_X_DIW G BACK
|
|---|
| 43 | I $P(DIWX,"SETPAGE(",1)="" S ^(DIWL,^UTILITY($J,"W",DIWL),"X")=X,X="" G BACK
|
|---|
| 44 | S DICMX=Y["D" X X I DICMX S Y=X X ^DD("DD") S X=Y
|
|---|
| 45 | I $P(DIWX,"INDENT(")="" S X=$J(X,$P(DIWF,"I",2)-$L(DIWI)-1)
|
|---|
| 46 | BACK D C^DIWP:X]"" S X=""
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | DIQ ;
|
|---|
| 50 | S DIWF=$E("N",C["L")_"W|",DIWL=2,DIWR=IOM,X=O_": " K ^UTILITY($J,"W")
|
|---|
| 51 | S W=0 F D S W=$O(@(D(DL-1)_"W)")) Q:W'>0!(S=0) S X=^(W,0)
|
|---|
| 52 | .D ^DIWP
|
|---|
| 53 | .N W D LF^DIQ
|
|---|
| 54 | G DIWW
|
|---|
| 55 | ;
|
|---|
| 56 | H G H^DIO2
|
|---|
| 57 | DT G DT^DIO2
|
|---|
| 58 | ;
|
|---|
| 59 | N W ! G B
|
|---|
