Refactoring cont.

Many changes in BSDX08. Extensive changes in BSDX31. Creation of BSDXAPI1 as continuation of BSDXAPI.
BSDXUT1 now has UTs for BSDX31. Transactions now gone from BSDX08 and BSDX31.
BSDX08 needs more tests at failure points. BSDX31 still needs analysis for transaction failure and
code for rollback points, plus tests for that.
This commit is contained in:
sam 2012-06-27 00:01:30 +00:00
parent 73927b151b
commit 00c73491bd
6 changed files with 347 additions and 261 deletions

View File

@ -1,24 +1,20 @@
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/25/12 6:17pm
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/26/12 10:49am
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
;
; 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.
;
; 3111125 UJO/SMH v1.5
; - 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.
;
; Error Reference:
; -1~BSDX08: Appt record is locked. Please contact technical support.
@ -30,6 +26,7 @@ BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/25/12 6:17pm
; -7~BSDX08: Patient does not have an appointment in PIMS Clinic
; -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
@ -75,7 +72,7 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
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
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
@ -89,25 +86,22 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
;
; 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
;
; BSDXAPPT First; todo: check for error
D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT
;
; Process PIMS issues second:
; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI
; Get zero node of resouce
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
; For BSDXC
N BSDXC
; Only file in 2/44 if there is an associated hospital location
I BSDXLOC D QUIT:BSDXERR
;
N BSDXC ; Array to pass to BSDXAPI
;
I BSDXLOC D
. S BSDXC("PAT")=BSDXPATID
. S BSDXC("CLN")=BSDXLOC
. S BSDXC("TYP")=BSDXTYP
@ -119,14 +113,30 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
. S BSDXC("USR")=DUZ
. ;
. S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message
. I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)) QUIT
; 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,"$$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
. N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) ; appt length
. S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI
. ; Rollback BSDXAPPT if error occurs
. ; TODO: If an M error occurs in BSDXAPI, ETRAP gets called, ^BSDXTMP is
. ; populated, then the output of $$CANCEL is the output of ETRAP.
. ; Then, we see that BSDXERR is true, and we do another write,
. ; which deletes the information we had in ^BSDXTMP. What to do???
. I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID) QUIT
. ;
. N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
. ;
. ; Cancel through BSDXAPI
. S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC)
. I BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
. ; Update Legacy PIMS clinic Availability
. ; Update Legacy PIMS clinic Availability ; no failure expected here.
. D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
;
;
@ -137,7 +147,6 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
ROLLBACK(BSDXAPTID)
AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability
;See SDCNP0
N SD,S ; Start Date
@ -184,16 +193,25 @@ AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability
S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set
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
;when appointments cancelled via PIMS interface.
@ -247,10 +265,13 @@ ETRAP ;EP Error trap entry
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
D ^%ZTER
S $EC="" ; Clear Error
; Roll back BSDXAPPT;
; TODO: What if a Mumps error happens in fileman in BSDXAPI? The Scheduling files can potentially be out of sync
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.
; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple

View File

@ -1,220 +1,180 @@
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am
;;1.6T2;BSDX;;May 16, 2011
; 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
;
;
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/26/12 4:35pm
;;1.7T1;BSDX;;Aug 31, 2011;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
;
; 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
; -100: M Error
;
;
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
;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
;Entry point for debugging
;
; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
Q
;
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)
; 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
;
; 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
;
; 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 '$D(^SC(BSDXLOC,0)) S BSDXLOC="" ; Unlink it if it doesn't exist
; I can go and then delete it from BSDXLOC like Mailman code which tries
; to be too helpful... but I will postpone that until this is need it.
;
; Edit BSDX APPOINTMENT entry
N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS) ;Edit BSDX APPOINTMENT entry NOSHOW field
I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT
;
; Edit File 2 "S" node entry
N BSDXERR ; 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 ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT
;
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
N BSDXFDA,BSDXIENS,BSDXMSG
S BSDXIENS=BSDXAPTID_","
S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
D FILE^DIE("","BSDXFDA","BSDXMSG")
QUIT:$D(BSDXMSG) -1_U_BSDXMSG("DIERR",1,"TEXT",1)
QUIT 0
;
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
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
;
;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
;
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
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
;
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
;
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
; Send to client
I '$D(BSDXI) N BSDXI S BSDXI=0
D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
QUIT
;
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
I $G(BSDXAPTID),$D(BSDXNS) N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; Reverse No-Show status (whatever it was)
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
;

View File

@ -1,4 +1,4 @@
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/25/12 6:13pm
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/26/12 4:55pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
; Licensed under LGPL
;
@ -7,10 +7,13 @@ BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/25/12 6:13pm
;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.
; - 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.
; - 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)
@ -36,7 +39,8 @@ BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/25/12 6:13pm
; out for making an appointment to MAKECK. We call this first to make sure
; that the appointment is okay to make before committing to make it. We
; still have the provision to delete the data though if we fail when we
; actually make the appointment
; actually make the appointment.
; CANCELCK exists for the same purpose.
;
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
; Call like this for DFN 23435 having an appointment at Hospital Location 33
@ -306,6 +310,7 @@ CANCEL(BSDR) ;PEP; called to cancel appt
;
; 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)
@ -317,7 +322,7 @@ CANCEL(BSDR) ;PEP; called to cancel appt
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 --old code
; 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

