Changeset 1625 for Scheduling/trunk/m/BSDXAPI.m
- Timestamp:
- Jun 1, 2013, 10:54:38 AM (11 years ago)
- File:
-
- 1 edited
-
Scheduling/trunk/m/BSDXAPI.m (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDXAPI.m
r1563 r1625 1 BSDXAPI ; IHS/ ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am2 ;;1. 6;BSDX;;Aug 31, 2011;Build 251 BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/10/12 5:58pm 2 ;;1.7;BSDX;;Jun 01, 2013;Build 24 3 3 ; Licensed under LGPL 4 4 ; 5 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW 6 ;local mods (many) by WV/SMH 7 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH 8 ; Change History: 9 ; 2010-11-5: (1.42) 10 ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment. 11 ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API. 12 ; 2010-11-12: (1.42) 13 ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well. 14 ; 2010-12-5 (1.42) 15 ; Added an entry point to update the patient note in file 44. 16 ; 2010-12-6 (1.42) 17 ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI") 18 ; 2010-12-8 (1.42) 19 ; Removed restriction on max appt length. Even though this restriction 20 ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I 21 ; will ignore it here too. 22 ; 2011-01-25 (v.1.5) 23 ; Added entry point $$RMCI to remove checked in appointments. 24 ; In $$CANCEL, if the appointment is checked in, delete check-in rather than 25 ; spitting an error message to the user saying 'Delete the check-in' 26 ; Changed all lines that look like this: 27 ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 28 ; to: 29 ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 30 ; to allow for date at midnight which does not have a dot at the end. 31 ; 2011-01-26 (v.1.5) 32 ; More user friendly message if patient already has appointment in $$MAKE: 33 ; Spits out pt name and user friendly date. 34 ; 5 ; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW 6 ; mods (many) by WV/SMH 7 ; Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH 8 ; Change history is located in BSDXAPI1 (to save space). 35 9 ; 36 10 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment … … 39 13 ; for Baby foxes hallucinations. 40 14 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") 15 N BSDR 41 16 S BSDR("PAT")=DFN ;DFN 42 17 S BSDR("CLN")=CLIN ;Hosp Loc IEN … … 65 40 ; = 1^message: error and reason 66 41 ; 42 N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment 43 I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why. 44 ; 45 ;Otherwise, we continue 46 ; 47 N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables 48 ; 49 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D 50 . ; "un-cancel" existing appt in file 2 51 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," 52 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") 53 . S BSDXFDA(2.98,BSDXIENS,"3")="" 54 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 55 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 56 . S BSDXFDA(2.98,BSDXIENS,"14")="" 57 . S BSDXFDA(2.98,BSDXIENS,"15")="" 58 . S BSDXFDA(2.98,BSDXIENS,"16")="" 59 . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over 60 . S BSDXFDA(2.98,BSDXIENS,"19")="" 61 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 62 . D FILE^DIE("","BSDXFDA","BSDXMSG") 63 Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) 64 ; 65 Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line 66 ; 67 E D ; File new appointment/edit existing appointment in file 2 68 . S BSDXIENS="?+2,"_BSDR("PAT")_"," 69 . S BSDXIENS(2)=BSDR("ADT") 70 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") 71 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 72 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 73 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 74 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG") 75 Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) 76 ; 77 Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line 78 ; 79 ; add appt to file 44. This adds it to the FIRST subfile (Appointment) 80 N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM 81 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" 82 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") 83 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") 84 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 85 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 86 ; 87 Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line 88 ; 89 ; add appt for file 44, second subfile (Appointment/Patient) 90 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh 91 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM 92 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 93 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") 94 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") 95 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 96 ;D FILE^DICN 97 ; 98 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_"," 99 N BSDXFDA 100 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT") 101 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN") 102 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150) 103 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR") 104 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".") 105 N BSDXERR 106 D UPDATE^DIE("","BSDXFDA","","BSDXERR") 107 ; 108 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) 109 ; 110 ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line 111 S:$G(BSDXSIMERR5) X=1/0 112 ; 113 ; Update the Availablilities ; Doesn't fail. Global reads and sets. 114 D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN"),BSDR("PAT")) 115 ; 116 ; call event driver 117 NEW DFN,SDT,SDCL,SDDA,SDMODE 118 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 119 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 120 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) 121 Q 0 122 ; 123 MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP 124 ; Input: Same as $$MAKE 125 ; Output: 1^error or 0 for success 126 ; NB: This subroutine saves no data. Only checks whether it's okay. 127 ; 67 128 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 68 129 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) … … 71 132 I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 72 133 ; 73 ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details. 134 ; Appt Length check removed in v 1.5 135 ; 74 136 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 75 ;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") ; v.1.5 more user friendly err msg 76 ; 137 ; More verbose error message in v1.5 77 138 ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others. 78 139 N BSDXERR ; place to store error message … … 88 149 . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U) 89 150 . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic 90 ; 91 NEW DIC,DA,Y,X,DD,DO,DLAYGO 92 ; 93 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D 94 . ; "un-cancel" existing appt in file 2 95 . N BSDXFDA,BSDXIENS,BSDXMSG 96 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," 97 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") 98 . S BSDXFDA(2.98,BSDXIENS,"3")="" 99 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 100 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 101 . S BSDXFDA(2.98,BSDXIENS,"14")="" 102 . S BSDXFDA(2.98,BSDXIENS,"15")="" 103 . S BSDXFDA(2.98,BSDXIENS,"16")="" 104 . S BSDXFDA(2.98,BSDXIENS,"19")="" 105 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 106 . D FILE^DIE("","BSDXFDA","BSDXMSG") 107 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) 108 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 109 . N BSDXFDA,BSDXIENS,BSDXMSG 110 . S BSDXIENS="?+2,"_BSDR("PAT")_"," 111 . S BSDXIENS(2)=BSDR("ADT") 112 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") 113 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 114 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 115 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 116 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") 117 ; add appt to file 44 118 K DIC,DA,X,Y,DLAYGO,DD,DO 119 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" 120 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") 121 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") 122 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 123 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 124 ; 125 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh 126 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM 127 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 128 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") 129 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") 130 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 131 ;D FILE^DICN 132 ; 133 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_"," 134 N BSDXFDA 135 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT") 136 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN") 137 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150) 138 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR") 139 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".") 140 N BSDXERR 141 D UPDATE^DIE("","BSDXFDA","","BSDXERR") 142 ; 143 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) 144 ; 145 ; call event driver 146 NEW DFN,SDT,SDCL,SDDA,SDMODE 147 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 148 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 149 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) 150 Q 0 151 Q 0 152 ; 153 UNMAKE(BSDR) ; Reverse Make - Private $$ 154 ; Only used in Emergiencies where Fileman data filing fails. 155 ; If previous data exists, which caused an error, it's destroyed. 156 ; NB: ^DIK stops for nobody 157 ; NB: If Patient Appointment previously existed as cancelled, it's removed. 158 ; How can I tell if one previously existed when data is in an intermediate 159 ; State? Can I restore it if the other file failed? Restoration can cause 160 ; another error. If I restore the global, there will be cross-references 161 ; missing (ASDCN specifically). 162 ; 163 ; Input: Same array as $$MAKE 164 ; Output: Always 0 165 NEW DIK,DA 166 S DIK="^DPT("_BSDR("PAT")_",""S""," 167 S DA(1)=BSDR("PAT"),DA=BSDR("ADT") 168 D ^DIK 169 ; 170 N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 171 I 'IEN QUIT 0 172 ; 173 NEW DIK,DA 174 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 175 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 176 D ^DIK 177 QUIT 0 151 178 ; 152 179 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in … … 154 181 ; for appt at Dec 20, 2009 @ 10:11:59 155 182 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) 183 N BSDR 156 184 S BSDR("PAT")=DFN ;DFN 157 185 S BSDR("CLN")=CLIN ;Hosp Loc IEN … … 175 203 ; = 0 means everything worked 176 204 ; = 1^message means error with reason message 205 ; 206 I $G(BSDXDIE2) N X S X=1/0 207 ; 208 N BSDXERR S BSDXERR=$$CHECKICK(.BSDR) 209 I BSDXERR Q BSDXERR 210 ; 211 ; find ien for appt in file 44 212 NEW IEN,DIE,DA,DR 213 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 214 ; 215 ; remember before status 216 ; Failure analysis: Only ^TMP global is set here. 217 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE 218 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 219 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 220 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 221 ; 222 ; set checkin; Old Code -- keep for ref VEN/SMH 3 Jul 2012 223 ; S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 224 ; S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 225 ; S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT 226 ; D ^DIE 227 ; 228 I $D(BSDXSIMERR3) Q 1_U_"Simulated Error" 229 ; 230 ; Failure analysis: If this fails, no other changes were made in this routine 231 N BSDXIENS S BSDXIENS=IEN_","_BSDR("ADT")_","_BSDR("CLN")_"," 232 N BSDXFDA 233 S BSDXFDA(44.003,BSDXIENS,309)=BSDR("CDT") 234 S BSDXFDA(44.003,BSDXIENS,302)=BSDR("USR") 235 S BSDXFDA(44.003,BSDXIENS,305)=$$NOW^XLFDT() 236 N BSDXERR 237 D UPDATE^DIE("","BSDXFDA","BSDXERR") 238 ; 239 I $D(BSDXERR) Q 1_U_"Error checking in appointment to file 44. Error: "_BSDXERR("DIERR",1,"TEXT",1) 240 ; 241 ; set after status 242 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 243 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 244 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 245 ; 246 ; Point of no Return 247 ; call event driver 248 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) 249 Q 0 250 ; 251 CHECKIC1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKICK - 252 ; Check-in Check 253 ; Call like this for DFN 23435 checking in now at Hospital Location 33 254 ; for appt at Dec 20, 2009 @ 10:11:59 255 ; S RESULT=$$CHECKIC1^BSDXAPI(23435,33,3091220.221159) 256 N BSDR 257 S BSDR("PAT")=DFN ;DFN 258 S BSDR("CLN")=CLIN ;Hosp Loc IEN 259 S BSDR("ADT")=APDATE ;Appt Date 260 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now 261 S BSDR("USR")=DUZ ;Check-in user defaults to current 262 Q $$CHECKICK(.BSDR) 263 ; 264 CHECKICK(BSDR) ; $$ PEP; - Is it okay to check-in patient? 265 ; Input: Same as $$CHECKIN 266 ; Output: 0 if okay or 1^message if error 267 ; 268 I $G(BSDXSIMERR2) Q 1_U_"Simulated Error" 177 269 ; 178 270 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) … … 185 277 ; 186 278 ; find ien for appt in file 44 187 NEW IEN,DIE,DA,DR 188 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 279 N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 189 280 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 190 ;191 ; remember before status192 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL193 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN194 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL195 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)196 ;197 ; set checkin198 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"199 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN200 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT201 D ^DIE202 ;203 ; set after status204 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))205 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL206 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)207 ;208 ; call event driver209 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)210 281 Q 0 211 282 ; … … 216 287 ; because foxes come out during bad weather. 217 288 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") 289 N BSDR 218 290 S BSDR("PAT")=DFN 219 291 S BSDR("CLN")=CLIN … … 244 316 ; = 1^message: error and reason 245 317 ; 318 ; Okay to Cancel? Call Cancel Check. 319 N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR) 320 I BSDXCANCK Q BSDXCANCK 321 ; 322 ; BSDX 1.5 3110125 323 ; UJO/SMH - Add ability to remove check-in if the patient is checked in 324 ; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in 325 ; Lets you remove appointment anyways! Not like RPMS. 326 ; Plus... deleting checkin affects S node on 44, which is DELETED anyways! 327 ; 328 ; remember before status 329 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE 330 NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 331 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 332 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 333 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) 334 ; NB: Here only ^TMP globals are set with before values. 335 ; 336 ; get user who made appt and date appt made from ^SC 337 ; because data in ^SC will be deleted 338 ; Appointment Length: ditto 339 NEW USER,DATE 340 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) 341 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) 342 N BSDXLEN S BSDXLEN=$$APPLEN(DFN,SDCL,SDT) ; appt length 343 ; 344 ; update file 2 info --old code; keep for reference 345 ;NEW DIE,DA,DR 346 ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT 347 ;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE 348 ;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) 349 ;D ^DIE 350 N BSDXIENS S BSDXIENS=SDT_","_DFN_"," 351 N BSDXFDA 352 S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP") 353 S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR") 354 S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT") 355 S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR") 356 S BSDXFDA(2.98,BSDXIENS,19)=USER 357 S BSDXFDA(2.98,BSDXIENS,20)=DATE 358 S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160) 359 N BSDXERR 360 D FILE^DIE("","BSDXFDA","BSDXERR") 361 I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2" 362 ; Failure point 1: If we fail here, nothing has happened yet. 363 ; 364 ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop 365 NEW DIK,DA 366 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 367 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 368 D ^DIK 369 ; Failure point 2: not expected to happen here 370 ; 371 ; Update PIMS availability -- this doesn't fail. Global gets/sets only. 372 D AVUPDTCN^BSDXAPI1(SDCL,SDT,BSDXLEN) 373 ; 374 ; call event driver -- point of no return 375 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) 376 ; 377 Q 0 378 ; 379 CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment? 380 ; Input: .BSDR array as documented in $$CANCEL 381 ; Output: 0 or 1^Error message 246 382 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 247 383 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) … … 254 390 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) 255 391 ; 256 NEW IEN,DIE,DA,DR 257 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 392 NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 258 393 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 259 394 ; 260 ; BSDX 1.5 3110125 261 ; UJO/SMH - Add ability to remove check-in if the patient is checked in 262 ; 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") 263 ; Remove check-in if the patient is checked in. 264 N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure 265 I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 266 I BSDXRESULT Q BSDXRESULT 267 ; 268 ; remember before status 269 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL 270 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 271 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 272 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) 273 ; 274 ; get user who made appt and date appt made from ^SC 275 ; because data in ^SC will be deleted 276 NEW USER,DATE 277 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) 278 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) 279 ; 280 ; update file 2 info 281 NEW DIE,DA,DR 282 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT 283 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE 284 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) 285 D ^DIE 286 ; 287 ; delete data in ^SC 288 NEW DIK,DA 289 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 290 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 291 D ^DIK 292 ; 293 ; call event driver 294 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) 395 ; Check-out check. New in v1.7 396 I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!" 295 397 Q 0 296 398 ; … … 302 404 Q $S(X:1,1:0) 303 405 ; 304 RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$ 305 ; PAT = DFN 306 ; CLINIC = SC IEN 307 ; DATE = FM Date/Time of Appointment 308 ; 309 ; Returns: 310 ; 0 if okay 311 ; -1 if failure 312 ; 313 ; Call like this: $$RMCI(233,33,3110102.1130) 314 ; 315 ; Move my variables into the ones used by SDAPIs (just a convenience) 316 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL 317 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT) 318 ; 319 I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 320 ; 321 ; remember before status 322 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 323 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 324 ; 325 ; remove check-in using filer. 326 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_"," 327 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN 328 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER 329 S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED 330 N BSDXERR 331 D FILE^DIE("","BSDXFDA","BSDXERR") 332 I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1) 333 ; 334 ; set after status 335 S SDDA=$$SCIEN(DFN,SDCL,SDT) 336 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 337 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 338 ; 339 ; call event driver 340 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) 341 QUIT 0 406 CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out 407 NEW X 408 S X=$G(SDIEN) ;ien sent in call 409 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 410 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) 411 Q $S(X:1,1:0) 342 412 ; 343 413 SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC … … 348 418 Q $G(IEN) 349 419 ; 420 APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length 421 ; Get either the appointment length or zero 422 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) 423 Q:SCIEN $P(^SC(CLINIC,"S",DATE,1,SCIEN,0),U,2) 424 Q 0 350 425 APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) 351 426 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) 352 427 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") 353 428 ; 354 CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out355 NEW X356 S X=$G(SDIEN) ;ien sent in call357 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0358 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)359 Q $S(X:1,1:0)360 ;361 UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE362 ; PAT = DFN363 ; CLINIC = SC IEN364 ; DATE = FM Date/Time of Appointment365 ;366 ; Returns:367 ; 0 if okay368 ; -1 if failure369 N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC370 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44371 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","372 S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)373 N BSDXERR374 D FILE^DIE("","BSDXFDA","BSDXERR")375 I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)376 QUIT 0
Note:
See TracChangeset
for help on using the changeset viewer.
