Changeset 1563 for Scheduling

Timestamp:

Oct 8, 2012, 6:59:10 AM (12 years ago)

Author:

Tariq Hamkari

Message:

updated the BSDX version to 1.7

• fix "BSDX01.m" routine , it was take too long time to retrieve patient radiology exams.

Location:

Scheduling/trunk/m

Files:

• BSDX01.m (modified) (3 diffs)
• BSDX02.m (modified) (3 diffs)
• BSDX03.m (modified) (1 diff)
• BSDX04.m (modified) (2 diffs)
• BSDX05.m (modified) (1 diff)
• BSDX06.m (modified) (1 diff)
• BSDX07.m (modified) (1 diff)
• BSDX08.m (modified) (9 diffs)
• BSDX09.m (modified) (1 diff)
• BSDX11.m (modified) (1 diff)
• BSDX12.m (modified) (1 diff)
• BSDX13.m (modified) (1 diff)
• BSDX14.m (modified) (1 diff)
• BSDX15.m (modified) (1 diff)
• BSDX16.m (modified) (1 diff)
• BSDX17.m (modified) (1 diff)
• BSDX18.m (modified) (1 diff)
• BSDX19.m (modified) (1 diff)
• BSDX20.m (modified) (1 diff)
• BSDX21.m (modified) (1 diff)
• BSDX22.m (modified) (1 diff)
• BSDX23.m (modified) (1 diff)
• BSDX24.m (modified) (1 diff)
• BSDX25.m (modified) (9 diffs)
• BSDX26.m (modified) (1 diff)
• BSDX27.m (modified) (1 diff)
• BSDX28.m (modified) (3 diffs)
• BSDX29.m (modified) (11 diffs)
• BSDX2E.m (modified) (5 diffs)
• BSDX30.m (modified) (5 diffs)
• BSDX31.m (modified) (1 diff)
• BSDX32.m (modified) (1 diff)
• BSDX33.m (modified) (1 diff)
• BSDX34.m (modified) (1 diff)
• BSDX35.m (modified) (1 diff)
• BSDXAPI.m (modified) (13 diffs)
• BSDXAPI1.m (modified) (1 diff)
• BSDXGPRV.m (modified) (3 diffs)
• BSDXUT.m (modified) (1 diff)
• BSDXUT1.m (modified) (1 diff)
• BSDXUT2.m (modified) (1 diff)

Scheduling/trunk/m/BSDX01.m

@@ -1 @@
-BSDX01  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:52am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX01  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:46pm
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;
@@ -282 +282 @@
         ;
 INDIV(BSDXSC)   ; PEP - Is ^SC clinic in the same DUZ(2) as user?
-        ; Input: BSDXSC - Hospital Location IEN
-        ; Output: True or False
-        I '+BSDXSC QUIT 1  ;If not tied to clinic, yes
-        I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
-        ; Jump to Division:Medical Center Division:Inst File Pointer for
-        ; Institution IEN (and get its internal value)
-        N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
-        I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
-        I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
-        E  Q 0 ; Otherwise, no
+           ; Input: BSDXSC - Hospital Location IEN
+           ; Output: True or False
+           I '+BSDXSC QUIT 1  ;If not tied to clinic, yes
+           I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
+           ; Jump to Division:Medical Center Division:Inst File Pointer for
+           ; Institution IEN (and get its internal value)
+           N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
+           I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
+           I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
+           E  Q 0 ; Otherwise, no
+           QUIT
 INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
-        ; Input BSDXRES - BSDX RESOURCE IEN
-        ; Output: True of False
-        Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
-UTINDIV ; Unit Test $$INDIV
-        W "Testing if they are the same",!
-        S DUZ(2)=67
-        I '$$INDIV(1) W "ERROR",!
-        I '$$INDIV(2) W "ERROR",!
-        W "Testing if Div not defined in 44, should be true",!
-        I '$$INDIV(3) W "ERROR",!
-        W "Testing empty string. Should be true",!
-        I '$$INDIV("") W "ERROR",!
-        W "Testing if they are different",!
-        S DUZ(2)=899
-        I $$INDIV(1) W "ERROR",!
-        I $$INDIV(2) W "ERROR",!
-        QUIT
-UTINDIV2        ; Unit Test $$INDIV2
-        W "Testing if they are the same",!
-        S DUZ(2)=69
-        I $$INDIV2(22)'=0 W "ERROR",!
-        I $$INDIV2(25)'=1 W "ERROR",!
-        I $$INDIV2(26)'=1 W "ERROR",!
-        I $$INDIV2(27)'=1 W "ERROR",!
-        QUIT
-        ;
+           ; Input BSDXRES - BSDX RESOURCE IEN
+           ; Output: True of False
+           Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
+UnitTestINDIV   
+           W "Testing if they are the same",!
+           S DUZ(2)=67
+           I '$$INDIV(1) W "ERROR",!
+           I '$$INDIV(2) W "ERROR",!
+           W "Testing if Div not defined in 44, should be true",!
+           I '$$INDIV(3) W "ERROR",!
+           W "Testing empty string. Should be true",!
+           I '$$INDIV("") W "ERROR",!
+           W "Testing if they are different",!
+           S DUZ(2)=899
+           I $$INDIV(1) W "ERROR",!
+           I $$INDIV(2) W "ERROR",!
+           QUIT
+UnitTestINDIV2  
+           W "Testing if they are the same",!
+           S DUZ(2)=69
+           I $$INDIV2(22)'=0 W "ERROR",!
+           I $$INDIV2(25)'=1 W "ERROR",!
+           I $$INDIV2(26)'=1 W "ERROR",!
+           I $$INDIV2(27)'=1 W "ERROR",!
+           QUIT
+           ;
 GETRADEX(BSDXY,DFN,SCIEN)       ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
         ; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
@@ -345 +346 @@
         ; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
         ; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
-        D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
+        ;
+               ;;EHS/MKH,BAH;;UJO*1.0*143;;30/09/2012;; Update [Fix the performance issue in SchedGUI]
+               ; START OF CODE CHANGES FOR [UJO*1.0*143]
+               ; Commented old Line
+               ;D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
+               DO FIND^DIC(75.1,"","@;5;2;16","QP",DFN,"","B","IF 35[$PIECE(^(0),U,5)&($PIECE(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
+               ; END OF CODE CHANGES FOR [UJO*1.0*143]
         ;
         IF $DATA(BSDXERR) GOTO END

Scheduling/trunk/m/BSDX02.m

@@ -1 @@
-BSDX02  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX02  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ;Licensed under LGPL 
         ; Change Log
@@ -30 +30 @@
         S BSDXERR=""
         S BSDXY="^BSDXTMP("_$J_")"
-        S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME"
-        S ^(0)=^(0)_"^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
+        S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
         D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
         ;
@@ -38 +37 @@
         ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
         ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
-        ;
+           ;
         S BSDXI=0
         D STRES

Scheduling/trunk/m/BSDX03.m

@@ -1 +1 @@
 BSDX03  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ;Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX04.m

@@ -1 @@
-BSDX04  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/6/12 10:55am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX04  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 4/28/11 10:15am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ; Change Log:
@@ -74 +74 @@
         . Q:BSDXRESN=""
         . Q:'$D(^BSDXRES("B",BSDXRESN))
-        . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
+        . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) 
         . Q:'+BSDXRESD
         . Q:'$D(^BSDXAB("ARSCT",BSDXRESD))

Scheduling/trunk/m/BSDX05.m

@@ -1 +1 @@
 BSDX05   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
-           ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+           ;;1.6;BSDX;;Aug 31, 2011;Build 25
            ; Licensed under LGPL
            ;

Scheduling/trunk/m/BSDX06.m

@@ -1 +1 @@
 BSDX06  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ; Change Log:

Scheduling/trunk/m/BSDX07.m

@@ -1 @@
-BSDX07  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS  ; 7/9/12 4:02pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
-        ; Licensed under LGPL
-        ;
-        ; Change Log:
-        ; UJO/SMH
-        ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
-        ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
-        ; v1.42 Oct 30 2010 - Extensive refactoring.
-        ; v1.5  Mar 15 2011 - End time does not have to have time anymore.
-        ;      It could be midnight of the next day
-        ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
-        ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes
-        ;                  - AVUPDT moved to AVUPDTMK in BSDXAPI1
-        ;
-        ; Error Reference:
-        ; -1: Patient Record is locked. This means something is wrong!!!!
-        ; -2: Start Time is not a valid Fileman date
-        ; -3: End Time is not a valid Fileman date
-        ; v1.5:obsolete::-4: End Time does not have time inside of it.
-        ; -5: BSDXPATID is not numeric
-        ; -6: Patient Does not exist in ^DPT
-        ; -7: Resource Name does not exist in B index of BSDX RESOURCE
-        ; -8: Resouce doesn't exist in ^BSDXRES
-        ; -9: Couldn't add appointment to BSDX APPOINTMENT
-        ; -10: Couldn't add appointment to files 2 and/or 44
-        ; -100: Mumps Error
-        ;
+BSDX07  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS  ; 4/28/11 10:17am
+           ;;1.6;BSDX;;Aug 31, 2011;Build 25
+           ; Licensed under LGPL
+           ;
+           ; Change Log:
+           ; UJO/SMH
+           ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
+           ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
+           ;   thanks to Rick Marshall and Zach Gonzalez at Oroville.
+           ; v1.42 Oct 30 2010 - Extensive refactoring.
+           ; v1.5  Mar 15 2011 - End time does not have to have time anymore.
+           ;      It could be midnight of the next day
+           ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
+           ;
+           ; Error Reference:
+           ; -1: Patient Record is locked. This means something is wrong!!!!
+           ; -2: Start Time is not a valid Fileman date
+           ; -3: End Time is not a valid Fileman date
+           ; v1.5:obsolete::-4: End Time does not have time inside of it.
+           ; -5: BSDXPATID is not numeric
+           ; -6: Patient Does not exist in ^DPT
+           ; -7: Resource Name does not exist in B index of BSDX RESOURCE
+           ; -8: Resouce doesn't exist in ^BSDXRES
+           ; -9: Couldn't add appointment to BSDX APPOINTMENT
+           ; -10: Couldn't add appointment to files 2 and/or 44
+           ; -100: Mumps Error
+        
 APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)       ;EP
