source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFGGI.m@ 789

DIFGGI ;SFISC/XAK,EDE(OHPRD)-FILEGRAM INITIALIZATION ;1/19/93  9:45 AM
 ;;22.0;VA FileMan;;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ; DIFGER values: 1 = required variable not passed
 ;                2 = variable form invalid
 ;                3 = variable content invalid
 ;
INIT ; INITIALIZATION
 K ^UTILITY("DIFG",$J),^UTILITY("DIFGLINK",$J)
 D SET1,REQ Q:DIFG("QFLG")
 D OPT Q:DIFG("QFLG")
 D FIRST
 Q
 ;
SET1 ; MISC SETS # 1
 S DIFGI=0,DILL=1 K DIFGER S U="^",DIFG("QFLG")=0
 Q
 ;
REQ ;
 ;
FE I '$D(DIFG("FE")) S DIFG("QFLG")=1 Q
 I DIFG("FE")'=+DIFG("FE") S DIFG("QFLG")=2 Q
FUNC I '$D(DIFG("FUNC")) S DIFG("QFLG")="1" Q
 I DIFG("FUNC")="" S DIFG("QFLG")=2 Q
 I "AMLD"'[DIFG("FUNC") S DIFG("QFLG")=3 Q
FGT I '$D(DIFGT) S DIFG("QFLG")=1 Q
 I DIFGT'=+DIFGT S DIFG("QFLG")=2 Q
 I '$D(^DIPT(DIFGT,0)) S DIFG("QFLG")=3 Q
 Q
 ;
OPT ;
 ;
FGR I '$D(DIFG("FGR")) S DIFG("FGR")="^UTILITY(""DIFG"",$J,"
 S X=DIFG("FGR")
 I "(,"'[$E(X,$L(X)) S DIFG("QFLG")=2 Q
 I $P(X,"(")["DIFG" S DIFG("QFLG")=3 Q
LC I $D(DILC),DILC'=+DILC S DIFG("QFLG")=2 Q
 S:'$D(DILC) DILC=0
PARM S:'$D(DIFG("PARM")) DIFG("PARM")="N"
TAB I $D(DITAB),DITAB'=+DITAB S DIFG("QFLG")=2 Q
 S:'$D(DITAB) DITAB=0
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")
 Q
 ;
FUNCSFT2 S Y=DIFG("FUNC SFT",X)
 I Y="" S DIFG("QFLG")=2 Q
 I "AMLD"'[Y S DIFG("QFLG")=3 Q
 Q
 ;
FIRST ; GET PRIMARY FILE VARIABLES
 S DIFGI=$O(^DIPT(DIFGT,1,DIFGI)) Q:DIFGI'=+DIFGI  S X=^(DIFGI,0)
 D FVARS
 I '$D(@(DIFG(DILL,"FGBL")_DIFG("FE")_",0)")) S DIFG("QFLG")=3 Q
 Q
 ;
FVARS ; SETUP FILE VARIABLES
 S DILL=$P(X,U,2),DITAB=2*(DILL-1),DIFG(DILL,"FILE")=+X
 S DIFG(DILL,"FNAME")=$O(^DD(DIFG(DILL,"FILE"),0,"NM",0))
 I DILL=1 S DIFG(DILL,"FE")=DIFG("FE"),DIFG(DILL,"FUNC")=DIFG("FUNC")
 E  S DIFG(DILL,"FUNC")=DIFG(DILL-1,"FUNC")
 I $D(DIFG("FUNC SFT",DIFG(DILL,"FILE"))) S DIFG(DILL,"FUNC")=DIFG("FUNC SFT",DIFG(DILL,"FILE"))
 I $P(X,U,4)=1 S DIFG(DILL,"FE")=DIFG(DILL-1,"FE") ; dinum back pointer
 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
 I $E(%,$L(%))=":" S DIFG(DILL,"NAV")=1 I $P(X,U,4)=2 S DIFG(DILL,"NAV")=2 D DIRECT K %,Y
 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
 S DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL")
 D:$P(X,U,4)=5 LOOKUP
 Q
 ;
DIRECT ;DIRECT POINTER
 S DIFG(DILL,"FE")=0,%=$P(%,":")
 S:'$D(^DD(DIFG(DILL-1,"FILE"),"B",%)) %=$O(^(%))
 S %=$O(^DD(DIFG(DILL-1,"FILE"),"B",%,0))
 Q:%'=+%
 S Y=$P(^DD(DIFG(DILL-1,"FILE"),%,0),U,4),%("N")=$P(Y,";"),%("P")=$P(Y,";",2) S:+%("N")'=%("N") %("N")=""""_%("N")_""""
 I $D(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_%("N")_")")) S Y=@("^("_%("N")_")"),DIFG(DILL,"FE")=$P(Y,U,%("P"))
 Q
 ;
LOOKUP ;COMPUTED FIELD LOOKUP FOR FILE SHIFT
 S DIFG(DILL,"FE")=""
 S %=$O(^DD(DIFG(DILL,"FILE"),"B",$P($P(X,U,5),":"),0))
 Q:'%
 X $P(^DD(DIFG(DILL,"FILE"),%,0),U,5,99)
 I $D(X) S DIFG(DILL,"FE")=$S(X?1"`"1N.N:$E(X,2,99),X?1N.N:X,1:"")
 Q