iSharkFly-Open
/
VistA-Scheduling
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added/fixed the following: 

- Unit Tests for running everything through PIMS
- Checks for end of message for error handling ((31))
- All routines previously using transactions use locks now
This commit is contained in:
sam 2012-07-09 23:43:46 +00:00
parent d10f16470e
commit 83543534b0
10 changed files with 190 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
m/BSDX07.m
View File

@ -1,4 +1,4 @@
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:57pm
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:02pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
@ -31,7 +31,7 @@ APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)
; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
Q
;
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP
;
;Called by RPC: BSDX ADD NEW APPOINTMENT
;
@ -57,7 +57,7 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
; ADO.net Recordset having fields:
; AppointmentID and ErrorNumber
;
; NB: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
; to sort out. Needs changes on client.
;
;Test lines:
@ -65,11 +65,11 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
;
; 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"
;
@ -79,7 +79,7 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
; 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
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)
@ -91,8 +91,8 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
; 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 for error. See if %ZTER works
I $G(BSDXDIE) N X S X=1/0
;;;test
;
; -- Start and End Date Processing --
@ -131,10 +131,10 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
;
; 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 ; Variable to hold value of $$MAKE and $$MAKECK
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 I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back
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
@ -146,6 +146,7 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
. 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
@ -159,12 +160,16 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
;
; Only if we have a valid Hosp Loc can we make an appointment in 2/44
; Use BSDXC array from before.
; NB: $$MAKE itself calls $$MAKECK to check again for being okay.
I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
. S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
; 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
L -^BSDXAPPT(BSDXPATID)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
S BSDXI=BSDXI+1
@ -178,7 +183,7 @@ STRIP(BSDXZ) ;Replace control characters with spaces
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
N BSDXAPPTID,BSDXFDA
S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
@ -207,7 +212,7 @@ ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
;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
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))
@ -242,8 +247,7 @@ ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
; Input:
; Appointment ID to remove from ^BSDXAPPT
; BSDXC array (see array format in $$MAKE^BSDXAPI)
; NB: I am not sure whether I want to do $G to protect against undefs?
; I send the variables to this EP from the Symbol Table in ETRAP
N %
D BSDXDEL^BSDX07(BSDXAPPTID)
S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
QUIT
@ -256,19 +260,23 @@ BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
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)
L -^BSDXAPPT(BSDXPATID)
Q
;
ETRAP ;EP Error trap entry
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
D ^%ZTER
S $EC="" ; Clear Error
;
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))

30
m/BSDX08.m
View File

@ -1,4 +1,4 @@
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:39pm
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
@ -36,7 +36,7 @@ APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
Q
;
APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP
;Called by RPC: BSDX CANCEL APPOINTMENT
;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
;Input Parameters:
@ -64,11 +64,6 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
; 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
;
; Turn off SDAM APPT PROTOCOL BSDX Entries
N BSDXNOEV
S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
@ -80,6 +75,11 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
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
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
@ -123,15 +123,14 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
; 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,"$$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT
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 D QUIT:BSDXERR
. 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
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
@ -185,7 +184,7 @@ CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) ;
. 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
;
CANEVT3(BSDXRES) ;
@ -200,6 +199,8 @@ CANEVT3(BSDXRES) ;
Q
;
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
@ -207,16 +208,17 @@ ERR(BSDXI,BSDXERR) ;Error processing
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
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)
;
; Log error message and send to client
I '$D(BSDXI) N BSDXI S BSDXI=0
D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))

20
m/BSDX25.m
View File

@ -1,4 +1,4 @@
BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 11:55am
BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
@ -40,6 +40,7 @@ CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
; -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
;
@ -66,6 +67,11 @@ CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
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
;
; 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
@ -100,6 +106,7 @@ CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
. 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)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)="0"_$C(30)
S BSDXI=BSDXI+1
@ -123,7 +130,7 @@ BSDXCHK(BSDXAPPTID,BSDXCDT) ; $$ Private Entry Point. File or delete check-in to
Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
Q 0
;
RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44
; Called by RPC BSDX REMOVE CHECK-IN
;
; Parameters to pass:
@ -162,6 +169,10 @@ RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
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
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
@ -199,6 +210,9 @@ RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
. 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)
;
; Return ADO recordset
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)="0"_$C(30)
@ -263,6 +277,8 @@ ERROR ;
Q:$Q "-100^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
S BSDXERR=$G(BSDXERR)

