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