source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDAMA307.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1SDAMA307 ;BPOIFO/ACS-Filter API Call RSA ; 9/14/05 12:45pm
2 ;;5.3;Scheduling;**301,508**;13 Aug 1993
3 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
4 ;
5 ;** GET APPOINTMENT DATA FROM RSA **
6 ;
7 ;***************************************************************
8 ; CHANGE LOG
9 ;
10 ; DATE PATCH DESCRIPTION
11 ;-------- ---------- ---------------------------------------
12 ;12/04/03 SD*5.3*301 ROUTINE COMPLETED
13 ;09/14/05 SD*5.3*372 Phase II Apptmts on Multiple Databases
14 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
15 ;***************************************************************
16 ;
17 ;***************************************************************
18 ;INPUT
19 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
20 ; SDVRFR OVERLOAD PARAMETER FOR VERIFIER [optional]
21 ; (Returns Screened RSA Appts (Migrating))
22 ;***************************************************************
23DATA(SDARRAY,SDVRFR) ;Get RSA appointment data (Phase II)
24 ;Initialize variables
25 N SDRESP,SDCOUNT,SDDFN,SDX,SDGBL
26 S SDX=0
27 ;if patient filter defined ensure that at least 1 patient has
28 ;an ICN. if no patient in the list or global has an icn then RSA
29 ;does not need to be called (No Appointments will exist.)
30 I (($G(SDARRAY(4))]"")&($G(SDARRAY(4))'="^DPT(")) D Q:'SDX
31 .;patients in global
32 .I SDARRAY("PATGBL")=1 D
33 ..S SDGBL=SDARRAY(4),SDDFN=0
34 ..F S SDDFN=$O(@(SDGBL_"SDDFN)")) Q:((+$G(SDDFN)=0)!SDX) D
35 ...S:(+$$GETICN^MPIF001(SDDFN)>0) SDX=1
36 .;patients in list
37 .I SDARRAY("PATGBL")=0 D
38 ..S SDCOUNT=$L(SDARRAY(4),";")
39 ..F SDDFN=1:1:SDCOUNT Q:SDX D
40 ...S:(+$$GETICN^MPIF001($P(SDARRAY(4),";",SDDFN))>0) SDX=1
41 ;if patient filter is not defined ensure that if the status
42 ;filter is defined that it has more than cancelled appt statuses
43 ;(Cancelled Appts not returned if Patient filter not defined)
44 I (($G(SDARRAY(4))']"")&($G(SDARRAY(3))]"")) D Q:'SDX
45 .N SDSTAT,SDI S SDSTAT="",SDX=0
46 .F SDI=1:1:$L(SDARRAY(3),";") Q:SDX D
47 ..S:($P(SDARRAY(3),";",SDI)'["C") SDX=1
48 ;Call RSA Business Delegate
49 ;S SDRESP=$$XMLDLGT^SDAMA309(.SDARRAY,$G(SDVRFR))
50 ;error occurred creating appt records
51 I SDRESP<0 S SDARRAY("CNT")=-1
52 ;no errors/update total appt counter/adjust appts to max filter
53 ;as RSA appts were appended to output and may exceed the MAX
54 I '(SDRESP<0) D
55 .S SDARRAY("CNT")=SDARRAY("CNT")+SDRESP
56 .;adjust total number of appointments
57 .D MAXAPPTS(.SDARRAY)
58 Q
59 ;
60 ;***************************************************************
61 ;OUTPUT
62 ; If RSA Implemented, return 1,10 or 11 if Appt Entry Exists
63 ; If RSA NOT Implemented, return 0
64 ;***************************************************************
65IMP() ;RSA Implemented
66 Q $D(^XOB(18.08,"B",$$GETSRVNM))
67 ;
68 ;***************************************************************
69 ;OUTPUT
70 ; Returns RSA Application Server Name
71 ;***************************************************************
72GETSRVNM() ;return the VL 2.0 application server name
73 Q "SDAM-RSA"
74 ;
75 ;***************************************************************
76 ;INPUT
77 ; SDCLIEN Clinic's Internal Entry Number (Required)
78 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
79 ;OUTPUT
80 ; 1 Return a Patients or Clinics VistA Appointments
81 ; 0 Exclude a Patients or Clinics VistA Appointments
82 ;
83 ; SDARRAY("RSA")=1 will exist if RSA has to be Called
84 ; SDARRAY("MIG") will exist for VistA Clinics that have an
85 ; earliest migrated date/time and has
86 ; completed migration.
87 ; ***************************************************************
88CLMIG(SDCLIEN,SDARRAY) ;clinic status switch
89 ;initialize variables
90 N SDRSA
91 S SDARRAY("CLIN")=SDCLIEN,SDARRAY("MIG")=""
92 ;quit if clinic is not of type "C" (Clinic)
93 Q:($P($G(^SC(SDCLIEN,0)),"^",3)'="C") 0
94 ;determine if RSA Clinic,
95 ;if RSA Clinic Quit VistA doesnt need to be called
96 S SDRSA=$$RSACLNC(SDCLIEN)
97 ;
98 ;RSA CLINIC (Check-In Point) Logic
99 ;Call RSA for Future Migrated/New appointments
100 I SDRSA S SDARRAY("RSA")=1 Q 0
101 ;
102 ;VISTA CLINIC Logic
103 ;return all VistA appointments (Migration not completed)
104 Q:($P($G(^SC(SDCLIEN,"RSA")),"^",6)']"") 1
105 ;retrieve earliest migrated date/time
106 S SDARRAY("MIG")=+$P($G(^SC(SDCLIEN,"RSA")),"^",3)
107 ;return non-migrated VistA appointments
108 Q:(SDARRAY("MIG")>+$G(SDARRAY("DATE"))) 1
109 ;migrated VistA appointments not returned
110 Q 0
111 ;
112 ;***************************************************************
113 ;INPUT
114 ; SDCLNC - Clinic IEN
115 ;OUTPUT
116 ; 1 - Is an RSA Clinic
117 ; 0 - Is not an RSA Clinic
118 ;***************************************************************
119RSACLNC(SDCLNC) ;determine if Clinic is an RSA Clinic
120 ;RSA Clinic if Resource Id (#44.203) and
121 ; Appt Purpose ID (#44.204) exist
122 ;initialize variables
123 N SDRID,SDLAPID
124 ;get resource id
125 S SDRID=$P($G(^SC(SDCLNC,"RSA")),"^",4)
126 ;get local appt purpose id
127 S SDLAPID=$P($G(^SC(SDCLNC,"RSA")),"^",5)
128 Q $S(((SDRID'="")&(SDLAPID'="")):1,1:0)
129 ;
130 ;***************************************************************
131 ;OUTPUT
132 ; Returns the Sites VistA Instance Number
133 ;***************************************************************
134VI() ;Get VistA Instance
135 N SDVI
136 S SDVI=$$SITE^VASITE
137 Q +$P(SDVI,"^",3)
138 ;
139 ;******************************************************************
140 ;INPUT
141 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
142 ;******************************************************************
143MAXAPPTS(SDARRAY) ;Adjust combined appointments (VistA/RSA) to MAX
144 N SDDIFF,SDDIR,SDREF,SDMAX,SDI,SDDTM,SDSORT1,SDSORT2
145 S SDMAX=$S(SDARRAY("MAX")<0:SDARRAY("MAX")*-1,1:SDARRAY("MAX"))
146 S SDDIR=1,SDREF="^TMP($J,""SDRSRT"")"
147 ;quit if max filter not defined / max equals appt count / or
148 ;appt count is less than max
149 Q:($S(SDARRAY("MAX")="":1,SDMAX=SDARRAY("CNT"):1,SDARRAY("CNT")<SDMAX:1,1:0))
150 ;determine how many appts to kill and QUERY direction
151 I SDARRAY("MAX")>0 D
152 .S SDDIFF=SDARRAY("CNT")-SDARRAY("MAX"),SDDIR=-1
153 .I $G(SDARRAY("SORT"))="P" S SDREF="^TMP($J,""SDRSRT"",""A"",""A"")"
154 .E S SDREF="^TMP($J,""SDRSRT"",""A"",""A"",""A"")"
155 S:SDARRAY("MAX")<0 SDDIFF=SDARRAY("CNT")+SDARRAY("MAX")
156 ;create temporary resorted output global by Date/Time
157 ;D MAXRESRT^SDAMA309(.SDARRAY)
158 ;
159 ;loop through appt set and kill the excess appts
160 F Q:'SDDIFF D
161 .S SDREF=$Q(@SDREF,SDDIR)
162 .;retrieve subscribpt to delete from output global
163 .S SDDTM=$P(SDREF,",",3),SDSORT1=+$P(SDREF,",",4),SDSORT2=+$P(SDREF,",",5)
164 .K:($G(SDARRAY("SORT"))="P") ^TMP($J,"SDAMA301",SDSORT1,SDDTM)
165 .K:($G(SDARRAY("SORT"))'="P") ^TMP($J,"SDAMA301",SDSORT1,SDSORT2,SDDTM)
166 .K @SDREF ;delete resorted temp output copy
167 .S SDDIFF=SDDIFF-1
168 ;reset total appt count to max
169 S SDARRAY("CNT")=$S(SDARRAY("MAX")>0:SDARRAY("MAX"),1:(SDARRAY("MAX")*(-1)))
170 K ^TMP($J,"SDRSRT")
171 Q
172 ;
173 ;Both Patient and Clinic Filter Defined, Determine if RSA should be
174 ;called, by evaluating the Clinic Filter List. Patient may have no
175 ;appointments in VistA, so Clinic Filter has to be evaluated.
176 ;******************************************************************
177 ;INPUT
178 ; SDARRAY APPOINTMENT FILTER ARRAY (by reference)
179 ;******************************************************************
180CALLRSA(SDARRAY) ;
181 ;initialize variables
182 N SDCOUNT,SDX,SDCLIEN,SDQUIT,SDGBL,SDRSLT
183 S (SDCOUNT,SDQUIT)=0
184 ;if clinic is in a list:
185 I SDARRAY("CLNGBL")=0 D
186 . S SDCOUNT=$L(SDARRAY(2),";")
187 . ;For each clinic in the filter (LIST):
188 . F SDX=1:1:SDCOUNT Q:SDQUIT D
189 .. S SDCLIEN=$P(SDARRAY(2),";",SDX)
190 .. ;determine if clinic has migrated (Call RSA)
191 .. S SDRSLT='$$CLMIG(SDCLIEN,.SDARRAY)
192 .. S SDQUIT=+$G(SDARRAY("RSA"))
193 ;if clinic is in array, get IENs
194 I SDARRAY("CLNGBL")=1 D
195 . S SDGBL=SDARRAY(2),SDCLIEN=0
196 . ;for each clinic in the filter (GLOBAL):
197 . F S SDCLIEN=$O(@(SDGBL_"SDCLIEN)")) Q:(($G(SDCLIEN)="")!(SDQUIT)) D
198 .. ;determine if clinic has migrated (Call RSA)
199 .. S SDRSLT='$$CLMIG(SDCLIEN,.SDARRAY)
200 .. S SDQUIT=+$G(SDARRAY("RSA"))
201 Q
202 ;
203 ;****************************************************************
204 ;INPUT
205 ; SDERRNUM Appropriate error diagnosing problem (REQUIRED)
206 ; 101 Database Unavailable
207 ; 115 Invalid Input Array Entry
208 ; 116 Data Mismatch
209 ; 117 SDAPI Error (Other Error)
210 ; SDVLRHNL Request Handle (optional)
211 ;
212 ;Output
213 ; N/A
214 ;****************************************************************
215ERROR(SDERRNUM,SDVLRHNL) ;error handling
216 ;clean up locations
217 ;D:$G(SDVLRHNL)'="" CLEAN^XOBVJLIB(SDVLRHNL)
218 ;kill existing global entries
219 K ^TMP($J,"SDAMA301")
220 ;create error entry in global
221 D ERROR^SDAMA300(SDERRNUM)
222 Q
223 ;
224 ;****************************************************************
225 ;INPUT
226 ; SDVLRHNL VistALink Request Handle (REQUIRED)
227 ; SDVRFR OVERLOAD PARAMETER FOR VERIFIER [optional]
228 ; (Creates Error Info in Output Global - 101 Returned)
229 ;****************************************************************
230VLERR(SDVLRHNL,SDVRFR) ;write vistalink errors to err log
231 N SDERR ;initialize variables
232 ;setup err log variables and call err log handler
233 S SDERR(1)="SDAMA301"
234 ;S SDERR(5)="VistALink returned ERROR Code: "_$$GETFLTCD^XOBVJRQ(SDVLRHNL)_" ERROR Message: "_$$GETFLTMS^XOBVJRQ(SDVLRHNL)
235 S SDERR(6)="SDRSA101"
236 ;remove special characters from VL calls
237 S SDERR(5)=$E(SDERR(5),1,$L(SDERR(5))-1)
238 ;D LOGERR^SDAMA314(.SDERR)
239 D:($G(SDVRFR)) ERROR(101,SDVLRHNL) ;write error to output global
240 Q
Note: See TracBrowser for help on using the repository browser.