39
m/BSDX26.m
View File

@ -1,4 +1,4 @@
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/25/12 4:29pm
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 2:19pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Change History:
@ -7,10 +7,15 @@ BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/25/12 4:29pm
; 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
; 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.
;
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
;Entry point for debugging
@ -47,8 +52,13 @@ EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be
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
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=""
@ -64,7 +74,7 @@ EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be
. 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
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
@ -72,12 +82,13 @@ EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be
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^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
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<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
I BSDXRES<0 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
@ -92,6 +103,10 @@ ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
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)
@ -102,7 +117,7 @@ ERR(BSDXI,BSDXERR) ;Error processing
ETRAP ;EP Error trap entry
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
D ^%ZTER
S $EC=""
;
I '$D(BSDXI) N BSDXI S BSDXI=0
D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
QUIT

5
m/BSDX29.m
View File

@ -1,4 +1,4 @@
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
@ -101,7 +101,6 @@ ZTM ;EP - Taskman entry point
ZTMERR ; For now, error from TM is only in trap; not returned to client.
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
D ^%ZTER
S $EC="" ; Clear Error
QUIT
;
XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
@ -152,6 +151,8 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
Q 1
;
ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
; If last line is $C(31), we are done. No more errors to send to client.
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
S BSDXI=BSDXI+1
S BSDXERR=$TR(BSDXERR,"^","~")
S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)

15
m/BSDX31.m
View File

@ -1,4 +1,4 @@
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/27/12 4:57pm
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 12:57pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Change Log:
@ -19,6 +19,7 @@ BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/27/12 4:57pm
; -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
;
;
@ -69,6 +70,11 @@ NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient
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
@ -113,6 +119,9 @@ NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient
. 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
@ -176,6 +185,8 @@ NOSEVT3(BSDXRES) ;
;
;
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
@ -188,7 +199,7 @@ ERR(BSDXERID,ERRTXT) ;Error processing
ETRAP ;EP Error trap entry
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
D ^%ZTER
S $EC="" ; Clear Error
;
I $G(BSDXAPTID),$D(BSDXNS) N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; Reverse No-Show status (whatever it was)
; Send to client
I '$D(BSDXI) N BSDXI S BSDXI=0

28
m/BSDXAPI.m
View File

@ -1,4 +1,4 @@
BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/6/12 10:24am
BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/9/12 4:00pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
@ -154,6 +154,12 @@ 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
; TODO: 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
@ -421,23 +427,3 @@ 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:"??")
;
UPDATENT(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
;
; ERROR SIMULATION
I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
;
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_","
N BSDXFDA 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

5
m/BSDXAPI1.m
View File

@ -1,4 +1,4 @@
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/6/12 10:23am
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
@ -48,6 +48,9 @@ BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/6/12 10:23am
; Moved Availability update EPs in BSDX07 and BSDX08 b/c they really
; belong to PIMS, not to the Scheduling GUI. $$MAKE and $$CANCEL now
; call the EPs here.
; Cancel and Remove-Check-in now check to see if the patient is checked-out
; If the patient is checked out, then we fail to cancel/no-show.
; UPDATENOTE was renamed to UPDATENT and moved to BSDXAPI1.
;
NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7)
; PAT = DFN

10
m/BSDXUT1.m
View File

@ -1,4 +1,4 @@
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/3/12 12:28pm
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;
;
@ -265,17 +265,17 @@ UT26 ; Unit Tests - BSDX26
N ZZZ
N NOTE S NOTE="Nothing important"
D EDITAPT^BSDX26(.ZZZ,"BLAHBLAH",NOTE)
I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",!
I +^BSDXTMP($J,1)'=1 W "ERROR IN -1",!
;
; Test 3: Test Error -2
; -2 --> ApptID not in ^BSDXAPPT
D EDITAPT^BSDX26(.ZZZ,298734322,NOTE)
I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",!
I +^BSDXTMP($J,1)'=2 W "ERROR IN -2",!
;
; Test 4: M Error
N BSDXDIE S BSDXDIE=1
D EDITAPT^BSDX26(.ZZZ,188,NOTE)
I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",!
I +^BSDXTMP($J,1)'=100 W "ERROR IN -100",!
K BSDXDIE
; Test 5: Trestart -- retired in v1.7
;
@ -333,7 +333,7 @@ UT26 ; Unit Tests - BSDX26
N %H S %H=$H
N NOTE S NOTE="New Note "_%H
D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
I +^BSDXTMP($J,1)'=-4 W "Simulated error not triggered",!
I +^BSDXTMP($J,1)'=4 W "Simulated error not triggered",!
I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE W "ERROR 3",!
I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",!
QUIT

