DIL0 ;SFISC/GFT-TURN PRINT FLDS INTO CODE ;01:16 PM 26 Apr 2002 [ 12/09/2003 4:09 PM ]
;;22.0;VA FileMan;**91,102,1002**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
D XDUY S %=$P(X,U,2) G WP:%["W",M:%["m",STATS^DIL1:$D(DCL(DP_U_+W)),N:W[";N"
I W[";W" D S D1=$S(%["C":Y,1:$P(" S Y=",U,Y'?1" ".E)_Y_" S X=Y") D W S Y=Y_D1_" D ^DIWP" Q
.N %,DNP S DNP=1 D ^DILL
D ^DILL
DN ;
I W[";X" D Q
.S DE=$S(W[";C"!(W[";S"):DE,$A(Y)-32:" W ?0",1:"")
.I $L(DE)+$L(Y)>250 D
..S %=Y,Y=DE,DE=% D PX^DIL S Y=DE
.E S Y=DE_Y
.I $D(DIWR(DM)) D DIWR
DNW D H:DHD I DG+DLN>IOM,DG K ^UTILITY("DIL",$J,DG) S DG='%*DM*2+2,DE=$P(W,";C",2),DG=$S(DE>0:DE-1,DE<0:IOM+DE,DG+DLN'>IOM!(W[";W"):DG,DLN>IOM:0,1:IOM-DLN),DE=" D T Q:'DN W ?"_DG D W^DIL,H:DHD
S DG=2+DLN+DG Q:$D(DNP) I $L(DE)+$L(Y)>250 S %=Y,Y=DE,DE=% D PX^DIL S Y=DE Q
S Y=DE_Y Q
;
H S V=$P(X,U),Z=99,I=$P(W,";""",2) I I]"" S V=$P(I,"""")
HEAD Q:V="" S I=$P(V," ") I $L(I)>DLN S DLN=$L(I)
XD S V=$P(V," ",2,99),D=$P(V," ") I D]"",$L(I)+$L(D)<DLN S I=I_" "_D G XD
S ^UTILITY("DIL",$J,DG,Z)=$J(I,DRJ*DLN),V(Z)="",Z=Z-1 G HEAD
;
XDUY ;
I '$D(^DD(DP,+W,0)) S X="",DU=0,Y=0 Q
S X=^(0),DU=$P(X,U,4),Y=$P(DU,";",2),DU=$P(DU,";") I W[";T",$D(^(.1)) S X=^(.1)_U_$P(X,U,2,99)
S:+DU'=DU DU=""""_DU_""""
I Y S Y="$P(X,U,"_Y_")" Q
I Y="" S Y="D"_DM Q
S Y=$E(Y,2,9) S:$P(Y,",",2)=+Y Y=+Y S Y="$E(X,"_Y_")" Q
;
WR ;
K DLN D W^DILL
W S DRJ=0,DIWL=DIWL+1 I '$D(DLN) S %=IOM-DG,DLN=$S(%>20:%,1:IOM)-2
S:W[";X" $P(X,U)="" D DNW S %=$P(DE,"W ?",2)+1,Y=DLN+%-1,DIO=2,%=" S DIWL="_%_",DIWR="_$S(IOM<Y:IOM,1:Y),Y=$P(DE," W ?")_% Q
;
WP S DN=%["L"_U D WR S DIO=3,Y=%_" D ^DIWP",X=F(DM-1) I DHT<0 G WP^DIPZ1
I $D(^UTILITY($J,99,X)) S I=^(X) D WPX S ^UTILITY($J,99,X)=I Q
WPX ;
S:DN I=^DD("FUNC",38,1)_" "_I
I DE[" D T,N" S %=$F(I," D N:$X>") S:% I=$E(I,1,%-9)_$E(I,$F(I,"T",%),999) S I=$E(DE,2,999)_" "_I
Q
;
M S D1=" S DICMX=""D "_$E("L",%'["w")_"^DIWP"" "_$P(X,U,5,99) D WR S Y=Y_D1 Q
;
N ;
S DCL=DCL+1,D=",C="_DCL_" D D",DITTO(DCL)="",I=""
I %["C" S X=X_" S Y=X"_D_" S X=Y",DXS="Y" G Z
S Y=" S Y="_Y_D,DXS="Y"
Z D V^DILL G DN
;
DIWR ;
G DIWR^DIPZ1:DHT I $D(DIWR(DM)),DX=DIWR(DM) S ^UTILITY($J,99,DX)="D A^DIWW" G K
I $D(DIWR(DM)) F DX=DX+1:1 I '$D(^UTILITY($J,99,DX)) S ^(DX)="D ^DIWW" D DX^DIL(DX) G K
D S ^(I)="D ^DIWW "_^UTILITY($J,99,I)
.F I=DM-1:-1:0 I $D(DIWR(I)) K DIWR(I) Q
.I I S I=F(I)
.E F I=1:1 Q:'$D(^UTILITY($J,99,I+1))
K K DIWR(DM) Q
DIL0 ;SFISC/GFT-TURN PRINT FLDS INTO CODE ;01:16 PM 26 Apr 2002 [ 12/09/2003 4:09 PM ]
+1 ;;22.0;VA FileMan;**91,102,1002**;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 DO XDUY
SET %=$PIECE(X,U,2)
IF %["W"
GOTO WP
IF %["m"
GOTO M
IF $DATA(DCL(DP_U_+W))
GOTO STATS^DIL1
IF W[";N"
GOTO N
+4 IF W[";W"
Begin DoDot:1
+5 NEW %,DNP
SET DNP=1
DO ^DILL
End DoDot:1
SET D1=$SELECT(%["C":Y,1:$PIECE(" S Y=",U,Y'?1" ".E)_Y_" S X=Y")
DO W
SET Y=Y_D1_" D ^DIWP"
QUIT
+6 DO ^DILL
DN ;
+1 IF W[";X"
Begin DoDot:1
+2 SET DE=$SELECT(W[";C"!(W[";S"):DE,$ASCII(Y)-32:" W ?0",1:"")
+3 IF $LENGTH(DE)+$LENGTH(Y)>250
Begin DoDot:2
+4 SET %=Y
SET Y=DE
SET DE=%
DO PX^DIL
SET Y=DE
End DoDot:2
+5 IF '$TEST
SET Y=DE_Y
+6 IF $DATA(DIWR(DM))
DO DIWR
End DoDot:1
QUIT
DNW IF DHD
DO H
IF DG+DLN>IOM
IF DG
KILL ^UTILITY("DIL",$JOB,DG)
SET DG='%*DM*2+2
SET DE=$PIECE(W,";C",2)
SET DG=$SELECT(DE>0:DE-1,DE<0:IOM+DE,DG+DLN'>IOM!(W[";W"):DG,DLN>IOM:0,1:IOM-DLN)
SET DE=" D T Q:'DN W ?"_DG
DO W^DIL
IF DHD
DO H
+1 SET DG=2+DLN+DG
IF $DATA(DNP)
QUIT
IF $LENGTH(DE)+$LENGTH(Y)>250
SET %=Y
SET Y=DE
SET DE=%
DO PX^DIL
SET Y=DE
QUIT
+2 SET Y=DE_Y
QUIT
+3 ;
H SET V=$PIECE(X,U)
SET Z=99
SET I=$PIECE(W,";""",2)
IF I]""
SET V=$PIECE(I,"""")
HEAD IF V=""
QUIT
SET I=$PIECE(V," ")
IF $LENGTH(I)>DLN
SET DLN=$LENGTH(I)
XD SET V=$PIECE(V," ",2,99)
SET D=$PIECE(V," ")
IF D]""
IF $LENGTH(I)+$LENGTH(D)<DLN
SET I=I_" "_D
GOTO XD
+1 SET ^UTILITY("DIL",$JOB,DG,Z)=$JUSTIFY(I,DRJ*DLN)
SET V(Z)=""
SET Z=Z-1
GOTO HEAD
+2 ;
XDUY ;
+1 IF '$DATA(^DD(DP,+W,0))
SET X=""
SET DU=0
SET Y=0
QUIT
+2 SET X=^(0)
SET DU=$PIECE(X,U,4)
SET Y=$PIECE(DU,";",2)
SET DU=$PIECE(DU,";")
IF W[";T"
IF $DATA(^(.1))
SET X=^(.1)_U_$PIECE(X,U,2,99)
+3 IF +DU'=DU
SET DU=""""_DU_""""
+4 IF Y
SET Y="$P(X,U,"_Y_")"
QUIT
+5 IF Y=""
SET Y="D"_DM
QUIT
+6 SET Y=$EXTRACT(Y,2,9)
IF $PIECE(Y,",",2)=+Y
SET Y=+Y
SET Y="$E(X,"_Y_")"
QUIT
+7 ;
WR ;
+1 KILL DLN
DO W^DILL
W SET DRJ=0
SET DIWL=DIWL+1
IF '$DATA(DLN)
SET %=IOM-DG
SET DLN=$SELECT(%>20:%,1:IOM)-2
+1 IF W[";X"
SET $PIECE(X,U)=""
DO DNW
SET %=$PIECE(DE,"W ?",2)+1
SET Y=DLN+%-1
SET DIO=2
SET %=" S DIWL="_%_",DIWR="_$SELECT(IOM<Y:IOM,1:Y)
SET Y=$PIECE(DE," W ?")_%
QUIT
+2 ;
WP SET DN=%["L"_U
DO WR
SET DIO=3
SET Y=%_" D ^DIWP"
SET X=F(DM-1)
IF DHT<0
GOTO WP^DIPZ1
+1 IF $DATA(^UTILITY($JOB,99,X))
SET I=^(X)
DO WPX
SET ^UTILITY($JOB,99,X)=I
QUIT
WPX ;
+1 IF DN
SET I=^DD("FUNC",38,1)_" "_I
+2 IF DE[" D T,N"
SET %=$FIND(I," D N:$X>")
IF %
SET I=$EXTRACT(I,1,%-9)_$EXTRACT(I,$FIND(I,"T",%),999)
SET I=$EXTRACT(DE,2,999)_" "_I
+3 QUIT
+4 ;
M SET D1=" S DICMX=""D "_$EXTRACT("L",%'["w")_"^DIWP"" "_$PIECE(X,U,5,99)
DO WR
SET Y=Y_D1
QUIT
+1 ;
N ;
+1 SET DCL=DCL+1
SET D=",C="_DCL_" D D"
SET DITTO(DCL)=""
SET I=""
+2 IF %["C"
SET X=X_" S Y=X"_D_" S X=Y"
SET DXS="Y"
GOTO Z
+3 SET Y=" S Y="_Y_D
SET DXS="Y"
Z DO V^DILL
GOTO DN
+1 ;
DIWR ;
+1 IF DHT
GOTO DIWR^DIPZ1
IF $DATA(DIWR(DM))
IF DX=DIWR(DM)
SET ^UTILITY($JOB,99,DX)="D A^DIWW"
GOTO K
+2 IF $DATA(DIWR(DM))
FOR DX=DX+1:1
IF '$DATA(^UTILITY($JOB,99,DX))
SET ^(DX)="D ^DIWW"
DO DX^DIL(DX)
GOTO K
+3 Begin DoDot:1
+4 FOR I=DM-1:-1:0
IF $DATA(DIWR(I))
KILL DIWR(I)
QUIT
+5 IF I
SET I=F(I)
+6 IF '$TEST
FOR I=1:1
IF '$DATA(^UTILITY($JOB,99,I+1))
QUIT
End DoDot:1
SET ^(I)="D ^DIWW "_^UTILITY($JOB,99,I)
K KILL DIWR(DM)
QUIT
