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

Last change on this file since 953 was 951, checked in by Sam Habiel, 14 years ago

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason
File size: 10.7 KB
Line 
1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm
2 ;;1.4;BSDX;;Sep 07, 2010
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.