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

Last change on this file since 699 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1DIFGGI ;SFISC/XAK,EDE(OHPRD)-FILEGRAM INITIALIZATION ;1/19/93 9:45 AM
2 ;;22.0;VA FileMan;;Mar 30, 1999
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 ;
8INIT ; 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 ;
15SET1 ; MISC SETS # 1
16 S DIFGI=0,DILL=1 K DIFGER S U="^",DIFG("QFLG")=0
17 Q
18 ;
19REQ ;
20 ;
21FE I '$D(DIFG("FE")) S DIFG("QFLG")=1 Q
22 I DIFG("FE")'=+DIFG("FE") S DIFG("QFLG")=2 Q
23FUNC 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
26FGT 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 ;
31OPT ;
32 ;
33FGR 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
37LC I $D(DILC),DILC'=+DILC S DIFG("QFLG")=2 Q
38 S:'$D(DILC) DILC=0
39PARM S:'$D(DIFG("PARM")) DIFG("PARM")="N"
40TAB I $D(DITAB),DITAB'=+DITAB S DIFG("QFLG")=2 Q
41 S:'$D(DITAB) DITAB=0
42FUNCSFT 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 ;
45FUNCSFT2 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 ;
50FIRST ; 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 ;
56FVARS ; 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 ;
70DIRECT ;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 ;
79LOOKUP ;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
Note: See TracBrowser for help on using the repository browser.