Return to DIFGGI.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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