Return to DIFGGU.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGGU.m, revision 1.1.1.1

1.1       snw         1: DIFGGU ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FUNCTIONS  ; [ 11/10/92  10:38 AM ]
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        ; Required variables:
                      5:        ;
                      6:        ;   DILC
                      7:        ;   DITAB
                      8:        ;   DIFG("PARM")
                      9:        ;   DIFG("FGR")
                     10:        ;   DILL
                     11:        ;   DIFG(DILL,"FILE")
                     12:        ;   DIFG(DILL,"FNAME")
                     13:        ;   DIFG(DILL,"FE")
                     14:        ;   DIFG(DILL,"FGBL")
                     15:        ;   DIFG(DILL,"FUNC")
                     16:        ;
                     17:        Q  ; INVALID ENTRY POINT
                     18:        ;
                     19: LOOKUP ; EXTERNAL ENTRY POINT
                     20:        ; LOOKUP ENTRY IN FILE/SUBFILE
                     21:        D SETX
                     22:        Q:$D(DIFGGUQ)
                     23:        S Z=""
                     24:        I '$D(^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) D SETLINK
                     25:        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
                     26:        E  S V=DIFG(DILL,"FNAME")_U_$S(DIFG("PARM")["N":DIFG(DILL,"FILE"),1:"")
                     27:        S V=V_$S($D(DIFG(DILL,"NAV")):":",1:"")_U_DIFG(DILL,"FUNC")_"="_X
                     28:        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"))
                     29:        D INCSET
                     30:        D:Z'="" SPBLK
                     31:        K S,V,X,Z
                     32:        Q
                     33:        ;
                     34: SETLINK        ;
                     35:        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)
                     36:        S Z="@"_^UTILITY("DIFGLINK",$J)
                     37:        Q
                     38:        ;
                     39: SETX   ; SET X TO @LINK OR LOOKUP VALUE
                     40:        S X=""
                     41:        D SETX2
                     42:        Q:$D(DIFGGUQ)
                     43:        Q:X'=""
                     44:        I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)) S X=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01) Q
                     45:        K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
                     46:        I '$D(DIFG(DILL,"MUL")) S DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE"),DR=".01"
                     47:        S DIQ(0)="N" D EN^DIQ1 K DIQ
                     48:        S X=^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)
                     49:        K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
                     50:        I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
                     51:        Q
                     52:        ;
                     53: SETX2  ; IF POINTER AND ALREADY LOOKED UP SET @LINK
                     54:        K DIFGGUQ
                     55:        I $D(^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) S X="@"_^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))_"E"
                     56:        Q:$P(^DD(DIFG(DILL,"FILE"),.01,0),U,2)'["P"
                     57:        S X=+$P($P(^DD(DIFG(DILL,"FILE"),.01,0),U,2),"P",2)
                     58:        I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P")) S Y=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P") I 1
                     59:        E  S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)"),U,1)
                     60:        NEW G
                     61:        S G="^"_$P(^DD(DIFG(DILL,"FILE"),.01,0),U,3)
                     62:        I '$D(@(G_Y_",0)")) S DIFGGUQ=1 Q
                     63:        S X=$S($D(^UTILITY("DIFGLINK",$J,X,Y)):"@"_^UTILITY("DIFGLINK",$J,X,Y),1:"")
                     64:        K Y
                     65:        Q
                     66:        ;
                     67: SPBLK  ; SPECIAL BLOCK
                     68:        S DITAB=DITAB+2
                     69:        D ^DIFGGSB
                     70:        S DITAB=DITAB-2
                     71:        Q
                     72:        ;
                     73: INCSET ; EXTERNAL ENTRY POINT
                     74:        ; INCREMENT LINE COUNT AND SET LINE
                     75:        S DILC=DILC+1
                     76:        S S=""
                     77:        I '$D(DIFG("WP")) S:DITAB $P(S," ",DITAB)=" "
                     78:        S @(DIFG("FGR")_DILC_",0)")=S_V
                     79:        Q
                     80:        ;
                     81: KILLLL ; EXTERNAL ENTRY POINT
                     82:        ; KILL LAST LINE, DECREMENT LINE COUNT, KILL LAST LINK, DECREMENT LINK COUNT
                     83:        D KILLDEC,DELLINK
                     84:        Q
                     85:        ;
                     86: KILLDEC        ; EXTERNAL ENTRY POINT
                     87:        ; KILL LAST LINE AND DECREMENT LINE COUNT
                     88:        K @(DIFG("FGR")_DILC_",0)")
                     89:        S DILC=DILC-1
                     90:        Q
                     91:        ;
                     92: DELLINK        ; EXTERNAL ENTRY POINT
                     93:        ; DELETE LAST @LINK AND DECREMENT LINK COUNTER
                     94:        K ^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))
                     95:        S ^UTILITY("DIFGLINK",$J)=^UTILITY("DIFGLINK",$J)-1
                     96:        Q