-        ;Entry point for debugging
-        ; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
-        Q
-        ;
-APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP
-        ;
-        ;Called by RPC: BSDX ADD NEW APPOINTMENT
-        ;
-        ;Add new appointment to 3 files
-        ; - BSDX APPOINTMENT
-        ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
-        ; - Patient Appointment Subfile if Resource is linked to clinic
-        ;
-        ;Paramters:
-        ;BSDXY: Global Return (RPC must be set to Global Array)
-        ;BSDXSTART: FM Start Date
-        ;BSDXEND: FM End Date
-        ;BSDXPATID: Patient DFN
-        ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
-        ;BSDXLEN is the appointment duration in minutes
-        ;BSDXNOTE is the Appiontment Note
-        ;BSDXATID is used for 2 purposes:
-        ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
-        ; if BSDXATID = a number, then it is the access type id (used for rebooking)
-        ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
-        ;
-        ;Return:
-        ; ADO.net Recordset having fields:
-        ; AppointmentID and ErrorNumber
-        ;
-        ; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
-        ; to sort out. Needs changes on client.
-        ;
-        ;Test lines:
-        ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
-        ;
-        ; Deal with optional arguments
-        S BSDXRADEXAM=$G(BSDXRADEXAM)
-        ;
-        ; Return Array; set Return and clear array
-        S BSDXY=$NA(^BSDXTMP($J))
-        K ^BSDXTMP($J)
-        ;
-        ; $ET
-        N $ET S $ET="G ETRAP^BSDX07"
-        ;
-        ; Counter
-        N BSDXI S BSDXI=0
-        ;
-        ; Lock BSDX node, only to synchronize access to the globals.
-        ; It's not expected that the error will ever happen as no filing
-        ; is supposed to take 5 seconds.
-        L +^BSDXPAT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
-        ;
-        ; Header Node
-        S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
-        ;
-        ; Turn off SDAM APPT PROTOCOL BSDX Entries
-        N BSDXNOEV
-        S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
-        ;
-        ; Set Error Message to be empty
-        N BSDXERR S BSDXERR=0
-        ;
-        ;;;test for error. See if %ZTER works
-        I $G(BSDXDIE) N X S X=1/0
-        ;;;test
-        ;
-        ; -- Start and End Date Processing --
-        ; If C# sends the dates with extra zeros, remove them
-        S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
-        ; Are the dates valid? Must be FM Dates > than 2010
-        I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
-        I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
-        ;
-        ;; If Ending date doesn't have a time, this is an error --rm 1.5
-        ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
-        ;
-        ; If the Start Date is greater than the end date, swap dates
-        N BSDXTMP
-        I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
-        ;
-        ; Check if the patient exists:
-        ; - DFN valid number?
-        ; - Valid Patient in file 2?
-        I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q 
-        I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
-        ;
-        ;Validate Resource entry
-        I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
-        N BSDXRESD ; Resource IEN
-        S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
-        N BSDXRNOD ; Resouce zero node
-        S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
-        I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
-        ;
-        ; Walk-in (Unscheduled) Appointment?
-        N BSDXWKIN S BSDXWKIN=0
-        I BSDXATID="WALKIN" S BSDXWKIN=1
-        ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
-        I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
-        ;
-        ; Now, check if PIMS has any issues with us making the appt using MAKECK
-        N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4)  ; Hosp Location IEN
-        N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
-        N BSDXC ; Array to send to MAKE and MAKECK APIs
-        ; Only if we have a valid Hosp Location
-        I +BSDXSCD,$D(^SC(BSDXSCD,0)) D 
-        . S BSDXC("PAT")=BSDXPATID
-        . S BSDXC("CLN")=BSDXSCD
-        . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
-        . S:BSDXWKIN BSDXC("TYP")=4
-        . S BSDXC("ADT")=BSDXSTART
-        . S BSDXC("LEN")=BSDXLEN
-        . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
-        . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
-        . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
-        . S BSDXC("USR")=DUZ
-        . S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC)
-        I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q  ; no need for roll back
-        ;
-        ; Done with all checks, let's make appointment in BSDX APPOINTMENT
-        N BSDXAPPTID
-        S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
-        I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q  ; no roll back needed! No appts made.
-        I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here
-        ; I don't think it's important b/c users can detect right away if the WP
-        ; filing fails.
-        ;
-        I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q  ; UT Line
-        ;
-        ; Only if we have a valid Hosp Loc can we make an appointment in 2/44
-        ; Use BSDXC array from before.
-        ; FYI: $$MAKE itself calls $$MAKECK to check again for being okay.
-        ; If an error happens here, we roll back both ^BSDXAPPT and 2/44 by deleting
-        N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
-        I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
-        I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
-        ;
-        ; Unlock
-        L -^BSDXPAT(BSDXPATID)
-        ;
-        ;Return Recordset
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)=$C(31)
-        Q
+           ;Entry point for debugging
+           D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
+           Q
+           ;
+UT      ; Unit Tests
+           N ZZZ
+           ; Test for bad start date
+           D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",!
+           ; Test for bad end date
+           D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
+           ; Test for end date without time
+           D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
+           ; Test for mumps error
+           S bsdxdie=1
+           D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
+           K bsdxdie
+           ; Test for TRESTART
+           s bsdxrestart=1
+           D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
+           k bsdxrestart
+           ; Test for non-numeric patient
+           D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
+           ; Test for a non-existent patient
+           D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",!
+           ; Test for a non-existent resource name
+           D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",!
+           ; Test for corrupted resource
+           ; Can't test for -8 since it requires DB corruption
+           ; Test for inability to add appointment to BSDX Appointment
+           ; Also requires something wrong in the DB
+           ; Test for inability to add appointment to 2,44
+           ; Test by creating a duplicate appointment
+           D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
+           D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
+           I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
+           ; Test for normality:
+           D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1)
+           ; Does Appt exist?
+           N APPID S APPID=+$P(^BSDXTMP($J,1),U)
+           I 'APPID W "Error Making Appt-1" QUIT
+           I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2"
+           I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3"
+           I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
+           QUIT
+           ; 
+APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
+           ;
+           ;Called by RPC: BSDX ADD NEW APPOINTMENT
+           ;
+           ;Add new appointment to 3 files
+           ; - BSDX APPOINTMENT
+           ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
+           ; - Patient Appointment Subfile if Resource is linked to clinic
+           ;
+           ;Paramters:
+           ;BSDXY: Global Return (RPC must be set to Global Array)
+           ;BSDXSTART: FM Start Date
+           ;BSDXEND: FM End Date
+           ;BSDXPATID: Patient DFN
+           ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
+           ;BSDXLEN is the appointment duration in minutes
+           ;BSDXNOTE is the Appiontment Note
+           ;BSDXATID is used for 2 purposes:
+           ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
+           ; if BSDXATID = a number, then it is the access type id (used for rebooking)
+           ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
+           ;
+           ;Return:
+           ; ADO.net Recordset having fields:
+           ; AppointmentID and ErrorNumber
+           ;
+           ;Test lines:
+           ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
+           ;
+           ; Deal with optional arguments
+           S BSDXRADEXAM=$G(BSDXRADEXAM)
+           ; Return Array; set Return and clear array
+           S BSDXY=$NA(^BSDXTMP($J))
+           K ^BSDXTMP($J)
+           ; $ET
+           N $ET S $ET="G ETRAP^BSDX07"
+           ; Counter
+           N BSDXI S BSDXI=0
+           ; Lock BSDX node, only to synchronize access to the globals.
+           ; It's not expected that the error will ever happen as no filing
+           ; is supposed to take 5 seconds.
+           L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
+           ; Header Node
+           S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
+           ;Restartable Transaction; restore paramters when starting.
+           ; (Params restored are what's passed here + BSDXI)
+           TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
+           ;
+           ; Turn off SDAM APPT PROTOCOL BSDX Entries
+           N BSDXNOEV
+           S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
+           ;
+           ; Set Error Message to be empty
+           N BSDXERR S BSDXERR=0
+           ;
+           ;;;test for error inside transaction. See if %ZTER works
+           I $G(bsdxdie) S X=1/0
+           ;;;test
+           ;;;test for TRESTART
+           I $G(bsdxrestart) K bsdxrestart TRESTART
+           ;;;test
+           ;
+           ; -- Start and End Date Processing --
+           ; If C# sends the dates with extra zeros, remove them
+           S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
+           ; Are the dates valid? Must be FM Dates > than 2010
+           I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
+           I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
+           ;
+           ;; If Ending date doesn't have a time, this is an error --rm 1.5
+           ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
+           ;
+           ; If the Start Date is greater than the end date, swap dates
+           N BSDXTMP
+           I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
+           ;
+           ; Check if the patient exists:
+           ; - DFN valid number?
+           ; - Valid Patient in file 2?
+           I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q 
+           I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
+           ;
+           ;Validate Resource entry
+           I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
+           N BSDXRESD ; Resource IEN
+           S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
+           N BSDXRNOD ; Resouce zero node
+           S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
+           I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
+           ;
+           ; Walk-in (Unscheduled) Appointment?
+           N BSDXWKIN S BSDXWKIN=0
+           I BSDXATID="WALKIN" S BSDXWKIN=1
+           ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
+           I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
+           ;
+           ; Done with all checks, let's make appointment in BSDX APPOINTMENT
+           N BSDXAPPTID
+           S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
+           I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
+           I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
+           ;
+           ; Then Create Subfiles in 2/44 Appointment
+           N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4)  ; Hosp Location IEN
+           ; Only if we have a valid Hosp Loc can we make an appointment
+           I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR) Q
+           . N BSDXC
+           . S BSDXC("PAT")=BSDXPATID
+           . S BSDXC("CLN")=BSDXSCD
+           . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
+           . S:BSDXWKIN BSDXC("TYP")=4
+           . S BSDXC("ADT")=BSDXSTART
+           . S BSDXC("LEN")=BSDXLEN
+           . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
+           . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
+           . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
+           . S BSDXC("USR")=DUZ
+           . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
+           . Q:BSDXERR
+           . ;Update RPMS Clinic availability
+           . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
+           . Q
+           ;
+           ;Return Recordset
+           TCOMMIT
+           L -^BSDXAPPT(BSDXPATID)
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)=$C(31)
+           Q
+BSDXDEL(BSDXAPPTID)     ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN
+           N DA,DIK
+           S DIK="^BSDXAPPT(",DA=BSDXAPPTID
+           D ^DIK
+           Q
+           ;
 STRIP(BSDXZ)       ;Replace control characters with spaces
-        N BSDXI
-        F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
-        Q BSDXZ
-        ;
+           N BSDXI
+           F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
+           Q BSDXZ
+           ;
 BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)       ;ADD BSDX APPOINTMENT ENTRY
-        ;Returns ien in BSDXAPPT or 0 if failed
-        ;Create entry in BSDX APPOINTMENT
-        N BSDXAPPTID,BSDXFDA
-        S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
-        S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
-        S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
-        S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
-        S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
-        S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
-        S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
-        S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
-        S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM)
-        N BSDXIEN,BSDXMSG
-        D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
-        S BSDXAPPTID=+$G(BSDXIEN(1))
-        Q BSDXAPPTID
-        ;
+           ;Returns ien in BSDXAPPT or 0 if failed
+           ;Create entry in BSDX APPOINTMENT
+           N BSDXAPPTID
+           S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
+           S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
+           S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
+           S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
+           S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
+           S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
+           S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
+           S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
+           S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM
+           N BSDXIEN,BSDXMSG
+           D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+           S BSDXAPPTID=+$G(BSDXIEN(1))
+           Q BSDXAPPTID
+           ;
 BSDXWP(BSDXAPPTID,BSDXNOTE)     ;
-        ;Add WP field
-        N BSDXMSG
-        I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
-        I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
-        I $D(BSDXNOTE(.5)) D
-        . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
-        Q
-        ;
+           ;Add WP field
+           I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
+           I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
+           I $D(BSDXNOTE(.5)) D
+           . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
+           Q
+           ;
 ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA)     ;EP
-        ;Called by BSDX ADD APPOINTMENT protocol
-        ;BSDXSC=IEN of clinic in ^SC
-        ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
-        ;
-        N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND
-        Q:+$G(BSDXNOEV)
-        I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
-        E  I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
-        Q:'+$G(BSDXRES)
-        S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
-        Q:BSDXNOD=""
-        S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
-        S BSDXWKIN=""
-        S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
-        S BSDXLEN=$P(BSDXNOD,U,2)
-        Q:'+BSDXLEN
-        S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
-        S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
-        Q:'+BSDXAPPTID
-        S BSDXNOTE=$P(BSDXNOD,U,4)
-        I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
-        D ADDEVT3(BSDXRES)
-        Q
-        ;
+           ;Called by BSDX ADD APPOINTMENT protocol
+           ;BSDXSC=IEN of clinic in ^SC
+           ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
+           ;
+           N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
+           Q:+$G(BSDXNOEV)
+           I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
+           E  I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
+           Q:'+$G(BSDXRES)
+           S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
+           Q:BSDXNOD=""
+           S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
+           S BSDXWKIN=""
+           S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
+           S BSDXLEN=$P(BSDXNOD,U,2)
+           Q:'+BSDXLEN
+           S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
+           S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
+           Q:'+BSDXAPPTID
+           S BSDXNOTE=$P(BSDXNOD,U,4)
+           I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
+           D ADDEVT3(BSDXRES)
+           Q
+           ;
 ADDEVT3(BSDXRES)           ;
-        ;Call RaiseEvent to notify GUI clients
-        N BSDXRESN
-        S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
-        Q:BSDXRESN=""
-        S BSDXRESN=$P(BSDXRESN,"^")
-        ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
-        D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
-        Q
-        ;
-ROLLBACK(BSDXAPPTID,BSDXC)      ; Private EP; Roll back appointment set
-        ; DO NOT USE except as an emergency measure - only if unforseen error occurs
-        ; Input: 
-        ; Appointment ID to remove from ^BSDXAPPT
-        ; BSDXC array (see array format in $$MAKE^BSDXAPI)
-        N %
-        D BSDXDEL^BSDX07(BSDXAPPTID)
-        S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
-        QUIT
-        ;
-BSDXDEL(BSDXAPPTID)     ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
-        ; DO NOT USE except in emergencies to roll back an appointment set
-        N DA,DIK
-        S DIK="^BSDXAPPT(",DA=BSDXAPPTID
-        D ^DIK
-        Q
-        ;
-ERR(BSDXI,BSDXERR)       ;Error processing - different from error trap.
-        ; Unlock first
-        L -^BSDXPAT(BSDXPATID)
-        ; 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)="0^"_BSDXERR_$C(30)
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)=$C(31)
-        Q
-        ;
+           ;Call RaiseEvent to notify GUI clients
+           N BSDXRESN
+           S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
+           Q:BSDXRESN=""
+           S BSDXRESN=$P(BSDXRESN,"^")
+           ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
+           D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
+           Q
+           ;
+ERR(BSDXI,BSDXERR)       ;Error processing
+           S BSDXI=BSDXI+1
+           S BSDXERR=$TR(BSDXERR,"^","~")
+           I $TL>0 TROLLBACK
+           S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)=$C(31)
+           L -^BSDXAPPT(BSDXPATID)
+           Q
+           ;
 ETRAP     ;EP Error trap entry