35
m/BSDXAPI1.m Normal file
View File

@ -0,0 +1,35 @@
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 6/26/12 4:32pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
; Licensed under LGPL
;
NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7)
; PAT = DFN
; CLINIC = SC IEN
; DATE = FM Date/Time of Appointment
; NSFLAG = truthy value to add no-show, or falsy to remove
; -1^error for failure, 0 for success
; Code follows EN1^SDN
N NOSHOWCK S NOSHOWCK=$$NOSHOWCK(PAT,CLINIC,DATE,NSFLAG)
I NOSHOWCK Q NOSHOWCK
;
N SDNSHDL,SDDA S SDNSHDL=$$HANDLE^SDAMEVT(1) S SDDA=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
N SDATA
D BEFORE^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,SDNSHDL)
N BSDXIENS S BSDXIENS=DATE_","_PAT_","
N BSDXFDA
I +NSFLAG D
. S BSDXFDA(2.98,BSDXIENS,3)="N"
. S BSDXFDA(2.98,BSDXIENS,14)=DUZ
. S BSDXFDA(2.98,BSDXIENS,15)=$$NOW^XLFDT()
E D
. S BSDXFDA(2.98,BSDXIENS,3)="@"
. S BSDXFDA(2.98,BSDXIENS,14)="@"
. S BSDXFDA(2.98,BSDXIENS,15)="@"
N BSDXMSG
D FILE^DIE("","BSDXFDA","BSDXMSG")
Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_PAT_" Appt="_DATE_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
D NOSHOW^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,0,SDNSHDL)
Q 0
NOSHOWCK(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Check
; pars are the same as above
QUIT 0

View File

@ -1,4 +1,4 @@
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/22/12 4:27pm
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/26/12 11:06am
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
; Licensed under LGPL
;
@ -275,13 +275,27 @@ UT08 ; Unit Tests for BSDX08; Must have patients 1,2,3,4,5 defined in system
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
;
; Test 3: Check for -100
N BSDXDIE S BSDXDIE=1
N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
N APPTTIME S APPTTIME=$P(TIMES,U)
N ENDTIME S ENDTIME=$P(TIMES,U,2)
D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
S APPID=+$P(^BSDXTMP($J,1),U)
N BSDXDIE1 S BSDXDIE1=1
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
K BSDXDIE
;
K BSDXDIE1
;
; Test 3.5: Check for -100 with an appointment to rollback.
N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
N APPTTIME S APPTTIME=$P(TIMES,U)
N ENDTIME S ENDTIME=$P(TIMES,U,2)
D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
S APPID=+$P(^BSDXTMP($J,1),U)
N BSDXDIE2 S BSDXDIE2=1
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100-1",!
I $P(^BSDXAPPT(APPID,0),U,12)'="" W "Error in -100-2",!
K BSDXDIE2
; Test 4: Restartable transaction -- retired in V 1.7
; Test 5: for invalid Appointment ID (-2 and -3)
D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons")

View File

@ -1,4 +1,4 @@
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/25/12 4:13pm
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/26/12 4:36pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;
;
@ -193,6 +193,57 @@ UT26 ; Unit Tests - BSDX26
N NOTE S NOTE="New Note "_%H
D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
I +^BSDXTMP($J,1)'=-4 W "Simulated error not triggered",!
I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE ZWRITE ^(*) W "ERROR 3",!
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
;
UT31 ; Unit Tests for BSDX31
; Set-up - Create Clinics
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)
;
; Get start and end times
N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
N APPTTIME S APPTTIME=$P(TIMES,U)
N ENDTIME S ENDTIME=$P(TIMES,U,2)
;
; Make appt
N ZZZ,DFN
S DFN=3
D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
; Test 1: Sanity Check
D NOSHOW^BSDX31(.ZZZ,APPID,1)
I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",!
I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="N" W "ERROR T1",!
; Test 2: Undo NOSHOW
D NOSHOW^BSDX31(.ZZZ,APPID,0)
I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",!
I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="" W "ERROR T2",!
; Test 3: -1
D NOSHOW^BSDX31(.ZZZ,"",0)
I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",!
; Test 4: -2
D NOSHOW^BSDX31(.ZZZ,2938748233,0)
I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",!
; Test 5: -3
D NOSHOW^BSDX31(.ZZZ,APPID,3)
I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",!
; Test 6: Mumps error (-100)
N BSDXDIE S BSDXDIE=1
D NOSHOW^BSDX31(.ZZZ,APPID,1)
I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",!
K BSDXDIE
; Test 7: Restartable transaction
N BSDXRESTART S BSDXRESTART=1
D NOSHOW^BSDX31(.ZZZ,APPID,1)
I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",!
QUIT