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.
This commit is contained in:
sam
parent
95362c15d8
commit
2800143ac1
225
m/BSDX08.m
225
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
|
||||
|
|
|
|||
75
m/BSDXAPI.m
75
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue