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

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

initial load of WorldVistAEHR
File size: 6.6 KB
RevLine 
[613]1DIKC2 ;SFISC/MKO-CHECK INPUT PARAMETERS TO INDEX^DIKC ;8:25 AM 30 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 ;CHK: Check input parameters to INDEX^DIKC
5 ;Also set:
6 ; DA = DA array
7 ; DIROOT = Closed root of file
8 ; DIFILE = File #
9 ; DIKERR = "X" : if there's a problem
10 ;
11CHK ;File is a required input param
12 I $G(DIFILE)="" D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D ERR Q
13 ;
14 ;Check DIREC and set DA array
15 I $G(DIREC)'["," M DA=DIREC
16 E S:DIREC'?.E1"," DIREC=DIREC_"," D DA^DILF(DIREC,.DA)
17 S:'$G(DA) DA=""
18 I '$$VDA^DIKCU1(.DA,DIF) D ERR Q
19 ;
20 ;Check DICTRL parameter
21 I $G(DICTRL)]"",'$$VFLAG^DIKCU1(DICTRL,"KSsDWiRIkCTrf",DIF) D ERR
22 I $G(DICTRL)["W",'$$VFNUM^DIKCU1(+$P(DICTRL,"W",2),DIF) D ERR
23 I $G(DICTRL)["C",$G(DICTRL)["T" D
24 . D:DIF["D" ERR^DIKCU2(301,"","","","C and T")
25 . D ERR
26 E I $G(DICTRL)["C",$G(DICTRL)["K" D
27 . D:DIF["D" ERR^DIKCU2(301,"","","","C and K")
28 . D ERR
29 E I $G(DICTRL)["T",$G(DICTRL)["S" D
30 . D:DIF["D" ERR^DIKCU2(301,"","","","T and S")
31 . D ERR
32 Q:$G(DIKERR)="X"
33 ;
34 ;Set DIFILE and DIROOT
35 N DILEV
36 I DIFILE=+$P(DIFILE,"E") D
37 . S DIROOT=$$FROOTDA^DIKCU(DIFILE,DIF,.DILEV) I DIROOT="" D ERR Q
38 . I DILEV,$D(DA(DILEV))[0 D Q
39 .. D:DIF["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
40 . S:DILEV DIROOT=$NA(@DIROOT)
41 . S DIFILE=$$FNUM^DIKCU(DIROOT,DIF) I DIFILE="" D ERR
42 E D
43 . S DIROOT=DIFILE
44 . S:"(,"[$E(DIROOT,$L(DIROOT)) DIROOT=$$CREF^DILF(DIFILE)
45 . S DIFILE=$$FNUM^DIKCU(DIROOT,DIF) I DIFILE="" D ERR Q
46 . S DILEV=$$FLEV^DIKCU(DIFILE,DIF) I DILEV="" D ERR Q
47 . I DILEV,$D(DA(DILEV))[0 D Q
48 .. D:DIF["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
49 ;
50 ;Set DIKVAL,DIKON
51 S DIKVAL=$G(DICTRL("VAL"))
52 I DIKVAL]"" D
53 . S:"(,_"'[$E(DIKVAL,$L(DIKVAL)) DIKVAL=$$OREF^DILF(DIKVAL)
54 . S DIKON="O^N"
55 E S DIKON=""
56 Q
57 ;
58ERR ;Set error flag
59 S DIKERR="X"
60 Q
61 ;
62 ;==========================
63 ; CRV(Index,ValueRoot,TMP)
64 ;==========================
65 ;Load values from Cross Reference Values multiple into @TMP
66 ;In:
67 ; XR = Index #
68 ; VALRT = Array Ref where old/new values are located
69 ; TMP = Root of array to store data
70 ;Returns:
71 ; @TMP@(RootFile,Index#) = Name^File^RootType^Type
72 ; Index#,Order#) = Code that sets X to the data
73 ; Order#,"SS") = Subscript^MaxLength
74 ; "T") = Transform (for 'Field'-type)
75 ; "F") = file^field^levdiff(file,rFile)
76CRV(XR,VALRT,TMP) ;
77 Q:'$G(XR)!($G(TMP)="")
78 N CRV,CRV0,DEC,FIL,FLD,MAXL,ND,ORD,OROOT,RFIL,SBSC,TYPE
79 ;
80 S RFIL=$P($G(^DD("IX",XR,0)),U,9) Q:RFIL="" Q:$D(@TMP@(RFIL,XR))
81 S @TMP@(RFIL,XR)=$P(^DD("IX",XR,0),U,2)_U_$P(^(0),U)_U_$P(^(0),U,8)_U_$P(^(0),U,4)
82 S OROOT=$$FROOTDA^DIKCU(RFIL,"O")_"DA," Q:OROOT="DA,"
83 ;
84 S CRV=0 F S CRV=$O(^DD("IX",XR,11.1,CRV)) Q:'CRV D
85 . S CRV0=$G(^DD("IX",XR,11.1,CRV,0))
86 . S ORD=$P(CRV0,U),TYPE=$P(CRV0,U,2),MAXL=$P(CRV0,U,5),SBSC=$P(CRV0,U,6)
87 . Q:ORD=""!(TYPE="")
88 . ;
89 . I TYPE="F" D
90 .. S FIL=$P(CRV0,U,3),FLD=$P(CRV0,U,4) Q:(FIL="")!'FLD
91 .. I FIL'=RFIL N OROOT,LDIF D Q:$G(OROOT)=""
92 ... S LDIF=$$FLEVDIFF^DIKCU(FIL,RFIL) Q:'LDIF
93 ... S OROOT=$$FROOTDA^DIKCU(FIL,LDIF_"O") Q:OROOT=""
94 ... S OROOT=OROOT_"DA("_LDIF_"),"
95 .. S DEC=$$DEC(FIL,FLD,$G(VALRT),OROOT) Q:DEC=""
96 .. S @TMP@(RFIL,XR,ORD)=DEC
97 .. S @TMP@(RFIL,XR,ORD,"F")=FIL_U_FLD_$S($G(LDIF):U_LDIF,1:"")
98 .. S:$G(^DD("IX",XR,11.1,CRV,2))'?."^" @TMP@(RFIL,XR,ORD,"T")=^(2)
99 . ;
100 . E I TYPE="C" S @TMP@(RFIL,XR,ORD)=$G(^DD("IX",XR,11.1,CRV,1.5))
101 . ;
102 . S:SBSC @TMP@(RFIL,XR,ORD,"SS")=SBSC_$S(MAXL:U_MAXL,1:"")
103 Q
104 ;
105 ;======================================
106 ; $$DEC(File,Field,ValueRoot,OpenRoot)
107 ;======================================
108 ;Return Data Extraction Code -- M code that sets X equal to the data.
109 ;In:
110 ; FIL = File #
111 ; FLD = Field #
112 ; VALRT = Array Ref where old/new values are located
113 ; if ends in "_", FILE subscript is concatenated to the last
114 ; subscript (used by DDS02)
115 ; OROOT = Open root of record w/ DA subscripts
116 ;Returns: M code
117 ; For example:
118 ; S X=$P(^DIZ(1000,DA(1),100,0),U,2) or
119 ; S X=$E(^DIZ(1000,DA(1),100,1),1,245) or
120 ; S X=$G(array(file,DIIENS,field,DION),$P(^root(DA,nd),U,pc))
121 ;
122DEC(FIL,FLD,VALRT,OROOT) ;
123 Q:$P($G(^DD(FIL,FLD,0)),U)="" ""
124 ;
125 N ND,PC,DEC
126 S PC=$P($G(^DD(FIL,FLD,0)),U,4)
127 S ND=$P(PC,";"),PC=$P(PC,";",2) Q:ND?." "!("0 "[PC) ""
128 S:ND'=+$P(ND,"E") ND=""""_ND_""""
129 ;
130 I $G(OROOT)="" S OROOT=$$FROOTDA^DIKCU(FIL,"O")_"DA," Q:OROOT="DA," ""
131 I PC S DEC="$P($G("_OROOT_ND_")),U,"_PC_")"
132 E S DEC="$E($G("_OROOT_ND_")),"_+$E(PC,2,999)_","_$P(PC,",",2)_")"
133 ;
134 I $G(VALRT)]"" D
135 . I $E(VALRT,$L(VALRT))="_" D Q
136 .. S VALRT=$E(VALRT,1,$L(VALRT)-3)
137 .. S DEC="$G("_VALRT_FIL_""",DIIENS,"_FLD_",DION),"_DEC_")"
138 . S:"(,"'[$E(VALRT,$L(VALRT)) VALRT=$$OREF^DILF(VALRT)
139 . S DEC="$G("_VALRT_FIL_",DIIENS,"_FLD_",DION),"_DEC_")"
140 S DEC="S X="_DEC
141 Q DEC
142 ;
143 ;======================
144 ; LOG(Index,Logic,TMP)
145 ;======================
146 ;Load Set and/or Kill logic into into @TMP
147 ;In:
148 ; XR = Index #
149 ; LOG [ K : load kill logic
150 ; [ S : load set logic
151 ; TMP = Root of array to store data
152 ;Returns:
153 ; @TMP@(RootFile,Index#,"S") = Set logic
154 ; "SC") = Set condition
155 ; "K") = Kill logic
156 ; "KC") = Kill condtion
157LOG(XR,LOG,TMP) ;
158 Q:'$G(XR) Q:$G(LOG)="" Q:$G(TMP)=""
159 N SL,KL,SC,KC,RFIL
160 ;
161 S RFIL=$P(^DD("IX",XR,0),U,9) Q:RFIL=""
162 I LOG["S" D
163 . S SL=$G(^DD("IX",XR,1)),SC=$G(^(1.4))
164 . I "Q"'[SL,SL'?."^" S @TMP@(RFIL,XR,"S")=SL
165 . I "Q"'[SC,SC'?."^" S @TMP@(RFIL,XR,"SC")=SC
166 I LOG["K" D
167 . S KL=$G(^DD("IX",XR,2)),KC=$G(^(2.4))
168 . I "Q"'[KL,KL'?."^" S @TMP@(RFIL,XR,"K")=KL
169 . I "Q"'[KC,KC'?."^" S @TMP@(RFIL,XR,"KC")=KC
170 Q
171 ;
172 ;===============
173 ; KW(Index,TMP)
174 ;===============
175 ;Load Kill Entire Index logic into @TMP
176 ;In:
177 ; XR = Index #
178 ; TMP = Root of array to store data
179 ;Returns:
180 ; @TMP@("KW",File#[.01],Index#) = Kill Entire Index logic
181 ; Index#,0) = Type ("W" for whole-file index)
182 ; ^RootFile
183 ; ^Level difference between top file
184 ; and root file
185KW(XR,TMP) ;Get Kill Entire Index logic
186 Q:'$G(XR)!($G(TMP)="")
187 N FILE,KW,RFIL,TYPE
188 S KW=$G(^DD("IX",XR,2.5)) Q:KW="Q"!(KW?."^")
189 S FILE=$P($G(^DD("IX",XR,0)),U),TYPE=$P(^(0),U,8),RFIL=$P(^(0),U,9)
190 Q:FILE=""!(RFIL="")
191 ;
192 S @TMP@("KW",FILE,XR)=KW
193 S:RFIL'=FILE @TMP@("KW",FILE,XR,0)=TYPE_U_RFIL_U_$$FLEVDIFF^DIKCU(FILE,RFIL)
194 Q
195 ;
196 ;#202 The input parameter that identifies the |1| is missing or invalid.
197 ;#205 File# |1| and IEN string |IENS| represent different subfile levels.
198 ;
Note: See TracBrowser for help on using the repository browser.