Changeset 888 for Scheduling/trunk/m/BSDXAPI.m
- Timestamp:
- Jul 18, 2010, 9:58:35 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDXAPI.m
r742 r888 1 BSDXAPI 2 ;;2.1;BSDX;;24JUL2009 3 4 5 6 7 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) 8 9 10 11 12 13 14 15 16 17 18 19 20 21 MAKE(BSDR) 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 CHECKIN1(DFN,CLIN,APDATE) 97 98 99 100 101 102 103 104 105 106 107 CHECKIN(BSDR) 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 CANCEL(BSDR) 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 CI(PAT,CLINIC,DATE,SDIEN) 236 237 238 239 240 241 242 SCIEN(PAT,CLINIC,DATE) 243 244 245 246 247 248 249 APPTYP(PAT,DATE) 250 251 252 253 CO(PAT,CLINIC,DATE,SDIEN) 254 255 256 257 258 259 260 1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm 2 ;;1.3T1;BSDX;;Jul 18, 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 ; 7 MAKE1(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 ; 21 MAKE(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 ; 96 CHECKIN1(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 ; 107 CHECKIN(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 ; 156 CANCEL1(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 ; 172 CANCEL(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 ; 235 CI(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 ; 242 SCIEN(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 ; 249 APPTYP(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 ; 253 CO(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 TracChangeset
for help on using the changeset viewer.