Index: Scheduling/trunk/m/BSDX08.m
===================================================================
--- Scheduling/trunk/m/BSDX08.m	(revision 1563)
+++ Scheduling/trunk/m/BSDX08.m	(revision 1625)
@@ -1,4 +1,4 @@
-BSDX08	; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
-	;;1.6;BSDX;;Aug 31, 2011;Build 25
+BSDX08	; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
+	;;1.7;BSDX;;Jun 01, 2013;Build 24
 	; 
 	; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
@@ -6,12 +6,6 @@
 	; Change History
 	; 3101022 UJO/SMH v1.42
-	;  - 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.
+	;  - Transaction work. As of v 1.7, all work here has been superceded
+	;  - Refactoring of AVUPDT - never tested though.
 	;  - Refactored all of APPDEL.
 	; 
@@ -19,5 +13,9 @@
 	;  - Added ability to remove checked in appointments. Added a couple
 	;    of units tests for that under UT2.
-	;  - Minor reformatting because of how KIDS adds tabs.
+	; 
+	; 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.
 	; 
 	; Error Reference:
@@ -31,74 +29,13 @@
 	;  -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
-	;
-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
+	;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
+	Q
+	;
+APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)	       ; Private EP
 	;Called by RPC: BSDX CANCEL APPOINTMENT
 	;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
@@ -124,68 +61,76 @@
 	; Counter
 	N BSDXI S BSDXI=0
+	;
 	; Header Node
 	S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
 	;
+	; Turn off SDAM APPT PROTOCOL BSDX Entries
+	N BSDXNOEV
+	S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
+	;
+	;;;test for error inside transaction. See if %ZTER works
+	I $G(BSDXDIE1) N X S X=1/0
+	;
+	; 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 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
-	N BSDXNOEV
-	S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
-	;
-	;;;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
-	;
-	; 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
+	L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
 	;
 	; Start Processing:
-	; First, add cancellation date to appt entry in BSDX APPOINTMENT
+	; First, get data
 	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
-	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
+	;
+	; Check the resource ID and whether it exists
 	N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
-	; If the resouce id doesn't exist...
+	; If the resource 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
-	S BSDXNOD=^BSDXRES(BSDXSC1,0)
+	N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0)
 	; Get Hosp location
 	N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
-	; Error indicator for Hosp Location filing for getting out of routine
+	; Error indicator
 	N BSDXERR S BSDXERR=0
-	; 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
+	; 
+	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
+	;
 	L -^BSDXAPPT(BSDXAPTID)
 	S BSDXI=BSDXI+1
@@ -195,78 +140,23 @@
 	Q
 	;
-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
+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()
 	S BSDXIENS=BSDXAPTID_","
 	S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
-	K BSDXMSG
 	D FILE^DIE("","BSDXFDA","BSDXMSG")
-	Q
+	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
 	;
 CANEVT(BSDXPAT,BSDXSTART,BSDXSC)	;EP Called by BSDX CANCEL APPOINTMENT event
@@ -292,7 +182,8 @@
 	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) D BSDXCAN(BSDXAPPT)
+	I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER
 	Q BSDXFOUND
 	;
@@ -309,23 +200,28 @@
 	;
 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
-	S $EC=""  ; Clear Error
+	;
+	; 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)
+	;
 	; Log error message and send to client
 	I '$D(BSDXI) N BSDXI S BSDXI=0
 	D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
-	QUIT
+	Q:$Q 1_U_"-100~Mumps Error" Q
 	;
 	;;;NB: This is code that is unused in both original and port.
