DIFGGU.m

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