73
m/BSDXUT2.m
View File

@ -1,8 +1,8 @@
BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/5/12 11:39am
BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 3:18pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;
EN ; Run all unit tests in this routine
D UT25
D UT25,PIMS
QUIT
;
UT25 ; Unit Tests for BSDX25
@ -176,17 +176,35 @@ UT25 ; Unit Tests for BSDX25
D RMCI^BSDX25(.ZZZ,APPTID)
IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 7",!
K BSDXDIE
QUIT
;
PIMS ; Tests for running PIMS by itself.
N $ET S $ET="W ""An Error Occured. Breaking."",! BREAK"
N RESNAM S RESNAM="UTCLINIC"
N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
D
. N $ET S $ET="D ^%ZTER B"
. S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
. I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
;
N HLIEN,RESIEN
S HLIEN=$P(HLRESIENS,U)
S RESIEN=$P(HLRESIENS,U,2)
;
;
; Tests for running PIMS by itself.
N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
N DFN S DFN=2
;
; TEST $$MAKE1^BSDXAPI
N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
;TODO: Index doesn't include resource.
N APPTID S APPTID=$O(^(APPTTIME,""))
N RESID S RESID=$O(^(APPTTIME,""))
N APPTID S APPTID=$O(^(RESID,""))
I 'APPTID W "Can't get appointment",!
IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 3",!
;
; TEST CHECKIN1 AND RMCI ^BSDXAPI[1]
N % S %=$$CHECKIN1^BSDXAPI(DFN,HLIEN,APPTTIME) ; Checkin via PIMS
I % W "Error in Checking in via BSDXAPI",!
IF '+$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 10",!
@ -199,4 +217,49 @@ UT25 ; Unit Tests for BSDX25
I % W "Error in Checking in via BSDXAPI",!
IF '+$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 14",!
IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 15",!
;
; TEST CANCEL1^BSDXAPI
N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
N DFN S DFN=2
N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
N RESID S RESID=$O(^(APPTTIME,""))
N APPTID S APPTID=$O(^(RESID,""))
I 'APPTID W "Can't get appointment",!
N % S %=$$CANCEL1^BSDXAPI(DFN,HLIEN,"PC",APPTTIME,1,"Afraid of Baby Foxes")
I % W "Error cancelling via $$CANCEL1^BSDXAPI",!
I ^BSDXAPPT(APPTID,0) ; Change $R
I '$P(^(0),U,12) W "No cancel date found in BSDXAPPT",!
; Make same appointment again!
; NB: Index APAT will have two identical entries, one for the cancelled
; appointment, and one for the new one. I won't check it for that reason.
N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
;
; TEST NOSHOW^BSDXAPI1
N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
N DFN S DFN=3
N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
N RESID S RESID=$O(^(APPTTIME,""))
N APPTID S APPTID=$O(^(RESID,""))
I 'APPTID W "Can't get appointment",!
; No show via PIMS
N % S %=$$NOSHOW^BSDXAPI1(DFN,HLIEN,APPTTIME,1)
I % W "Error no-showing via $$NOSHOW^BSDXAPI1",!
I ^BSDXAPPT(APPTID,0) ; Change $R
I '$P(^(0),U,10) W "No-show not present in ^BSDXAPPT",!
; un-noshow via PIMS
N % S %=$$NOSHOW^BSDXAPI1(DFN,HLIEN,APPTTIME,0)
I % W "Error no-showing via $$NOSHOW^BSDXAPI1",!
I ^BSDXAPPT(APPTID,0) ; Change $R
I $P(^(0),U,10) W "No-show present in ^BSDXAPPT when it shouldn't",!
;
; NB: UPDATENT^BSDXAPI is updates the note. Right now, we don't have any
; way to update the note from BSDXAPI back to ^BSDXAPPT as the protocol
; file is currently not involved. Right now I can't even find the code
; that lets you change an appointment note in PIMS.
;
QUIT