Changeset 996
- Timestamp:
- Oct 31, 2010, 6:15:06 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX07.m
r988 r996 1 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 10/ 4/10 6:22pm1 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 10/24/10 12:07am 2 2 ;;1.42;BSDX;;Sep 29, 2010 3 3 ; … … 7 7 ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments 8 8 ; thanks to Rick Marshall and Zach Gonzalez at Oroville. 9 ; 10 ; 9 ; v1.42 Oct 30 2010 - Extensive refactoring. 10 ; 11 ; Error Reference: 12 ; -1: Patient Record is locked. This means something is wrong!!!! 13 ; -2: Start Time is not a valid Fileman date 14 ; -3: End Time is not a valid Fileman date 15 ; -4: End Time does not have time inside of it. 16 ; -5: BSDXPATID is not numeric 17 ; -6: Patient Does not exist in ^DPT 18 ; -7: Resource Name does not exist in B index of BSDX RESOURCE 19 ; -8: Resouce doesn't exist in ^BSDXRES 20 ; -9: Couldn't add appointment to BSDX APPOINTMENT 21 ; -10: Couldn't add appointment to files 2 and/or 44 22 ; -100: Mumps Error 23 11 24 APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP 12 25 ;Entry point for debugging … … 14 27 Q 15 28 ; 29 UT ; Unit Tests 30 N ZZZ 31 ; Test for bad start date 32 D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1) 33 I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",! 34 ; Test for bad end date 35 D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1) 36 I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",! 37 ; Test for end date without time 38 D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1) 39 I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",! 40 ; Test for mumps error 41 S bsdxdie=1 42 D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1) 43 I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",! 44 K bsdxdie 45 ; Test for TRESTART 46 s bsdxrestart=1 47 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) 48 I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",! 49 k bsdxrestart 50 ; Test for non-numeric patient 51 D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1) 52 I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",! 53 ; Test for a non-existent patient 54 D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1) 55 I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",! 56 ; Test for a non-existent resource name 57 D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1) 58 I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",! 59 ; Test for corrupted resource 60 ; Can't test for -8 since it requires DB corruption 61 ; Test for inability to add appointment to BSDX Appointment 62 ; Also requires something wrong in the DB 63 ; Test for inability to add appointment to 2,44 64 ; Test by creating a duplicate appointment 65 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) 66 D APPADD(.ZZZ,3100123.09,3100123.093,1,"Dr Office",30,"Sam's Note",1) 67 I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",! 68 QUIT 69 ; 16 70 APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP 17 ;Called by BSDX ADD NEW APPOINTMENT 18 ;Add new appointment 19 ;BSDXRES is ResourceName 71 ;Called by RPC: BSDX ADD NEW APPOINTMENT 72 ; 73 ;Add new appointment to 3 files 74 ; - BSDX APPOINTMENT 75 ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic 76 ; - Patient Appointment Subfile if Resource is linked to clinic 77 ; 78 ;Paramters: 79 ;BSDXY: Global Return (RPC must be set to Global Array) 80 ;BSDXSTART: FM Start Date 81 ;BSDXEND: FM End Date 82 ;BSDXPATID: Patient DFN 83 ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN) 20 84 ;BSDXLEN is the appointment duration in minutes 85 ;BSDXNOTE is the Appiontment Note 21 86 ;BSDXATID is used for 2 purposes: 22 87 ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. 23 88 ; if BSDXATID = a number, then it is the access type id (used for rebooking) 24 89 ; 25 ; Create entry in BSDX APPOINTMENT26 ;Returns recordset having fields 90 ;Return: 91 ; ADO.net Recordset having fields: 27 92 ; AppointmentID and ErrorNumber 28 93 ; 29 94 ;Test lines: 30 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^2^PEDIATRICIAN,DEMO^EXAM^SCRATCH NOTE 31 ; 32 ;Lock BSDX node 33 L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI+1,"Another user is working with this patient's record. Please try again later") Q 34 ; 95 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN 96 ; 97 ; Return Array; set Return and clear array 98 S BSDXY=$NA(^BSDXTMP($J)) 99 K ^BSDXTMP($J) 100 ; $ET 101 N $ET S $ET="G ETRAP^BSDX07" 102 ; Counter 103 N BSDXI S BSDXI=0 104 ; Lock BSDX node, only to synchronize access to the globals. 105 ; It's not expected that the error will ever happen as no filing 106 ; is supposed to take 5 seconds. 107 L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q 108 ; Header Node 109 S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30) 35 110 ;Restartable Transaction; restore paramters when starting. 36 TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID):T="BSDX ADD NEW APPOINTMENT^BSDX07" 37 ; 38 N BSDXERR,BSDXIEN,BSDXDEP,BSDXI,BSDXJ,BSDXAPPTI,BSDXDJ,BSDXRESD,BSDXRNOD,BSDXSCD,BSDXC,BSDXERR,BSDXWKIN 111 ; (Params restored are what's passed here + BSDXI) 112 TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07" 113 ; 114 ; Turn off SDAM APPT PROTOCOL BSDX Entries 39 115 N BSDXNOEV 40 116 S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol 41 K ^BSDXTMP($J) 42 S X="ETRAP^BSDX07",@^%ZOSF("TRAP") 43 S BSDXERR=0 44 S BSDXI=0 45 S BSDXY="^BSDXTMP("_$J_")" 46 S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30) 47 S BSDXI=BSDXI+1 48 ; v1.3 - date passed in as FM Date, not US date. 49 ;Check input data for errors 50 ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@") 51 ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@") 52 ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y 53 ; I BSDXSTART=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid Start Time") Q 54 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y 55 ; I BSDXEND=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q 56 ; 57 ; If C# sends the dates with extra zeros, remove them 117 ; 118 ; Set Error Message to be empty 119 N BSDXERR S BSDXERR=0 120 ; 121 ;;;test for error inside transaction. See if %ZTER works 122 I $G(bsdxdie) S X=1/0 123 ;;;test 124 ;;;test for TRESTART 125 I $G(bsdxrestart) K bsdxrestart TRESTART 126 ;;;test 127 ; 128 ; -- Start and End Date Processing -- 129 ; If C# sends the dates with extra zeros, remove them 58 130 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND 59 ; 60 I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q 61 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP 62 I '+BSDXPATID,'$D(^DPT(BSDXPATID,0)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Patient ID") Q 63 ;Validate Resource entry 64 S BSDXERR=0 K BSDXRESD 65 I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Resource ID") Q 131 ; Are the dates valid? Must be FM Dates > than 2010 132 I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q 133 I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q 134 ; If Ending date doesn't have a time, this is an error 135 I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q 136 ; If the Start Date is greater than the end date, swap dates 137 N BSDXTMP 138 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP 139 ; 140 ; Check if the patient exists: 141 ; - DFN valid number? 142 ; - Valid Patient in file 2? 143 I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q 144 I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q 145 ; 146 ;Validate Resource entry 147 I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q 148 N BSDXRESD ; Resource IEN 66 149 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) 67 S BSDXWKIN=0 150 N BSDXRNOD ; Resouce zero node 151 S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) 152 I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q 153 ; 154 ; Walk-in (Unscheduled) Appointment? 155 N BSDXWKIN S BSDXWKIN=0 68 156 I BSDXATID="WALKIN" S BSDXWKIN=1 157 ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number 69 158 I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" 70 159 ; 71 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) 72 I 'BSDXAPPTID D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q 160 ; Done with all checks, let's make appointment in BSDX APPOINTMENT 161 N BSDXAPPTID 162 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) 163 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q 73 164 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) 74 165 ; 75 ;Create RPMS Appointment 76 S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) 77 ;I BSDXRNOD="" D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment -- invalid Resource entry."),BSDXDEL(BSDXAPPTID) Q 78 I BSDXRNOD="" D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment -- invalid Resource entry.") Q 79 S BSDXSCD=$P(BSDXRNOD,U,4) 80 ;I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI+1,"BSDX07 Error: Unable to make appointment. MAKE^BSDAPI returned error code: "_BSDXERR),BSDXDEL(BSDXAPPTID) Q 81 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI+1,"BSDX07 Error: Unable to make appointment. MAKE^BSDAPI returned error code: "_BSDXERR) Q 82 . S BSDXC("PAT")=BSDXPATID 166 ; Then Create Subfiles in 2/44 Appointment 167 N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN 168 ; Only if we have a valid Hosp Loc can we make an appointment 169 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: ~MAKE^BSDAPI returned error code: "_BSDXERR) Q 170 . N BSDXC 171 . S BSDXC("PAT")=BSDXPATID 83 172 . S BSDXC("CLN")=BSDXSCD 84 173 . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins … … 87 176 . S BSDXC("LEN")=BSDXLEN 88 177 . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field 89 . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSD API178 . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI 90 179 . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note 91 180 . S BSDXC("USR")=DUZ 92 181 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) 93 182 . Q:BSDXERR 183 . ;Update RPMS Clinic availability 94 184 . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) 95 . ;L96 185 . Q 97 186 ; 98 ;Update RPMS Clinic availability99 187 ;Return Recordset 100 188 TCOMMIT … … 125 213 S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD 126 214 S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) 127 ;S BSDXFDA(9002018.4,"+1,",.09)=$G(DT) ;MJL 1/25/2007128 215 S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT 129 216 S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" 130 217 S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID 131 KBSDXIEN,BSDXMSG218 N BSDXIEN,BSDXMSG 132 219 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 133 220 S BSDXAPPTID=+$G(BSDXIEN(1)) … … 178 265 ; 179 266 ERR(BSDXI,BSDXERR) ;Error processing 180 D ^%ZTER ;XXX: remove after we figure out the cause of error 181 S BSDXI=BSDXI+1 267 S BSDXI=BSDXI+1 182 268 S BSDXERR=$TR(BSDXERR,"^","~") 183 TROLLBACK269 I $TL>0 TROLLBACK 184 270 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) 185 271 S BSDXI=BSDXI+1 186 272 S ^BSDXTMP($J,BSDXI)=$C(31) 187 L 273 L -^BSDXAPPT(BSDXPATID) 188 274 Q 189 275 ; 190 276 ETRAP ;EP Error trap entry 191 D ^%ZTER 192 I '$D(BSDXI) N BSDXI S BSDXI=999999 193 S BSDXI=BSDXI+1 194 D ERR(BSDXI,"BSDX07 Error: "_$G(%ZTERROR)) 277 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 278 ; Rollback, otherwise ^XTER will be empty from future rollback 279 I $TL>0 TROLLBACK 280 D ^%ZTER 281 S $EC="" ; Clear Error 282 ; Log error message and send to client 283 I '$D(BSDXI) N BSDXI S BSDXI=0 284 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) 195 285 Q 196 286 ;
Note:
See TracChangeset
for help on using the changeset viewer.