Changeset 1455
- Timestamp:
- Jun 22, 2012, 7:11:05 PM (13 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 1 added
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX08.m
r1454 r1455 1 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/2 1/12 4:49pm2 ;;1. 6;BSDX;;Aug 31, 2011;Build 181 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/22/12 4:19pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; 4 4 ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL. … … 71 71 L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q 72 72 ; 73 ;Restartable Transaction; restore paramters when starting.74 ; (Params restored are what's passed here + BSDXI)75 TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08"76 ;77 73 ; Turn off SDAM APPT PROTOCOL BSDX Entries 78 74 N BSDXNOEV … … 81 77 ;;;test for error inside transaction. See if %ZTER works 82 78 I $G(BSDXDIE) S X=1/0 83 ;;;test84 ;;;test for TRESTART85 I $G(BSDXRESTART) K BSDXRESTART tRESTART86 ;;;test87 79 ; 88 80 ; Check appointment ID and whether it exists 89 81 I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q 90 82 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q 91 ; 83 ; 92 84 ; Start Processing: 93 ; First, add cancellation date to appt entry in BSDX APPOINTMENT85 ; First, get data 94 86 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node 95 87 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID 96 88 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time 97 D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT 98 ; 99 ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability 89 ; 90 ; Check the resource ID and whether it exists 100 91 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 101 92 ; If the resouce id doesn't exist... 102 93 I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT 103 94 I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT 95 ; 96 ; Process PIMS issues first: 97 ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability 104 98 ; Get zero node of resouce 105 S BSDXNOD=^BSDXRES(BSDXSC1,0)99 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) 106 100 ; Get Hosp location 107 101 N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4) 108 102 ; Error indicator for Hosp Location filing for getting out of routine 109 103 N BSDXERR S BSDXERR=0 104 ; For BSDXC 105 N BSDXC 110 106 ; Only file in 2/44 if there is an associated hospital location 111 107 I BSDXLOC D QUIT:BSDXERR 112 . I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT 113 . ; Get the IEN of the appointment in the "S" node of ^SC 114 . N BSDXSCIEN 115 . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) 116 . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT 117 . ; Get the appointment node 118 . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0)) 119 . I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT 120 . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) 108 . S BSDXC("PAT")=BSDXPATID 109 . S BSDXC("CLN")=BSDXLOC 110 . S BSDXC("TYP")=BSDXTYP 111 . S BSDXC("ADT")=BSDXSTART 112 . S BSDXC("CDT")=$$NOW^XLFDT() 113 . S BSDXC("NOT")=BSDXNOT 114 . S:'+$G(BSDXCR) BSDXCR=11 ;Other 115 . S BSDXC("CR")=BSDXCR 116 . S BSDXC("USR")=DUZ 117 . ; 118 . S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message 119 . I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)) QUIT 120 . ; 121 . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) 122 . ; DEBUG 123 . I 'BSDXLEN S $EC=",U1," 124 . ; DEBUG 121 125 . ; Cancel through BSDXAPI 122 . N BSDXZ 123 . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART) 124 . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT 126 . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) 127 . I BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT 125 128 . ; Update Legacy PIMS clinic Availability 126 129 . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN) 127 130 ; 128 TCOMMIT 131 D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT 132 ; 129 133 L -^BSDXAPPT(BSDXAPTID) 130 134 S BSDXI=BSDXI+1 … … 180 184 Q 181 185 ; 182 APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD) ;183 ;Cancel appointment for patient BSDXDFN in clinic BSDXSC1184 ;at time BSDXSD185 N BSDXC,%H186 S BSDXC("PAT")=BSDXPATID187 S BSDXC("CLN")=BSDXLOC188 S BSDXC("TYP")=BSDXTYP189 S BSDXC("ADT")=BSDXSD190 S %H=$H D YMD^%DTC191 S BSDXC("CDT")=X+%192 S BSDXC("NOT")=BSDXNOT193 S:'+$G(BSDXCR) BSDXCR=11 ;Other194 S BSDXC("CR")=BSDXCR195 S BSDXC("USR")=DUZ196 ;197 S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC)198 Q199 ;200 186 BSDXCAN(BSDXAPTID) ; 201 187 ;Cancel BSDX APPOINTMENT entry … … 231 217 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 232 218 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 219 . N BSDXNOD 233 220 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 234 221 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q … … 250 237 S BSDXI=BSDXI+1 251 238 S BSDXERR=$TR(BSDXERR,"^","~") 252 I $TL>0 TROLLBACK253 239 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) 254 240 S BSDXI=BSDXI+1 … … 259 245 ETRAP ;EP Error trap entry 260 246 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 261 ; Rollback, otherwise ^XTER will be empty from future rollback262 I $TL>0 TROLLBACK263 247 D ^%ZTER 264 248 S $EC="" ; Clear Error -
Scheduling/trunk/m/BSDX29.m
r1187 r1455 1 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am2 ;;1. 6T2;BSDX;;May 16, 20111 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL 4 4 ; … … 8 8 ; v1.42 by WV/SMH on 3101023 9 9 ; - Transaction moved; now restartable too. 10 ; --> Thanks to Zach Gonzalez and Rick Marshall.11 10 ; - Refactoring of major portions of routine 11 ; v1.7 by VEN/SMH on 3120622 12 ; - Removed transaction code; Locks added in update to prevent concurrent 13 ; update 12 14 ; 13 15 BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP 14 16 ;Entry point for debugging 15 17 ; 16 D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")18 ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)") 17 19 Q 18 20 ; … … 22 24 ;Called by RPC: BSDX COPY APPOINTMENTS 23 25 ; 24 25 26 27 28 29 30 26 ; Parameters: 27 ; - BSDXY: Global Return 28 ; - BSDXRES: BSDX RESOURCE to copy appointments to 29 ; - BSDX44: Hospital Location IEN to copy appointments from 30 ; - BSDXBEG: Beginning Date in FM Format 31 ; - BSDXEND: End Date in FM Format 32 ; 31 33 ;Returns ADO Recordset containing TASK_NUMBER and ERRORID 32 34 ; 33 35 ; Return Array 34 36 S BSDXY=$NA(^BSDXTMP($J)) 35 36 37 37 K ^BSDXTMP($J) 38 ; $ET 39 N $ET S $ET="G ETRAP^BSDX29" 38 40 ; Counter 39 40 41 N BSDXI S BSDXI=0 42 ; Header Node 41 43 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30) 42 44 ; 43 44 S BSDXBEG=BSDXBEG-145 S BSDXEND= BSDXEND+146 ; 47 48 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE45 ; Make dates inclusive; add 1 to FM dates 46 S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1) 47 S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1) 48 ; 49 ; Taskman variables 50 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO 49 51 ; Task Load 50 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS" 52 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO="" 51 53 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")="" 52 54 D ^%ZTLOAD … … 62 64 ; 63 65 ZTM ;EP - Taskman entry point 64 65 66 ; Variables set up in ZTSAVE above 67 ; 66 68 Q:'$D(ZTSK) 67 ; $ET68 N $ET S $ET="G ZTMERR^BSDX29"69 ; Txn70 TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"69 ; 70 ; $ET 71 N $ET S $ET="G ZTMERR^BSDX29" 72 ; 71 73 ;$O through ^SC(BSDX44,"S", 72 74 N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments 73 75 N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc 74 76 ; Set Count 75 77 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT 76 78 ; Loop through dates here. 77 78 79 80 79 F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D 80 . ; Loop through Entries in each date in the subsubfile. 81 . ; Quit if we are at the end or if a remote process requests a quit. 82 . N BSDXIEN S BSDXIEN=0 81 83 . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D 82 84 . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node 83 85 . . Q:'+BSDXNOD ; Quit if no node 84 86 . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag 85 . . Q:BSDXCAN="C" ; Quit if appt cancelled 86 87 87 . . Q:BSDXCAN="C" ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 44 88 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient 89 . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes 88 90 . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) 89 91 . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made … … 91 93 . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) 92 94 . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record 93 . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag 94 . . Q 95 . Q 96 I 'BSDXQUIT TCOMMIT 97 E TROLLBACK 95 . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7) 96 ; 97 ; 98 98 S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.") 99 99 Q … … 101 101 ZTMERR ; For now, error from TM is only in trap; not returned to client. 102 102 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 103 ; Rollback before logging the error104 I $TL>0 TROLLBACK105 103 D ^%ZTER 106 104 S $EC="" ; Clear Error 107 105 QUIT 108 106 ; … … 112 110 ;Return 1 if record copied, otherwise 0 113 111 ; 112 N REF 113 S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique 114 L +@REF:0 E Q 0 115 ; 114 116 ;$O Thru ^BSDXAPPT to determine if this appt already added 115 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2 117 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD 116 118 S BSDXIEN=0,BSDXFND=0 117 119 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND … … 122 124 . I BSDXPAT2=BSDXPAT S BSDXFND=1 123 125 . Q 124 Q:BSDXFND0126 I BSDXFND L -@REF Q 0 125 127 ; 126 128 ;Add to BSDX APPOINTMENT … … 128 130 ;Calculate ending time from beginning time and duration. 129 131 S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN) 132 N BSDXFDA,BSDXIENS 130 133 S BSDXIENS="+1," 131 134 S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG … … 137 140 ; 138 141 K BSDXIEN 142 ; 139 143 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 140 144 S BSDXIEN=+$G(BSDXIEN(1)) 141 I '+BSDXIEN Q 0145 I '+BSDXIEN L -@REF Q 0 142 146 ; 143 147 ;Add WP field 144 148 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D 145 149 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") 150 L -@REF 146 151 ; 147 152 Q 1 … … 149 154 ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing 150 155 S BSDXI=BSDXI+1 151 156 S BSDXERR=$TR(BSDXERR,"^","~") 152 157 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) 153 158 S BSDXI=BSDXI+1 … … 157 162 ETRAP ;EP Error trap entry 158 163 ; No Txn here. So don't rollback anything 159 160 161 164 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 165 D ^%ZTER 166 S $EC="" ; Clear error 162 167 I '$D(BSDXI) N BSDXI S BSDXI=0 163 168 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE)) -
Scheduling/trunk/m/BSDXUT.m
r1454 r1455 1 BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/2 1/12 4:42pm1 BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/22/12 4:27pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 262 262 S APPID=+$P(^BSDXTMP($J,1),U) 263 263 D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note") 264 I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1" 265 I $O(^SC(HLIEN,"S",APPTTIME,1,0))]"" W "Error in Cancellation-2" 266 I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="PC" W "Error in Cancellation-3" 267 I ^DPT(DFN,"S",APPTTIME,"R")'="Sam's Cancel Note" W "Error in Cancellation-4" 264 I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1",! 265 I $O(^SC(HLIEN,"S",APPTTIME,1,0))]"" W "Error in Cancellation-2",! 266 I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="PC" W "Error in Cancellation-3",! 267 I ^DPT(DFN,"S",APPTTIME,"R")'="Sam's Cancel Note" W "Error in Cancellation-4",! 268 268 ; 269 269 ; Test 2: Check for -1 -- TODO: Fix later... Can't do right now automatically … … 312 312 I APPID=0 W "Error in test 6",! 313 313 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin 314 S BSDXRESULT=$$RMCI^BSDXAPI(DFN,HLIEN, BSDXSTART) ; remove checkin314 S BSDXRESULT=$$RMCI^BSDXAPI(DFN,HLIEN,APPTTIME) ; remove checkin 315 315 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt 316 316 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",! … … 358 358 I APPID=0 W "Error in test 6",! 359 359 D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin 360 S BSDXRESULT=$$RMCI^BSDXAPI(DFN,HLIEN, BSDXSTART) ; remove checkin360 S BSDXRESULT=$$RMCI^BSDXAPI(DFN,HLIEN,APPTTIME) ; remove checkin 361 361 D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt 362 362 I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",! … … 415 415 ; 416 416 TIMES() ; $$ - Create a next available appointment time^ending time; Private 417 ; Output: appttime^endtime 417 418 N NOW S NOW=$$NOW^XLFDT() ; Now time 418 419 N LAST S LAST=$O(^BSDXAPPT("B"," "),-1) ; highest time in file … … 422 423 N ENDTIME S ENDTIME=$$FMADD^XLFDT(APPTIME,0,0,15,0) ; Add 15 more min 423 424 Q APPTIME_U_ENDTIME ; quit with apptime^endtime 425 ; 426 TIMEHL(HLIEN) ; $$ - Create a next available appointment time^ending time by HL; Private 427 ; Input: HLIEN 428 ; Output: Next available appointment time for the HLIEN 429 N LAST S LAST=$O(^SC(HLIEN,"S",""),-1) 430 Q $$FMADD^XLFDT(LAST,1,0,15,0) ; Add 1 day and 15 minutes
Note:
See TracChangeset
for help on using the changeset viewer.
