Return to DIFGGI.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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