Changeset 1563 for Scheduling/trunk/m/BSDX29.m
- Timestamp:
- Oct 8, 2012, 6:59:10 AM (12 years ago)
- File:
-
- 1 edited
-
Scheduling/trunk/m/BSDX29.m (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX29.m
r1481 r1563 1 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am2 ;;1. 7T2;BSDX;;Jul 11, 2012;Build 181 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am 2 ;;1.6;BSDX;;Aug 31, 2011;Build 25 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. 10 11 ; - Refactoring of major portions of routine 11 ; v1.7 by VEN/SMH on 312062212 ; - Removed transaction code; Locks added in update to prevent concurrent13 ; update14 12 ; 15 13 BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP 16 14 ;Entry point for debugging 17 15 ; 18 ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")16 D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)") 19 17 Q 20 18 ; … … 24 22 ;Called by RPC: BSDX COPY APPOINTMENTS 25 23 ; 26 ; Parameters:27 ; - BSDXY: Global Return28 ; - BSDXRES: BSDX RESOURCE to copy appointments to29 ; - BSDX44: Hospital Location IEN to copy appointments from30 ; - BSDXBEG: Beginning Date in FM Format31 ; - BSDXEND: End Date in FM Format32 ;24 ; Parameters: 25 ; - BSDXY: Global Return 26 ; - BSDXRES: BSDX RESOURCE to copy appointments to 27 ; - BSDX44: Hospital Location IEN to copy appointments from 28 ; - BSDXBEG: Beginning Date in FM Format 29 ; - BSDXEND: End Date in FM Format 30 ; 33 31 ;Returns ADO Recordset containing TASK_NUMBER and ERRORID 34 32 ; 35 ; Return Array33 ; Return Array 36 34 S BSDXY=$NA(^BSDXTMP($J)) 37 K ^BSDXTMP($J)38 ; $ET39 N $ET S $ET="G ETRAP^BSDX29"35 K ^BSDXTMP($J) 36 ; $ET 37 N $ET S $ET="G ETRAP^BSDX29" 40 38 ; Counter 41 N BSDXI S BSDXI=042 ; Header Node39 N BSDXI S BSDXI=0 40 ; Header Node 43 41 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30) 44 42 ; 45 ; Make dates inclusive; add 1 to FM dates46 S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1)47 S BSDXEND= $$FMADD^XLFDT(BSDXEND,+1)48 ; 49 ; Taskman variables50 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO43 ; Make dates inclusive; add 1 to FM dates 44 S BSDXBEG=BSDXBEG-1 45 S BSDXEND=BSDXEND+1 46 ; 47 ; Taskman variables 48 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE 51 49 ; Task Load 52 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS" ,ZTIO=""50 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS" 53 51 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")="" 54 52 D ^%ZTLOAD … … 64 62 ; 65 63 ZTM ;EP - Taskman entry point 66 ; Variables set up in ZTSAVE above67 ;64 ; Variables set up in ZTSAVE above 65 ; 68 66 Q:'$D(ZTSK) 69 ;70 ; $ET71 N $ET S $ET="G ZTMERR^BSDX29"72 ;67 ; $ET 68 N $ET S $ET="G ZTMERR^BSDX29" 69 ; Txn 70 TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29" 73 71 ;$O through ^SC(BSDX44,"S", 74 72 N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments 75 N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc73 N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc 76 74 ; Set Count 77 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT75 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT 78 76 ; Loop through dates here. 79 F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D80 . ; 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=077 F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D 78 . ; Loop through Entries in each date in the subsubfile. 79 . ; Quit if we are at the end or if a remote process requests a quit. 80 . N BSDXIEN S BSDXIEN=0 83 81 . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D 84 82 . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node 85 83 . . Q:'+BSDXNOD ; Quit if no node 86 84 . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag 87 . . Q:BSDXCAN="C" ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 4488 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient89 . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes85 . . Q:BSDXCAN="C" ; Quit if appt cancelled 86 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient 87 . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes 90 88 . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) 91 89 . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made … … 93 91 . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) 94 92 . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record 95 . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7) 96 ; 97 ; 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 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 error 104 I $TL>0 TROLLBACK 103 105 D ^%ZTER 106 S $EC="" ; Clear Error 104 107 QUIT 105 108 ; … … 109 112 ;Return 1 if record copied, otherwise 0 110 113 ; 111 N REF112 S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique113 L +@REF:0 E Q 0114 ;115 114 ;$O Thru ^BSDXAPPT to determine if this appt already added 116 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2 ,BSDXNOD115 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2 117 116 S BSDXIEN=0,BSDXFND=0 118 117 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND … … 123 122 . I BSDXPAT2=BSDXPAT S BSDXFND=1 124 123 . Q 125 I BSDXFND L -@REF Q0124 Q:BSDXFND 0 126 125 ; 127 126 ;Add to BSDX APPOINTMENT … … 129 128 ;Calculate ending time from beginning time and duration. 130 129 S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN) 131 N BSDXFDA,BSDXIENS132 130 S BSDXIENS="+1," 133 131 S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG … … 139 137 ; 140 138 K BSDXIEN 141 ;142 139 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 143 140 S BSDXIEN=+$G(BSDXIEN(1)) 144 I '+BSDXIEN L -@REFQ 0141 I '+BSDXIEN Q 0 145 142 ; 146 143 ;Add WP field 147 144 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D 148 145 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") 149 L -@REF150 146 ; 151 147 Q 1 152 148 ; 153 149 ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing 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,"^","~") 150 S BSDXI=BSDXI+1 151 S BSDXERR=$TR(BSDXERR,"^","~") 158 152 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) 159 153 S BSDXI=BSDXI+1 … … 163 157 ETRAP ;EP Error trap entry 164 158 ; No Txn here. So don't rollback anything 165 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap166 D ^%ZTER167 S $EC="" ; Clear error159 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 160 D ^%ZTER 161 S $EC="" ; Clear error 168 162 I '$D(BSDXI) N BSDXI S BSDXI=0 169 163 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
Note:
See TracChangeset
for help on using the changeset viewer.
