DIWP.m

DIWP ;SFISC/GFT-ASSEMBLE WP LINE ;25APR2012

 ;;22.0;VA FileMan;**46,152,169**;Mar 30, 1999;Build 28

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;The DIWF variable contains a string of one-letter codes to control W-P output.

 ;"|" in DIWF means that "|"-windows are not to be evaluated, but are to be printed as

 ;     they stand.

 ;"X" means eXactly line-for-line, with "||" printed as "||"

 ;"W" in DIWF means that formatted text will be written out to

 ;     the current device as it is assembled.

 ;"N" means NOWRAP-- text is assembled line-for-line

 ;"R" means text will be assembled Right-justified

 ;"D" means text will be double-spaced

 ;"L" means internal line numbers appear at the left margin

 ;"C" followed by a number will cause formatting of text in a column

 ;     width specified by the number.

 ;"I" followed by a number will cause text to be indented that number

 ;     of columns.

 ;"?" means that, if user's terminal is available, "|"-windows that cannot

 ;     be evaluated will be asked from the user's terminal.

 ;"B" followed by number causes new page when output gets within that

 ;   number of lines from the bottom of the page (as defined by IOSL).

 ;   

 ;DIWTC is a Boolean -- Are we printing out in LINE MODE?

 S:'$L(X) X=" "

 S DIWTC=X[($C(124)_"TAB") S:'$D(DN) DN=1

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

 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

 S I=^(DIWL),DIWI=^(DIWL,I,0) I DIWI="" D DIWI G Z

 D NEW:DIWTC

Z S Z=X?.P!DIWTC I X?1" ".E!Z S DIWTC=1 D NEW:DIWI]"" S DIWTC=Z

DIW ;from RCR+5^DIWW

 I DIWF["X" S DIWTC=1,X=DIWX,DIWX="" D C G D ;**DI*22*152**  Leave line unaltered

 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

 S X=$P(DIWX,DIW,1) I $P(X,"TAB",1)="" D TAB G N

 I X="TOP" D PUT S ^("X")="S DIFF=1 X:$D(^UTILITY($J,1)) ^(1)" D NEW G N

 I DIWF'[DIW G U:X="_" D PUT,RCR^DIWW G N:$D(X)

 S X=DIW_$P(DIWX,DIW,1) S:DIWX[DIW!(DIWF'[DIW) X=X_DIW D C ;DO NOT PUT GRATUITOUS "|" AT END, IF DIWF["|"

N K X S DIWX=$P(DIWX,DIW,2,99) I DIWX]"" D ST:$D(DIWP) G DIW

D K DIWP D PUT,PRE:DIWTC S:DIWTC DIWI="" Q

 ;

ST S DIWI=$E(DIWI,1,$L(DIWI)-1) K DIWP Q

 ;

DIWI S DIWI=$J("",+$P(DIWF,"I",2)) I DIWF["L",$D(D)#2 S DIWLL=D

 Q

PUT S I=^UTILITY($J,"W",DIWL),^(DIWL,I,0)=DIWI I DIWF["L",$D(DIWLL) S ^("L")=DIWLL

 Q

L ;

 S DIWTC=1 G LN

 ;

TAB I X="" S X=DIW G C

 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)

 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)

 S J=J-1-$L(DIWI) Q:J<1  S X=$J("",J)

C K DIWP I DIWTC S DIWI=DIWI_X Q

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

 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

FULL I $P(DIWF,"I",2)'<$L(DIWI) S DIWI=DIWI_$P(X," ",1),X=$P(X," ",2,999)

S D PUT,NEW G B:X]"" Q

 ;

U S I=^UTILITY($J,"W",DIWL) I $D(DIWFU) S ^(DIWL,I,"U",$L(DIWI)+1)="" K DIWFU G N

 S ^(DIWL,I,"U",$L(DIWI)+1)=X,DIWFU=1 G N

 ;

NEW D DIWI

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)=""

 I $D(DIWFU) S ^("U",1+$P(DIWF,"I",2))="_"

 G P:DIWF'["R"!DIWTC K % Q:'$D(^UTILITY($J,"W",DIWL,I,0))

 S Y=^(0),%=$L(Y) F %=%:-1 Q:$A(Y,%)-32

 S Y=$E(Y,1,%),J=DIWR-DIWL-%+1,%X=0 G P:J<1

 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,%(%)=%(%)_" "

PAD I J F Y=%\2+1:1:%-1,%\2:-1 S %(Y)=%(Y)_" ",J=J-1 G PAD:Y=1!'J

 S Y=%(%) F %=%-1:-1:1 S Y=%(%)_" "_Y

 S ^(0)=$J("",%X)_Y K %

