- 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
