source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMA300.m@ 1147

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

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1SDAMA300 ;BPOIFO/ACS-Filter API Validate Filters ; 9/14/05 7:49am
2 ;;5.3;Scheduling;**301,347,508**;13 Aug 1993
3 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
4 ;
5 ;*****************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ;-------- ---------- -----------------------------------------
10 ;12/04/03 SD*5.3*301 ROUTINE COMPLETED
11 ;08/06/04 SD*5.3*347 ADDITION OF A NEW FILTER - DATE APPOINTMENT
12 ; MADE (FIELD #16) AND 2 NEW FIELDS TO RETURN:
13 ; 1) AUTO-REBOOKED APPT DATE/TIME (FIELD #24)
14 ; 2) NO-SHOW/CANCEL APPT DATE/TIME (FIELD #25)
15 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
16 ;*****************************************************************
17 ;
18 ;*****************************************************************
19 ;
20 ; VALIDATE FILTER ARRAY CONTENTS
21 ;INPUT
22 ; SDARRAY Appointment filters
23 ; SDFLTR Filter Flag array
24 ;
25 ;OUTPUT
26 ; -1 if error
27 ; 1 if no errors
28 ;
29 ;*****************************************************************
30VALARR(SDARRAY,SDFLTR) ;
31 ;Initialize local variables
32 N SDI,SDX,SDQUIT,SDDATA,SDCOUNT,SDERR
33 S SDQUIT=0,SDERR=115
34 ;
35 ;Set filter flags and validate input array entries
36 F SDI="MAX","FLDS","FLTRS","SORT","VSTAPPTS","PURGED" Q:SDQUIT D @SDI
37 Q:(SDARRAY("CNT")=-1) -1
38 ;filters allowed on these fields
39 F SDI=1:1:4,13,16 Q:SDQUIT D
40 . I $G(SDARRAY(SDI))']"" S SDFLTR(SDI)=0
41 . E S SDFLTR(SDI)=1 D
42 .. S SDCOUNT=$L(SDARRAY(SDI),";")
43 .. S SDQUIT=0
44 .. D @SDI
45 ;
46 I SDQUIT=0 D
47 . ;filters not allowed on these fields
48 . F SDI=5:1:12,14,15,17:1:26,28:1:SDARRAY("FC") Q:SDQUIT D NOFIL
49 Q SDARRAY("CNT")
50 ;
51 ;*****************************************************************
52 ;
531 ;SDARRAY(1): Appt dates
54 ;validate from/to date(/time)s
55 D CHKDTES($G(SDARRAY("FR")),$G(SDARRAY("TO")))
56 Q:SDQUIT
57 ;allow seconds in date/time filter!
58 I $L(SDARRAY("FR"))>14 D ERROR(SDERR)
59 Q:SDQUIT
60 I $L(SDARRAY("TO"))>14 D ERROR(SDERR)
61 Q
622 ;SDARRAY(2): Clinic IEN
63 ;Clinic must be on ^SC
64 ;Clinic list is not in global
65 I SDARRAY("CLNGBL")'=1 D
66 . ; get each clinic IEN in the string and validate
67 . F SDX=1:1:SDCOUNT Q:SDQUIT D
68 .. S SDDATA=$P(SDARRAY(2),";",SDX)
69 .. I ($G(SDDATA)=""!'$D(^SC(SDDATA,0))) D ERROR(SDERR) Q
70 .. D:$$CHKRSACL(SDDATA) ERROR(SDERR) ;validate RSA Clinic (Type R)
71 ;Clinic list is in global or local array
72 I SDARRAY("CLNGBL")=1 D
73 . Q:SDARRAY(2)="^SC(" ; no validation required if clinic global
74 . S SDX=SDARRAY(2)
75 . ;check for existence of IENs
76 . N SDIEN S SDIEN=$O(@(SDX_"0)")) I +$G(SDIEN)=0 D ERROR(SDERR)
77 . Q:SDQUIT
78 . S SDDATA=0
79 . ; get each IEN in the array and validate
80 . F S SDDATA=$O(@(SDX_"SDDATA)")) Q:(($G(SDDATA)="")!(SDQUIT)) D
81 .. I '$D(^SC(SDDATA,0)) D ERROR(SDERR) Q
82 .. D:$$CHKRSACL(SDDATA) ERROR(SDERR) ;validate RSA Clinic (Type R)
83 Q
843 ;SDARRAY(3): Appointment Status Code
85 F SDX=1:1:SDCOUNT Q:SDQUIT D
86 . S SDDATA=";"_$P(SDARRAY(3),";",SDX)_";"
87 . I ";I;R;NT;NS;NSR;CC;CCR;CP;CPR;"'[(SDDATA) D ERROR(SDERR)
88 Q
894 ;SDARRAY(4): Patient DFN
90 ;patient must be on ^DPT
91 ;DFN list is not in global
92 I SDARRAY("PATGBL")'=1 D
93 . ; get each DFN in the string and validate
94 . F SDX=1:1:SDCOUNT Q:SDQUIT D
95 .. S SDDATA=$P(SDARRAY(4),";",SDX)
96 .. I $G(SDDATA)="" D ERROR(SDERR)
97 .. Q:SDQUIT
98 .. I '$D(^DPT(SDDATA)) D ERROR(SDERR)
99 .. Q:SDQUIT
100 ;DFN list is in global or local array
101 I SDARRAY("PATGBL")=1 D
102 . Q:SDARRAY(4)="^DPT("
103 . S SDX=SDARRAY(4)
104 . ;check for existence of DFNs
105 . N SDDFN S SDDFN=$O(@(SDX_"0)")) I +$G(SDDFN)=0 D ERROR(SDERR)
106 . Q:SDQUIT
107 . S SDDATA=0
108 . ; get each DFN in the array and validate
109 . F S SDDATA=$O(@(SDX_"SDDATA)")) Q:(($G(SDDATA)="")!(SDQUIT)) D
110 .. I '$D(^DPT(SDDATA)) D ERROR(SDERR)
111 .. Q:SDQUIT
112 Q
11312 ;SDARRAY(12): Encounter Exists
114 ;Unpublished and should not be used by other applications
115 ;validate value
116 ;S SDQUIT=$S(SDARRAY("ENCTR")="":0,SDARRAY("ENCTR")="Y":0,SDARRAY("ENCTR")="N":0,1:1)
117 ;D:SDQUIT ERROR(SDERR)
118 Q
11913 ;SDARRAY(13): Primary Stop Code
120 ;primary stop code must exist on ^DIC(40.7,"C"
121 F SDX=1:1:SDCOUNT Q:SDQUIT D
122 . S SDDATA=$P(SDARRAY(13),";",SDX)
123 . I '+SDDATA D ERROR(SDERR) Q
124 . I '$D(^DIC(40.7,"C",SDDATA)) D ERROR(SDERR) Q
125 Q
12616 ;SDARRAY(16): Date Appointment Made
127 ;validate from/to date(s)
128 D CHKDTES($G(SDARRAY("DAMFR")),$G(SDARRAY("DAMTO")))
129 Q:SDQUIT
130 ;ensure time not entered
131 I $L(SDARRAY("DAMFR"))>7 D ERROR(SDERR)
132 Q:SDQUIT
133 I $L(SDARRAY("DAMTO"))>7 D ERROR(SDERR)
134 Q
135CHKRSACL(SDCL) ;validate RSA clinics
136 ;
137 ;Input SDCL - IEN of the clinic
138 ;Output 0 - Clinic OK
139 ; 1 - Clinic Error (Missing either Local Appointment
140 ; purpose Id or Resource Id entry)
141 ;
142 ;initialize variables
143 N SDRSA,SDRNODE,SDERR
144 S SDERR=0
145 ;quit if clinic is not of type "C" (Clinic)
146 ; - RSA Clinic that has not completed migration
147 Q:($P($G(^SC(SDCL,0)),"^",3)'="C") SDERR
148 ;determine clinic (RSA or VistA)
149 S SDRSA=$$RSACLNC^SDAMA307(SDCL)
150 Q:SDRSA SDERR ;valid RSA clinic (has both Resource/LAP Ids)
151 ;check to ensure valid VistA clinic
152 S SDRNODE=$G(^SC(SDCL,"RSA"))
153 ;error if either resource or lap defined
154 S SDERR=$S((($P(SDRNODE,"^",4)="")&($P(SDRNODE,"^",5)="")):0,1:1)
155 Q SDERR
156VSTAPPTS ;validate parameter for retrieving only VistA Appointments
157 ;This flag supports the RPC View for RSA - unpublished feature
158 Q:($G(SDARRAY("VSTAPPTS"))="")
159 D:($G(SDARRAY("VSTAPPTS"))'=1) ERROR(SDERR)
160 Q
161PURGED ;validate parameter for retrieving PURGED VistA appts
162 Q:($G(SDARRAY("PURGED"))="") ;parameter not set/used
163 D:($G(SDARRAY("PURGED"))'=1) ERROR(SDERR)
164 Q:(SDQUIT) ;quit if parameter not set correctly
165 ;throw error if patient filter not defined or invalid field requested
166 D:($G(SDARRAY(4))']"") ERROR(SDERR)
167 Q:(SDQUIT)
168 N SDI F SDI=5:1:9,11,22,28,30,31,33 Q:(SDQUIT) D
169 .D:((";"_$G(SDARRAY("FLDS"))_";")[(";"_SDI_";")) ERROR(SDERR)
170 Q
171NOFIL ;No filter allowed
172 I $G(SDARRAY(SDI))]"" D ERROR(SDERR)
173 Q
174FMDATE(SDDATE,SDERR) ;
175 ;dates must be valid internal FileMan format
176 N X,Y,%H,%T,%Y
177 S Y=SDDATE D DD^%DT I Y=-1 D ERROR(SDERR)
178 Q:SDQUIT
179 ;dates cannot be imprecise
180 S X=SDDATE D H^%DTC I %H=0 D ERROR(SDERR)
181 Q
182CHKDTES(SDFROM,SDTO) ;validate date(/time)s
183 N SDI,X,Y,%DT
184 S %DT="STX"
185 F SDI=SDFROM,SDTO Q:SDQUIT D
186 .;valid fileman format
187 .I $G(SDI)'="" D
188 ..D FMDATE(SDI,SDERR)
189 ..Q:SDQUIT
190 ..;check for valid dates / leap yr dates
191 ..I SDI'[9999999 D
192 ...S X=$$FMTE^XLFDT(SDI)
193 ...D ^%DT
194 ...I Y<0 D ERROR(SDERR)
195 .Q:SDQUIT
196 Q:SDQUIT
197 ;from date(/time) can't be after to date(/time)
198 I SDFROM>SDTO D ERROR(SDERR)
199 Q
200MAX ;Maximum number of appointments requested
201 ;max can't be 0
202 N SDMAXAPT,SDPCOUNT,SDCCOUNT
203 S SDMAXAPT=$G(SDARRAY("MAX"))
204 S (SDPCOUNT,SDCCOUNT)=0
205 I $G(SDMAXAPT)]"" D
206 . ;Check Max Entry
207 . I +SDMAXAPT'=SDMAXAPT S SDQUIT=1 Q
208 . I SDMAXAPT=0 S SDQUIT=1 Q
209 . I SDMAXAPT["." S SDQUIT=1 Q
210 . ;Verify a SINGLE valid PATIENT &/OR CLINIC Entry
211 . ;Get Number of Patients passed in
212 . I SDARRAY("PATGBL")=1 S SDPCOUNT=$$CHKGBL(SDARRAY(4))
213 . I SDARRAY("PATGBL")=0 S SDPCOUNT=$L(SDARRAY(4),";")
214 . ;Get Number of Clinics passed in
215 . I SDARRAY("CLNGBL")=1 S SDCCOUNT=$$CHKGBL(SDARRAY(2))
216 . I SDARRAY("CLNGBL")=0 S SDCCOUNT=$L(SDARRAY(2),";")
217 . I (SDPCOUNT>1)!(SDCCOUNT>1) S SDQUIT=1 Q
218 . I SDPCOUNT=0,SDCCOUNT=0 S SDQUIT=1
219 I SDQUIT D ERROR(SDERR)
220 Q
221 ;
222FLDS ;Quit if field list is null
223 N SDFIELDS,SDFIELD
224 I $G(SDARRAY("FLDS"))="" D ERROR(SDERR)
225 Q:SDQUIT
226 S SDFIELDS=SDARRAY("FLDS")
227 S SDCOUNT=$L(SDFIELDS,";")
228 F SDI=1:1:SDCOUNT Q:SDQUIT D
229 . S SDFIELD=$P(SDFIELDS,";",SDI)
230 . I (($G(SDFIELD)'?.N)!($G(SDFIELD)<1)!($G(SDFIELD)=27)!($G(SDFIELD)>SDARRAY("FC"))) D ERROR(SDERR) S SDQUIT=1
231 Q
232 ;
233FLTRS ;Quit if max filters exceeded
234 N SDFCNT S SDFCNT=0
235 F SDI=1:1:SDARRAY("FC") D
236 . I $G(SDARRAY(SDI))]"" S SDFCNT=SDFCNT+1
237 I SDFCNT>SDARRAY("MF") D ERROR(SDERR) S SDQUIT=1
238 Q
239 ;
240SORT ;Quit if SORT Filter is a value other than P or null
241 N SDSORT
242 S SDSORT=$G(SDARRAY("SORT"))
243 I $G(SDSORT)="" Q
244 I '($G(SDSORT)="P") D ERROR(SDERR)
245 Q
246 ;
247ERROR(SDERRNUM) ;Generate Error and put in ^TMP global
248 S SDARRAY("CNT")=-1,SDQUIT=1
249 S $P(^TMP($J,"SDAMA301",SDERRNUM),"^",1)=$P($T(@SDERRNUM),";;",2)
250 Q
251 ;
252101 ;;DATABASE IS UNAVAILABLE
253115 ;;INVALID INPUT ARRAY ENTRY
254116 ;;DATA MISMATCH
255117 ;;Fatal RSA error. See SDAM RSA ERROR LOG file.
256 ;
257CHKGBL(SDGBL) ;Check Global for number of entries
258 N SDIEN,SDCOUNT
259 S (SDIEN,SDCOUNT)=0
260 F S SDIEN=$O(@(SDGBL_"SDIEN)")) Q:(+$G(SDIEN)=0)!(SDCOUNT>2) D
261 .S SDCOUNT=SDCOUNT+1
262 Q SDCOUNT
Note: See TracBrowser for help on using the repository browser.