From 2800143ac11e863e1a182239509d942c1268ed1e Mon Sep 17 00:00:00 2001 From: sam Date: Tue, 25 Jan 2011 10:58:58 +0000 Subject: [PATCH] Final checkin. Completed ability to be able to remove appointments that have been checked in. Also, fixed not being able to make an appointment at midnight issue. --- m/BSDX08.m | 225 ++++++++++++++++++++++++++-------------------------- m/BSDXAPI.m | 75 +++++++++++------- 2 files changed, 159 insertions(+), 141 deletions(-) diff --git a/m/BSDX08.m b/m/BSDX08.m index 4a3152b..44eee02 100644 --- a/m/BSDX08.m +++ b/m/BSDX08.m @@ -1,4 +1,4 @@ -BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:35pm +BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1/25/11 12:39pm ;;1.42;BSDX;;Dec 07, 2010 ; ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL. @@ -15,6 +15,11 @@ BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:35pm ; --> worked in the first place. Waiting for bug report to know. ; - 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. + ; ; Error Reference: ; -1~BSDX08: Appt record is locked. Please contact technical support. ; -2~BSDX08: Invalid Appointment ID @@ -71,119 +76,113 @@ UT ; Unit Tests 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 (should fail). + ; 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) + D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt S APPID=+$P(^BSDXTMP($J,1),U) - B - D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) - B - D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") - B + 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 (this should pass) + ; 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) + D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt S APPID=+$P(^BSDXTMP($J,1),U) - B - D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) + 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) - B - S BSDXRESULT=$$RMCI^BSDXAPI(4,BSDXCLN,BSDXSTART) - B - D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") - ; - + 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 - ; Lock the node in another job for testing. -UTL(APPID) L +^BSDXAPPT(APPID) HANG 10 QUIT - ; APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP ;Called by RPC: BSDX CANCEL APPOINTMENT ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles - ;Input Parameters: + ;Input Parameters: ; - BSDXAPTID is entry number in BSDX APPOINTMENT file ; - BSDXTYP is C for clinic-cancelled and PC for patient cancelled ; - BSDXCR is pointer to CANCELLATION REASON File (409.2) ; - BSDXNOT is user note ; - ; Returns error code in recordset field ERRORID. Zero is success. - ; Returns Global Array. Must use this type in RPC. + ; Returns error code in recordset field ERRORID. Empty string is success. + ; Returns Global Array. Must use this type in RPC. ; - ; Return Array: set Return and clear array + ; Return Array: set Return and clear array S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) + K ^BSDXTMP($J) ; - ; Set min DUZ vars if they don't exist - D ^XBKVAR - ; - ; $ET - N $ET S $ET="G ETRAP^BSDX08" + ; Set min DUZ vars if they don't exist + D ^XBKVAR ; - ; Counter + ; $ET + N $ET S $ET="G ETRAP^BSDX08" + ; + ; Counter N BSDXI S BSDXI=0 - ; Header Node + ; 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 + ; 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" + ;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 + ; 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 + ;;;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 ; ; Start Processing: - ; First, add cancellation date to appt entry in BSDX APPOINTMENT + ; First, add cancellation date to appt entry in BSDX APPOINTMENT N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time 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 + ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID - ; If the resouce id doesn't exist... + ; If the resouce id doesn't exist... I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT - I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT + I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT ; Get zero node of resouce - S BSDXNOD=^BSDXRES(BSDXSC1,0) - ; Get Hosp location + 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 - N BSDXERR S BSDXERR=0 - ; Only file in 2/44 if there is an associated hospital location - I BSDXLOC D QUIT:BSDXERR + ; Error indicator for Hosp Location filing for getting out of routine + 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 + . ; 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 + . 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)) + . 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 + . 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) ; @@ -198,46 +197,46 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP 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 (SD,S)=BSDXSTART + N I ; Clinic IEN in 44 S I=BSDXSCD - ; if day has no schedule in legacy PIMS, forget about this update. + ; 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) + 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) + 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 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 + 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 ; @@ -320,25 +319,25 @@ ERR(BSDXI,BSDXERR) ;Error processing ; 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 + ; Rollback, otherwise ^XTER will be empty from future rollback + I $TL>0 TROLLBACK + D ^%ZTER + S $EC="" ; Clear Error ; Log error message and send to client - I '$D(BSDXI) N BSDXI S BSDXI=0 + I '$D(BSDXI) N BSDXI S BSDXI=0 D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE)) QUIT - ; - ;;;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 - ; I BSDXSCIEN="" D I 'BSDXZ Q ;Q:BSDXZ + ; + ;;;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 + ; I BSDXSCIEN="" D I 'BSDXZ Q ;Q:BSDXZ ; . S BSDXERR="BSDX08: Unable to find associated RPMS appointment for this patient. " ; . S BSDXZ=1 - ; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit + ; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit ; . I '$D(^BSDXRES(BSDXSC1,20)) S BSDXZ=0 QUIT - ; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN. + ; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN. ; . N BSDX1 S BSDX1=0 ; . F S BSDX1=$O(^BSDXRES(BSDXSC1,20,BSDX1)) Q:'+BSDX1 Q:BSDXZ=0 D ; . . Q:'$D(^BSDXRES(BSDXSC1,20,BSDX1,0)) ; . . S BSDXLOC=$P(^BSDXRES(BSDXSC1,20,BSDX1,0),U) - . ; . . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I +BSDXSCIEN S BSDXZ=0 Q + ; . . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I +BSDXSCIEN S BSDXZ=0 Q diff --git a/m/BSDXAPI.m b/m/BSDXAPI.m index 1e1d4ea..f50a11a 100644 --- a/m/BSDXAPI.m +++ b/m/BSDXAPI.m @@ -1,22 +1,32 @@ -BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 12/6/10 5:50pm +BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 1/25/11 1:00pm ;;1.42;BSDX;;Dec 07, 2010;Build 7 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW ;local mods (many) by WV/SMH ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH ; Change History: - ; 2010-11-5: + ; 2010-11-5: (1.42) ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment. ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API. - ; 2010-11-12: + ; 2010-11-12: (1.42) ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well. - ; 2010-12-5 + ; 2010-12-5 (1.42) ; Added an entry point to update the patient note in file 44. - ; 2010-12-6 + ; 2010-12-6 (1.42) ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI") - ; 2010-12-8 + ; 2010-12-8 (1.42) ; Removed restriction on max appt length. Even though this restriction ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I ; will ignore it here too. + ; 2011-01-25 (v.1.5) + ; Added entry point $$RMCI to remove checked in appointments. + ; In $$CANCEL, if the appointment is checked in, delete check-in rather than + ; spitting an error message to the user saying 'Delete the check-in' + ; Changed all lines that look like this: + ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + ; to: + ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + ; to allow for date at midnight which does not have a dot at the end. + ; ; 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 @@ -53,7 +63,7 @@ MAKE(BSDR) ;PEP; call to store appt made I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds - I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ; ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details. I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) @@ -149,9 +159,9 @@ CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PAT I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds - I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds - I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) + I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) ; ; find ien for appt in file 44 @@ -218,9 +228,9 @@ CANCEL(BSDR) ;PEP; called to cancel appt I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds - I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds - I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) + I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) ; @@ -228,7 +238,13 @@ CANCEL(BSDR) ;PEP; called to cancel appt S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") ; - I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") + ; BSDX 1.5 3110125 + ; UJO/SMH - Add ability to remove check-in if the patient is checked in + ; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") + ; Remove check-in if the patient is checked in. + N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure + I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + I BSDXRESULT Q BSDXRESULT ; ; remember before status NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL @@ -275,12 +291,15 @@ RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$ ; 0 if okay ; -1 if failure ; - ; remember before status + ; Call like this: $$RMCI(233,33,3110102.1130) + ; + ; Move my variables into the ones used by SDAPIs (just a convenience) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT) ; I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 ; + ; remember before status S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ; @@ -321,18 +340,18 @@ CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out Q $S(X:1,1:0) ; UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE - ; PAT = DFN - ; CLINIC = SC IEN - ; DATE = FM Date/Time of Appointment - ; - ; Returns: - ; 0 if okay - ; -1 if failure - N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC - I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 - N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_"," - S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150) - N BSDXERR - D FILE^DIE("","BSDXFDA","BSDXERR") - I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1) - QUIT 0 + ; PAT = DFN + ; CLINIC = SC IEN + ; DATE = FM Date/Time of Appointment + ; + ; Returns: + ; 0 if okay + ; -1 if failure + N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC + I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 + N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_"," + S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150) + N BSDXERR + D FILE^DIE("","BSDXFDA","BSDXERR") + I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1) + QUIT 0