-        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
-        D ^%ZTER
-        ;
-        I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
-        ;
-        ; Log error message and send to client
-        I '$D(BSDXI) N BSDXI S BSDXI=0
-        D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
-        Q:$Q 1_U_"Mumps Error" Q
-        ;
+           N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
+           ; Rollback, otherwise ^XTER will be empty from future rollback
+           I $TL>0 TROLLBACK 
+           D ^%ZTER
+           S $EC=""  ; Clear Error
+           ; Log error message and send to client
+           I '$D(BSDXI) N BSDXI S BSDXI=0
+           D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
+           Q
+           ;
+DAY     ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
+           ;
+DOW     S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
+           F %=%:-1:281 S Y=%#4=1+1+Y
+           S Y=$E(X,6,7)+Y#7
+           Q
+           ;
+AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)         ;Update RPMS Clinic availability
+           ;SEE SDM1
+           N Y,DFN
+           N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
+           N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
+           S Y=BSDXSCD,DFN=BSDXPATID
+           S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
+           ;Determine maximum days for scheduling
+           S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
+           S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
+           S SDDATE=BSDXSTART
+           S SDSDATE=SDDATE,SDDATE=SDDATE\1
+1         ;L  Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
+           Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
+           S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
+           S X2=SDEDT D C^%DTC S SDEDT=X
+           S Y=BSDXSTART
+EN1     S (X,SD)=Y,SM=0 D DOW
+S         I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0  Q:^(SS,1)=""  S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")
+           S S=BSDXLEN
+           ;Check if BSDXLEN evenly divisible by appointment length
+           S RPMSL=$P(SL,U)
+           I BSDXLEN<RPMSL S BSDXLEN=RPMSL
+           I BSDXLEN#RPMSL'=0 D
+           . S BSDXINC=BSDXLEN\RPMSL
+           . S BSDXINC=BSDXINC+1
+           . S BSDXLEN=RPMSL*BSDXINC
+           S SL=S_U_$P(SL,U,2,99)
+SC       S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
+           L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
+           S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
+           S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
+           I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
+           I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
+           ;
+SP       I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
+           S SDNOT=1
+           S ABORT=0
+           F I=ST+ST:SDDIF:SS-SDDIF D  Q:ABORT
+           . S ST=$E(S,I+1) S:ST="" ST=" "
+           . S Y=$E(STR,$F(STR,ST)-2)
+           . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
+           . I Y="" S ABORT=1 Q
+           . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST
+           . Q
+           S ^SC(SC,"ST",$P(SD,"."),1)=S
+           L -^SC(SC,"ST",$P(SD,"."),1)
+           Q

Scheduling/trunk/m/BSDX08.m

@@ -1 @@
-BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; 
         ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
@@ -6 +6 @@
         ; Change History
         ; 3101022 UJO/SMH v1.42
-        ;  - Transaction work. As of v 1.7, all work here has been superceded
-        ;  - Refactoring of AVUPDT - never tested though.
+        ;  - Transaction now restartable. Thanks to 
+        ;   --> Zach Gonzalez and Rick Marshall for fix.
+        ;  - Extra TROLLBACK in Lock Statement when lock fails.
+        ;   --> Removed--Rollback is already in ERR tag.
+        ;  - Added new statements to old SD code in AVUPDT to obviate
+        ;   --> need to restore variables in transaction
+        ;  - Refactored this chunk of code. Don't really know whether it 
+        ;   --> worked in the first place. Waiting for bug report to know.
         ;  - Refactored all of APPDEL.
         ; 
@@ -13 +19 @@
         ;  - Added ability to remove checked in appointments. Added a couple
         ;    of units tests for that under UT2.
-        ; 
-        ; 3120625 VEN/SMH v1.7
-        ;  - Transactions removed. Code refactored to work w/o txns.
-        ;  - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling
-        ;    that.
+        ;  - Minor reformatting because of how KIDS adds tabs.
         ; 
         ; Error Reference:
@@ -29 +31 @@
         ;  -8^BSDX08: Unable to find associated PIMS appointment for this patient
         ;  -9^BSDX08: BSDXAPI returned an error: (error)
-        ;  -10^BSDX08: $$BSDXCAN failed (Fileman filing error)
         ;  -100~BSDX08 Error: (Mumps Error)
         ;
 APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
         ;Entry point for debugging
-        ;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
-        Q
-        ;
-APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)         ; Private EP
+        D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
+        Q
+        ;
+UT      ; Unit Tests
+        ; Test 1: Make normal appointment and cancel it. See if every thing works
+        N ZZZ
+        D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1)
+        S APPID=+$P(^BSDXTMP($J,1),U)
+        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
+        I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1"
+        I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2"
+        I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3"
+        I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4"
+        ;
+        ; Test 2: Check for -1
+        ; Make appt
+        D APPADD^BSDX07(.ZZZ,3110125.2,3110125.3,4,"Dr Office",10,"Sam's Note",1)
+        ; Lock the node in another job
+        S APPID=+$P(^BSDXTMP($J,1),U)
+        ; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10
+        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
+        ;
+        ; Test 3: Check for -100
+        S bsdxdie=1
+        D APPADD^BSDX07(.ZZZ,3110126.2,3110126.3,4,"Dr Office",10,"Sam's Note",1)
+        S APPID=+$P(^BSDXTMP($J,1),U)
+        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
+        I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
+        K bsdxdie
+        ;
+        ; Test 4: Restartable transaction
+        S bsdxrestart=1
+        D APPADD^BSDX07(.ZZZ,3110128.2,3110128.3,4,"Dr Office",10,"Sam's Note",1)
+        S APPID=+$P(^BSDXTMP($J,1),U)
+        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
+        I $P(^DPT(4,"S",3110128.2,0),U,2)'="PC" W "Error in Restartable Transaction",!
+        ;
+        ; Test 5: for invalid Appointment ID (-2 and -3)
+        D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons")
+        I $P(^BSDXTMP($J,1),"~")'=-2 W "Error in -2",!
+        D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons")
+        I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",!
+UT2     ; More unit Tests
+        ;
+        ; Test 6: for Cancelling walkin and checked-in appointments 
+        S BSDXSTART=$E($$NOW^XLFDT,1,12),BSDXEND=BSDXSTART+.0001
+        D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt
+        S APPID=+$P(^BSDXTMP($J,1),U)
+        I APPID=0 W "Error in test 6",!
+        D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; check-in
+        D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; Delete appt
+        I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
+        ;
+        ; Test 7: for cancelling walkin and checked-in appointments
+        S BSDXSTART=$E($$NOW^XLFDT,1,12)+.0001,BSDXEND=BSDXSTART+.0001
+        D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt
+        S APPID=+$P(^BSDXTMP($J,1),U)
+        I APPID=0 W "Error in test 6",!
+        D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin
+        S BSDXRES=$O(^BSDXRES("B","Dr Office",""))
+        S BSDXCLN=$P(^BSDXRES(BSDXRES,0),U,4)
+        S BSDXRESULT=$$RMCI^BSDXAPI(4,BSDXCLN,BSDXSTART) ; remove checkin
+        D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt
+        I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
+        QUIT
+APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)         ;EP
         ;Called by RPC: BSDX CANCEL APPOINTMENT
         ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
@@ -61 +124 @@
         ; Counter
         N BSDXI S BSDXI=0
-        ;
         ; Header Node
         S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
+        ;
+        ; Lock BSDX node, only to synchronize access to the globals.
+        ; It's not expected that the error will ever happen as no filing
+        ; is supposed to take 5 seconds.
+        L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
+        ;
+        ;Restartable Transaction; restore paramters when starting.
+        ; (Params restored are what's passed here + BSDXI)
+        TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08"
         ;
         ; Turn off SDAM APPT PROTOCOL BSDX Entries
@@ -70 +141 @@
         ;
         ;;;test for error inside transaction. See if %ZTER works
-        I $G(BSDXDIE1) N X S X=1/0
+        I $G(bsdxdie) S X=1/0
+        ;;;test
+        ;;;test for TRESTART
+        I $G(bsdxrestart) K bsdxrestart TRESTART
+        ;;;test
         ;
         ; Check appointment ID and whether it exists
         I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
         I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q
-        ; 
-        ; Lock BSDX node, only to synchronize access to the globals.
-        ; It's not expected that the error will ever happen as no filing
-        ; is supposed to take 5 seconds.
-        L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
         ;
         ; Start Processing:
-        ; First, get data
+        ; First, add cancellation date to appt entry in BSDX APPOINTMENT
         N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
         N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID
         N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time
-        ;
-        ; Check the resource ID and whether it exists
+        D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
+        ;
+        ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
         N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
-        ; If the resource id doesn't exist...
+        ; If the resouce id doesn't exist...
         I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
         I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
-        ;
-        ;
-        ; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI
         ; Get zero node of resouce
-        N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0)
+        S BSDXNOD=^BSDXRES(BSDXSC1,0)
         ; Get Hosp location
         N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
-        ; Error indicator
+        ; Error indicator for Hosp Location filing for getting out of routine
         N BSDXERR S BSDXERR=0
-        ; 
-        N BSDXC ; Array to pass to BSDXAPI
-        ;
-        I BSDXLOC D 
-        . S BSDXC("PAT")=BSDXPATID
-        . S BSDXC("CLN")=BSDXLOC
-        . S BSDXC("TYP")=BSDXTYP
-        . S BSDXC("ADT")=BSDXSTART
-        . S BSDXC("CDT")=$$NOW^XLFDT()
-        . S BSDXC("NOT")=BSDXNOT
-        . S:'+$G(BSDXCR) BSDXCR=11 ;Other
-        . S BSDXC("CR")=BSDXCR
-        . S BSDXC("USR")=DUZ
-        . ;
-        . S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message
-        ; If error, quit. No need to rollback as no changes took place.
-        I BSDXERR D ERR(BSDXI,"-9~BSDX08: BSDXAPI reports that "_$P(BSDXERR,U,2)) QUIT
-        ;
-        I $G(BSDXDIE2) N X S X=1/0
-        ;
-        ; Now cancel the appointment for real
-        ; BSDXAPPT First; no need for rollback if error occured.
-        N BSDXERR S BSDXERR=$$BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
-        I BSDXERR D ERR(BSDXI,"-10~BSDX08: $$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT
-        ;
-        ; Then PIMS: 
-        ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
-        ; If error happens, must rollback ^BSDXAPPT
-        I BSDXLOC S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI
-        ; Rollback BSDXAPPT if error occurs
-        I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID)  QUIT
-        ;
+        ; Only file in 2/44 if there is an associated hospital location
+        I BSDXLOC D  QUIT:BSDXERR  
+        . I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT
+        . ; Get the IEN of the appointment in the "S" node of ^SC
+        . N BSDXSCIEN
+        . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
+        . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT
+        . ; Get the appointment node
+        . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0))
+        . I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT
+        . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2)
+        . ; Cancel through BSDXAPI
+        . N BSDXZ
+        . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART)
+        . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
+        . ; Update Legacy PIMS clinic Availability
+        . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
+        ;
+        TCOMMIT
         L -^BSDXAPPT(BSDXAPTID)
         S BSDXI=BSDXI+1
@@ -140 +195 @@
         Q
         ;
-BSDXCAN(BSDXAPTID)      ; $$; Private; Cancel BSDX APPOINTMENT entry
-        ; Input: Appt IEN in ^BSDXAPPT
-        ; Output: 0 for success and 1^Msg for failure
-        N BSDXDATE,BSDXIENS,BSDXFDA,BSDXMSG
-        S BSDXDATE=$$NOW^XLFDT()
+AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)       ;Update Legacy PIMS Clinic availability
+        ;See SDCNP0
+        N SD,S  ; Start Date
+        S (SD,S)=BSDXSTART 
+        N I ; Clinic IEN in 44
+        S I=BSDXSCD
+        ; if day has no schedule in legacy PIMS, forget about this update.
+        Q:'$D(^SC(I,"ST",SD\1,1))
+        N SL ; Clinic characteristics node (length of appt, when appts start etc)
+        S SL=^SC(I,"SL")
+        N X ; Hour Clinic Display Begins
+        S X=$P(SL,U,3)
+        N STARTDAY ; When does the day start?
+        S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
+        N SB ; ?? Who knows? Day Start - 1 divided by 100.
+        S SB=STARTDAY-1/100
+        S X=$P(SL,U,6) ; Now X is Display increments per hour
+        N HSI ; Slots per hour, try 1
+        S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
+        N SI ; Slots per hour, try 2
+        S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
+        N STR ; ??
+        S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
+        N SDDIF ; Slots per hour diff??
+        S SDDIF=$S(HSI<3:8/HSI,1:2)
+        S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
+        S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
+        N Y ; Hours since start of Date
+        S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
+        N ST  ; ??
+        ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
+        ; Y\1 -> Hours since start of day; * SI: * slots
+        S ST=Y#1*SI\.6+(Y\1*SI) 
+        N SS ; how many slots are supposed to be taken by appointment
+        S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
+        N I
+        I Y'<1 D  ; If Hours since start of Date is greater than 1
+        . ; loop through pattern. Tired of documenting.
+        . F I=ST+ST:SDDIF D  Q:Y=""  Q:SS'>0
+        . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""  
+        . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
+        . . S SS=SS-1 
+        . . Q:SS'>0
+        S ^SC(BSDXSCD,"ST",SD\1,1)=S  ; new pattern; global set
+        Q
+        ;
+APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD)             ;
+        ;Cancel appointment for patient BSDXDFN in clinic BSDXSC1
+        ;at time BSDXSD
+        N BSDXC,%H
+        S BSDXC("PAT")=BSDXPATID
+        S BSDXC("CLN")=BSDXLOC
+        S BSDXC("TYP")=BSDXTYP
+        S BSDXC("ADT")=BSDXSD
+        S %H=$H D YMD^%DTC
+        S BSDXC("CDT")=X+%
+        S BSDXC("NOT")=BSDXNOT
+        S:'+$G(BSDXCR) BSDXCR=11 ;Other
+        S BSDXC("CR")=BSDXCR
+        S BSDXC("USR")=DUZ
+        ;
+        S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC)
+        Q
+        ;
+BSDXCAN(BSDXAPTID)      ;
+        ;Cancel BSDX APPOINTMENT entry
+        N %DT,X,BSDXDATE,Y,BSDXIENS,BSDXFDA,BSDXMSG
+        S %DT="XT",X="NOW" D ^%DT ; X ^DD("DD")
+        S BSDXDATE=Y
         S BSDXIENS=BSDXAPTID_","
         S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
