DIFGGU ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FUNCTIONS ; [ 11/10/92 10:38 AM ]
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
; Required variables:
;
; DILC
; DITAB
; DIFG("PARM")
; DIFG("FGR")
; DILL
; DIFG(DILL,"FILE")
; DIFG(DILL,"FNAME")
; DIFG(DILL,"FE")
; DIFG(DILL,"FGBL")
; DIFG(DILL,"FUNC")
;
Q ; INVALID ENTRY POINT
;
LOOKUP ; EXTERNAL ENTRY POINT
; LOOKUP ENTRY IN FILE/SUBFILE
D SETX
Q:$D(DIFGGUQ)
S Z=""
I '$D(^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) D SETLINK
I $D(^DD(DIFG(DILL,"FILE"),0,"UP")) S A=^("UP"),B=$O(^DD(A,"SB",DIFG(DILL,"FILE"),0)),C=$P(^DD(A,B,0),U,1),V=C_U_$S(DIFG("PARM")["N":B,1:"") K A,B,C
E S V=DIFG(DILL,"FNAME")_U_$S(DIFG("PARM")["N":DIFG(DILL,"FILE"),1:"")
S V=V_$S($D(DIFG(DILL,"NAV")):":",1:"")_U_DIFG(DILL,"FUNC")_"="_X
I $D(DIFG(DILL,"NAV")),DIFG(DILL,"NAV")=1,$G(DIFG(DILL,"XREF"))?1A.E S V=V_U_DIFG(DILL,"XREF")_"=@"_^UTILITY("DIFGLINK",$J,DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"))
D INCSET
D:Z'="" SPBLK
K S,V,X,Z
Q
;
SETLINK ;
S ^UTILITY("DIFGLINK",$J)=$S($D(^UTILITY("DIFGLINK",$J))#2:^UTILITY("DIFGLINK",$J)+1,1:1),^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))=^UTILITY("DIFGLINK",$J)
S Z="@"_^UTILITY("DIFGLINK",$J)
Q
;
SETX ; SET X TO @LINK OR LOOKUP VALUE
S X=""
D SETX2
Q:$D(DIFGGUQ)
Q:X'=""
I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)) S X=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01) Q
K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
I '$D(DIFG(DILL,"MUL")) S DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE"),DR=".01"
S DIQ(0)="N" D EN^DIQ1 K DIQ
S X=^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)
K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
Q
;
SETX2 ; IF POINTER AND ALREADY LOOKED UP SET @LINK
K DIFGGUQ
I $D(^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) S X="@"_^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))_"E"
Q:$P(^DD(DIFG(DILL,"FILE"),.01,0),U,2)'["P"
S X=+$P($P(^DD(DIFG(DILL,"FILE"),.01,0),U,2),"P",2)
I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P")) S Y=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P") I 1
E S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)"),U,1)
NEW G
S G="^"_$P(^DD(DIFG(DILL,"FILE"),.01,0),U,3)
I '$D(@(G_Y_",0)")) S DIFGGUQ=1 Q
S X=$S($D(^UTILITY("DIFGLINK",$J,X,Y)):"@"_^UTILITY("DIFGLINK",$J,X,Y),1:"")
K Y
Q
;
SPBLK ; SPECIAL BLOCK
S DITAB=DITAB+2
D ^DIFGGSB
S DITAB=DITAB-2
Q
;
INCSET ; EXTERNAL ENTRY POINT
; INCREMENT LINE COUNT AND SET LINE
S DILC=DILC+1
S S=""
I '$D(DIFG("WP")) S:DITAB $P(S," ",DITAB)=" "
S @(DIFG("FGR")_DILC_",0)")=S_V
Q
;
KILLLL ; EXTERNAL ENTRY POINT
; KILL LAST LINE, DECREMENT LINE COUNT, KILL LAST LINK, DECREMENT LINK COUNT
D KILLDEC,DELLINK
Q
;
KILLDEC ; EXTERNAL ENTRY POINT
; KILL LAST LINE AND DECREMENT LINE COUNT
K @(DIFG("FGR")_DILC_",0)")
S DILC=DILC-1
Q
;
DELLINK ; EXTERNAL ENTRY POINT
; DELETE LAST @LINK AND DECREMENT LINK COUNTER
K ^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))
S ^UTILITY("DIFGLINK",$J)=^UTILITY("DIFGLINK",$J)-1
Q
DIFGGU ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FUNCTIONS ; [ 11/10/92 10:38 AM ]
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ; Required variables:
+4 ;
+5 ; DILC
+6 ; DITAB
+7 ; DIFG("PARM")
+8 ; DIFG("FGR")
+9 ; DILL
+10 ; DIFG(DILL,"FILE")
+11 ; DIFG(DILL,"FNAME")
+12 ; DIFG(DILL,"FE")
+13 ; DIFG(DILL,"FGBL")
+14 ; DIFG(DILL,"FUNC")
+15 ;
+16 ; INVALID ENTRY POINT
QUIT
+17 ;
LOOKUP ; EXTERNAL ENTRY POINT
+1 ; LOOKUP ENTRY IN FILE/SUBFILE
+2 DO SETX
+3 IF $DATA(DIFGGUQ)
QUIT
+4 SET Z=""
+5 IF '$DATA(^UTILITY("DIFGLINK",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE")))
DO SETLINK
+6 IF $DATA(^DD(DIFG(DILL,"FILE"),0,"UP"))
SET A=^("UP")
SET B=$ORDER(^DD(A,"SB",DIFG(DILL,"FILE"),0))
SET C=$PIECE(^DD(A,B,0),U,1)
SET V=C_U_$SELECT(DIFG("PARM")["N":B,1:"")
KILL A,B,C
+7 IF '$TEST
SET V=DIFG(DILL,"FNAME")_U_$SELECT(DIFG("PARM")["N":DIFG(DILL,"FILE"),1:"")
+8 SET V=V_$SELECT($DATA(DIFG(DILL,"NAV")):":",1:"")_U_DIFG(DILL,"FUNC")_"="_X
+9 IF $DATA(DIFG(DILL,"NAV"))
IF DIFG(DILL,"NAV")=1
IF $GET(DIFG(DILL,"XREF"))?1A.E
SET V=V_U_DIFG(DILL,"XREF")_"=@"_^UTILITY("DIFGLINK",$JOB,DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"))
+10 DO INCSET
+11 IF Z'=""
DO SPBLK
+12 KILL S,V,X,Z
+13 QUIT
+14 ;
SETLINK ;
+1 SET ^UTILITY("DIFGLINK",$JOB)=$SELECT($DATA(^UTILITY("DIFGLINK",$JOB))#2:^UTILITY("DIFGLINK",$JOB)+1,1:1)
SET ^UTILITY("DIFGLINK",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))=^UTILITY("DIFGLINK",$JOB)
+2 SET Z="@"_^UTILITY("DIFGLINK",$JOB)
+3 QUIT
+4 ;
SETX ; SET X TO @LINK OR LOOKUP VALUE
+1 SET X=""
+2 DO SETX2
+3 IF $DATA(DIFGGUQ)
QUIT
+4 IF X'=""
QUIT
+5 IF $DATA(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01))
SET X=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)
QUIT
+6 KILL ^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"))
+7 IF '$DATA(DIFG(DILL,"MUL"))
SET DIC=DIFG(DILL,"FILE")
SET DA=DIFG(DILL,"FE")
SET DR=".01"
+8 SET DIQ(0)="N"
DO EN^DIQ1
KILL DIQ
+9 SET X=^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)
+10 KILL ^UTILITY("DIQ1",$JOB,DIFG(DILL,"FILE"))
+11 IF '$DATA(DIFG(DILL,"MUL"))
KILL DA,DIC,DR
+12 QUIT
+13 ;
SETX2 ; IF POINTER AND ALREADY LOOKED UP SET @LINK
+1 KILL DIFGGUQ
+2 IF $DATA(^UTILITY("DIFGLINK",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE")))
SET X="@"_^UTILITY("DIFGLINK",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))_"E"
+3 IF $PIECE(^DD(DIFG(DILL,"FILE"),.01,0),U,2)'["P"
QUIT
+4 SET X=+$PIECE($PIECE(^DD(DIFG(DILL,"FILE"),.01,0),U,2),"P",2)
+5 IF $DATA(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P"))
SET Y=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P")
IF 1
+6 IF '$TEST
SET Y=$PIECE(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)"),U,1)
+7 NEW G
+8 SET G="^"_$PIECE(^DD(DIFG(DILL,"FILE"),.01,0),U,3)
+9 IF '$DATA(@(G_Y_",0)"))
SET DIFGGUQ=1
QUIT
+10 SET X=$SELECT($DATA(^UTILITY("DIFGLINK",$JOB,X,Y)):"@"_^UTILITY("DIFGLINK",$JOB,X,Y),1:"")
+11 KILL Y
+12 QUIT
+13 ;
SPBLK ; SPECIAL BLOCK
+1 SET DITAB=DITAB+2
+2 DO ^DIFGGSB
+3 SET DITAB=DITAB-2
+4 QUIT
+5 ;
INCSET ; EXTERNAL ENTRY POINT
+1 ; INCREMENT LINE COUNT AND SET LINE
+2 SET DILC=DILC+1
+3 SET S=""
+4 IF '$DATA(DIFG("WP"))
IF DITAB
SET $PIECE(S," ",DITAB)=" "
+5 SET @(DIFG("FGR")_DILC_",0)")=S_V
+6 QUIT
+7 ;
KILLLL ; EXTERNAL ENTRY POINT
+1 ; KILL LAST LINE, DECREMENT LINE COUNT, KILL LAST LINK, DECREMENT LINK COUNT
+2 DO KILLDEC
DO DELLINK
+3 QUIT
+4 ;
KILLDEC ; EXTERNAL ENTRY POINT
+1 ; KILL LAST LINE AND DECREMENT LINE COUNT
+2 KILL @(DIFG("FGR")_DILC_",0)")
+3 SET DILC=DILC-1
+4 QUIT
+5 ;
DELLINK ; EXTERNAL ENTRY POINT
+1 ; DELETE LAST @LINK AND DECREMENT LINK COUNTER
+2 KILL ^UTILITY("DIFGLINK",$JOB,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))
+3 SET ^UTILITY("DIFGLINK",$JOB)=^UTILITY("DIFGLINK",$JOB)-1
+4 QUIT
