source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMA305.m@ 1096

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

initial load of WorldVistAEHR
File size: 9.4 KB
Line 
1SDAMA305 ;BPOIFO/ACS-Filter API Get Data ; 6/21/05 1:50pm
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 ; RENAME ENTRY POINT TO ROUTINE
16 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
17 ;*****************************************************************
18 ;
19 ;*****************************************************************
20 ; GET APPOINTMENT DATA FROM VISTA
21 ;INPUT
22 ; SDARRAY Appointment Filter array
23 ;
24 ;OUTPUT
25 ; ^TMP($J,"SDAMA301",SORT1,SORT2,APPT D/T)
26 ;*****************************************************************
27SETARRAY(SDARRAY) ;
28 ;Initialize local variables
29 N SDI,SDIEN,SDNAME,SDFLDS,SDDATA,SDCOUNT,SDFIELD,SDCLIEN,SDDV,SDSCRTCH
30 S SDFLDS=SDARRAY("FLDS")
31 S SDCOUNT=$L(SDFLDS,";")
32 ;Add 1 to appointment count
33 S SDARRAY("CNT")=(SDARRAY("CNT")+1)
34 ;For each appoitment field requested
35 F SDI=1:1:SDCOUNT D
36 . S (SDIEN,SDNAME,SDDATA)=""
37 . S SDFIELD=$P(SDFLDS,";",SDI)
38 . ;get data
39 . D @SDFIELD
40 . ;nodes in output global can't be null
41 . I $G(SDARRAY("SORT1"))="" S SDARRAY("SORT1")="X"_SDARRAY("CNT")
42 . I $G(SDARRAY("SORT2"))="" S SDARRAY("SORT2")="Y"_SDARRAY("CNT")
43 . ;add data to output array
44 . ;Store information with just Patient IEN (No Clinic IEN) in the global reference
45 . I $G(SDARRAY("SORT"))="P" D
46 . .S:(SDFIELD<28) $P(^TMP($J,"SDAMA301",$G(SDARRAY("PAT")),SDARRAY("DATE")),"^",SDFIELD)=$S(SDFIELD=6:"",1:$G(SDDV(SDFIELD)))
47 . .S:(SDFIELD>27) $P(^TMP($J,"SDAMA301",$G(SDARRAY("PAT")),SDARRAY("DATE"),0),"^",(SDFIELD#27))=$G(SDDV(SDFIELD))
48 . .S:(SDFIELD=6) ^TMP($J,"SDAMA301",$G(SDARRAY("PAT")),SDARRAY("DATE"),"C")=$G(SDDV(SDFIELD))
49 . ;Store information with Patient and Clinic IEN (Sort1, Sort2) in the global reference
50 . I $G(SDARRAY("SORT"))'="P" D
51 . .S:(SDFIELD<28) $P(^TMP($J,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE")),"^",SDFIELD)=$S(SDFIELD=6:"",1:$G(SDDV(SDFIELD)))
52 . .S:(SDFIELD>27) $P(^TMP($J,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE"),0),"^",(SDFIELD#27))=$G(SDDV(SDFIELD))
53 . .S:(SDFIELD=6) ^TMP($J,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE"),"C")=$G(SDDV(SDFIELD))
54 Q
551 ;Appt date/time
56 S SDDV(SDFIELD)=SDARRAY("DATE")
57 Q
582 ;Clinic IEN and Name
59 S SDIEN=+$G(SDARRAY("DPT0"))
60 I '$G(SDIEN) S SDNAME=""
61 E S SDNAME=$P($G(^SC(SDIEN,0)),"^",1)
62 S SDDV(SDFIELD)=$G(SDIEN)_";"_$G(SDNAME)
63 Q
643 ;Appt Status and Status Description
65 N SDSTAT
66 S SDSTAT=$P($G(SDARRAY("DPT0")),"^",2)
67 I $G(SDSTAT)="" S SDDATA="R;SCHEDULED/KEPT"
68 E D
69 . S SDDATA=$S(SDSTAT="I":"I;INPATIENT",SDSTAT="C":"CC;CANCELLED BY CLINIC",1:"X")
70 . I SDDATA="X" S SDDATA=$S(SDSTAT="CA":"CCR;CANCELLED BY CLINIC & RESCHEDULED",SDSTAT="PC":"CP;CANCELLED BY PATIENT",1:"X")
71 . I SDDATA="X" S SDDATA=$S(SDSTAT="PCA":"CPR;CANCELLED BY PATIENT & RESCHEDULED",SDSTAT="N":"NS;NO-SHOW",1:"X")
72 . I SDDATA="X" S SDDATA=$S(SDSTAT="NA":"NSR;NO-SHOW & RESCHEDULED",SDSTAT="NT":"NT;NO ACTION TAKEN",1:SDSTAT_";UNKNOWN")
73 S SDDV(SDFIELD)=SDDATA
74 Q
754 ;Patient IEN and Name
76 S SDIEN=$G(SDARRAY("PAT"))
77 S SDNAME=$P($G(^DPT(SDIEN,0)),"^",1)
78 S SDDV(SDFIELD)=$G(SDIEN)_";"_$G(SDNAME)
79 Q
805 ;Length of Appt
81 S SDDV(SDFIELD)=$P($G(SDARRAY("SC0")),"^",2)
82 Q
836 ;Comments
84 S SDDV(SDFIELD)=$P($G(SDARRAY("SC0")),"^",4)
85 Q
867 ;Overbook (return null if appt cancelled)
87 I $G(SDARRAY("SC0"))'="" D
88 . S SDDATA=$P($G(SDARRAY("SCOB")),"^",1)
89 . S SDDV(SDFIELD)=$S($G(SDDATA)="O":"Y",1:"N")
90 Q
918 ;Local & National Eligiblity of Visit Codes and Names
92 N SDELIG,SDPELIG,SDASTS,DFN,VAROOT,VAERR
93 S VAERR=0,SDDATA=$P($G(SDARRAY("SC0")),"^",10)
94 S SDASTS=$P($G(SDARRAY("DPT0")),"^",2)
95 ;if eligibility is null, get patients primary eligibility
96 ; * only if appointment status is not cancelled *
97 I (($G(SDDATA)']"")&($G(SDASTS)'["C")) D
98 . S VAROOT="SDPELIG",DFN=$G(SDARRAY("PAT")) D ELIG^VADPT
99 . S SDDATA=$P(SDPELIG(1),"^")
100 ;get local/national eligibility to add to output if
101 ;ELIG^VADPT did not error and the ien is not null
102 I (('VAERR)&($G(SDDATA)]"")) D
103 . S SDELIG=$G(^DIC(8,SDDATA,0))
104 . ;Append Local Eligibility IEN and Name
105 . S SDDV(SDFIELD)=$G(SDDATA)_";"_$P(SDELIG,"^")
106 . ;Append National Eligibility IEN and Name
107 . S SDIEN=$P(SDELIG,"^",9)
108 . I $G(SDIEN) D
109 .. S SDNAME=$P($G(^DIC(8.1,SDIEN,0)),"^",1)
110 .. S SDDV(SDFIELD)=SDDV(SDFIELD)_";"_$G(SDIEN)_";"_$G(SDNAME)
111 Q
1129 ;Check-In Date/time
113 S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",1)
114 S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
115 Q
11610 ;Appt Type IEN and Name
117 S SDIEN=$P($G(SDARRAY("DPT0")),"^",16)
118 I $G(SDIEN)]"" D
119 . S SDNAME=$P($G(^SD(409.1,SDIEN,0)),"^",1)
120 . S SDDV(SDFIELD)=$G(SDIEN)_";"_$G(SDNAME)
121 Q
12211 ;Check-Out date/time
123 S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",3)
124 S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
125 Q
12612 ;Outpatient Encounter
127 S SDDV(SDFIELD)=$P($G(SDARRAY("DPT0")),"^",20)
128 Q
12913 ;Primary Stop Code IEN and AMIS STOP CODE
130 N SDCODES
131 S SDCLIEN=+SDARRAY("DPT0")
132 I $G(SDCLIEN)]"" D
133 . S SDCODES=$$GETSTOP(SDCLIEN)
134 . I SDCODES'=-1 S SDDV(SDFIELD)=$P(SDCODES,"^",1)
135 Q
13614 ;Credit Stop Code IEN and AMIS STOP CODE
137 S SDCLIEN=+SDARRAY("DPT0")
138 I $G(SDCLIEN)]"" D
139 . S SDCODES=$$GETSTOP(SDCLIEN)
140 . I SDCODES'=-1 S SDDV(SDFIELD)=$P(SDCODES,"^",2)
141 Q
14215 ;Workload Non-Count
143 S SDCLIEN=+SDARRAY("DPT0")
144 I $G(SDCLIEN)]"" D
145 . S SDCODES=$$GETSTOP(SDCLIEN)
146 . I SDCODES'=-1 S SDDV(SDFIELD)=$P($G(SDCODES),"^",3)
147 Q
14816 ;Date Appt Made
149 S SDDV(SDFIELD)=$P($P($G(SDARRAY("DPT0")),"^",19),".")
150 Q
15117 ;Desired Date of Appt
152 S SDDV(SDFIELD)=$P($P($G(SDARRAY("DPT1")),"^",1),".")
153 Q
15418 ;Purpose of Visit
155 S SDDATA=$P($G(SDARRAY("DPT0")),"^",7)
156 I $G(SDDATA)'="" D
157 . S SDDATA=SDDATA_$S(SDDATA="1":";C&P",SDDATA="2":";10-10",SDDATA="3":";SV",SDDATA="4":";UV",1:";")
158 . S SDDV(SDFIELD)=SDDATA
159 Q
16019 ;EKG Date/time
161 S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",5)
162 S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
163 Q
16420 ;X-Ray Date/time
165 S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",4)
166 S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
167 Q
16821 ;Lab Date/time
169 S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",3)
170 S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
171 Q
17222 ;Status
173 ; (Status IEN; Status Description; Print Status; Checked In Date/Time;
174 ; Checked Out Date/Time; Admission Movement IEN)
175 ;convert to new appt status code
176 D 3
177 S SDDV(SDFIELD)=$$STATUS^SDAMA308(+$G(SDARRAY("PAT")),+$G(SDARRAY("DATE")),+$G(SDARRAY("DPT0")),$P(SDDV(SDFIELD),";"),$P($G(SDARRAY("SCC")),"^"),$P($G(SDARRAY("SCC")),"^",3),$P($G(SDARRAY("DPT0")),"^",20))
178 Q
17923 ;X-Ray Films
180 N SDRECS
181 ;Get Clinic IEN, X-Ray Films Required
182 S SDIEN=+$G(SDARRAY("DPT0"))
183 S SDRECS=$P($G(^SC(SDIEN,"RAD")),"^")
184 ;Translate Lower Case to Upper
185 S SDRECS=$TR(SDRECS,"ny","NY")
186 S SDDATA=$S(SDRECS["Y":"Y",1:"N")
187 S SDDV(SDFIELD)=SDDATA
188 Q
18924 ;Auto-Rebooked Appt. Date/Time
190 S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",10)
191 S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
192 Q
19325 ;No-Show/Cancel Date/Time
194 S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",14)
195 S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
196 Q
197 ;This field is only associated with appt info from RSA
198 ;(No VistA Scheduling Value Exists)
19926 ;RSA Appointment ID
200 Q
20127 ;2507 Request IEN
202 ;N SDREQ
203 ;retrieve 2507 request for patient's appt
204 ;S SDREQ=$$GET2507^DVBCMKLK(+$G(SDARRAY("PAT")),$G(SDARRAY("DATE")))
205 ;S SDDV(SDFIELD)=$S((SDREQ>0):SDREQ,1:"")
206 Q
20728 ;Data Entry Clerk DUZ and Name
208 N SDSTAT
209 S SDSTAT=$P($G(SDARRAY("DPT0")),"^",2) ;determine appt status
210 ;Appt is deleted from ^SC when appt is cancelled
211 S SDSCRTCH=$S(SDSTAT["C":$P($G(SDARRAY("DPT0")),"^",18),1:$P($G(SDARRAY("SC0")),"^",6))
212 S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
213 Q
21429 ;No-Show/Cancelled By DUZ and Name
215 S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",12)
216 S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
217 Q
21830 ;Check-In User DUZ and Name
219 S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",2)
220 S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
221 Q
22231 ;Check-Out User DUZ and Name
223 S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",4)
224 S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
225 Q
22632 ;Cancellation Reason IEN and Name
227 S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",15)
228 S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(409.2,SDSCRTCH,.01)
229 Q
23033 ;Consult Link IEN
231 S SDDV(SDFIELD)=$G(SDARRAY("SCONS"))
232 Q
233GETSTOP(SDCLIEN) ;Primary Stop Code, Credit Stop Code, Non-Count
234 ; return codes or -1 if bad clinic
235 N SDPSC,SDPSCIEN,SDCSC,SDCSCIEN,SDNC,SDCODES
236 I +$G(SDCLIEN)=0 S SDCODES=-1
237 I +$G(SDCLIEN)'=0 D
238 . ;make sure clinic is on ^SC
239 . I '$D(^SC(SDCLIEN)) S SDCODES=-1 Q
240 . ;get primary stop code ien
241 . S SDPSCIEN=$P($G(^SC(SDCLIEN,0)),"^",7)
242 . ;get credit stop code ien
243 . S SDCSCIEN=$P($G(^SC(SDCLIEN,0)),"^",18)
244 . I $G(SDPSCIEN) S SDPSC=$P($G(^DIC(40.7,SDPSCIEN,0)),"^",2)
245 . I $G(SDCSCIEN) S SDCSC=$P($G(^DIC(40.7,SDCSCIEN,0)),"^",2)
246 . ;get workload non-count
247 . S SDNC=$P($G(^SC(SDCLIEN,0)),"^",17)
248 . S SDNC=$S($G(SDNC)="Y":"Y",1:"N")
249 . S SDCODES=$G(SDPSCIEN)_";"_$G(SDPSC)_"^"_$G(SDCSCIEN)_";"_$G(SDCSC)_"^"_SDNC
250 Q SDCODES
Note: See TracBrowser for help on using the repository browser.