+        K BSDXMSG
         D FILE^DIE("","BSDXFDA","BSDXMSG")
-        I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1)
-        QUIT 0
-        ;
-ROLLBACK(BSDXAPTID)      ; Proc; Private; Rollback cancellation
-        ; Input same as $$BSDXCAN
-        N BSDXIENS S BSDXIENS=BSDXAPTID_","
-        N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@"
-        N BSDXMSG
-        D FILE^DIE("","BSDXFDA","BSDXMSG")
-        ;I $D(BSDXMSG)  ; Not sure what to do. We are already handling an error.
-        QUIT
+        Q
         ;
 CANEVT(BSDXPAT,BSDXSTART,BSDXSC)        ;EP Called by BSDX CANCEL APPOINTMENT event
@@ -182 +292 @@
         Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
         S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
-        . N BSDXNOD
         . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
         . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
-        I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER
+        I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT)
         Q BSDXFOUND
         ;
@@ -200 +309 @@
         ;
 ERR(BSDXI,BSDXERR)      ;Error processing
-        ; Unlock first
-        L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
-        ; 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,"^","~")
+        I $TL>0 TROLLBACK
         S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
         S BSDXI=BSDXI+1
         S ^BSDXTMP($J,BSDXI)=$C(31)
+        L -^BSDXAPPT(BSDXAPTID)
         QUIT
         ;
 ETRAP   ;EP Error trap entry
         N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
+        ; Rollback, otherwise ^XTER will be empty from future rollback
+        I $TL>0 TROLLBACK 
         D ^%ZTER
-        ;
-        ; Roll back BSDXAPPT; 
-        ; NB: What if a Mumps error happens inside fileman in BSDXAPI? 
-        ; I have decided the M errors are out of scope for me to handle.
-        D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID)
-        ;
+        S $EC=""  ; Clear Error
         ; Log error message and send to client
         I '$D(BSDXI) N BSDXI S BSDXI=0
         D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
-        Q:$Q 1_U_"-100~Mumps Error" Q
+        QUIT
         ;
         ;;;NB: This is code that is unused in both original and port.

Scheduling/trunk/m/BSDX09.m

@@ -1 @@
-BSDX09  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 6/21/12 11:03am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX09  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 4/28/11 10:18am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX11.m

@@ -1 +1 @@
 BSDX11  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX12.m

@@ -1 +1 @@
 BSDX12  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ; 

Scheduling/trunk/m/BSDX13.m

@@ -1 +1 @@
 BSDX13  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX14.m

@@ -1 +1 @@
 BSDX14  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX15.m

@@ -1 +1 @@
 BSDX15  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX16.m

@@ -1 +1 @@
 BSDX16  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 4/28/11 10:20am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX17.m

@@ -1 +1 @@
 BSDX17  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX18.m

@@ -1 +1 @@
 BSDX18  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX19.m

@@ -1 +1 @@
 BSDX19  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX20.m

@@ -1 +1 @@
 BSDX20  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX21.m

@@ -1 +1 @@
 BSDX21  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX22.m

@@ -1 +1 @@
 BSDX22  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX23.m

@@ -1 +1 @@
 BSDX23  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX24.m

@@ -1 +1 @@
 BSDX24  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX25.m

@@ -1 @@
-BSDX25  ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX25  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;
         ; Change Log:
         ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C#
-        ; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions.
-        ;                  -> Functionality still the same.
-        ;                  -> Unit Tests in UT25^BSDXUT2
-        ;
-        ;
-CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)        ;EP
+        ;
+        ;
+UT      ; Unit Tests
+        ; Make appointment, checkin, then uncheckin
+        N ZZZ
+        N APPTTIME S APPTTIME=$E($$NOW^XLFDT(),1,12)
+        D APPADD^BSDX07(.ZZZ,APPTTIME,APPTTIME+.0001,3,"Dr Office",30,"Sam's Note",1)
+        N APPTID S APPTID=+^BSDXTMP($J,1)
+        N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I")
+        D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
+        IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1",!
+        IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 2",!
+        D RMCI^BSDX25(.ZZZ,APPTID)
+        IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
+        IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
+        D RMCI^BSDX25(.ZZZ,APPTID)  ; again, test sanity in repeat
+        IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
+        IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
+        ; now test various error conditions
+        ; Test Error 1
+        D RMCI^BSDX25(.ZZZ,)
+        IF +^BSDXTMP($J,1)'=-1 WRITE "ERROR IN ETest 1",!
+        ; Test Error 2
+        D RMCI^BSDX25(.ZZZ,234987234398)
+        IF +^BSDXTMP($J,1)'=-2 WRITE "ERROR IN Etest 2",!
+        ; Tests for 3 to 5 difficult to produce
+        ; Error tests follow: Mumps error test; Transaction restartability
+        N bsdxdie S bsdxdie=1
+        D RMCI^BSDX25(.ZZZ,APPTID)
+        IF +^BSDXTMP($J,1)'=-20 WRITE "ERROR IN Etest 3",!
+        K bsdxdie
+        N bsdxrestart S bsdxrestart=1
+        D RMCI^BSDX25(.ZZZ,APPTID)
+        IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 4",!
+        QUIT
+CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
         ;Entry point for debugging
         ;
-        ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
-        Q
-        ;
-CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT)       ;Private EP Check in appointment
-        ; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
-        ; Called by RPC: BSDX CHECKIN APPOINTMENT
-        ;
+        ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
+        Q
+        ;
+CHECKIN(BSDXY,BSDXAPTID,BSDXCDT)        ; ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)       ;EP Check in appointment
         ; Private to GUI; use BSDXAPI for general API to checkin patients
         ; Parameters:
         ; BSDXY: Global Out
-        ; BSDXAPPTID: Appointment ID in ^BSDXAPPT
+        ; BSDXAPTID: Appointment ID in ^BSDXAPPT
         ; BSDXCDT: Checkin Date --> Changed
         ; BSDXCC: Clinic Stop IEN (not used)
@@ -30 +57 @@
         ; BSDXVCL: PCC+ Clinic IEN (not used)
         ; BSDXVFM: PCC+ Form IEN (not used)
-        ; BSDXOG: PCC+ Outguide (true or false) (not used)
+        ; BSDXOG: PCC+ Outguide (true or false)
         ;
         ; Output:
@@ -36 +63 @@
         ; - 0 if all okay
         ; - Another number or text if not
-        ;
-        ; Error reference:
-        ; -1 -> Invalid Appointment ID
-        ; -2 -> Invalid Check-in Date
-        ; -3 -> Cannot check-in due to Fileman Filer failure
-        ; -4 -> Cannot lock ^BSDXAPPT(APPTID)
-        ; -10 -> BSDXAPI error
-        ; -100 -> Mumps Error
-        ;
-        ; Turn off SDAM Appointment Events BSDX Protocol Processing
+        
+        N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
         N BSDXNOEV
         S BSDXNOEV=1 ;Don't execute protocol
         ;
-        ; Set min DUZ vars
-        D ^XBKVAR
-        ;
-        ; $ET
-        N $ET S $ET="G ERROR^BSDX25"
-        ;
-        ; Test for error trap for Unit Tests
-        I $G(BSDXDIE) N X S X=1/0
-        ;
-        N BSDXI S BSDXI=0
-        ;
-        S BSDXY=$NAME(^BSDXTMP($J))
-        K @BSDXY
-        ;
+        D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
+        S BSDXI=0
+        K ^BSDXTMP($J)
+        S BSDXY="^BSDXTMP("_$J_")"
         S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
-        ;
-        I '+BSDXAPPTID D ERR("-1~Invalid Appointment ID") QUIT
-        I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-1~Invalid Appointment ID") QUIT
-        ;
-        ; Lock BSDX node, only to synchronize access to the globals.
-        ; It's not expected that the error will ever happen as no filing
-        ; is supposed to take 5 seconds.
-        L +^BSDXAPPT(BSDXAPPTID):5 E  D ERR("-4~Appt record is locked. Please contact technical support.") QUIT
-        ;
+        I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q
+        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q
         ; Remove Date formatting v.1.5. Client will send date as FM Date.
         ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
         ;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
-        S BSDXCDT=+BSDXCDT  ; Strip off zeros if C# sends them
-        I BSDXCDT'>2000000 D ERR("-2~Invalid Check-in Date") QUIT
+           S BSDXCDT=+BSDXCDT  ; Strip off zeros if C# sends them
+        I BSDXCDT=-1 D ERR(70) Q
         I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
-        ;
-        ; Some data
-        N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) ; Appointment Node
-        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
-        N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Appointment Start Time
-        ;
-        ; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION)
-        N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I")
-        I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist
-        ;
-        ; Check if we can check-in using BSDXAPI
-        N BSDXERR S BSDXERR=0
-        I BSDXSC1 S BSDXERR=$$CHECKIC1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
-        I BSDXERR D ERR(-10_"~"_$P(BSDXERR,U,2)) QUIT
-        ;
-        ; Checkin BSDX APPOINTMENT entry
-        ; Failure Analysis: If we fail here, no changes were made.
-        N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT)
-        I BSDXERR D ERR("-3~Fileman Filer failed to check-in appt") QUIT
-        ;
-        ; File check-in using BSDXAPI
-        ; Failure Analysis: If we fail here, we need to roll back first check-in.
-        N BSDXERR S BSDXERR=0
-        I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
-        I BSDXERR D  QUIT
-        . N % S %=$$BSDXCHK(BSDXAPPTID,"@") ; No Error checking to prevent loop.
-        . D ERR(-10_"~"_$P(BSDXERR,U,2)) ; Send error message to client
-        ;
-        L -^BSDXAPPT(BSDXAPPTID)
+        ;Checkin BSDX APPOINTMENT entry
+        D BSDXCHK(BSDXAPTID,BSDXCDT)
+        S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
+        S BSDXPATID=$P(BSDXNOD,U,5)
+        S BSDXSTART=$P(BSDXNOD,U)
+        ;
+        S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
+        I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D  I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q
+        . S BSDXNOD=^BSDXRES(BSDXSC1,0)
+        . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
+        . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART)
+        ;
         S BSDXI=BSDXI+1
         S ^BSDXTMP($J,BSDXI)="0"_$C(30)
@@ -114 +99 @@
         Q
         ;
-BSDXCHK(BSDXAPPTID,BSDXCDT)     ; $$ Private Entry Point. File or delete check-in to
-        ; BSDX Appointment
-        ; Input: BSDXAPPTID -> Appointment ID
-        ;        BSDXCDT -> Check-in date, or "@" to remove check-in.
-        ;
-        ; Output: 1^Error for error
-        ;         0 for success
-        ;
-        Q:$G(BSDXSIMERR1) 1_U_"Simulated Error 1"
-        ;
-        N BSDXIENS,BSDXMSG,BSDXFDA ; Filer variables
-        S BSDXIENS=BSDXAPPTID_","
+BSDXCHK(BSDXAPTID,BSDXCDT)      ;
+        ;
+        S BSDXIENS=BSDXAPTID_","
         S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
         D FILE^DIE("","BSDXFDA","BSDXMSG")
-        Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
-        Q 0
-        ;
-RMCI(BSDXY,BSDXAPPTID)  ; Private EP - Remove Check-in from BSDX APPT and 2/44
-        ; Called by RPC BSDX REMOVE CHECK-IN
+        Q
+        ;
+APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART)          ;
+        ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
+        ;at time BSDXSTART
+        S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART)
+        Q
+        ;
+RMCI(BSDXY,BSDXAPPTID)  ; EP - Remove Check-in from BSDX APPT and 2/44
+        ; Called by RPC [Fill in later]
         ; 
         ; Parameters to pass:
@@ -147 +128 @@
         ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
         ; -5~BSDXAPI Error. Message depends on error.
-        ; -6~Data Filing Error in BSDXCHK
-        ; -7~Lock not acquired
-        ; -100~Mumps Error
+        ; -20~Mumps Error
         ; 
         N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
@@ -163 +142 @@
         S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
         ;
+        TSTART (BSDXI):SERIAL ; Perform Autolocking
+        ;
         ;;;test
-        I $G(BSDXDIE) N X S X=8/0
+        I $g(bsdxdie) S X=8/0
+        ;;;
+        I $g(bsdxrestart) k bsdxrestart TRESTART
+        ;;;test
         ;
         ; Check for Appointment ID (passed and exists in file)
