Changeset 1455 for Scheduling/trunk/m/BSDX29.m

Timestamp:

Jun 22, 2012, 7:11:05 PM (12 years ago)

Author:

Sam Habiel

Message:

Refactored BSDX08 and BSDX29 routines; plus new UT routine BSDXUT1

File:

• Scheduling/trunk/m/BSDX29.m (modified) (12 diffs)

Scheduling/trunk/m/BSDX29.m

@@ -1 @@
-BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
-        ;;1.6T2;BSDX;;May 16, 2011
+BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm
+        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
         ; Licensed under LGPL
         ; 
@@ -8 +8 @@
         ; v1.42 by WV/SMH on 3101023
         ; - Transaction moved; now restartable too.
-        ; --> Thanks to Zach Gonzalez and Rick Marshall.
         ; - 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)")
+        ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
         Q
         ;
@@ -22 +24 @@
            ;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
-           ;
+        ; 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
+        ; Return Array
         S BSDXY=$NA(^BSDXTMP($J))
-           K ^BSDXTMP($J)
-           ; $ET
-           N $ET S $ET="G ETRAP^BSDX29"
+        K ^BSDXTMP($J)
+        ; $ET
+        N $ET S $ET="G ETRAP^BSDX29"
         ; Counter
-           N BSDXI S BSDXI=0
-           ; Header Node
+        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=BSDXBEG-1
-        S BSDXEND=BSDXEND+1
-        ;
-           ; Taskman variables
-           N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE 
+        ; 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"
+        S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO=""
         S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
         D ^%ZTLOAD
@@ -62 +64 @@
         ;
 ZTM     ;EP - Taskman entry point
-           ; Variables set up in ZTSAVE above
-           ;
+        ; Variables set up in ZTSAVE above
+        ;
         Q:'$D(ZTSK)
-           ; $ET
-           N $ET S $ET="G ZTMERR^BSDX29"
-        ; Txn
-           TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
+        ;
+        ; $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
+        N BSDXQUIT S BSDXQUIT=0  ; Quit Flag to be retrieved from an external proc
         ; Set Count
-           S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
+        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 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
-           . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
-           . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
+        . . 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
@@ -91 +93 @@
         . . 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
-        . . Q
-        . Q
-        I 'BSDXQUIT TCOMMIT
-        E  TROLLBACK
+        . . 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
@@ -101 +101 @@
 ZTMERR  ; For now, error from TM is only in trap; not returned to client.
         N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
-           ; Rollback before logging the error
-           I $TL>0 TROLLBACK
         D ^%ZTER
-           S $EC="" ; Clear Error
+        S $EC="" ; Clear Error
         QUIT
         ;
@@ -112 +110 @@
         ;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
+        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
@@ -122 +124 @@
         . I BSDXPAT2=BSDXPAT S BSDXFND=1
         . Q
-        Q:BSDXFND 0
+        I BSDXFND L -@REF Q 0
         ;
         ;Add to BSDX APPOINTMENT
@@ -128 +130 @@
         ;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
@@ -137 +140 @@
         ;
         K BSDXIEN
+        ;
         D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
         S BSDXIEN=+$G(BSDXIEN(1))
-        I '+BSDXIEN Q 0
+        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
@@ -149 +154 @@
 ERR(BSDXI,BSDXCNT,BSDXERR)      ;Error processing
         S BSDXI=BSDXI+1
-           S BSDXERR=$TR(BSDXERR,"^","~")
+        S BSDXERR=$TR(BSDXERR,"^","~")
         S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
         S BSDXI=BSDXI+1
@@ -157 +162 @@
 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
+        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))