Annotation of freem_fileman/DIFGGU.m, revision 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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>