@@ -170 +154 @@
         I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
         ;
-        ; Lock
-        ; Timeout not expected to happen except in error conditions.
-        L +^BSDXAPPT(BSDXAPPTID):5 E  D ERR("-7~Appt record is locked. Please contact technical support.") QUIT
-        ;
-        ; Get appointment Data
+        ; Remove checkin from BSDX APPOINTMENT entry
+        D BSDXCHK(BSDXAPPTID,"@")
+        ;
+        ; Now, remove checkin from PIMS files 2/44
         N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
-        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
-        N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
-        N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID
+        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
+        N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)   ; Start Date
+        N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID
         ; 
         ; If the resource doesn't exist, error out. DB is corrupt.
-        I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT
-        I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT 
-        ;
-        ; Get HL Data
-        N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node
-        N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN
-        I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist
-        ;
-        ; Is it okay to remove check-in from PIMS?
-        N BSDXERR S BSDXERR=0 ; Scratch variable
-        ; $$RMCICK = Remove Check-in Check
-        I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
-        I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT
-        ;
-        ; For possible rollback, get old check-in date (internal value)
-        N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I")
-        ;
-        ; Remove checkin from BSDX APPOINTMENT entry
-        ; No need to rollback here on failure.
-        N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@")
-        I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT
-        ;
-        ; Now, remove checkin from PIMS files 2/44
-        ; Restore BSDXCDT into ^BSDXAPPT if we fail.
-        N BSDXERR S BSDXERR=0 ; Scratch variable to hold error message
-        I BSDXSC1 S BSDXERR=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
-        I BSDXERR D  QUIT
-        . N % S %=$$BSDXCHK(BSDXAPPTID,BSDXCDT) ; No error checking here.
-        . D ERR("-5~"_$P(BSDXERR,U,2)) ; Send error message to client
-        ;
-        ; Unlock
-        L -^BSDXAPPT(BSDXAPPTID)
+        I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT
+        I '$D(^BSDXRES(BSDXSC1,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT 
+        ;
+        N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node
+        S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
+        ;
+        N BSDXZ ; Scratch variable to hold error message
+        I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
+        I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT
+        ; 
+        TCOMMIT  ; Save Data into Globals
         ;
         ; Return ADO recordset
@@ -246 +208 @@
         Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
         S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
-        . N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
+        . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
         . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
-        I BSDXFOUND,+$G(BSDXAPPT) D
-        . N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT)
-        . I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort
+        I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT)
         Q BSDXFOUND
         ;
@@ -265 +225 @@
 ERROR   ;
         S $ETRAP="D ^%ZTER HALT"  ; Emergency Error Trap for the wise
-        D ^%ZTER
-        ; VEN/SMH: NB: I make a conscious decision not to roll back anything
-        ; here in the error trap. Once the error is fixed, users can 
-        ; undo or redo the check-in.
-        ; Individual portions of this routine may choose to do rolling back
-        ; of their own (e.g. a failed call to BSDXAPI causes rollback to occur
-        ; in CHECKIN and RMCI)
-        ;
-        ; Log error message and send to client
-        D ERR("-100~Mumps Error")
-        Q:$Q "-100^Mumps Error" Q
+           ; Rollback, otherwise ^XTER will be empty from future rollback
+           I $TL>0 TROLLBACK
+           D ^%ZTER
+           S $EC=""  ; Clear Error
+           ; Log error message and send to client
+        D ERR("-20~Mumps Error")
+        Q
         ;
 ERR(BSDXERR)    ;Error processing
-        ; Unlock first
-        L:$D(BSDXAPPTID) -^BSDXAPPT(BSDXAPPTID)
-        ; 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
+        I $TLEVEL>0 TROLLBACK
         S BSDXERR=$G(BSDXERR)
         S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name

Scheduling/trunk/m/BSDX26.m

@@ -1 @@
-BSDX26   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
-        ; Licensed under LGPL
-        ; Change History:
-        ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
-        ; 3101205 - UJO/SMH - Extensive refactoring.
-        ; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1
-        ;
-        ; Error Reference:
-        ; 1: Appt ID is not a number
-        ; 2: Appt IEN is not in ^BSDXAPPT
-        ; 3: FM Failure to file WP field in ^BSDXAPPT
-        ; 4: BSDXAPI reports failure to change note field in ^SC
-        ; 5: Failure to acquire lock on ^BSDXAPPT(APPTID)
-        ; 100: Mumps Error
-        ; 
-        ; NB: Normally I use negative numbers for errors; this routine returns
-        ;     -1 as a successful result! So I needed to use +ve numbers.
-        ;
+BSDX26   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
+           ;;1.6;BSDX;;Aug 31, 2011;Build 25
+           ; Licensed under LGPL
+           ; Change History:
+           ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
+           ; --> Thanks to Zach Gonzalez and Rick Marshall
+           ; 3101205 - UJO/SMH - Extensive refactoring.
+           ;
+           ; Error Reference:
+           ; -1: Appt ID is not a number
+           ; -2: Appt IEN is not in ^BSDXAPPT
+           ; -3: FM Failure to file WP field in ^BSDXAPPT
+           ;
 EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE)       ;EP
-        ;Entry point for debugging
-        ;
-        ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
-        Q
+           ;Entry point for debugging
+           ;
+           D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
+           Q
+UT      ; Unit Tests
+           ; Test 1: Make sure this damn thing works
+           N ZZZ
+           N %H S %H=$H
+           N NOTE S NOTE="New Note "_%H
+           D EDITAPT(.ZZZ,188,NOTE)
+           I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B
+           ; Test 2: Test Errors -1 and -2
+           N ZZZ
+           N NOTE S NOTE="Nothing important"
+           D EDITAPT(.ZZZ,"BLAHBLAH",NOTE)
+           I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B
+           D EDITAPT(.ZZZ,298734322,NOTE)
+           I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B
+           ; Test 4: M Error
+           N bsdxdie S bsdxdie=1
+           D EDITAPT(.ZZZ,188,NOTE)
+           I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B
+           k bsdxdie
+           ; Test 5: Trestart
+           N bsdxrestart S bsdxrestart=1
+           N %H S %H=$H
+           N NOTE S NOTE="New Note "_%H
+           D EDITAPT(.ZZZ,188,NOTE)
+           I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B
+           ; Test 6: for Hosp Location Update
+           N DATE S DATE=$$NOW^XLFDT()
+           S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
+           D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1)
+           N APPID S APPID=+$P(^BSDXTMP($J,1),U)
+           D EDITAPT(.ZZZ,APPID,"New Note")
+           I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B
+           I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B
+           QUIT
+           ;
 EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE)         ;EP Edit appointment (only note text can be edited)
-        ; Called by RPC: BSDX EDIT APPOINTMENT
-        ;
-        ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
-        ;
-        ; Parameters:
-        ; - BSDXY: Global Return (RPC must be set to Global Array)
-        ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
-        ; - BSDXNOTE: New note
-        ;
-        ; Return:
-        ; ADO.net Recordset having 1 field: ERRORID
-        ; If Okay: -1; otherwise, positive integer with message
-        ;
-        ; Return Array; set Return and clear array
-        S BSDXY=$NA(^BSDXTMP($J))
-        K ^BSDXTMP($J)
-        ; ET
-        N $ET S $ET="G ETRAP^BSDX26"
-        ; Set up basic DUZ variables
-        D ^XBKVAR
-        ; Counter
-        N BSDXI S BSDXI=0
-        ; Header Node
-        S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
-        ;
-        ;;;test for error. See if %ZTER works
-        I $G(BSDXDIE) S X=1/0
-        ;
-        ; Validate Appointment ID
-        I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT
-        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT
-        ;
-        ; Lock BSDX node, only to synchronize access to the globals.
-        ; It's not expected that the error will ever happen as no filing
-        ; is supposed to take 5 seconds.
-        L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") QUIT
-        ;
-        ; Put the WP in decendant fields from the root to file as a WP field
-        S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
-        I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
-        ;
-        N BSDXMSG ; Message in case of error in filing.
-        ;
-        ; Save Before State in case we need it for rollback
-        K ^TMP($J)
-        M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID)
-        ;
-        ; Update note in BSDX APPOINTMENT
-        I $D(BSDXNOTE(.5)) D
-        . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
-        ;
-        ; Error handling. No need for rollback since nothing else changed.
-        I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
-        ;
-        ; Now file in file 44:
-        N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
-        N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
-        N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
-        N BSDXRES S BSDXRES=0 ; Result
-        ; Update Note only if we have a linked hospital location.
-        I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
-        ; If we get an error (denoted by -1 in BSDXRES), return error to client
-        ; AND restore the original note
-        I BSDXRES D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
-        ;
-        ;Return Recordset indicating success
-        L -^BSDXAPPT(BSDXAPTID)
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)=$C(31)
-        ;
-        K ^TMP($J) ; Done; remove TMP data
-        QUIT
-        ;
-ROLLBACK(BSDXAPTID)     ; Rollback note to original in ^BSDXAPPT
-        M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
-        K ^TMP($J)
-        QUIT
-        ;
+           ; Called by RPC: BSDX EDIT APPOINTMENT
+           ;
+           ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
+           ;
+           ; Parameters:
+           ; - BSDXY: Global Return (RPC must be set to Global Array)
+           ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
+           ; - BSDXNOTE: New note
+           ;
+           ; Return:
+           ; ADO.net Recordset having 1 field: ERRORID
+           ; If Okay: -1; otherwise, positive integer with message
+           ;
+           ; Return Array; set Return and clear array
+           S BSDXY=$NA(^BSDXTMP($J))
+           K ^BSDXTMP($J)
+           ; ET
+           N $ET S $ET="G ETRAP^BSDX26"
+           ; Set up basic DUZ variables
+           D ^XBKVAR
+           ; Counter
+           N BSDXI S BSDXI=0
+           ; Header Node
+           S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
+           ; Restartable txn for GT.M. Restored vars are Params + BSDXI.
+           TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26"
+           ;
+           ;;;test for error inside transaction. See if %ZTER works
+           I $G(bsdxdie) S X=1/0
+           ;;;test
+           ;;;test for TRESTART
+           I $G(bsdxrestart) K bsdxrestart TRESTART
+           ;;;test
+           ;
+           ; Validate Appointment ID
+           I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
+           I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
+           ; Put the WP in decendant fields from the root to file as a WP field
+           S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
+           I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
+           N BSDXMSG ; Message in case of error in filing.
+           I $D(BSDXNOTE(.5)) D
+           . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
+           I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
+           ;
+           ; Now file in file 44:
+           N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
+           N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
+           N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
+           N BSDXRES S BSDXRES=0 ; Result
+           ; Update Note only if we have a linked hospital location.
+           I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
+           ; If we get an error (denoted by -1 in BSDXRES), return error to client
+           I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT
+           ;Return Recordset
+           TCOMMIT
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)=$C(31)
+           QUIT
+           ;
 ERR(BSDXI,BSDXERR)       ;Error processing
-        ; Unlock first
-        L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
-        ; 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)=BSDXERR_$C(30)
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)=$C(31)
-        QUIT
-        ;
+           S BSDXI=BSDXI+1
+           S BSDXERR=$TR(BSDXERR,"^","~")
+           I $TL>0 TROLLBACK
+           S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)=$C(31)
+           QUIT
+           ;
 ETRAP     ;EP Error trap entry
-        N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
-        D ^%ZTER
-        ;
-        I '$D(BSDXI) N BSDXI S BSDXI=0
-        D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
-        QUIT
+           N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
+           I $TL>0 TROLLBACK
+           D ^%ZTER
+           S $EC=""
+           I '$D(BSDXI) N BSDXI S BSDXI=0
+           D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
+           Q

Scheduling/trunk/m/BSDX27.m

@@ -1 +1 @@
 BSDX27   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
-           ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+           ;;1.6;BSDX;;Aug 31, 2011;Build 25
            ; Licensed under LGPL
            ; 

Scheduling/trunk/m/BSDX28.m

@@ -1 @@
-BSDX28  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:57am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX28  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ; Change Log:
@@ -38 +38 @@
         . S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30)
 PID     ;PID Lookup
-        ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
-        ; won't work anyways.
-        I $D(^DPT("UJOPID",BSDXP)) DO  SET BSDXY=BSDXRET_$C(31) QUIT
-        . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
-        . Q:'$D(^DPT(BSDXIEN,0))
-        . S BSDXDPT=$G(^DPT(BSDXIEN,0))
-        . S BSDXZ=$P(BSDXDPT,U) ;NAME
-        . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
-        . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
-        . ; Inactivated Chart get an *
-        . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
-        . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
-        . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
-        . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
-        . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
-        . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
-        . S BSDXRET=BSDXRET_BSDXZ_$C(30)
+           ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
+           ; won't work anyways.
+           I $D(^DPT("UJOPID",BSDXP)) DO  SET BSDXY=BSDXRET_$C(31) QUIT
+           . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
+           . Q:'$D(^DPT(BSDXIEN,0))
+           . S BSDXDPT=$G(^DPT(BSDXIEN,0))
+           . S BSDXZ=$P(BSDXDPT,U) ;NAME
+           . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
+           . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
+           . ; Inactivated Chart get an *
+           . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
+           . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
+           . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
+           . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
+           . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
+           . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
+           . S BSDXRET=BSDXRET_BSDXZ_$C(30)
         ;
 DOB     ;DOB Lookup
