DIFGGU ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FUNCTIONS ;11/10/92 10:38 AM
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
; 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFGGU 3426 printed Dec 13, 2024@02:47:54 Page 2
DIFGGU ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FUNCTIONS ;11/10/92 10:38 AM
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ; Required variables:
+8 ;
+9 ; DILC
+10 ; DITAB
+11 ; DIFG("PARM")
+12 ; DIFG("FGR")
+13 ; DILL
+14 ; DIFG(DILL,"FILE")
+15 ; DIFG(DILL,"FNAME")
+16 ; DIFG(DILL,"FE")
+17 ; DIFG(DILL,"FGBL")
+18 ; DIFG(DILL,"FUNC")
+19 ;
+20 ; INVALID ENTRY POINT
QUIT
+21 ;
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
