Return to DIFGGI.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGGI.m, revision 1.1

1.1     ! snw         1: DIFGGI ;SFISC/XAK,EDE(OHPRD)-FILEGRAM INITIALIZATION ;1/19/93  9:45 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ; DIFGER values: 1 = required variable not passed
        !             5:        ;                2 = variable form invalid
        !             6:        ;                3 = variable content invalid
        !             7:        ;
        !             8: INIT   ; INITIALIZATION
        !             9:        K ^UTILITY("DIFG",$J),^UTILITY("DIFGLINK",$J)
        !            10:        D SET1,REQ Q:DIFG("QFLG")
        !            11:        D OPT Q:DIFG("QFLG")
        !            12:        D FIRST
        !            13:        Q
        !            14:        ;
        !            15: SET1   ; MISC SETS # 1
        !            16:        S DIFGI=0,DILL=1 K DIFGER S U="^",DIFG("QFLG")=0
        !            17:        Q
        !            18:        ;
        !            19: REQ    ;
        !            20:        ;
        !            21: FE     I '$D(DIFG("FE")) S DIFG("QFLG")=1 Q
        !            22:        I DIFG("FE")'=+DIFG("FE") S DIFG("QFLG")=2 Q
        !            23: FUNC   I '$D(DIFG("FUNC")) S DIFG("QFLG")="1" Q
        !            24:        I DIFG("FUNC")="" S DIFG("QFLG")=2 Q
        !            25:        I "AMLD"'[DIFG("FUNC") S DIFG("QFLG")=3 Q
        !            26: FGT    I '$D(DIFGT) S DIFG("QFLG")=1 Q
        !            27:        I DIFGT'=+DIFGT S DIFG("QFLG")=2 Q
        !            28:        I '$D(^DIPT(DIFGT,0)) S DIFG("QFLG")=3 Q
        !            29:        Q
        !            30:        ;
        !            31: OPT    ;
        !            32:        ;
        !            33: FGR    I '$D(DIFG("FGR")) S DIFG("FGR")="^UTILITY(""DIFG"",$J,"
        !            34:        S X=DIFG("FGR")
        !            35:        I "(,"'[$E(X,$L(X)) S DIFG("QFLG")=2 Q
        !            36:        I $P(X,"(")["DIFG" S DIFG("QFLG")=3 Q
        !            37: LC     I $D(DILC),DILC'=+DILC S DIFG("QFLG")=2 Q
        !            38:        S:'$D(DILC) DILC=0
        !            39: PARM   S:'$D(DIFG("PARM")) DIFG("PARM")="N"
        !            40: TAB    I $D(DITAB),DITAB'=+DITAB S DIFG("QFLG")=2 Q
        !            41:        S:'$D(DITAB) DITAB=0
        !            42: FUNCSFT        I $D(DIFG("FUNC SFT")) F X=0:0 S X=$O(DIFG("FUNC SFT",X)) Q:X'=+X  D FUNCSFT2 Q:DIFG("QFLG")
        !            43:        Q
        !            44:        ;
        !            45: FUNCSFT2       S Y=DIFG("FUNC SFT",X)
        !            46:        I Y="" S DIFG("QFLG")=2 Q
        !            47:        I "AMLD"'[Y S DIFG("QFLG")=3 Q
        !            48:        Q
        !            49:        ;
        !            50: FIRST  ; GET PRIMARY FILE VARIABLES
        !            51:        S DIFGI=$O(^DIPT(DIFGT,1,DIFGI)) Q:DIFGI'=+DIFGI  S X=^(DIFGI,0)
        !            52:        D FVARS
        !            53:        I '$D(@(DIFG(DILL,"FGBL")_DIFG("FE")_",0)")) S DIFG("QFLG")=3 Q
        !            54:        Q
        !            55:        ;
        !            56: FVARS  ; SETUP FILE VARIABLES
        !            57:        S DILL=$P(X,U,2),DITAB=2*(DILL-1),DIFG(DILL,"FILE")=+X
        !            58:        S DIFG(DILL,"FNAME")=$O(^DD(DIFG(DILL,"FILE"),0,"NM",0))
        !            59:        I DILL=1 S DIFG(DILL,"FE")=DIFG("FE"),DIFG(DILL,"FUNC")=DIFG("FUNC")
        !            60:        E  S DIFG(DILL,"FUNC")=DIFG(DILL-1,"FUNC")
        !            61:        I $D(DIFG("FUNC SFT",DIFG(DILL,"FILE"))) S DIFG(DILL,"FUNC")=DIFG("FUNC SFT",DIFG(DILL,"FILE"))
        !            62:        I $P(X,U,4)=1 S DIFG(DILL,"FE")=DIFG(DILL-1,"FE") ; dinum back pointer
        !            63:        S DIFG(DILL,"XREF")=$S($P(X,U,4)=4:$P(X,U,7),1:$P(X,U,4)),%=$P(X,U,5) ;Back pointer if $P=4 X-ref in $P7
        !            64:        I $E(%,$L(%))=":" S DIFG(DILL,"NAV")=1 I $P(X,U,4)=2 S DIFG(DILL,"NAV")=2 D DIRECT K %,Y
        !            65:        I $P(X,U,4)=3 S %=$P(X,U,3),%=$O(^DD(%,"SB",+X,0)),%=^DD(+$P(X,U,3),%,0),%=$P($P(^(0),U,4),";") S:+%'=% %=""""_%_"""" S DIFG(DILL,"FGBL")=DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_%_"," K DIFG(DILL,"NAV") Q  ; multiple
        !            66:        S DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL")
        !            67:        D:$P(X,U,4)=5 LOOKUP
        !            68:        Q
        !            69:        ;
        !            70: DIRECT ;DIRECT POINTER
        !            71:        S DIFG(DILL,"FE")=0,%=$P(%,":")
        !            72:        S:'$D(^DD(DIFG(DILL-1,"FILE"),"B",%)) %=$O(^(%))
        !            73:        S %=$O(^DD(DIFG(DILL-1,"FILE"),"B",%,0))
        !            74:        Q:%'=+%
        !            75:        S Y=$P(^DD(DIFG(DILL-1,"FILE"),%,0),U,4),%("N")=$P(Y,";"),%("P")=$P(Y,";",2) S:+%("N")'=%("N") %("N")=""""_%("N")_""""
        !            76:        I $D(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_%("N")_")")) S Y=@("^("_%("N")_")"),DIFG(DILL,"FE")=$P(Y,U,%("P"))
        !            77:        Q
        !            78:        ;
        !            79: LOOKUP ;COMPUTED FIELD LOOKUP FOR FILE SHIFT
        !            80:        S DIFG(DILL,"FE")=""
        !            81:        S %=$O(^DD(DIFG(DILL,"FILE"),"B",$P($P(X,U,5),":"),0))
        !            82:        Q:'%
        !            83:        X $P(^DD(DIFG(DILL,"FILE"),%,0),U,5,99)
        !            84:        I $D(X) S DIFG(DILL,"FE")=$S(X?1"`"1N.N:$E(X,2,99),X?1N.N:X,1:"")
        !            85:        Q