@@ -76 +76 @@
         . Q
         ;
-CHART   ;Chart# Lookup
+CHART   
+           ;Chart# Lookup
         I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
         . S BSDXIEN=0 F  S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN  I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D  Q

Scheduling/trunk/m/BSDX29.m

@@ -1 @@
-BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; 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
         ;
@@ -24 +22 @@
            ;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=$$FMADD^XLFDT(BSDXBEG,-1)
-        S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1)
-        ;
-        ; Taskman variables
-        N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO
+           ; Make dates inclusive; add 1 to FM dates
+           S BSDXBEG=BSDXBEG-1
+        S BSDXEND=BSDXEND+1
+        ;
+           ; Taskman variables
+           N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE 
         ; Task Load
-        S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO=""
+        S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
         S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
         D ^%ZTLOAD
@@ -64 +62 @@
         ;
 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"
-        ;
+           ; $ET
+           N $ET S $ET="G ZTMERR^BSDX29"
+        ; Txn
+           TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^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 -- 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
+        . . 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
         . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
         . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
@@ -93 +91 @@
         . . 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)
-        ;
-        ;
+        . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag
+        . . Q
+        . Q
+        I 'BSDXQUIT TCOMMIT
+        E  TROLLBACK
         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
         QUIT
         ;
@@ -109 +112 @@
         ;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
+        N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2
         S BSDXIEN=0,BSDXFND=0
         F  S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN  D  Q:BSDXFND
@@ -123 +122 @@
         . I BSDXPAT2=BSDXPAT S BSDXFND=1
         . Q
-        I BSDXFND L -@REF Q 0
+        Q:BSDXFND 0
         ;
         ;Add to BSDX APPOINTMENT
@@ -129 +128 @@
         ;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
@@ -139 +137 @@
         ;
         K BSDXIEN
-        ;
         D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
         S BSDXIEN=+$G(BSDXIEN(1))
-        I '+BSDXIEN L -@REF Q 0
+        I '+BSDXIEN 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 BSDXI=BSDXI+1
+           S BSDXERR=$TR(BSDXERR,"^","~")
         S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
         S BSDXI=BSDXI+1
@@ -163 +157 @@
 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))

Scheduling/trunk/m/BSDX2E.m

@@ -1 @@
-BSDX2E  ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/11/12 9:37am]
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX2E  ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [4/28/11 10:28am]
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;
@@ -24 +24 @@
         Q:'$$VERCHK("SD",5.3)
         ; Q:'$$PATCHCK("PIMS*5.3*1003") D
-        Q:'$$VERCHK("BMX",4)
+        Q:'$$VERCHK("BMX",2)
         ;
 OTHER   ;
@@ -91 +91 @@
         . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
         . ; Error message
-        . I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
+        . I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
         ;
         ; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
@@ -106 +106 @@
         D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
         ; If error
-        I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
+        I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
         ;
         ;
@@ -117 +117 @@
         I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
         D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR)
-        I $G(BSDXERR) D MES^XPDUTL("Error: ",BSDXERR)
+        I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
         QUIT
         ;

Scheduling/trunk/m/BSDX30.m

@@ -1 @@
-BSDX30  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [7/6/12 11:03am]
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX30  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [4/28/11 10:28am]
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;
@@ -7 +7 @@
         ;Entry point for debugging
         ;
-        ; D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
+        D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
         Q
         ;
@@ -49 +49 @@
 EHRPTD(BSDXY,BSDXWID,BSDXDFN)   ;
         ;
-        ; D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
+        D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
         Q
         ;
@@ -70 +70 @@
         ;
 PEVENT(BSDXWID,DFN)     ;EP - Raise patient selection event to EHR
-        ; VEN/SMH v1.7 3120706 - Not used in VISTA.
-        ; No way right now to synchronize with CPRS.
-        ; Code commented out for now.
         ;
         ;Change patient context to patient DFN
@@ -81 +78 @@
         ;all EHR client sessions belonging to user DUZ.
         ;
-        ;Q:'$G(DUZ)
+        Q:'$G(DUZ)
         ;N X
         ;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T
         ;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T
-        ;N UID,BRET
-        ;S BRET=0,UID=0
-        ;F  S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID  D
-        ;. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
-        ;. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
-        ;. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
-        ;Q
+        N UID,BRET
+        S BRET=0,UID=0
+        F  S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID  D
+        . Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
+        . I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+        . D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
+        Q

Scheduling/trunk/m/BSDX31.m

@@ -1 @@
-BSDX31   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:39am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
-        ; Licensed under LGPL
-        ; Change Log:
-        ; v1.42 3101023 WV/SMH - Change transaction to restartable. 
-        ; v1.42 3101206 UJO/SMH - Extensive refactoring
-        ; v1.7  3120626 VEN/SMH - Removed transactions; extensive refactoring
-        ;                       - Moved APTNS (whatever it was) to BSDXAPI1 
-        ;                         as $$NOSHOW
-        ;                       - Made BSDXNOS extrinsic.
-        ;                       - Moved Unit Tests to BSDXUT1
-        ;                       - BSDXNOS deletes no-show rather than file 0 for
-        ;                         undoing a no show
-        ; 
-        ; Error Reference:
-        ; -1: zero or null Appt ID
-        ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
-        ; -3: No-show flag is invalid
-        ; -4: Filing of No-show in ^BSDXAPPT failed
-        ; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
-        ; -6: Invalid Resource ID
-        ; -7: Lock not acquired on ^BSDXAPPT(BSDXAPTID)
-        ; -100: M Error
-        ;
-        ;
+BSDX31   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am
+           ;;1.6;BSDX;;Aug 31, 2011;Build 25
+           ; Licensed under LGPL
+           ; Change Log:
+           ; v1.42 Oct 23 2010 WV/SMH
+           ; - Change transaction to restartable. Thanks to Zach Gonzalez
+           ; --> and Rick Marshall for their help.
+           ; v1.42 Dec 6 2010: Extensive refactoring
+           ; 
+           ; Error Reference:
+           ; -1: zero or null Appt ID
+           ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
+           ; -3: No-show flag is invalid
+           ; -4: Filing of No-show in ^BSDXAPPT failed
+           ; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
+           ; -100: M Error
+           ;
+           ;
 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
-        ;Entry point for debugging
-        ;
-        ; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
-        Q
-        ;
+           ;Entry point for debugging
+           ;
+           D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
+           Q
+           ;
+UT      ; Unit Tests
+           ; Test 1: Sanity Check
+           N ZZZ ; Garbage return variable
+           N DATE S DATE=$$NOW^XLFDT()
+           S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
+           D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1)
+           N APPID S APPID=+$P(^BSDXTMP($J,1),U)
+           D NOSHOW(.ZZZ,APPID,1)
+           I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B
+           I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B
+           ; Test 2: Undo noshow
+           D NOSHOW(.ZZZ,APPID,0)
+           I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B
+           I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B
+           ; Test 3: -1
+           D NOSHOW(.ZZZ,"",0)
+           I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B
+           ; Test 4: -2
+           D NOSHOW(.ZZZ,2938748233,0)
+           I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B
+           ; Test 5: -3
+           D NOSHOW(.ZZZ,APPID,3)
+           I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",! B
+           ; Test 6: Mumps error (-100)
+           s bsdxdie=1
+           D NOSHOW(.ZZZ,APPID,1)
+           I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",! B
+           k bsdxdie
+           ; Test 7: Restartable transaction
+           s bsdxrestart=1
+           D NOSHOW(.ZZZ,APPID,1)
+           I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",! B
+           QUIT
 NOSHOW(BSDXY,BSDXAPTID,BSDXNS)          ;EP - No show a patient
-        ; Called by RPC: BSDX NOSHOW
-        ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
-        ;
-        ; Parameters:
-        ; BSDXY: Global Return
-        ; BSDXAPTID is entry number in BSDX APPOINTMENT file
-        ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
-        ; 
-        ; Returns ADO.net record set with fields
-        ; - ERRORID; ERRORTEXT
-        ; ERRORID of 1 is okay
-        ; Anything else is an error.
-        ;
-        ; Return Array; set and clear
-        S BSDXY=$NA(^BSDXTMP($J))
-        K ^BSDXTMP($J)
-        ;
-        ; $ET
-        N $ET S $ET="G ETRAP^BSDX31"
-        ;
-        ; Basline vars
-        D ^XBKVAR  ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
-        ;
-        ; Counter
-        N BSDXI S BSDXI=0
-        ;
-        ; Header Node
-        S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
-        ;
-        ;;;test for error. See if %ZTER works
-        I $G(BSDXDIE) N X S X=1/0
-        ;;;TEST
-        ;
-        ; Turn off SDAM APPT PROTOCOL BSDX Entries
-        N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
-        ;
-        ; Appointment ID check
-        I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
-        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
-        ;
-        ; Lock BSDX node, only to synchronize access to the globals.
-        ; It's not expected that the error will ever happen as no filing
-        ; is supposed to take 5 seconds.
-        L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(-7,"BSDX31: Appt record is locked. Please contact technical support.") Q
-        ;
-        ; Noshow value check - Must be 1 or 0
-        S BSDXNS=+BSDXNS
-        I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
-        ;
-        ; Get Some data
-        N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
-        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
-        N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)  ; Start Date/Time
-        N BSDXRES S BSDXRES=$P(BSDXNOD,U,7) ; Resource ID
-        ;
-        ; Check if Resource ID is missing or invalid
-        I BSDXRES="" D ERR(-6,"BSDX31: Invalid Resource") QUIT
-        I '$D(^BSDXRES(BSDXRES,0)) D ERR(-6,"BSDX31: Invalid Resource") QUIT
-        ;
-        ; Get the Hospital Location
-        N BSDXRESNOD S BSDXRESNOD=^BSDXRES(BSDXRES,0)
-        N BSDXLOC S BSDXLOC=$P(BSDXRESNOD,U,4) ;HOSPITAL LOCATION
-        I BSDXLOC,'$D(^SC(BSDXLOC,0)) S BSDXLOC="" ; Unlink it if it doesn't exist
-        ; I can go and then delete it from ^BSDXRES like Mailman code which tries
-        ; to be too helpful... but I will postpone that until this is a need.
-        ;
-        ; Check if it's okay to no-show patient.
-        N BSDXERR S BSDXERR=0 ; Error variable
-        I BSDXLOC S BSDXERR=$$NOSHOWCK^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS)
-        I BSDXERR D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT
-        ;
-        ; Simulated Error
-        I $G(BSDXSIMERR1) D ERR(-4,"BSDX31: Simulated Error") QUIT
-        ; Edit BSDX APPOINTMENT entry No-show field
-        ; Failure Analysis: If we fail here, no rollback needed, as this is the 1st
-        ; call
-        N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS)
-        I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT
-        ;
-        ; Edit File 2 "S" node entry
-        ; Failure Analysis: If we fail here, we need to rollback the BSDX
-        ; Apptointment Entry
-        N BSDXERR S BSDXERR=0 ; Error variable
-        ; If HL exist, (resource is linked to PIMS), file no show in File 2
-        I BSDXLOC S BSDXERR=$$NOSHOW^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS)
-        I BSDXERR D  QUIT
-        . D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2))
-        . N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; no error checking for filer
-        ;
-        ; Unlock
-        L -^BSDXAPPT(BSDXAPTID)
-        ;
-        ; Return data in ADO.net table
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)=$C(31)
-        QUIT
-        ;
-BSDXNOS(BSDXAPTID,BSDXNS)       ; $$ Private; File/unfile noshow in ^BSDXAPPT
-        ; in v1.7 I delete the no-show value rather than file zero
-        N BSDXFDA,BSDXIENS,BSDXMSG
-        N BSDXVALUE ; What to file: 1 or delete it.
-        I BSDXNS S BSDXVALUE=1
-        E  S BSDXVALUE="@"
-        S BSDXIENS=BSDXAPTID_","
-        S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXVALUE ;NOSHOW 1 or 0
-        D FILE^DIE("","BSDXFDA","BSDXMSG")
-        QUIT:$D(BSDXMSG) -1_U_BSDXMSG("DIERR",1,"TEXT",1)
-        QUIT 0
-        ;
+           ; Called by RPC: BSDX NOSHOW
+           ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
+           ;
+           ; Parameters:
+           ; BSDXY: Global Return
+           ; BSDXAPTID is entry number in BSDX APPOINTMENT file
+           ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
+           ; 
+           ; Returns ADO.net record set with fields
+           ; - ERRORID; ERRORTEXT
+           ; ERRORID of 1 is okay
+           ; Anything else is an error.
+           ;
+           ; Return Array; set and clear
+           S BSDXY=$NA(^BSDXTMP($J))
+           K ^BSDXTMP($J)
+           ; $ET
+           N $ET S $ET="G ETRAP^BSDX31"
+           ; Basline vars
+           D ^XBKVAR  ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
+           ; Counter
+           N BSDXI S BSDXI=0
+           ; Header Node
+           S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
+           ; Begin transaction
+           TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29"
+           ;;;test for error inside transaction. See if %ZTER works
+           I $G(bsdxdie) S X=1/0
+           ;;;TEST
+           ;;;test for TRESTART
+           I $G(bsdxrestart) K bsdxrestart TRESTART
+           ;;;test
+           ; Turn off SDAM APPT PROTOCOL BSDX Entries
+           N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
+           ; Appointment ID check
+           I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
+           I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
+           ; Noshow value check - Must be 1 or 0
+           S BSDXNS=+BSDXNS
+           I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
+           ; Get Some data
+           N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
+           N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
+           N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)  ; Start Date/Time
+           ; Edit BSDX APPOINTMENT entry
+           N BSDXMSG  ; 
+           D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG)  ;Edit BSDX APPOINTMENT entry NOSHOW field 
+           I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q
+           ; Edit File 2 "S" node entry
+           N BSDXZ,BSDXERR ; Error variables to control looping
+           S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
+           ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2
+           I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D  I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q
+           . S BSDXNOD=^BSDXRES(BSDXSC1,0)
+           . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
+           . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
+           ;
+           TCOMMIT
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)=$C(31)
+           QUIT
+           ;
+APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS)               ;
+           ; update file 2 info
+           ;Set noshow for patient BSDXDFN in clinic BSDXSC1
+           ;at time BSDXSD
+           N BSDXC,%H,BSDXCDT,BSDXIEN
+           N BSDXIENS,BSDXFDA,BSDXMSG
+           S %H=$H D YMD^%DTC
+           S BSDXCDT=X+%
+           ;
+           S BSDXIENS=BSDXSD_","_BSDXDFN_","
+           I +BSDXNS D
+           . S BSDXFDA(2.98,BSDXIENS,3)="N"
+           . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
+           . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
+           E  D
+           . S BSDXFDA(2.98,BSDXIENS,3)=""
+           . S BSDXFDA(2.98,BSDXIENS,14)=""
+           . S BSDXFDA(2.98,BSDXIENS,15)=""
+           K BSDXIEN
+           D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+           S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
+           Q
+           ;
+BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG)         ;
+           ;
+           N BSDXFDA,BSDXIENS
+           S BSDXIENS=BSDXAPTID_","
+           S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
+           D FILE^DIE("","BSDXFDA","BSDXMSG")
+           QUIT
+           ;
 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC)           ;EP Called by BSDX NOSHOW APPOINTMENT event
