- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIWP.m
r613 r623 1 DIWP ;SFISC/GFT-ASSEMBLE WP LINE ;10JUN2005 2 ;;22.0;VA FileMan;**46,152**;Mar 30, 1999;Build 10 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ;The DIWF variable contains a string of one-letter codes to control W-P output. 5 ;"|" in DIWF means that "|"-windows are not to be evaluated, but are to be printed as 6 ; they stand. 7 ;"X" means eXactly line-for-line, with "||" printed as "||" 8 ;"W" in DIWF means that formatted text will be written out to 9 ; the current device as it is assembled. 10 ;"N" means NOWRAP-- text is assembled line-for-line 11 ;"R" means text will be assembled Right-justified 12 ;"D" means text will be double-spaced 13 ;"L" means internal line numbers appear at the left margin 14 ;"C" followed by a number will cause formatting of text in a column 15 ; width specified by the number. 16 ;"I" followed by a number will cause text to be indented that number 17 ; of columns. 18 ;"?" means that, if user's terminal is available, "|"-windows that cannot 19 ; be evaluated will be asked from the user's terminal. 20 ;"B" followed by number causes new page when output gets within that 21 ; number of lines from the bottom of the page (as defined by IOSL). 22 ; 23 ;DIWTC is a Boolean -- Are we printing out in LINE MODE? 24 S:'$L(X) X=" " 25 S DIWTC=X[($C(124)_"TAB") S:'$D(DN) DN=1 26 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 27 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 28 S I=^(DIWL),DIWI=^(DIWL,I,0) I DIWI="" D DIWI G Z 29 D NEW:DIWTC 30 Z S Z=X?.P!DIWTC I X?1" ".E!Z S DIWTC=1 D NEW:DIWI]"" S DIWTC=Z 31 DIW ;from RCR+5^DIWW 32 I DIWF["X" S DIWTC=1,X=DIWX,DIWX="" D C G D ;**DI*22*152** Leave line unaltered 33 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 34 S X=$P(DIWX,DIW,1) I $P(X,"TAB",1)="" D TAB G N 35 I X="TOP" D PUT S ^("X")="S DIFF=1 X:$D(^UTILITY($J,1)) ^(1)" D NEW G N 36 I DIWF'[DIW G U:X="_" D PUT,RCR^DIWW G N:$D(X) 37 S X=DIW_$P(DIWX,DIW,1)_DIW D C 38 N K X S DIWX=$P(DIWX,DIW,2,99) I DIWX]"" D ST:$D(DIWP) G DIW 39 D K DIWP D PUT,PRE:DIWTC S:DIWTC DIWI="" Q 40 ; 41 ST S DIWI=$E(DIWI,1,$L(DIWI)-1) K DIWP Q 42 ; 43 DIWI S DIWI=$J("",+$P(DIWF,"I",2)) I DIWF["L",$D(D)#2 S DIWLL=D 44 Q 45 PUT S I=^UTILITY($J,"W",DIWL),^(DIWL,I,0)=DIWI I DIWF["L",$D(DIWLL) S ^("L")=DIWLL 46 Q 47 L ; 48 S DIWTC=1 G LN 49 ; 50 TAB I X="" S X=DIW G C 51 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) 52 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) 53 S J=J-1-$L(DIWI) Q:J<1 S X=$J("",J) 54 C K DIWP I DIWTC S DIWI=DIWI_X Q 55 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 56 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 57 FULL I $P(DIWF,"I",2)'<$L(DIWI) S DIWI=DIWI_$P(X," ",1),X=$P(X," ",2,999) 58 S D PUT,NEW G B:X]"" Q 59 ; 60 U S I=^UTILITY($J,"W",DIWL) I $D(DIWFU) S ^(DIWL,I,"U",$L(DIWI)+1)="" K DIWFU G N 61 S ^(DIWL,I,"U",$L(DIWI)+1)=X,DIWFU=1 G N 62 ; 63 NEW D DIWI 64 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)="" 65 I $D(DIWFU) S ^("U",1+$P(DIWF,"I",2))="_" 66 G P:DIWF'["R"!DIWTC K % Q:'$D(^UTILITY($J,"W",DIWL,I,0)) 67 S Y=^(0),%=$L(Y) F %=%:-1 Q:$A(Y,%)-32 68 S Y=$E(Y,1,%),J=DIWR-DIWL-%+1,%X=0 G P:J<1 69 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,%(%)=%(%)_" " 70 PAD I J F Y=%\2+1:1:%-1,%\2:-1 S %(Y)=%(Y)_" ",J=J-1 G PAD:Y=1!'J 71 S Y=%(%) F %=%-1:-1:1 S Y=%(%)_" "_Y 72 S ^(0)=$J("",%X)_Y K % 73 P I DIWF["W" G NX^DIWW 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
Note:
See TracChangeset
for help on using the changeset viewer.