diff --git a/m/BSDX08.m b/m/BSDX08.m index 9ae3484..d9b521e 100644 --- a/m/BSDX08.m +++ b/m/BSDX08.m @@ -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 diff --git a/m/BSDX31.m b/m/BSDX31.m index 4f47180..a517011 100644 --- a/m/BSDX31.m +++ b/m/BSDX31.m @@ -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 + ; diff --git a/m/BSDXAPI.m b/m/BSDXAPI.m index fe1a985..b8f5573 100644 --- a/m/BSDXAPI.m +++ b/m/BSDXAPI.m @@ -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 diff --git a/m/BSDXAPI1.m b/m/BSDXAPI1.m new file mode 100644 index 0000000..eb4d4af --- /dev/null +++ b/m/BSDXAPI1.m @@ -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 diff --git a/m/BSDXUT.m b/m/BSDXUT.m index 8a8f0d1..0e714f9 100644 --- a/m/BSDXUT.m +++ b/m/BSDXUT.m @@ -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") diff --git a/m/BSDXUT1.m b/m/BSDXUT1.m index 4299309..49355b5 100644 --- a/m/BSDXUT1.m +++ b/m/BSDXUT1.m @@ -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