| 1 | DIWP ;SFISC/GFT-ASSEMBLE WP LINE ;12:15 PM 5 Jun 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**46**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S:'$L(X) X=" "
|
|---|
| 5 | S DIWTC=X[($C(124)_"TAB") S:'$D(DN) DN=1
|
|---|
| 6 | LN S:'$D(DIWF) DIWF="" S:'DIWTC DIWTC=DIWF["N" S DIWX=X,DIW=$C(124),I=$P(DIWF,"C",2) I I S DIWR=DIWL+I-1
|
|---|
| 7 | I '$D(^UTILITY($J,"W",DIWL)) S ^(DIWL)=1 K DIWFU,DIWFWU,DIWLL D DIWI S:'$D(DIWT) DIWT="5,10,15,20,25" G DIW
|
|---|
| 8 | S I=^(DIWL),DIWI=^(DIWL,I,0) I DIWI="" D DIWI G Z
|
|---|
| 9 | D NEW:DIWTC
|
|---|
| 10 | Z S Z=X?.P!DIWTC I X?1" ".E!Z S DIWTC=1 D NEW:DIWI]"" S DIWTC=Z
|
|---|
| 11 | DIW ;
|
|---|
| 12 | S X=$P(DIWX,DIW,1) D C:X]"" S X=$P(DIWX,DIW,1),DIWX=$P(DIWX,DIW,2,999) G D:DIWX="" I $D(DIWP),X'?.E1" " D ST
|
|---|
| 13 | S X=$P(DIWX,DIW,1) I $P(X,"TAB",1)="" D TAB G N
|
|---|
| 14 | I X="TOP" D PUT S ^("X")="S DIFF=1 X:$D(^UTILITY($J,1)) ^(1)" D NEW G N
|
|---|
| 15 | I DIWF'[DIW G U:X="_" D PUT,RCR^DIWW G N:$D(X)
|
|---|
| 16 | S X=DIW_$P(DIWX,DIW,1)_DIW D C
|
|---|
| 17 | N K X S DIWX=$P(DIWX,DIW,2,99) I DIWX]"" D ST:$D(DIWP) G DIW
|
|---|
| 18 | D K DIWP D PUT,PRE:DIWTC S:DIWTC DIWI="" Q
|
|---|
| 19 | ;
|
|---|
| 20 | ST S DIWI=$E(DIWI,1,$L(DIWI)-1) K DIWP Q
|
|---|
| 21 | ;
|
|---|
| 22 | DIWI S DIWI=$J("",+$P(DIWF,"I",2)) I DIWF["L",$D(D)#2 S DIWLL=D
|
|---|
| 23 | Q
|
|---|
| 24 | PUT S I=^UTILITY($J,"W",DIWL),^(DIWL,I,0)=DIWI I DIWF["L",$D(DIWLL) S ^("L")=DIWLL
|
|---|
| 25 | Q
|
|---|
| 26 | L ;
|
|---|
| 27 | S DIWTC=1 G LN
|
|---|
| 28 | ;
|
|---|
| 29 | TAB I X="" S X=DIW G C
|
|---|
| 30 | S J=$P(DIWT,",",DIWTC),DIWTC=DIWTC+1 S:X?3A1P.P.N.E J=$E(X,5,9) S:J?1"""".E1"""" J=$E(J,2,$L(J)-1)
|
|---|
| 31 | I J'>0 S %=$P(DIWX,DIW,2) Q:%="" S J=$S(J<0:1-$L(%)-J,J="C":DIWR-DIWL-$L(%)\2,1:0)
|
|---|
| 32 | S J=J-1-$L(DIWI) Q:J<1 S X=$J("",J)
|
|---|
| 33 | C K DIWP I DIWTC S DIWI=DIWI_X Q
|
|---|
| 34 | B S Z=DIWR-DIWL+1-$L(DIWI) G FULL:$F(X," ")-1>Z F %=Z:-1 I " "[$E(X,%) S:$E(X,%+1)=" " %=%+1 Q
|
|---|
| 35 | S Z=$E(X,1,%-1),X=$E(X,%+1,999) I Z]"" S DIWI=DIWI_Z G S:X]"" S %=$E(Z,$L(Z)) S:%'=" " DIWI=DIWI_$J("",%="."+1),DIWP=1 Q
|
|---|
| 36 | FULL I $P(DIWF,"I",2)'<$L(DIWI) S DIWI=DIWI_$P(X," ",1),X=$P(X," ",2,999)
|
|---|
| 37 | S D PUT,NEW G B:X]"" Q
|
|---|
| 38 | ;
|
|---|
| 39 | U S I=^UTILITY($J,"W",DIWL) I $D(DIWFU) S ^(DIWL,I,"U",$L(DIWI)+1)="" K DIWFU G N
|
|---|
| 40 | S ^(DIWL,I,"U",$L(DIWI)+1)=X,DIWFU=1 G N
|
|---|
| 41 | ;
|
|---|
| 42 | NEW D DIWI
|
|---|
| 43 | PRE S I=^UTILITY($J,"W",DIWL),^(DIWL)=I+1,^(DIWL,I+1,0)="" I DIWF["D" S ^(0)=" ",^UTILITY($J,"W",DIWL)=I+2,^(DIWL,I+2,0)=""
|
|---|
| 44 | I $D(DIWFU) S ^("U",1+$P(DIWF,"I",2))="_"
|
|---|
| 45 | G P:DIWF'["R"!DIWTC K % Q:'$D(^UTILITY($J,"W",DIWL,I,0))
|
|---|
| 46 | S Y=^(0),%=$L(Y) F %=%:-1 Q:$A(Y,%)-32
|
|---|
| 47 | S Y=$E(Y,1,%),J=DIWR-DIWL-%+1,%X=0 G P:J<1
|
|---|
| 48 | F %=1:1 S %(%)=$P(Y," ",1),Y=$P(Y," ",2,999) G:Y="" PAD:%-1,P I $E(%(%),$L(%(%)))?.P S:%=1&(%(%)="") %=0,%X=%X+1 S:%&J J=J-1,%(%)=%(%)_" "
|
|---|
| 49 | PAD I J F Y=%\2+1:1:%-1,%\2:-1 S %(Y)=%(Y)_" ",J=J-1 G PAD:Y=1!'J
|
|---|
| 50 | S Y=%(%) F %=%-1:-1:1 S Y=%(%)_" "_Y
|
|---|
| 51 | S ^(0)=$J("",%X)_Y K %
|
|---|
| 52 | P I DIWF["W" G NX^DIWW
|
|---|