-        ;when appointments NOSHOW via PIMS interface.
-        ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
-        ;
-        Q:+$G(BSDXNOEV)
-        Q:'+$G(BSDXSC)
-        Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
-        N BSDXSTAT,BSDXFOUND,BSDXRES
-        S BSDXSTAT=1
-        S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
-        S BSDXFOUND=0
-        I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
-        I BSDXFOUND D NOSEVT3(BSDXRES) Q
-        I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
-        I BSDXFOUND D NOSEVT3(BSDXRES)
-        Q
-        ;
+           ;when appointments NOSHOW via PIMS interface.
+           ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
+           ;
+           Q:+$G(BSDXNOEV)
+           Q:'+$G(BSDXSC)
+           Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
+           N BSDXSTAT,BSDXFOUND,BSDXRES
+           S BSDXSTAT=1
+           S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
+           S BSDXFOUND=0
+           I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
+           I BSDXFOUND D NOSEVT3(BSDXRES) Q
+           I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
+           I BSDXFOUND D NOSEVT3(BSDXRES)
+           Q
+           ;
 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)     ;
-        ;Get appointment id in BSDXAPT
-        ;If found, call BSDXNOS(BSDXAPPT) and return 1
-        ;else return 0
-        N BSDXFOUND,BSDXAPPT,BSDXNOD
-        S BSDXFOUND=0
-        Q:'+$G(BSDXRES) BSDXFOUND
-        Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
-        S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
-        . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
-        . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
-        I BSDXFOUND,+$G(BSDXAPPT) N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPPT,BSDXSTAT)
-        I BSDXMSG D ^%ZTER ; Last ditch error handling. This is supposed to be silently called from the protocol file.
-        Q BSDXFOUND
-        ;
+           ;Get appointment id in BSDXAPT
+           ;If found, call BSDXNOS(BSDXAPPT) and return 1
+           ;else return 0
+           N BSDXFOUND,BSDXAPPT
+           S BSDXFOUND=0
+           Q:'+$G(BSDXRES) BSDXFOUND
+           Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
+           S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
+           . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
+           . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
+           I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
+           Q BSDXFOUND
+           ;
 NOSEVT3(BSDXRES)           ;
-        ;Call RaiseEvent to notify GUI clients
-        ;
-        N BSDXRESN
-        S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
-        Q:BSDXRESN=""
-        S BSDXRESN=$P(BSDXRESN,"^")
-        D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
-        Q
-        ;
-        ;
+           ;Call RaiseEvent to notify GUI clients
+           ;
+           N BSDXRESN
+           S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
+           Q:BSDXRESN=""
+           S BSDXRESN=$P(BSDXRESN,"^")
+           D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
+           Q
+           ;
+           ;
 ERR(BSDXERID,ERRTXT)       ;Error processing
-        ; Unlock first
-        L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
-        ; 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 ERRTXT=$TR(ERRTXT,"^","~")
-        S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
-        S BSDXI=BSDXI+1
-        S ^BSDXTMP($J,BSDXI)=$C(31)
-        QUIT
-        ;
+           S BSDXI=BSDXI+1
+           S ERRTXT=$TR(ERRTXT,"^","~")
+           I $TL>0 TROLLBACK
+           S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
+           S BSDXI=BSDXI+1
+           S ^BSDXTMP($J,BSDXI)=$C(31)
+           QUIT
+           ;
 ETRAP     ;EP Error trap entry
-        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
-        D ^%ZTER
-        ;
-        ; Send to client
-        I '$D(BSDXI) N BSDXI S BSDXI=0
-        D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
-        Q:$Q 100_U_"Mumps Error" Q
-        ;
+           N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
+           ; Rollback, otherwise ^XTER will be empty from future rollback
+           I $TL>0 TROLLBACK
+           D ^%ZTER
+           S $EC="" ; Clear Error
+           ; Send to client
+           I '$D(BSDXI) N BSDXI S BSDXI=0
+           D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
+           QUIT
+           ;
 IMHERE(BSDXRES) ;EP
-        ;Entry point for BSDX IM HERE remote procedure
-        S BSDXRES=1
-        Q
-        ;
+           ;Entry point for BSDX IM HERE remote procedure
+           S BSDXRES=1
+           Q
+           ;

Scheduling/trunk/m/BSDX32.m

@@ -1 +1 @@
 BSDX32  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDX33.m

@@ -1 +1 @@
 BSDX33  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL
         ; Mods by WV/STAR

Scheduling/trunk/m/BSDX34.m

@@ -1 +1 @@
 BSDX34  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL  
         ;

Scheduling/trunk/m/BSDX35.m

@@ -1 @@
-BSDX35  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/21/12 3:57pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDX35  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL  
         ;

Scheduling/trunk/m/BSDXAPI.m

@@ -1 @@
-BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/10/12 5:58pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL  
         ;
-        ; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
-        ; mods (many) by WV/SMH
-        ; Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
-        ; Change history is located in BSDXAPI1 (to save space).
+        ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
+        ;local mods (many) by WV/SMH
+        ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
+        ; Change History:
+        ; 2010-11-5: (1.42)
+        ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
+        ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
+        ; 2010-11-12: (1.42)
+        ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well. 
+        ; 2010-12-5 (1.42)
+        ; Added an entry point to update the patient note in file 44.
+        ; 2010-12-6 (1.42)
+        ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
+        ; 2010-12-8 (1.42)
+        ; Removed restriction on max appt length. Even though this restriction
+        ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I 
+        ; will ignore it here too.
+        ; 2011-01-25 (v.1.5)
+        ; Added entry point $$RMCI to remove checked in appointments.
+        ; In $$CANCEL, if the appointment is checked in, delete check-in rather than
+        ;  spitting an error message to the user saying 'Delete the check-in'
+        ; Changed all lines that look like this:
+        ;  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
+        ; to:
+        ;  I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
+        ; to allow for date at midnight which does not have a dot at the end.
+        ; 2011-01-26 (v.1.5)
+        ; More user friendly message if patient already has appointment in $$MAKE:
+        ;  Spits out pt name and user friendly date.
+        ;  
         ;
 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO)       ; Simplified PEP w/ parameters for $$MAKE - making appointment
@@ -13 +39 @@
         ; for Baby foxes hallucinations.
         ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
-        N BSDR
         S BSDR("PAT")=DFN       ;DFN
         S BSDR("CLN")=CLIN      ;Hosp Loc IEN
@@ -40 +65 @@
         ;   = 1^message:  error and reason
         ;
-        N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment
-        I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why.
-        ;
-        ;Otherwise, we continue
-        ;
-        N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables
-        ;
-        I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
-        . ; "un-cancel" existing appt in file 2
-        . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
-        . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
-        . S BSDXFDA(2.98,BSDXIENS,"3")=""
-        . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
-        . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
-        . S BSDXFDA(2.98,BSDXIENS,"14")=""
-        . S BSDXFDA(2.98,BSDXIENS,"15")=""
-        . S BSDXFDA(2.98,BSDXIENS,"16")=""
-        . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over
-        . S BSDXFDA(2.98,BSDXIENS,"19")=""
-        . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
-        . D FILE^DIE("","BSDXFDA","BSDXMSG")
-        Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
-        ;
-        Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line
-        ;
-        E  D  ; File new appointment/edit existing appointment in file 2
-        . S BSDXIENS="?+2,"_BSDR("PAT")_","
-        . S BSDXIENS(2)=BSDR("ADT")
-        . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
-        . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
-        . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
-        . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
-        . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG")
-        Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
-        ;
-        Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line
-        ;
-        ; add appt to file 44. This adds it to the FIRST subfile (Appointment)
-        N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM
-        I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
-        I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
-        . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
-        . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
-        . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
-        ;
-        Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line
-        ;
-        ; add appt for file 44, second subfile (Appointment/Patient)
-        ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
-        ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
-        ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
-        ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
-        ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
-        ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
-        ;D FILE^DICN
-        ;
-        N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
-        N BSDXFDA
-        S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
-        S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
-        S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
-        S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
-        S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
-        N BSDXERR
-        D UPDATE^DIE("","BSDXFDA","","BSDXERR")
-        ;
-        I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
-        ;
-        ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line
-        S:$G(BSDXSIMERR5) X=1/0
-        ;
-        ; Update the Availablilities ; Doesn't fail. Global reads and sets.
-        D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN"),BSDR("PAT"))
-        ;
-        ; call event driver
-        NEW DFN,SDT,SDCL,SDDA,SDMODE
-        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
-        S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
-        D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
-        Q 0
-        ;
-MAKECK(BSDR)    ; $$ - Is it okay to make an appointment? ; PEP
-        ; Input: Same as $$MAKE
-        ; Output: 1^error or 0 for success
-        ; NB: This subroutine saves no data. Only checks whether it's okay.
-        ;
         I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
         I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
@@ -132 +71 @@
         I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
         ;
-        ; Appt Length check removed in v 1.5
-        ;
+        ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
         I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
-        ; More verbose error message in v1.5
+        ;I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") ; v.1.5 more user friendly err msg
+        ;
         ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
         N BSDXERR ; place to store error message
@@ -149 +88 @@
         . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
         . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
+        ;
+        NEW DIC,DA,Y,X,DD,DO,DLAYGO
+        ;
+        I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
+        . ; "un-cancel" existing appt in file 2
+        . N BSDXFDA,BSDXIENS,BSDXMSG
+        . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
+        . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
+        . S BSDXFDA(2.98,BSDXIENS,"3")=""
+        . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
+        . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
+        . S BSDXFDA(2.98,BSDXIENS,"14")=""
+        . S BSDXFDA(2.98,BSDXIENS,"15")=""
+        . S BSDXFDA(2.98,BSDXIENS,"16")=""
+        . S BSDXFDA(2.98,BSDXIENS,"19")=""
+        . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
+        . D FILE^DIE("","BSDXFDA","BSDXMSG")
+        . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
+        E  D  I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")  
+        . N BSDXFDA,BSDXIENS,BSDXMSG
+        . S BSDXIENS="?+2,"_BSDR("PAT")_","
+        . S BSDXIENS(2)=BSDR("ADT")
+        . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
+        . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
+        . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
+        . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
+        . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
+        ; add appt to file 44
+        K DIC,DA,X,Y,DLAYGO,DD,DO
+        I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
+        I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
+        . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
+        . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
+        . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
+        ;
+        ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
+        ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
+        ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+        ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
+        ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
+        ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
+        ;D FILE^DICN
+        ;
+        N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
+        N BSDXFDA
+        S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
+        S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
+        S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
+        S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
+        S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
+        N BSDXERR
+        D UPDATE^DIE("","BSDXFDA","","BSDXERR")
+        ;
+        I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
+        ;
+        ; call event driver
+        NEW DFN,SDT,SDCL,SDDA,SDMODE
+        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
+        S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+        D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
         Q 0