P I DIWF["W" G NX^DIWW

DIWP      ;SFISC/GFT-ASSEMBLE WP LINE ;25APR2012

 +1       ;;22.0;VA FileMan;**46,152,169**;Mar 30, 1999;Build 28

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;The DIWF variable contains a string of one-letter codes to control W-P output.

 +4       ;"|" in DIWF means that "|"-windows are not to be evaluated, but are to be printed as

 +5       ;     they stand.

 +6       ;"X" means eXactly line-for-line, with "||" printed as "||"

 +7       ;"W" in DIWF means that formatted text will be written out to

 +8       ;     the current device as it is assembled.

 +9       ;"N" means NOWRAP-- text is assembled line-for-line

 +10      ;"R" means text will be assembled Right-justified

 +11      ;"D" means text will be double-spaced

 +12      ;"L" means internal line numbers appear at the left margin

 +13      ;"C" followed by a number will cause formatting of text in a column

 +14      ;     width specified by the number.

 +15      ;"I" followed by a number will cause text to be indented that number

 +16      ;     of columns.

 +17      ;"?" means that, if user's terminal is available, "|"-windows that cannot

 +18      ;     be evaluated will be asked from the user's terminal.

 +19      ;"B" followed by number causes new page when output gets within that

 +20      ;   number of lines from the bottom of the page (as defined by IOSL).

 +21      ;   

 +22      ;DIWTC is a Boolean -- Are we printing out in LINE MODE?

 +23       IF '$LENGTH(X)

               SET X=" "

 +24       SET DIWTC=X[($CHAR(124)_"TAB")

           IF '$DATA(DN)

               SET DN=1

LN         IF '$DATA(DIWF)

               SET DIWF=""

           IF 'DIWTC

               SET DIWTC=DIWF["N"

           SET DIWX=X

           SET DIW=$CHAR(124)

           SET I=$PIECE(DIWF,"C",2)

           IF I

               SET DIWR=DIWL+I-1

 +1        IF '$DATA(^UTILITY($JOB,"W",DIWL))

               SET ^(DIWL)=1

               KILL DIWFU,DIWFWU,DIWLL

               DO DIWI

               IF '$DATA(DIWT)

                   SET DIWT="5,10,15,20,25"

               GOTO DIW

 +2        SET I=^(DIWL)

           SET DIWI=^(DIWL,I,0)

           IF DIWI=""

               DO DIWI

               GOTO Z

 +3        IF DIWTC

               DO NEW

Z          SET Z=X?.P!DIWTC

           IF X?1" ".E!Z

               SET DIWTC=1

               IF DIWI]""

                   DO NEW

               SET DIWTC=Z

DIW       ;from RCR+5^DIWW

 +1       ;**DI*22*152**  Leave line unaltered

           IF DIWF["X"

               SET DIWTC=1

               SET X=DIWX

               SET DIWX=""

               DO C

               GOTO D

 +2        SET X=$PIECE(DIWX,DIW,1)

           IF X]""

               DO C

           SET X=$PIECE(DIWX,DIW,1)

           SET DIWX=$PIECE(DIWX,DIW,2,999)

           IF DIWX=""

               GOTO D

           IF $DATA(DIWP)

               IF X'?.E1" "

                   DO ST

 +3        SET X=$PIECE(DIWX,DIW,1)

           IF $PIECE(X,"TAB",1)=""

               DO TAB

               GOTO N

 +4        IF X="TOP"

               DO PUT

               SET ^("X")="S DIFF=1 X:$D(^UTILITY($J,1)) ^(1)"

               DO NEW

               GOTO N

 +5        IF DIWF'[DIW

               IF X="_"

                   GOTO U

               DO PUT

               DO RCR^DIWW

               IF $DATA(X)

                   GOTO N

 +6       ;DO NOT PUT GRATUITOUS "|" AT END, IF DIWF["|"

           SET X=DIW_$PIECE(DIWX,DIW,1)

           IF DIWX[DIW!(DIWF'[DIW)

               SET X=X_DIW

           DO C

N          KILL X

           SET DIWX=$PIECE(DIWX,DIW,2,99)

           IF DIWX]""

               IF $DATA(DIWP)

                   DO ST

               GOTO DIW

D          KILL DIWP

           DO PUT

           IF DIWTC

               DO PRE

           IF DIWTC

               SET DIWI=""

           QUIT 

 +1       ;

ST         SET DIWI=$EXTRACT(DIWI,1,$LENGTH(DIWI)-1)

           KILL DIWP

           QUIT 

 +1       ;

DIWI       SET DIWI=$JUSTIFY("",+$PIECE(DIWF,"I",2))

           IF DIWF["L"

               IF $DATA(D)#2

                   SET DIWLL=D

 +1        QUIT 

PUT        SET I=^UTILITY($JOB,"W",DIWL)

           SET ^(DIWL,I,0)=DIWI

           IF DIWF["L"

               IF $DATA(DIWLL)

                   SET ^("L")=DIWLL

 +1        QUIT 

L         ;

 +1        SET DIWTC=1

           GOTO LN

 +2       ;

TAB        IF X=""

               SET X=DIW

               GOTO C

 +1        SET J=$PIECE(DIWT,",",DIWTC)

           SET DIWTC=DIWTC+1

           IF X?3A1P.P.N.E

               SET J=$EXTRACT(X,5,9)

           IF J?1"""".E1""""

               SET J=$EXTRACT(J,2,$LENGTH(J)-1)

 +2        IF J'>0

               SET %=$PIECE(DIWX,DIW,2)

               IF %=""

                   QUIT 

               SET J=$SELECT(J<0:1-$LENGTH(%)-J,J="C":DIWR-DIWL-$LENGTH(%)\2,1:0)

 +3        SET J=J-1-$LENGTH(DIWI)

           IF J<1

               QUIT 

           SET X=$JUSTIFY("",J)

C          KILL DIWP

           IF DIWTC

               SET DIWI=DIWI_X

               QUIT 

B          SET Z=DIWR-DIWL+1-$LENGTH(DIWI)

           IF $FIND(X," ")-1>Z

               GOTO FULL

           FOR %=Z:-1

               IF " "[$EXTRACT(X,%)

                   IF $EXTRACT(X,%+1)=" "

                       SET %=%+1

                   QUIT 

 +1        SET Z=$EXTRACT(X,1,%-1)

           SET X=$EXTRACT(X,%+1,999)

           IF Z]""

               SET DIWI=DIWI_Z

               IF X]""

                   GOTO S

               SET %=$EXTRACT(Z,$LENGTH(Z))

               IF %'=" "

                   SET DIWI=DIWI_$JUSTIFY("",%="."+1)

                   SET DIWP=1

               QUIT 

FULL       IF $PIECE(DIWF,"I",2)'<$LENGTH(DIWI)

               SET DIWI=DIWI_$PIECE(X," ",1)

               SET X=$PIECE(X," ",2,999)

S          DO PUT

           DO NEW

           IF X]""

               GOTO B

           QUIT 

 +1       ;

U          SET I=^UTILITY($JOB,"W",DIWL)

           IF $DATA(DIWFU)

               SET ^(DIWL,I,"U",$LENGTH(DIWI)+1)=""

               KILL DIWFU

               GOTO N

 +1        SET ^(DIWL,I,"U",$LENGTH(DIWI)+1)=X

           SET DIWFU=1

           GOTO N

 +2       ;

NEW        DO DIWI

PRE        SET I=^UTILITY($JOB,"W",DIWL)

           SET ^(DIWL)=I+1

           SET ^(DIWL,I+1,0)=""

           IF DIWF["D"

               SET ^(0)=" "

               SET ^UTILITY($JOB,"W",DIWL)=I+2

               SET ^(DIWL,I+2,0)=""

 +1        IF $DATA(DIWFU)

               SET ^("U",1+$PIECE(DIWF,"I",2))="_"

 +2        IF DIWF'["R"!DIWTC

               GOTO P

           KILL %

           IF '$DATA(^UTILITY($JOB,"W",DIWL,I,0))

               QUIT 

 +3        SET Y=^(0)

           SET %=$LENGTH(Y)

           FOR %=%:-1

               IF $ASCII(Y,%)-32

                   QUIT 

 +4        SET Y=$EXTRACT(Y,1,%)

           SET J=DIWR-DIWL-%+1

           SET %X=0

           IF J<1

               GOTO P

 +5        FOR %=1:1

               SET %(%)=$PIECE(Y," ",1)

               SET Y=$PIECE(Y," ",2,999)

               IF Y=""

                   IF %-1

                       GOTO PAD

                   GOTO P

               IF $EXTRACT(%(%),$LENGTH(%(%)))?.P

                   IF %=1&(%(%)="")

                       SET %=0

                       SET %X=%X+1

                   IF %&J

                       SET J=J-1

                       SET %(%)=%(%)_" "

PAD        IF J

               FOR Y=%\2+1:1:%-1,%\2:-1

                   SET %(Y)=%(Y)_" "

                   SET J=J-1

                   IF Y=1!'J

                       GOTO PAD

 +1        SET Y=%(%)

           FOR %=%-1:-1:1

               SET Y=%(%)_" "_Y

 +2        SET ^(0)=$JUSTIFY("",%X)_Y

           KILL %

P          IF DIWF["W"

               GOTO NX^DIWW