BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; ; Change Log: ; v1.3 by WV/SMH on 3100713 ; - Beginning and Ending dates passed as FM Dates ; v1.42 by WV/SMH on 3101023 ; - Transaction moved; now restartable too. ; - Refactoring of major portions of routine ; v1.7 by VEN/SMH on 3120622 ; - Removed transaction code; Locks added in update to prevent concurrent ; update ; BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP ;Entry point for debugging ; ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)") Q ; BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive ;Called by RPC: BSDX COPY APPOINTMENTS ; ; Parameters: ; - BSDXY: Global Return ; - BSDXRES: BSDX RESOURCE to copy appointments to ; - BSDX44: Hospital Location IEN to copy appointments from ; - BSDXBEG: Beginning Date in FM Format ; - BSDXEND: End Date in FM Format ; ;Returns ADO Recordset containing TASK_NUMBER and ERRORID ; ; Return Array S BSDXY=$NA(^BSDXTMP($J)) K ^BSDXTMP($J) ; $ET N $ET S $ET="G ETRAP^BSDX29" ; Counter N BSDXI S BSDXI=0 ; Header Node S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30) ; ; Make dates inclusive; add 1 to FM dates S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1) S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1) ; ; Taskman variables N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO ; Task Load S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO="" S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")="" D ^%ZTLOAD ; Set up return ADO.net dataset N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.") S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31) QUIT ; ZTMD ;EP - Debug entry point ;D DEBUG^%Serenji("ZTM^BSDX29") Q ; ZTM ;EP - Taskman entry point ; Variables set up in ZTSAVE above ; Q:'$D(ZTSK) ; ; $ET N $ET S $ET="G ZTMERR^BSDX29" ; ;$O through ^SC(BSDX44,"S", N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc ; Set Count S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT ; Loop through dates here. F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D . ; Loop through Entries in each date in the subsubfile. . ; Quit if we are at the end or if a remote process requests a quit. . N BSDXIEN S BSDXIEN=0 . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node . . Q:'+BSDXNOD ; Quit if no node . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag . . Q:BSDXCAN="C" ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 44 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made . . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7) ; ; S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.") Q ; ZTMERR ; For now, error from TM is only in trap; not returned to client. N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap D ^%ZTER QUIT ; XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP ; ;Copy record to BSDX APPOINTMENT file ;Return 1 if record copied, otherwise 0 ; N REF S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique L +@REF:0 E Q 0 ; ;$O Thru ^BSDXAPPT to determine if this appt already added N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD S BSDXIEN=0,BSDXFND=0 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0)) . Q:'+BSDXNOD . S BSDXPAT2=$P(BSDXNOD,U,5) . S BSDXFND=0 . I BSDXPAT2=BSDXPAT S BSDXFND=1 . Q I BSDXFND L -@REF Q 0 ; ;Add to BSDX APPOINTMENT S BSDXEND=BSDXBEG ;Calculate ending time from beginning time and duration. S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN) N BSDXFDA,BSDXIENS S BSDXIENS="+1," S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE ; K BSDXIEN ; D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") S BSDXIEN=+$G(BSDXIEN(1)) I '+BSDXIEN L -@REF Q 0 ; ;Add WP field I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") L -@REF ; Q 1 ; ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing ; If last line is $C(31), we are done. No more errors to send to client. I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT S BSDXI=BSDXI+1 S BSDXERR=$TR(BSDXERR,"^","~") S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) Q ; ETRAP ;EP Error trap entry ; No Txn here. So don't rollback anything N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap D ^%ZTER S $EC="" ; Clear error I '$D(BSDXI) N BSDXI S BSDXI=0 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE)) Q ; CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK ; S BSDXY="^BSDXTMP("_$J_")" N BSDXI,BSDXCNT S BSDXI=0 S X="ETRAP^BSDX29",@^%ZOSF("TRAP") S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30) S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK)) I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK) I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK) ;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31) Q ; CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code. ;Signal tasked job having ZTSK=BSDXTSK to cancel ;Returns current record count of copy process ; S BSDXY="^BSDXTMP("_$J_")" N BSDXI,BSDXCNT S BSDXI=0 S X="ETRAP^BSDX29",@^%ZOSF("TRAP") S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30) S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK)) I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK) E S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")="" S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31) Q ; ADDMIN(BSDXSTRT,BSDXLEN) ; ; ;Add BSDXLEN minutes to time BSDXSTRT and return end time N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM S BSDXEND=$P(BSDXSTRT,".") ; ;Convert start time to minutes past midnight S BSDXSTIM=$P(BSDXSTRT,".",2) S BSDXSTIM=BSDXSTIM_"0000" S BSDXSTIM=$E(BSDXSTIM,1,4) S BSDXH=$E(BSDXSTIM,1,2) S BSDXH=BSDXH*60 S BSDXH=BSDXH+$E(BSDXSTIM,3,4) ; ;Add duration to find minutes past midnight of end time S BSDXETIM=BSDXH+BSDXLEN ; ;Convert back to a time S BSDXH=BSDXETIM\60 S BSDXH="00"_BSDXH S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH)) S BSDXM=BSDXETIM#60 S BSDXM="00"_BSDXM S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM)) S BSDXETIM=BSDXH_BSDXM I BSDXETIM>2400 S BSDXETIM=2400 S $P(BSDXEND,".",2)=BSDXETIM Q BSDXEND