-        ;
-UNMAKE(BSDR)    ; Reverse Make - Private $$
-        ; Only used in Emergiencies where Fileman data filing fails.
-        ; If previous data exists, which caused an error, it's destroyed.
-        ; NB: ^DIK stops for nobody
-        ; NB: If Patient Appointment previously existed as cancelled, it's removed.
-        ; How can I tell if one previously existed when data is in an intermediate
-        ; State? Can I restore it if the other file failed? Restoration can cause
-        ; another error. If I restore the global, there will be cross-references
-        ; missing (ASDCN specifically).
-        ;
-        ; Input: Same array as $$MAKE
-        ; Output: Always 0
-        NEW DIK,DA
-        S DIK="^DPT("_BSDR("PAT")_",""S"","
-        S DA(1)=BSDR("PAT"),DA=BSDR("ADT")
-        D ^DIK
-        ;
-        N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
-        I 'IEN QUIT 0
-        ;
-        NEW DIK,DA
-        S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
-        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
-        D ^DIK
-        QUIT 0
         ;
 CHECKIN1(DFN,CLIN,APDATE)       ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
@@ -181 +154 @@
         ; for appt at Dec 20, 2009 @ 10:11:59 
         ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
-        N BSDR
         S BSDR("PAT")=DFN          ;DFN
         S BSDR("CLN")=CLIN         ;Hosp Loc IEN
@@ -203 +175 @@
         ;              = 0 means everything worked
         ;              = 1^message means error with reason message
-        ;
-        I $G(BSDXDIE2) N X S X=1/0
-        ;
-        N BSDXERR S BSDXERR=$$CHECKICK(.BSDR)
-        I BSDXERR Q BSDXERR
-        ;
-        ; find ien for appt in file 44
-        NEW IEN,DIE,DA,DR
-        S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
-        ;
-        ; remember before status
-        ; Failure analysis: Only ^TMP global is set here.
-        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
-        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
-        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
-        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
-        ;
-        ; set checkin; Old Code -- keep for ref VEN/SMH 3 Jul 2012
-        ; S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
-        ; S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
-        ; S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
-        ; D ^DIE
-        ;
-        I $D(BSDXSIMERR3) Q 1_U_"Simulated Error"
-        ;
-        ; Failure analysis: If this fails, no other changes were made in this routine
-        N BSDXIENS S BSDXIENS=IEN_","_BSDR("ADT")_","_BSDR("CLN")_","
-        N BSDXFDA
-        S BSDXFDA(44.003,BSDXIENS,309)=BSDR("CDT")
-        S BSDXFDA(44.003,BSDXIENS,302)=BSDR("USR")
-        S BSDXFDA(44.003,BSDXIENS,305)=$$NOW^XLFDT()
-        N BSDXERR
-        D UPDATE^DIE("","BSDXFDA","BSDXERR")
-        ;
-        I $D(BSDXERR) Q 1_U_"Error checking in appointment to file 44. Error: "_BSDXERR("DIERR",1,"TEXT",1)
-        ;
-        ; set after status
-        S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
-        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
-        D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
-        ;
-        ; Point of no Return
-        ; call event driver
-        D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
-        Q 0
-        ;
-CHECKIC1(DFN,CLIN,APDATE)       ; Simplified PEP w/ parameters for $$CHECKICK -
-        ; Check-in Check
-        ; Call like this for DFN 23435 checking in now at Hospital Location 33
-        ; for appt at Dec 20, 2009 @ 10:11:59 
-        ; S RESULT=$$CHECKIC1^BSDXAPI(23435,33,3091220.221159)
-        N BSDR
-        S BSDR("PAT")=DFN          ;DFN
-        S BSDR("CLN")=CLIN         ;Hosp Loc IEN
-        S BSDR("ADT")=APDATE       ;Appt Date
-        S BSDR("CDT")=$$NOW^XLFDT  ;Check-in date defaults to now
-        S BSDR("USR")=DUZ          ;Check-in user defaults to current
-        Q $$CHECKICK(.BSDR)
-        ;
-CHECKICK(BSDR)  ; $$ PEP; - Is it okay to check-in patient?
-        ; Input: Same as $$CHECKIN
-        ; Output: 0 if okay or 1^message if error
-        ;
-        I $G(BSDXSIMERR2) Q 1_U_"Simulated Error"
         ;
         I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
@@ -277 +185 @@
         ;
         ; find ien for appt in file 44
-        N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+        NEW IEN,DIE,DA,DR
+        S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
         I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+        ;
+        ; remember before status
+        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
+        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
+        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+        ;
+        ; set checkin
+        S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
+        S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
+        D ^DIE
+        ;
+        ; set after status
+        S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+        D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+        ;
+        ; call event driver
+        D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
         Q 0
         ;
@@ -287 +216 @@
         ; because foxes come out during bad weather.
         ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
-        N BSDR
         S BSDR("PAT")=DFN
         S BSDR("CLN")=CLIN
@@ -316 +244 @@
         ;   = 1^message:  error and reason
         ;
-        ; Okay to Cancel? Call Cancel Check.
-        N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR)
-        I BSDXCANCK Q BSDXCANCK
-        ;
-        ; BSDX 1.5 3110125
-        ; UJO/SMH - Add ability to remove check-in if the patient is checked in
-        ; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in
-        ; Lets you remove appointment anyways! Not like RPMS.
-        ; Plus... deleting checkin affects S node on 44, which is DELETED anyways!
-        ;
-        ; remember before status
-        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE
-        NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
-        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
-        S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
-        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
-        ; NB: Here only ^TMP globals are set with before values.
-        ;
-        ; get user who made appt and date appt made from ^SC
-        ;    because data in ^SC will be deleted
-        ; Appointment Length: ditto
-        NEW USER,DATE
-        S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
-        S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
-        N BSDXLEN S BSDXLEN=$$APPLEN(DFN,SDCL,SDT) ; appt length
-        ;
-        ; update file 2 info --old code; keep for reference
-        ;NEW DIE,DA,DR
-        ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
-        ;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
-        ;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
-        ;D ^DIE
-        N BSDXIENS S BSDXIENS=SDT_","_DFN_","
-        N BSDXFDA
-        S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP")
-        S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR")
-        S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT")
-        S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR")
-        S BSDXFDA(2.98,BSDXIENS,19)=USER
-        S BSDXFDA(2.98,BSDXIENS,20)=DATE
-        S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160)
-        N BSDXERR
-        D FILE^DIE("","BSDXFDA","BSDXERR")
-        I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2"
-        ; Failure point 1: If we fail here, nothing has happened yet.
-        ;
-        ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop
-        NEW DIK,DA
-        S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
-        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
-        D ^DIK
-        ; Failure point 2: not expected to happen here
-        ;
-        ; Update PIMS availability -- this doesn't fail. Global gets/sets only.
-        D AVUPDTCN^BSDXAPI1(SDCL,SDT,BSDXLEN)
-        ;
-        ; call event driver -- point of no return
-        D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
-        ;
-        Q 0
-        ;
-CANCELCK(BSDR)  ; $$ PEP; Okay to Cancel Appointment?
-        ; Input: .BSDR array as documented in $$CANCEL
-        ; Output: 0 or 1^Error message
         I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
         I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
@@ -390 +254 @@
         I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
         ;
-        NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+        NEW IEN,DIE,DA,DR
+        S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
         I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
         ;
-        ; Check-out check. New in v1.7
-        I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!"
+        ; BSDX 1.5 3110125
+        ; UJO/SMH - Add ability to remove check-in if the patient is checked in
+        ; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+        ; Remove check-in if the patient is checked in.
+        N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure
+        I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+        I BSDXRESULT Q BSDXRESULT
+        ;
+        ; remember before status
+        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
+        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
+        S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
+        ;
+        ; get user who made appt and date appt made from ^SC
+        ;    because data in ^SC will be deleted
+        NEW USER,DATE
+        S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
+        S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
+        ;
+        ; update file 2 info
+        NEW DIE,DA,DR
+        S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
+        S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
+        S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
+        D ^DIE
+        ;
+        ; delete data in ^SC
+        NEW DIK,DA
+        S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
+        D ^DIK
+        ;
+        ; call event driver
+        D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
         Q 0
         ;
@@ -404 +302 @@
         Q $S(X:1,1:0)
         ;
+RMCI(PAT,CLINIC,DATE)    ;PEP; -- Remove Check-in; $$
+        ; PAT = DFN
+        ; CLINIC = SC IEN
+        ; DATE = FM Date/Time of Appointment
+        ;
+        ; Returns:
+        ; 0 if okay
+        ; -1 if failure
+        ;
+        ; Call like this: $$RMCI(233,33,3110102.1130)
+        ;
+        ; Move my variables into the ones used by SDAPIs (just a convenience)
+        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
+        S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT)
+        ;
+        I SDDA<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
+        ;
+        ; remember before status
+        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+        ;
+        ; remove check-in using filer.
+        N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
+        S BSDXFDA(44.003,BSDXIENS,309)="@"      ; CHECKED-IN
+        S BSDXFDA(44.003,BSDXIENS,302)="@"      ; CHECK IN USER
+        S BSDXFDA(44.003,BSDXIENS,305)="@"      ; CHECK IN ENTERED
+        N BSDXERR
+        D FILE^DIE("","BSDXFDA","BSDXERR")
+        I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
+        ;
+        ; set after status
+        S SDDA=$$SCIEN(DFN,SDCL,SDT)
+        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+        D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+        ;
+        ; call event driver
+        D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
+        QUIT 0
+        ;
+SCIEN(PAT,CLINIC,DATE)  ;PEP; returns ien for appt in ^SC
+        NEW X,IEN
+        S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  Q:$G(IEN)  D
+        . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C"  ;cancelled
+         . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
+        Q $G(IEN)
+        ;
+APPTYP(PAT,DATE)        ;PEP; -- returns type of appt (scheduled or walk-in)
+        NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
+        Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
+        ;
 CO(PAT,CLINIC,DATE,SDIEN)       ;PEP; -- returns 1 if appt already checked-out
         NEW X
@@ -411 +359 @@
         Q $S(X:1,1:0)
         ;
-SCIEN(PAT,CLINIC,DATE)  ;PEP; returns ien for appt in ^SC
-        NEW X,IEN
-        S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  Q:$G(IEN)  D
-        . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C"  ;cancelled
-         . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
-        Q $G(IEN)
-        ;
-APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length
-        ; Get either the appointment length or zero
-        N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE)
-        Q:SCIEN $P(^SC(CLINIC,"S",DATE,1,SCIEN,0),U,2)
-        Q 0
-APPTYP(PAT,DATE)        ;PEP; -- returns type of appt (scheduled or walk-in)
-        NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
-        Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
-        ;
+UPDATENOTE(PAT,CLINIC,DATE,NOTE)        ; PEP; Update Note in ^SC for patient's appointment @ DATE
+        ; PAT = DFN
+        ; CLINIC = SC IEN
+        ; DATE = FM Date/Time of Appointment
+        ;
+        ; Returns:
+        ; 0 if okay
+        ; -1 if failure
+        N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
+        I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
+        N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
+        S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
+        N BSDXERR
+        D FILE^DIE("","BSDXFDA","BSDXERR")
+        I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
+        QUIT 0

Scheduling/trunk/m/BSDXAPI1.m

@@ -1 +1 @@
 BSDXAPI1        ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.7;BSDX;;Oct 04, 2012;Build 25
         ; Licensed under LGPL  
         ;

Scheduling/trunk/m/BSDXGPRV.m

@@ -1 @@
-BSDXGPRV        ; WV/SMH - WINDOWS SCHEDULING RPCS ; 7/6/12 11:07am
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+BSDXGPRV        ; WV/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:31am
+        ;;1.6;BSDX;;Aug 31, 2011;Build 25
         ; Licensed under LGPL  
         ;
@@ -18 +18 @@
 PD(BSDXY,HLIEN) ;EP Debugging entry point
         ;
-        ;D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
+        D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
         ;
         Q
@@ -33 +33 @@
         S BSDXI=0
         I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
-        D ^XBKVAR
+        D ^XBKVAR 
         N $ET S $ET="G ERROR^BSDXGPRV"
         K ^BSDXTMP($J)

Scheduling/trunk/m/BSDXUT.m

@@ -1 +1 @@
 BSDXUT  ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.7;BSDX;;Oct 04, 2012;Build 25
         ; Licensed under LGPL
         ;

Scheduling/trunk/m/BSDXUT1.m

@@ -1 +1 @@
 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.7;BSDX;;Oct 04, 2012;Build 25
         ;
         ;

Scheduling/trunk/m/BSDXUT2.m

@@ -1 +1 @@
 BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 3:18pm
-        ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
+        ;;1.7;BSDX;;Oct 04, 2012;Build 25
         ;
 EN      ; Run all unit tests in this routine