DIL11 ;SFISC/GFT-TURN PRINT FLDS INTO CODE ;5APR2007
;;22.0;VA FileMan;**152**;Mar 30, 1999;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
DOWN ;
I W>0,'$D(^DD(DP,+W,0)) Q ;IN CASE FIELD IS GONE FOR SOME REASON!
S DN=-6,DY(DM)=DY,DP(DM)=DP,DI(DM)=DI G F:W'>0 S X=^DD(DP,+W,0),DU=$P($P(X,U,4),";") S:+DU'=DU DU=""""_DU_""""
S W=$P(W,","),DY="D"_(DIL-DIL0+1),DI=DI_","_DU_","_DY,%=":0 Q:$O("_DI_"))'>0 ",DP=+$P(X,U,2),M(DP)=1,D=$P("""""",U,+DU'=DU),D=" S I("_(DIL+1)_")="_D_DU_D_",J("_(DIL+1)_")="_DP,Y=" S "_DY_"=$O(^("_DY_"))"
W I $P(^DD(DP,.01,0),U,2)["W" D:$P(^(0),U,2)["x"!($P(^(0),U,2)["X") G P ;**DI*22*152**
.S D=D_",D"_(DIL+1)_"=$G(DIWF) N DIWF S DIWF=D"_(DIL+1)_"_""X"""
I DHT+1 F X=1:1 G P:X>DPP,DPP:+DPP(X)=DP!$D(DPP(X,DP))
DPP S %=%_" X:$D(DSC("_DP_")) DSC("_DP_")",Y=Y_" Q:"_DY_"'>0" I $T,"@"[$P(DPP(X),U,4),$P(DPP(X),U,2)=0 S DPP(X,U)="" G R:$D(DPP(X,"F"))
S Y=Y_" "
P S Y=D_" F "_DY_"=0"_%_Y_$S($D(DIARP(DP)):" X DIARP("_DP_") I $T",1:"")
G S
R S V=$P(DPP(X,"T"),U),Y=D_" F "_DY_"="_$P(DPP(X,"F"),U)_%_Y_$S(V:"!("_DY_">"_V_") ",1:" ")
S S:($G(DDXP)'=4) %=" D:$X>"_DG,Y=Y_%_$S($D(DIWR):" NX^DIWW",1:" T Q:'DN ") I DHT>0 S ^UTILITY($J,DV)="I "_DY_"'>0 S "_DY_"=0 "_$P(Y," ",2,9),DV=DV+1
G D^DIL
;
F ;
S DP=-W,X=$P(W,U,2),DD=DD+1,M(DP)=1,DIL(DM)=DIL,DIL(DM,0)=DIL0,Y=0,DIL0=DIL0+100,%=X["(" I % S (X,DI)=U_X,DIL=DIL0
E S DI=DI(DM)_","""_X_""",",DIL=DIL+101
QT S Y=$F(X,"""",Y) I Y S X=$E(X,1,Y-1)_$E(X,Y-1,999),Y=Y+1 G QT
S Y=" S I("_DIL_")="""_X_""",J("_DIL_")="_DP
S X=" "_$P($P(W,U,4,99),";")
S DY="D"_(DIL-DIL0),DI=DI_DY,DIL=DIL-1 I $P(W,U,3)="" S W=+W,Y=Y_X_" S D0=D(0) I D0>0" G D^DIL
S %="I("_(DIL0-100)_",0)=D0" I X'[% S X=","_%_X
I DHT=-1 D DREL^DIPZ1 G END
F %=900:1 I '$D(^UTILITY($J,99,%)) S ^(%)="I 1 X:$D(DSC("_DP_")) DSC("_DP_") I D T:$X>"_DG_" Q:'DN "_Y,Y=" S (DIXX,DIXX("_(DM+1)_"))="_%_X,W=+W D D^DIL K R(DX) Q
END S (F(DM-1),DX)=%,R(%)=DP(DM-1),R(%,1)=M(DP(DM-1))
Q
DIL11 ;SFISC/GFT-TURN PRINT FLDS INTO CODE ;5APR2007
+1 ;;22.0;VA FileMan;**152**;Mar 30, 1999;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
DOWN ;
+1 ;IN CASE FIELD IS GONE FOR SOME REASON!
IF W>0
IF '$DATA(^DD(DP,+W,0))
QUIT
+2 SET DN=-6
SET DY(DM)=DY
SET DP(DM)=DP
SET DI(DM)=DI
IF W'>0
GOTO F
SET X=^DD(DP,+W,0)
SET DU=$PIECE($PIECE(X,U,4),";")
IF +DU'=DU
SET DU=""""_DU_""""
+3 SET W=$PIECE(W,",")
SET DY="D"_(DIL-DIL0+1)
SET DI=DI_","_DU_","_DY
SET %=":0 Q:$O("_DI_"))'>0 "
SET DP=+$PIECE(X,U,2)
SET M(DP)=1
SET D=$PIECE("""""",U,+DU'=DU)
SET D=" S I("_(DIL+1)_")="_D_DU_D_",J("_(DIL+1)_")="_DP
SET Y=" S "_DY_"=$O(^("_DY_"))"
W ;**DI*22*152**
IF $PIECE(^DD(DP,.01,0),U,2)["W"
IF $PIECE(^(0),U,2)["x"!($PIECE(^(0),U,2)["X")
Begin DoDot:1
+1 SET D=D_",D"_(DIL+1)_"=$G(DIWF) N DIWF S DIWF=D"_(DIL+1)_"_""X"""
End DoDot:1
GOTO P
+2 IF DHT+1
FOR X=1:1
IF X>DPP
GOTO P
IF +DPP(X)=DP!$DATA(DPP(X,DP))
GOTO DPP
DPP SET %=%_" X:$D(DSC("_DP_")) DSC("_DP_")"
SET Y=Y_" Q:"_DY_"'>0"
IF $TEST
IF "@"[$PIECE(DPP(X),U,4)
IF $PIECE(DPP(X),U,2)=0
SET DPP(X,U)=""
IF $DATA(DPP(X,"F"))
GOTO R
+1 SET Y=Y_" "
P SET Y=D_" F "_DY_"=0"_%_Y_$SELECT($DATA(DIARP(DP)):" X DIARP("_DP_") I $T",1:"")
+1 GOTO S
R SET V=$PIECE(DPP(X,"T"),U)
SET Y=D_" F "_DY_"="_$PIECE(DPP(X,"F"),U)_%_Y_$SELECT(V:"!("_DY_">"_V_") ",1:" ")
S IF ($GET(DDXP)'=4)
SET %=" D:$X>"_DG
SET Y=Y_%_$SELECT($DATA(DIWR):" NX^DIWW",1:" T Q:'DN ")
IF DHT>0
SET ^UTILITY($JOB,DV)="I "_DY_"'>0 S "_DY_"=0 "_$PIECE(Y," ",2,9)
SET DV=DV+1
+1 GOTO D^DIL
+2 ;
F ;
+1 SET DP=-W
SET X=$PIECE(W,U,2)
SET DD=DD+1
SET M(DP)=1
SET DIL(DM)=DIL
SET DIL(DM,0)=DIL0
SET Y=0
SET DIL0=DIL0+100
SET %=X["("
IF %
SET (X,DI)=U_X
SET DIL=DIL0
+2 IF '$TEST
SET DI=DI(DM)_","""_X_""","
SET DIL=DIL+101
QT SET Y=$FIND(X,"""",Y)
IF Y
SET X=$EXTRACT(X,1,Y-1)_$EXTRACT(X,Y-1,999)
SET Y=Y+1
GOTO QT
+1 SET Y=" S I("_DIL_")="""_X_""",J("_DIL_")="_DP
+2 SET X=" "_$PIECE($PIECE(W,U,4,99),";")
+3 SET DY="D"_(DIL-DIL0)
SET DI=DI_DY
SET DIL=DIL-1
IF $PIECE(W,U,3)=""
SET W=+W
SET Y=Y_X_" S D0=D(0) I D0>0"
GOTO D^DIL
+4 SET %="I("_(DIL0-100)_",0)=D0"
IF X'[%
SET X=","_%_X
+5 IF DHT=-1
DO DREL^DIPZ1
GOTO END
+6 FOR %=900:1
IF '$DATA(^UTILITY($JOB,99,%))
SET ^(%)="I 1 X:$D(DSC("_DP_")) DSC("_DP_") I D T:$X>"_DG_" Q:'DN "_Y
SET Y=" S (DIXX,DIXX("_(DM+1)_"))="_%_X
SET W=+W
DO D^DIL
KILL R(DX)
QUIT
END SET (F(DM-1),DX)=%
SET R(%)=DP(DM-1)
SET R(%,1)=M(DP(DM-1))
+1 QUIT
