DIFGG2 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FIELDS ;2/4/93 10:59 AM
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
START K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
D DRS
K S,V,X,DIFG2
Q
;
DRS S DR=""
I $P(^DIPT(DIFGT,1,DIFGI,0),U,8) F DIFG2=.001:0 S DIFG2=$O(^DD(DIFG(DILL,"FILE"),DIFG2)) Q:DIFG2'>0 S %=$P(^(DIFG2,0),U,2) I $S('%:%'["C",1:$P(^DD(+%,.01,0),U,2)["W") S DR=DR_DIFG2_";" I $L(DR)>200 D DR S DR=""
F DIFG2=0:0 S DIFG2=$O(^DIPT(DIFGT,1,DIFGI,"F",DIFG2)) Q:DIFG2'=+DIFG2 I $D(^(DIFG2,0)) S DR=DR_^(0)_";" I $L(DR)>200 D DR S DR=""
D DR:DR]"" Q
;
EN ;
DR I '$D(DIFG(DILL,"MUL")) S DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE")
S DIQ(0)="N" D EN^DIQ1 K DIQ
I $D(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) F DIFG2(DILL,"FLD")=0:0 S DIFG2(DILL,"FLD")=$O(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))) Q:'DIFG2(DILL,"FLD") D
. NEW VAL
. S VAL=DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))
. S ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))=$S(VAL]"":VAL,1:"^")
. Q
F DIFG2(DILL,"FLD")=0:0 D DR2 Q:DIFG2(DILL,"FLD")'=+DIFG2(DILL,"FLD") S V=^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD")) D FIELD
I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE")),DIFGGF(DIFG(DILL,"FILE"))
Q
;
DR2 S DIFG2(DILL,"FLD")=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))) Q:DIFG2(DILL,"FLD")=""
I $O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),0)) S V("WP")=0,^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))="wp"
Q
;
EN2 ;
FIELD Q:V=""
D SETXY
K F,N,P,W
S V=$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,1)_U_$S(DIFG("PARM")["N":DIFG2(DILL,"FLD"),1:"")_"="_X
D INCSET^DIFGGU
D:Y'="" PTRCHK
D:$D(V)>9 WP
K X,Y,V
Q
;
WP NEW I
S DITAB=DITAB+2
S DIFG("WP")=""
F I=0:0 S I=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),I)) Q:I="" S V=""""_^(I)_"""" D INCSET^DIFGGU
S V="." D INCSET^DIFGGU
K DIFG("WP")
S DITAB=DITAB-2
Q
;
SETXY S X=V
S Y=""
Q:$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
S F=+$P($P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2),"P",2),W=$P(^(0),U,4),N=$P(W,";",1),P=$P(W,";",2)
S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",N)"),U,P)
I $D(^UTILITY("DIFGLINK",$J,F,Y)) S X="@"_^UTILITY("DIFGLINK",$J,F,Y),Y="" Q
S ^UTILITY("DIFGLINK",$J)=$S($D(^UTILITY("DIFGLINK",$J))#2:^UTILITY("DIFGLINK",$J)+1,1:1)
S ^UTILITY("DIFGLINK",$J,F,Y)=^UTILITY("DIFGLINK",$J)
S Y="@"_^UTILITY("DIFGLINK",$J)
Q
;
PTRCHK Q:$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
S DITAB=DITAB+2
S DILL=DILL+1
D POINTER
S DITAB=DITAB-2
K DIFG(DILL)
S DILL=DILL-1
Q
;
POINTER S DIFG(DILL,"FILE")=+$P($P(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2),"P",2),X=$P(^(0),U,4) S:$P(X,";")'=+X X=""""_$P(X,";")_""";"_$P(X,";",2)
S DIFG(DILL,"FE")=$P(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_$P(X,";",1)_")"),U,$P(X,";",2))
I '$D(^DIC(DIFG(DILL,"FILE"),0)) D KILLLL^DIFGGU Q
S DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL")
I '$D(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)")) D KILLLL^DIFGGU Q
S DIFG(DILL,"FNAME")=$P(^DIC(DIFG(DILL,"FILE"),0),U,1)
I $D(Y),Y'="" S Z=Y,Y=""
I $D(DIFGENV("LAYGO",DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD")))!($P(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2)'["'") S DIFG(DILL,"NOKEY")=""
D ^DIFGGSB
Q
DIFGG2 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FIELDS ;2/4/93 10:59 AM
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
START KILL ^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"))
+1 DO DRS
+2 KILL S,V,X,DIFG2
+3 QUIT
+4 ;
DRS SET DR=""
+1 IF $PIECE(^DIPT(DIFGT,1,DIFGI,0),U,8)
FOR DIFG2=.001:0
SET DIFG2=$ORDER(^DD(DIFG(DILL,"FILE"),DIFG2))
IF DIFG2'>0
QUIT
SET %=$PIECE(^(DIFG2,0),U,2)
IF $SELECT('%:%'["C",1:$PIECE(^DD(+%,.01,0),U,2)["W")
SET DR=DR_DIFG2_";"
IF $LENGTH(DR)>200
DO DR
SET DR=""
+2 FOR DIFG2=0:0
SET DIFG2=$ORDER(^DIPT(DIFGT,1,DIFGI,"F",DIFG2))
IF DIFG2'=+DIFG2
QUIT
IF $DATA(^(DIFG2,0))
SET DR=DR_^(0)_";"
IF $LENGTH(DR)>200
DO DR
SET DR=""
+3 IF DR]""
DO DR
QUIT
+4 ;
EN ;
DR IF '$DATA(DIFG(DILL,"MUL"))
SET DIC=DIFG(DILL,"FILE")
SET DA=DIFG(DILL,"FE")
+1 SET DIQ(0)="N"
DO EN^DIQ1
KILL DIQ
+2 IF $DATA(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE")))
FOR DIFG2(DILL,"FLD")=0:0
SET DIFG2(DILL,"FLD")=$ORDER(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD")))
IF 'DIFG2(DILL,"FLD")
QUIT
Begin DoDot:1
+3 NEW VAL
+4 SET VAL=DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))
+5 SET ^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))=$SELECT(VAL]"":VAL,1:"^")
+6 QUIT
End DoDot:1
+7 FOR DIFG2(DILL,"FLD")=0:0
DO DR2
IF DIFG2(DILL,"FLD")'=+DIFG2(DILL,"FLD")
QUIT
SET V=^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))
DO FIELD
+8 IF '$DATA(DIFG(DILL,"MUL"))
KILL DA,DIC,DR
+9 KILL ^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE")),DIFGGF(DIFG(DILL,"FILE"))
+10 QUIT
+11 ;
DR2 SET DIFG2(DILL,"FLD")=$ORDER(^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD")))
IF DIFG2(DILL,"FLD")=""
QUIT
+1 IF $ORDER(^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),0))
SET V("WP")=0
SET ^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))="wp"
+2 QUIT
+3 ;
EN2 ;
FIELD IF V=""
QUIT
+1 DO SETXY
+2 KILL F,N,P,W
+3 SET V=$PIECE(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,1)_U_$SELECT(DIFG("PARM")["N":DIFG2(DILL,"FLD"),1:"")_"="_X
+4 DO INCSET^DIFGGU
+5 IF Y'=""
DO PTRCHK
+6 IF $DATA(V)>9
DO WP
+7 KILL X,Y,V
+8 QUIT
+9 ;
WP NEW I
+1 SET DITAB=DITAB+2
+2 SET DIFG("WP")=""
+3 FOR I=0:0
SET I=$ORDER(^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),I))
IF I=""
QUIT
SET V=""""_^(I)_""""
DO INCSET^DIFGGU
+4 SET V="."
DO INCSET^DIFGGU
+5 KILL DIFG("WP")
+6 SET DITAB=DITAB-2
+7 QUIT
+8 ;
SETXY SET X=V
+1 SET Y=""
+2 IF $PIECE(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
QUIT
+3 SET F=+$PIECE($PIECE(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2),"P",2)
SET W=$PIECE(^(0),U,4)
SET N=$PIECE(W,";",1)
SET P=$PIECE(W,";",2)
+4 SET Y=$PIECE(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",N)"),U,P)
+5 IF $DATA(^UTILITY("DIFGLINK",$JOB,F,Y))
SET X="@"_^UTILITY("DIFGLINK",$JOB,F,Y)
SET Y=""
QUIT
+6 SET ^UTILITY("DIFGLINK",$JOB)=$SELECT($DATA(^UTILITY("DIFGLINK",$JOB))#2:^UTILITY("DIFGLINK",$JOB)+1,1:1)
+7 SET ^UTILITY("DIFGLINK",$JOB,F,Y)=^UTILITY("DIFGLINK",$JOB)
+8 SET Y="@"_^UTILITY("DIFGLINK",$JOB)
+9 QUIT
+10 ;
PTRCHK IF $PIECE(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
QUIT
+1 SET DITAB=DITAB+2
+2 SET DILL=DILL+1
+3 DO POINTER
+4 SET DITAB=DITAB-2
+5 KILL DIFG(DILL)
+6 SET DILL=DILL-1
+7 QUIT
+8 ;
POINTER SET DIFG(DILL,"FILE")=+$PIECE($PIECE(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2),"P",2)
SET X=$PIECE(^(0),U,4)
IF $PIECE(X,";")'=+X
SET X=""""_$PIECE(X,";")_""";"_$PIECE(X,";",2)
+1 SET DIFG(DILL,"FE")=$PIECE(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_$PIECE(X,";",1)_")"),U,$PIECE(X,";",2))
+2 IF '$DATA(^DIC(DIFG(DILL,"FILE"),0))
DO KILLLL^DIFGGU
QUIT
+3 SET DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL")
+4 IF '$DATA(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)"))
DO KILLLL^DIFGGU
QUIT
+5 SET DIFG(DILL,"FNAME")=$PIECE(^DIC(DIFG(DILL,"FILE"),0),U,1)
+6 IF $DATA(Y)
IF Y'=""
SET Z=Y
SET Y=""
+7 IF $DATA(DIFGENV("LAYGO",DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD")))!($PIECE(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2)'["'")
SET DIFG(DILL,"NOKEY")=""
+8 DO ^DIFGGSB
+9 QUIT
