Changeset 1460 for Scheduling/trunk/m/BSDX08.m

Timestamp:

Jun 25, 2012, 8:54:59 PM (13 years ago)

Author:

Sam Habiel

Message:

refactored BSDX26; still working on BSDX08

File:

• Scheduling/trunk/m/BSDX08.m (modified) (5 diffs)

Scheduling/trunk/m/BSDX08.m

@@ -1 @@
-BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/22/12 4:19pm
+BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/25/12 6:17pm
         ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
         ; 
@@ -94 +94 @@
         I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
         ;
-        ; Process PIMS issues first: 
+        ; BSDXAPPT First; todo: check for error
+        D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
+        ;
+        ; Process PIMS issues second: 
         ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
         ; Get zero node of resouce
@@ -120 +123 @@
         . ;
         . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
-        . ; DEBUG
-        . I 'BSDXLEN S $EC=",U1,"
-        . ; DEBUG
+        . ;
         . ; Cancel through BSDXAPI
         . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC)
@@ -129 +130 @@
         . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
         ;
-        D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
         ;
         L -^BSDXAPPT(BSDXAPTID)
@@ -138 +138 @@
         Q
         ;
+ROLLBACK(BSDXAPTID)
 AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)       ;Update Legacy PIMS Clinic availability
         ;See SDCNP0