Changeset 1625 for Scheduling/trunk/m/BSDX29.m
- Timestamp:
- Jun 1, 2013, 10:54:38 AM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX29.m
r1563 r1625 1 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am2 ;;1. 6;BSDX;;Aug 31, 2011;Build 251 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am 2 ;;1.7;BSDX;;Jun 01, 2013;Build 24 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 S $EC="" ; Clear Error107 104 QUIT 108 105 ; … … 112 109 ;Return 1 if record copied, otherwise 0 113 110 ; 111 N REF 112 S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique 113 L +@REF:0 E Q 0 114 ; 114 115 ;$O Thru ^BSDXAPPT to determine if this appt already added 115 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2 116 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD 116 117 S BSDXIEN=0,BSDXFND=0 117 118 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND … … 122 123 . I BSDXPAT2=BSDXPAT S BSDXFND=1 123 124 . Q 124 Q:BSDXFND0125 I BSDXFND L -@REF Q 0 125 126 ; 126 127 ;Add to BSDX APPOINTMENT … … 128 129 ;Calculate ending time from beginning time and duration. 129 130 S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN) 131 N BSDXFDA,BSDXIENS 130 132 S BSDXIENS="+1," 131 133 S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG … … 137 139 ; 138 140 K BSDXIEN 141 ; 139 142 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 140 143 S BSDXIEN=+$G(BSDXIEN(1)) 141 I '+BSDXIEN Q 0144 I '+BSDXIEN L -@REF Q 0 142 145 ; 143 146 ;Add WP field 144 147 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D 145 148 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") 149 L -@REF 146 150 ; 147 151 Q 1 148 152 ; 149 153 ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing 150 S BSDXI=BSDXI+1 151 S BSDXERR=$TR(BSDXERR,"^","~") 154 ; If last line is $C(31), we are done. No more errors to send to client. 155 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT 156 S BSDXI=BSDXI+1 157 S BSDXERR=$TR(BSDXERR,"^","~") 152 158 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) 153 159 S BSDXI=BSDXI+1 … … 157 163 ETRAP ;EP Error trap entry 158 164 ; No Txn here. So don't rollback anything 159 160 161 165 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 166 D ^%ZTER 167 S $EC="" ; Clear error 162 168 I '$D(BSDXI) N BSDXI S BSDXI=0 163 169 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
Note:
See TracChangeset
for help on using the changeset viewer.