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

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

initial load of WorldVistAEHR

File size: 4.6 KB
RevLine 
[613]1DIEZ4 ;SFISC/MKO-COMPILE INPUT TEMPLATE, RECORD-LEVEL INDEXES ;2:15 PM 14 Jul 1999
2 ;;22.0;VA FileMan;**11**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;Variables passed in through symbol table:
6 ; DNM = Name of routine
7 ; DRN(routine#) = "" : array of routine numbers
8 ; DMAX = Maximum routine size
9 ; DIEZTMP = Root of global that contains record-level index info
10 ;
11 ;Routine-wide variables
12 ; T = Total byte count of current routine
13 ; L = Last line number in current routine
14 ; DP = file #
15 ; DRN = routine #
16 ; DIEZCNT = Count of xrefs processed in current routine (used as
17 ; a line tag)
18 ; DIEZAR(file#,xref#) = linetag^routine (returned)
19 ; DIEZKEYR(file#,key#,uniqxref#) = Xn^routine
20 ;
21RECXR(DIEZAR) ;Build routines for record-level indexes
22 Q:'$D(@DIEZTMP@("R"))
23 N DIEZCNT,DIEZXR,DP
24 ;
25 S DRN=$O(DRN(""),-1)+1
26 D NEWROU
27 ;
28 S DP=0 F S DP=$O(@DIEZTMP@("R",DP)) Q:'DP D Q:$G(DIEZQ)
29 . S DIEZXR=0
30 . F S DIEZXR=$O(@DIEZTMP@("R",DP,DIEZXR)) Q:'DIEZXR D Q:$G(DIEZQ)
31 .. D GETXR(DIEZXR) Q:$G(DIEZQ)
32 Q:$G(DIEZQ)
33 D SAVE
34 Q
35 ;
36GETXR(DIEZXR) ;Get code for one index DIEZXR
37 N DIEZCOD,DIEZF,DIEZKLOG,DIEZNSS,DIEZO,DIEZSLOG
38 I T>DMAX D SAVE Q:$G(DIEZQ) D NEWROU
39 ;
40 S DIEZCNT=$G(DIEZCNT)+1
41 S DIEZAR(DP,DIEZXR)=DIEZCNT_U_DNM_DRN
42 ;
43 ;Build code to call subroutine to set X array
44 D L(DIEZCNT_" N X,X1,X2 S DIXR="_DIEZXR_" D X"_DIEZCNT_"(U) K X2 M X2=X D X"_DIEZCNT_"(""F"") K X1 M X1=X")
45 ;
46 ;Build code to check for null subscripts
47 S DIEZNSS="",DIEZO=0
48 F S DIEZO=$O(@DIEZTMP@("R",DP,DIEZXR,DIEZO)) Q:'DIEZO D
49 . Q:'$G(@DIEZTMP@("R",DP,DIEZXR,DIEZO,"SS"))
50 . I DIEZNSS="" S DIEZNSS="$G(X("_DIEZO_"))]"""""
51 . E S DIEZNSS=DIEZNSS_",$G(X("_DIEZO_"))]"""""
52 I DIEZNSS]"" S DIEZNSS=" I "_DIEZNSS_" D"
53 E S DIEZNSS=" D"
54 ;
55 ;Store kill logic and condition
56 S DIEZKLOG=$G(@DIEZTMP@("R",DP,DIEZXR,"K"))
57 I DIEZKLOG'?."^" D
58 . D L(DIEZNSS)
59 . ;Build kill condition code
60 . S DIEZCOD=$G(@DIEZTMP@("R",DP,DIEZXR,"KC"))
61 . I DIEZCOD'?."^" D
62 .. D L(" . N DIEZCOND,DIEXARR M DIEXARR=X S DIEZCOND=1")
63 .. D L(" . "_DIEZCOD)
64 .. D L(" . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND")
65 . ;Store kill logic
66 . D L(" . "_DIEZKLOG)
67 ;
68 ;Store set logic and condition
69 S DIEZSLOG=$G(@DIEZTMP@("R",DP,DIEZXR,"S"))
70 I DIEZSLOG'?."^" D
71 . D L(" K X M X=X2"_DIEZNSS)
72 . ;Build set condition code
73 . S DIEZCOD=$G(@DIEZTMP@("R",DP,DIEZXR,"SC"))
74 . I DIEZCOD'?."^" D
75 .. D L(" . N DIEZCOND,DIEXARR M DIEXARR=X S DIEZCOND=1")
76 .. D L(" . "_DIEZCOD)
77 .. D L(" . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND")
78 . ;Store set logic
79 . D L(" . "_DIEZSLOG)
80 ;
81 ;Build code to check record level keys
82 D:$D(^DD("KEY","AU",DIEZXR)) BLDKCHK(DIEZXR)
83 D L(" Q")
84 ;
85 ;Build code to set X array
86 S DIEZF=$O(@DIEZTMP@("R",DP,DIEZXR,0))
87 D L("X"_DIEZCNT_"(DION) K X")
88 ;
89 S DIEZO=0
90 F S DIEZO=$O(@DIEZTMP@("R",DP,DIEZXR,DIEZO)) Q:'DIEZO D BLDDEC(DIEZXR,DIEZO)
91 D L(" S X=$G(X("_DIEZF_"))")
92 D L(" Q")
93 Q
94 ;
95BLDDEC(DIEZXR,DIEZO) ;Build data extraction code
96 N CODE,NODE,TRANS
97 ;
98 S CODE=$G(@DIEZTMP@("R",DP,DIEZXR,DIEZO)) Q:CODE?."^"
99 S TRANS=$G(@DIEZTMP@("R",DP,DIEZXR,DIEZO,"T"))
100 I TRANS'?."^" D
101 . D L(" "_CODE)
102 . D DOTLINE(" I $D(X)#2 "_TRANS)
103 . D L(" S:$D(X)#2 X("_DIEZO_")=X")
104 E I $D(@DIEZTMP@("R",DP,DIEZXR,DIEZO,"F"))#2,CODE?1"S X=".E D
105 . D L(" S X("_DIEZO_")"_$E(CODE,4,999))
106 E D
107 . D L(" "_CODE)
108 . D L(" S:$D(X)#2 X("_DIEZO_")=X")
109 Q
110 ;
111BLDKCHK(DIEZUI) ;Build code to check key for xref
112 N DIEZKLST,DIEZMAXL,DIEZUIR,I
113 ;
114 D XRINFO^DIKCU2(DIEZUI,.DIEZUIR,"",.DIEZMAXL)
115 ;
116 ;Get list of keys with this uniqueness index
117 S DIEZKLST="",I=0
118 S I=0 F S I=$O(^DD("KEY","AU",DIEZUI,I)) Q:'I S DIEZKLST=I_","
119 Q:DIEZKLST=""
120 S DIEZKLST=$E(DIEZKLST,1,$L(DIEZKLST)-1)
121 ;
122 D L(" . I $G(DIEXEC)[""K"" D")
123 D L(" .. N DIMAXL,DIUIR")
124 D L(" .. S DIUIR=$NA("_DIEZUIR_") Q:'$D(@DIUIR)")
125 ;
126 ;Build code to set DIMAXL(order#)=maxLength
127 I $D(DIEZMAXL) D
128 . N ORD,X
129 . S X="S ",ORD=0
130 . F S ORD=$O(DIEZMAXL(ORD)) Q:'ORD D
131 .. S X=X_"DIMAXL("_ORD_")="_DIEZMAXL(ORD)_","
132 . I X?.E1"," D L(" .. "_$E(X,1,$L(X)-1))
133 ;
134 D L(" .. I '$$UNIQUE^DIE17(.X,.DA,DIUIR,""X"_DIEZCNT_U_DNM_DRN_""""_$S($D(DIEZMAXL):",.DIMAXL",1:"")_") N I F I="_DIEZKLST_" S DIKEY("_DP_",I,DIIENS)=""""")
135 Q
136 ;
137L(X) ;Add CODE to ^UTILITY
138 S L=L+1,^UTILITY($J,0,L)=X,T=T+$L(X)+2
139 Q
140 ;
141DOTLINE(X) ;
142 I X[" Q"!(X[" Q:") D
143 . D L(" D"),L(" ."_X)
144 E D L(X)
145 Q
146 ;
147NEWROU ;Start a new routine
148 K ^UTILITY($J,0)
149 S ^UTILITY($J,0,1)=DNM_DRN_" ; ;"_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),T=$L(^(1))
150 S ^UTILITY($J,0,2)=" ;;",T=T+$L(^(2))
151 S L=2,DIEZCNT=0
152 Q
153 ;
154SAVE ;Get the next available routine number
155 N DQ
156 F DQ=DRN+1:1 Q:'$D(DRN(DQ))
157 ;
158 ;Save current routine
159 D SAVE^DIEZ1 Q:$G(DIEZQ)
160 K ^UTILITY($J,0)
161 Q
Note: See TracBrowser for help on using the repository browser.