source: Scheduling/trunk/m/BSDXAPI.m@ 798

Last change on this file since 798 was 742, checked in by Sam Habiel, 15 years ago

Fixes in BSDX27 referring to a routine that doesn't exist in VISTA. References changed to BSDXAPI.
File size: 10.7 KB
Line 
1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm
2 ;;2.1;BSDX;;24JUL2009
3 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
4 ;local mods (many) by WV/SMH
5 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
6 ;
7MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
8 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
9 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
10 ; for Baby foxes hallucinations.
11 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
12 S BSDR("PAT")=DFN ;DFN
13 S BSDR("CLN")=CLIN ;Hosp Loc IEN
14 S BSDR("TYP")=TYP ;3 sched or 4 walkin
15 S BSDR("ADT")=DATE ;Appointment date in FM format
16 S BSDR("LEN")=LEN ;Appt len upto 240 (min)
17 S BSDR("INFO")=INFO ;Reason for appt - up to 150 char
18 S BSDR("USR")=DUZ ;Person who made appt - current user
19 Q $$MAKE(.BSDR)
20 ;
21MAKE(BSDR) ;PEP; call to store appt made
22 ;
23 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
24 ;
25 ; Input Array -
26 ; BSDR("PAT") = ien of patient in file 2
27 ; BSDR("CLN") = ien of clinic in file 44
28 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
29 ; BSDR("ADT") = appointment date and time
30 ; BSDR("LEN") = appointment length in minutes (5-120)
31 ; BSDR("OI") = reason for appt - up to 150 characters
32 ; BSDR("USR") = user who made appt
33 ;
34 ;Output: error status and message
35 ; = 0 or null: everything okay
36 ; = 1^message: error and reason
37 ;
38 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
39 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
40 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
41 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
42 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
43 ;
44 I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
45 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
46 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'="C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
47 ;
48 NEW DIC,DA,Y,X,DD,DO,DLAYGO
49 ;
50 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D
51 . ; "un-cancel" existing appt in file 2
52 . N BSDXFDA,BSDXIENS,BSDXMSG
53 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
54 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
55 . S BSDXFDA(2.98,BSDXIENS,"3")=""
56 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
57 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
58 . S BSDXFDA(2.98,BSDXIENS,"14")=""
59 . S BSDXFDA(2.98,BSDXIENS,"15")=""
60 . S BSDXFDA(2.98,BSDXIENS,"16")=""
61 . S BSDXFDA(2.98,BSDXIENS,"19")=""
62 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
63 . D FILE^DIE("","BSDXFDA","BSDXMSG")
64 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
65 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
66 . N BSDXFDA,BSDXIENS,BSDXMSG
67 . S BSDXIENS="?+2,"_BSDR("PAT")_","
68 . S BSDXIENS(2)=BSDR("ADT")
69 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
70 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
71 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
72 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
73 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
74 ; add appt to file 44
75 K DIC,DA,X,Y,DLAYGO,DD,DO
76 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
77 I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
78 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
79 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
80 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
81 ;
82 K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
83 S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
84 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
85 S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
86 S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
87 D FILE^DICN
88 ;
89 ; call event driver
90 NEW DFN,SDT,SDCL,SDDA,SDMODE
91 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
92 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
93 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
94 Q 0
95 ;
96CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
97 ; Call like this for DFN 23435 checking in now at Hospital Location 33
98 ; for appt at Dec 20, 2009 @ 10:11:59
99 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
100 S BSDR("PAT")=DFN ;DFN
101 S BSDR("CLN")=CLIN ;Hosp Loc IEN
102 S BSDR("ADT")=APDATE ;Appt Date
103 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
104 S BSDR("USR")=DUZ ;Check-in user defaults to current
105 Q $$CHECKIN(.BSDR)
106 ;
107CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
108 ;
109 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
110 ;
111 ; Input array -
112 ; BSDR("PAT") = ien of patient in file 2
113 ; BSDR("CLN") = ien of clinic in file 44
114 ; BSDR("ADT") = appt date/time
115 ; BSDR("CDT") = checkin date/time
116 ; BSDR("USR") = checkin user
117 ;
118 ; Output value -
119 ; = 0 means everything worked
120 ; = 1^message means error with reason message
121 ;
122 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
123 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
124 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
125 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
126 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
127 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
128 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
129 ;
130 ; find ien for appt in file 44
131 NEW IEN,DIE,DA,DR
132 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
133 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
134 ;
135 ; remember before status
136 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
137 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
138 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
139 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
140 ;
141 ; set checkin
142 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
143 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
144 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
145 D ^DIE
146 ;
147 ; set after status
148 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
149 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
150 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
151 ;
152 ; call event driver
153 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
154 Q 0
155 ;
156CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
157 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
158 ; cancellation initiated by patient ("PC" rather than clinic "C"),
159 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
160 ; because foxes come out during bad weather.
161 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
162 S BSDR("PAT")=DFN
163 S BSDR("CLN")=CLIN
164 S BSDR("TYP")=TYP
165 S BSDR("ADT")=APDATE
166 S BSDR("CDT")=$$NOW^XLFDT
167 S BSDR("USR")=DUZ
168 S BSDR("CR")=REASON
169 S BSDR("NOT")=INFO
170 Q $$CANCEL(.BSDR)
171 ;
172CANCEL(BSDR) ;PEP; called to cancel appt
173 ;
174 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
175 ;
176 ; Input Array -
177 ; BSDR("PAT") = ien of patient in file 2
178 ; BSDR("CLN") = ien of clinic in file 44
179 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
180 ; BSDR("ADT") = appointment date and time
181 ; BSDR("CDT") = cancel date and time
182 ; BSDR("USR") = user who canceled appt
183 ; BSDR("CR") = cancel reason - pointer to file 409.2
184 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
185 ;
186 ;Output: error status and message
187 ; = 0 or null: everything okay
188 ; = 1^message: error and reason
189 ;
190 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
191 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
192 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
193 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
194 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
195 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
196 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
197 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
198 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
199 ;
200 NEW IEN,DIE,DA,DR
201 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
202 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
203 ;
204 I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
205 ;
206 ; remember before status
207 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
208 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
209 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
210 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
211 ;
212 ; get user who made appt and date appt made from ^SC
213 ; because data in ^SC will be deleted
214 NEW USER,DATE
215 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
216 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
217 ;
218 ; update file 2 info
219 NEW DIE,DA,DR
220 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
221 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
222 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
223 D ^DIE
224 ;
225 ; delete data in ^SC
226 NEW DIK,DA
227 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
228 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
229 D ^DIK
230 ;
231 ; call event driver
232 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
233 Q 0
234 ;
235CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
236 NEW X
237 S X=$G(SDIEN) ;ien sent in call
238 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
239 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
240 Q $S(X:1,1:0)
241 ;
242SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
243 NEW X,IEN
244 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
245 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled
246 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
247 Q $G(IEN)
248 ;
249APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
250 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
251 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
252 ;
253CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
254 NEW X
255 S X=$G(SDIEN) ;ien sent in call
256 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
257 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
258 Q $S(X:1,1:0)
259 ;
260
Note: See TracBrowser for help on using the repository browser.