updated the BSDX version to 1.7 ,,
- fix "BSDX01.m" routine , it was take too long time to retrieve patient radiology exams.
This commit is contained in:
tariq
parent
fbdc25600b
commit
3e60d492b4
85
m/BSDX01.m
85
m/BSDX01.m
|
|
@ -1,5 +1,5 @@
|
|||
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:52am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:46pm
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
||||
|
|
@ -281,43 +281,44 @@ GP(BSDXY,PARAM) ; Get Param - EP
|
|||
QUIT
|
||||
;
|
||||
INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
|
||||
; Input: BSDXSC - Hospital Location IEN
|
||||
; Output: True or False
|
||||
I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
|
||||
I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
|
||||
; Jump to Division:Medical Center Division:Inst File Pointer for
|
||||
; Institution IEN (and get its internal value)
|
||||
N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
|
||||
I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
|
||||
I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
|
||||
E Q 0 ; Otherwise, no
|
||||
; Input: BSDXSC - Hospital Location IEN
|
||||
; Output: True or False
|
||||
I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
|
||||
I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
|
||||
; Jump to Division:Medical Center Division:Inst File Pointer for
|
||||
; Institution IEN (and get its internal value)
|
||||
N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
|
||||
I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
|
||||
I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
|
||||
E Q 0 ; Otherwise, no
|
||||
QUIT
|
||||
INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
|
||||
; Input BSDXRES - BSDX RESOURCE IEN
|
||||
; Output: True of False
|
||||
Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
|
||||
UTINDIV ; Unit Test $$INDIV
|
||||
W "Testing if they are the same",!
|
||||
S DUZ(2)=67
|
||||
I '$$INDIV(1) W "ERROR",!
|
||||
I '$$INDIV(2) W "ERROR",!
|
||||
W "Testing if Div not defined in 44, should be true",!
|
||||
I '$$INDIV(3) W "ERROR",!
|
||||
W "Testing empty string. Should be true",!
|
||||
I '$$INDIV("") W "ERROR",!
|
||||
W "Testing if they are different",!
|
||||
S DUZ(2)=899
|
||||
I $$INDIV(1) W "ERROR",!
|
||||
I $$INDIV(2) W "ERROR",!
|
||||
QUIT
|
||||
UTINDIV2 ; Unit Test $$INDIV2
|
||||
W "Testing if they are the same",!
|
||||
S DUZ(2)=69
|
||||
I $$INDIV2(22)'=0 W "ERROR",!
|
||||
I $$INDIV2(25)'=1 W "ERROR",!
|
||||
I $$INDIV2(26)'=1 W "ERROR",!
|
||||
I $$INDIV2(27)'=1 W "ERROR",!
|
||||
QUIT
|
||||
;
|
||||
; Input BSDXRES - BSDX RESOURCE IEN
|
||||
; Output: True of False
|
||||
Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
|
||||
UnitTestINDIV
|
||||
W "Testing if they are the same",!
|
||||
S DUZ(2)=67
|
||||
I '$$INDIV(1) W "ERROR",!
|
||||
I '$$INDIV(2) W "ERROR",!
|
||||
W "Testing if Div not defined in 44, should be true",!
|
||||
I '$$INDIV(3) W "ERROR",!
|
||||
W "Testing empty string. Should be true",!
|
||||
I '$$INDIV("") W "ERROR",!
|
||||
W "Testing if they are different",!
|
||||
S DUZ(2)=899
|
||||
I $$INDIV(1) W "ERROR",!
|
||||
I $$INDIV(2) W "ERROR",!
|
||||
QUIT
|
||||
UnitTestINDIV2
|
||||
W "Testing if they are the same",!
|
||||
S DUZ(2)=69
|
||||
I $$INDIV2(22)'=0 W "ERROR",!
|
||||
I $$INDIV2(25)'=1 W "ERROR",!
|
||||
I $$INDIV2(26)'=1 W "ERROR",!
|
||||
I $$INDIV2(27)'=1 W "ERROR",!
|
||||
QUIT
|
||||
;
|
||||
GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
|
||||
; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
|
||||
;
|
||||
|
|
@ -344,7 +345,13 @@ GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Pati
|
|||
; File 75.1 = RAD/NUC MED ORDERS
|
||||
; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
|
||||
; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
|
||||
D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
|
||||
;
|
||||
;;EHS/MKH,BAH;;UJO*1.0*143;;30/09/2012;; Update [Fix the performance issue in SchedGUI]
|
||||
; START OF CODE CHANGES FOR [UJO*1.0*143]
|
||||
; Commented old Line
|
||||
;D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
|
||||
DO FIND^DIC(75.1,"","@;5;2;16","QP",DFN,"","B","IF 35[$PIECE(^(0),U,5)&($PIECE(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR")
|
||||
; END OF CODE CHANGES FOR [UJO*1.0*143]
|
||||
;
|
||||
IF $DATA(BSDXERR) GOTO END
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
;Licensed under LGPL
|
||||
; Change Log
|
||||
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
|
||||
|
|
@ -29,15 +29,14 @@ CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
|
|||
K ^BSDXTMP($J)
|
||||
S BSDXERR=""
|
||||
S BSDXY="^BSDXTMP("_$J_")"
|
||||
S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME"
|
||||
S ^(0)=^(0)_"^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
|
||||
S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
|
||||
D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
|
||||
;
|
||||
; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
|
||||
; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
||||
; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
|
||||
; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
||||
;
|
||||
;
|
||||
S BSDXI=0
|
||||
D STRES
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
;Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/6/12 10:55am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:15am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
; Change Log:
|
||||
; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
|
||||
|
|
@ -73,7 +73,7 @@ CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP -- RPC: BSDX CRE
|
|||
. S BSDXRESN=$P(BSDXRES,"|",BSDXCOUN)
|
||||
. Q:BSDXRESN=""
|
||||
. Q:'$D(^BSDXRES("B",BSDXRESN))
|
||||
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
|
||||
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
|
||||
. Q:'+BSDXRESD
|
||||
. Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
|
||||
. S BSDXBS=0
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
; Change Log:
|
||||
; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
|
||||
|
|
|
|||
630
m/BSDX07.m
630
m/BSDX07.m
|
|
@ -1,284 +1,360 @@
|
|||
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:02pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
; UJO/SMH
|
||||
; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
|
||||
; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
|
||||
; v1.42 Oct 30 2010 - Extensive refactoring.
|
||||
; v1.5 Mar 15 2011 - End time does not have to have time anymore.
|
||||
; It could be midnight of the next day
|
||||
; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
|
||||
; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes
|
||||
; - AVUPDT moved to AVUPDTMK in BSDXAPI1
|
||||
;
|
||||
; Error Reference:
|
||||
; -1: Patient Record is locked. This means something is wrong!!!!
|
||||
; -2: Start Time is not a valid Fileman date
|
||||
; -3: End Time is not a valid Fileman date
|
||||
; v1.5:obsolete::-4: End Time does not have time inside of it.
|
||||
; -5: BSDXPATID is not numeric
|
||||
; -6: Patient Does not exist in ^DPT
|
||||
; -7: Resource Name does not exist in B index of BSDX RESOURCE
|
||||
; -8: Resouce doesn't exist in ^BSDXRES
|
||||
; -9: Couldn't add appointment to BSDX APPOINTMENT
|
||||
; -10: Couldn't add appointment to files 2 and/or 44
|
||||
; -100: Mumps Error
|
||||
;
|
||||
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
; UJO/SMH
|
||||
; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
|
||||
; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
|
||||
; thanks to Rick Marshall and Zach Gonzalez at Oroville.
|
||||
; v1.42 Oct 30 2010 - Extensive refactoring.
|
||||
; v1.5 Mar 15 2011 - End time does not have to have time anymore.
|
||||
; It could be midnight of the next day
|
||||
; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
|
||||
;
|
||||
; Error Reference:
|
||||
; -1: Patient Record is locked. This means something is wrong!!!!
|
||||
; -2: Start Time is not a valid Fileman date
|
||||
; -3: End Time is not a valid Fileman date
|
||||
; v1.5:obsolete::-4: End Time does not have time inside of it.
|
||||
; -5: BSDXPATID is not numeric
|
||||
; -6: Patient Does not exist in ^DPT
|
||||
; -7: Resource Name does not exist in B index of BSDX RESOURCE
|
||||
; -8: Resouce doesn't exist in ^BSDXRES
|
||||
; -9: Couldn't add appointment to BSDX APPOINTMENT
|
||||
; -10: Couldn't add appointment to files 2 and/or 44
|
||||
; -100: Mumps Error
|
||||
|
||||
APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
|
||||
;Entry point for debugging
|
||||
; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
|
||||
Q
|
||||
;
|
||||
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP
|
||||
;
|
||||
;Called by RPC: BSDX ADD NEW APPOINTMENT
|
||||
;
|
||||
;Add new appointment to 3 files
|
||||
; - BSDX APPOINTMENT
|
||||
; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
|
||||
; - Patient Appointment Subfile if Resource is linked to clinic
|
||||
;
|
||||
;Paramters:
|
||||
;BSDXY: Global Return (RPC must be set to Global Array)
|
||||
;BSDXSTART: FM Start Date
|
||||
;BSDXEND: FM End Date
|
||||
;BSDXPATID: Patient DFN
|
||||
;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
|
||||
;BSDXLEN is the appointment duration in minutes
|
||||
;BSDXNOTE is the Appiontment Note
|
||||
;BSDXATID is used for 2 purposes:
|
||||
; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
|
||||
; if BSDXATID = a number, then it is the access type id (used for rebooking)
|
||||
;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
|
||||
;
|
||||
;Return:
|
||||
; ADO.net Recordset having fields:
|
||||
; AppointmentID and ErrorNumber
|
||||
;
|
||||
; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
|
||||
; to sort out. Needs changes on client.
|
||||
;
|
||||
;Test lines:
|
||||
;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
|
||||
;
|
||||
; Deal with optional arguments
|
||||
S BSDXRADEXAM=$G(BSDXRADEXAM)
|
||||
;
|
||||
; Return Array; set Return and clear array
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
K ^BSDXTMP($J)
|
||||
;
|
||||
; $ET
|
||||
N $ET S $ET="G ETRAP^BSDX07"
|
||||
;
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
;
|
||||
; 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 +^BSDXPAT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
|
||||
;
|
||||
; Header Node
|
||||
S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
|
||||
;
|
||||
; Turn off SDAM APPT PROTOCOL BSDX Entries
|
||||
N BSDXNOEV
|
||||
S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
|
||||
;
|
||||
; Set Error Message to be empty
|
||||
N BSDXERR S BSDXERR=0
|
||||
;
|
||||
;;;test for error. See if %ZTER works
|
||||
I $G(BSDXDIE) N X S X=1/0
|
||||
;;;test
|
||||
;
|
||||
; -- Start and End Date Processing --
|
||||
; If C# sends the dates with extra zeros, remove them
|
||||
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
|
||||
; Are the dates valid? Must be FM Dates > than 2010
|
||||
I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
|
||||
I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
|
||||
;
|
||||
;; If Ending date doesn't have a time, this is an error --rm 1.5
|
||||
; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
|
||||
;
|
||||
; If the Start Date is greater than the end date, swap dates
|
||||
N BSDXTMP
|
||||
I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
|
||||
;
|
||||
; Check if the patient exists:
|
||||
; - DFN valid number?
|
||||
; - Valid Patient in file 2?
|
||||
I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
|
||||
I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
|
||||
;
|
||||
;Validate Resource entry
|
||||
I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
|
||||
N BSDXRESD ; Resource IEN
|
||||
S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
|
||||
N BSDXRNOD ; Resouce zero node
|
||||
S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
|
||||
I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
|
||||
;
|
||||
; Walk-in (Unscheduled) Appointment?
|
||||
N BSDXWKIN S BSDXWKIN=0
|
||||
I BSDXATID="WALKIN" S BSDXWKIN=1
|
||||
; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
|
||||
I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
|
||||
;
|
||||
; Now, check if PIMS has any issues with us making the appt using MAKECK
|
||||
N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN
|
||||
N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
|
||||
N BSDXC ; Array to send to MAKE and MAKECK APIs
|
||||
; Only if we have a valid Hosp Location
|
||||
I +BSDXSCD,$D(^SC(BSDXSCD,0)) D
|
||||
. S BSDXC("PAT")=BSDXPATID
|
||||
. S BSDXC("CLN")=BSDXSCD
|
||||
. S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
|
||||
. S:BSDXWKIN BSDXC("TYP")=4
|
||||
. S BSDXC("ADT")=BSDXSTART
|
||||
. S BSDXC("LEN")=BSDXLEN
|
||||
. S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
|
||||
. S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
|
||||
. S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
|
||||
. S BSDXC("USR")=DUZ
|
||||
. S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC)
|
||||
I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back
|
||||
;
|
||||
; Done with all checks, let's make appointment in BSDX APPOINTMENT
|
||||
N BSDXAPPTID
|
||||
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
|
||||
I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q ; no roll back needed! No appts made.
|
||||
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here
|
||||
; I don't think it's important b/c users can detect right away if the WP
|
||||
; filing fails.
|
||||
;
|
||||
I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q ; UT Line
|
||||
;
|
||||
; Only if we have a valid Hosp Loc can we make an appointment in 2/44
|
||||
; Use BSDXC array from before.
|
||||
; FYI: $$MAKE itself calls $$MAKECK to check again for being okay.
|
||||
; If an error happens here, we roll back both ^BSDXAPPT and 2/44 by deleting
|
||||
N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
|
||||
I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
|
||||
I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
|
||||
;
|
||||
; Unlock
|
||||
L -^BSDXPAT(BSDXPATID)
|
||||
;
|
||||
;Return Recordset
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
Q
|
||||
;Entry point for debugging
|
||||
D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
|
||||
Q
|
||||
;
|
||||
UT ; Unit Tests
|
||||
N ZZZ
|
||||
; Test for bad start date
|
||||
D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",!
|
||||
; Test for bad end date
|
||||
D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
|
||||
; Test for end date without time
|
||||
D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
|
||||
; Test for mumps error
|
||||
S bsdxdie=1
|
||||
D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
|
||||
K bsdxdie
|
||||
; Test for TRESTART
|
||||
s bsdxrestart=1
|
||||
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
|
||||
k bsdxrestart
|
||||
; Test for non-numeric patient
|
||||
D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
|
||||
; Test for a non-existent patient
|
||||
D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",!
|
||||
; Test for a non-existent resource name
|
||||
D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",!
|
||||
; Test for corrupted resource
|
||||
; Can't test for -8 since it requires DB corruption
|
||||
; Test for inability to add appointment to BSDX Appointment
|
||||
; Also requires something wrong in the DB
|
||||
; Test for inability to add appointment to 2,44
|
||||
; Test by creating a duplicate appointment
|
||||
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
|
||||
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
|
||||
I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
|
||||
; Test for normality:
|
||||
D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1)
|
||||
; Does Appt exist?
|
||||
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
I 'APPID W "Error Making Appt-1" QUIT
|
||||
I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2"
|
||||
I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3"
|
||||
I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
|
||||
QUIT
|
||||
;
|
||||
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
|
||||
;
|
||||
;Called by RPC: BSDX ADD NEW APPOINTMENT
|
||||
;
|
||||
;Add new appointment to 3 files
|
||||
; - BSDX APPOINTMENT
|
||||
; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
|
||||
; - Patient Appointment Subfile if Resource is linked to clinic
|
||||
;
|
||||
;Paramters:
|
||||
;BSDXY: Global Return (RPC must be set to Global Array)
|
||||
;BSDXSTART: FM Start Date
|
||||
;BSDXEND: FM End Date
|
||||
;BSDXPATID: Patient DFN
|
||||
;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
|
||||
;BSDXLEN is the appointment duration in minutes
|
||||
;BSDXNOTE is the Appiontment Note
|
||||
;BSDXATID is used for 2 purposes:
|
||||
; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
|
||||
; if BSDXATID = a number, then it is the access type id (used for rebooking)
|
||||
;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
|
||||
;
|
||||
;Return:
|
||||
; ADO.net Recordset having fields:
|
||||
; AppointmentID and ErrorNumber
|
||||
;
|
||||
;Test lines:
|
||||
;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
|
||||
;
|
||||
; Deal with optional arguments
|
||||
S BSDXRADEXAM=$G(BSDXRADEXAM)
|
||||
; Return Array; set Return and clear array
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
K ^BSDXTMP($J)
|
||||
; $ET
|
||||
N $ET S $ET="G ETRAP^BSDX07"
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
; Lock BSDX node, only to synchronize access to the globals.
|
||||
; It's not expected that the error will ever happen as no filing
|
||||
; is supposed to take 5 seconds.
|
||||
L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
|
||||
; Header Node
|
||||
S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
|
||||
;Restartable Transaction; restore paramters when starting.
|
||||
; (Params restored are what's passed here + BSDXI)
|
||||
TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
|
||||
;
|
||||
; Turn off SDAM APPT PROTOCOL BSDX Entries
|
||||
N BSDXNOEV
|
||||
S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
|
||||
;
|
||||
; Set Error Message to be empty
|
||||
N BSDXERR S BSDXERR=0
|
||||
;
|
||||
;;;test for error inside transaction. See if %ZTER works
|
||||
I $G(bsdxdie) S X=1/0
|
||||
;;;test
|
||||
;;;test for TRESTART
|
||||
I $G(bsdxrestart) K bsdxrestart TRESTART
|
||||
;;;test
|
||||
;
|
||||
; -- Start and End Date Processing --
|
||||
; If C# sends the dates with extra zeros, remove them
|
||||
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
|
||||
; Are the dates valid? Must be FM Dates > than 2010
|
||||
I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
|
||||
I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
|
||||
;
|
||||
;; If Ending date doesn't have a time, this is an error --rm 1.5
|
||||
; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
|
||||
;
|
||||
; If the Start Date is greater than the end date, swap dates
|
||||
N BSDXTMP
|
||||
I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
|
||||
;
|
||||
; Check if the patient exists:
|
||||
; - DFN valid number?
|
||||
; - Valid Patient in file 2?
|
||||
I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
|
||||
I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
|
||||
;
|
||||
;Validate Resource entry
|
||||
I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
|
||||
N BSDXRESD ; Resource IEN
|
||||
S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
|
||||
N BSDXRNOD ; Resouce zero node
|
||||
S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
|
||||
I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
|
||||
;
|
||||
; Walk-in (Unscheduled) Appointment?
|
||||
N BSDXWKIN S BSDXWKIN=0
|
||||
I BSDXATID="WALKIN" S BSDXWKIN=1
|
||||
; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
|
||||
I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
|
||||
;
|
||||
; Done with all checks, let's make appointment in BSDX APPOINTMENT
|
||||
N BSDXAPPTID
|
||||
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
|
||||
I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
|
||||
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
|
||||
;
|
||||
; Then Create Subfiles in 2/44 Appointment
|
||||
N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN
|
||||
; Only if we have a valid Hosp Loc can we make an appointment
|
||||
I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR) Q
|
||||
. N BSDXC
|
||||
. S BSDXC("PAT")=BSDXPATID
|
||||
. S BSDXC("CLN")=BSDXSCD
|
||||
. S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
|
||||
. S:BSDXWKIN BSDXC("TYP")=4
|
||||
. S BSDXC("ADT")=BSDXSTART
|
||||
. S BSDXC("LEN")=BSDXLEN
|
||||
. S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
|
||||
. S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
|
||||
. S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
|
||||
. S BSDXC("USR")=DUZ
|
||||
. S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
|
||||
. Q:BSDXERR
|
||||
. ;Update RPMS Clinic availability
|
||||
. D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
|
||||
. Q
|
||||
;
|
||||
;Return Recordset
|
||||
TCOMMIT
|
||||
L -^BSDXAPPT(BSDXPATID)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
Q
|
||||
BSDXDEL(BSDXAPPTID) ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN
|
||||
N DA,DIK
|
||||
S DIK="^BSDXAPPT(",DA=BSDXAPPTID
|
||||
D ^DIK
|
||||
Q
|
||||
;
|
||||
STRIP(BSDXZ) ;Replace control characters with spaces
|
||||
N BSDXI
|
||||
F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
|
||||
Q BSDXZ
|
||||
;
|
||||
N BSDXI
|
||||
F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
|
||||
Q BSDXZ
|
||||
;
|
||||
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY
|
||||
;Returns ien in BSDXAPPT or 0 if failed
|
||||
;Create entry in BSDX APPOINTMENT
|
||||
N BSDXAPPTID,BSDXFDA
|
||||
S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
|
||||
S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
|
||||
S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
|
||||
S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
|
||||
S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
|
||||
S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
|
||||
S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
|
||||
S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
|
||||
S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM)
|
||||
N BSDXIEN,BSDXMSG
|
||||
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
||||
S BSDXAPPTID=+$G(BSDXIEN(1))
|
||||
Q BSDXAPPTID
|
||||
;
|
||||
;Returns ien in BSDXAPPT or 0 if failed
|
||||
;Create entry in BSDX APPOINTMENT
|
||||
N BSDXAPPTID
|
||||
S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
|
||||
S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
|
||||
S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
|
||||
S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
|
||||
S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
|
||||
S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
|
||||
S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
|
||||
S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
|
||||
S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM
|
||||
N BSDXIEN,BSDXMSG
|
||||
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
||||
S BSDXAPPTID=+$G(BSDXIEN(1))
|
||||
Q BSDXAPPTID
|
||||
;
|
||||
BSDXWP(BSDXAPPTID,BSDXNOTE) ;
|
||||
;Add WP field
|
||||
N BSDXMSG
|
||||
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
||||
I $D(BSDXNOTE(.5)) D
|
||||
. D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||
Q
|
||||
;
|
||||
;Add WP field
|
||||
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
||||
I $D(BSDXNOTE(.5)) D
|
||||
. D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||
Q
|
||||
;
|
||||
ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
|
||||
;Called by BSDX ADD APPOINTMENT protocol
|
||||
;BSDXSC=IEN of clinic in ^SC
|
||||
;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
|
||||
;
|
||||
N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND
|
||||
Q:+$G(BSDXNOEV)
|
||||
I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
|
||||
E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
|
||||
Q:'+$G(BSDXRES)
|
||||
S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
|
||||
Q:BSDXNOD=""
|
||||
S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
|
||||
S BSDXWKIN=""
|
||||
S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
|
||||
S BSDXLEN=$P(BSDXNOD,U,2)
|
||||
Q:'+BSDXLEN
|
||||
S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
|
||||
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
|
||||
Q:'+BSDXAPPTID
|
||||
S BSDXNOTE=$P(BSDXNOD,U,4)
|
||||
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
|
||||
D ADDEVT3(BSDXRES)
|
||||
Q
|
||||
;
|
||||
;Called by BSDX ADD APPOINTMENT protocol
|
||||
;BSDXSC=IEN of clinic in ^SC
|
||||
;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
|
||||
;
|
||||
N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
|
||||
Q:+$G(BSDXNOEV)
|
||||
I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
|
||||
E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
|
||||
Q:'+$G(BSDXRES)
|
||||
S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
|
||||
Q:BSDXNOD=""
|
||||
S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
|
||||
S BSDXWKIN=""
|
||||
S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
|
||||
S BSDXLEN=$P(BSDXNOD,U,2)
|
||||
Q:'+BSDXLEN
|
||||
S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
|
||||
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
|
||||
Q:'+BSDXAPPTID
|
||||
S BSDXNOTE=$P(BSDXNOD,U,4)
|
||||
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
|
||||
D ADDEVT3(BSDXRES)
|
||||
Q
|
||||
;
|
||||
ADDEVT3(BSDXRES) ;
|
||||
;Call RaiseEvent to notify GUI clients
|
||||
N BSDXRESN
|
||||
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
|
||||
Q:BSDXRESN=""
|
||||
S BSDXRESN=$P(BSDXRESN,"^")
|
||||
;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
|
||||
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
|
||||
Q
|
||||
;
|
||||
ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
|
||||
; DO NOT USE except as an emergency measure - only if unforseen error occurs
|
||||
; Input:
|
||||
; Appointment ID to remove from ^BSDXAPPT
|
||||
; BSDXC array (see array format in $$MAKE^BSDXAPI)
|
||||
N %
|
||||
D BSDXDEL^BSDX07(BSDXAPPTID)
|
||||
S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
|
||||
QUIT
|
||||
;
|
||||
BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
|
||||
; DO NOT USE except in emergencies to roll back an appointment set
|
||||
N DA,DIK
|
||||
S DIK="^BSDXAPPT(",DA=BSDXAPPTID
|
||||
D ^DIK
|
||||
Q
|
||||
;
|
||||
ERR(BSDXI,BSDXERR) ;Error processing - different from error trap.
|
||||
; Unlock first
|
||||
L -^BSDXPAT(BSDXPATID)
|
||||
; If last line is $C(31), we are done. No more errors to send to client.
|
||||
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
Q
|
||||
;
|
||||
;Call RaiseEvent to notify GUI clients
|
||||
N BSDXRESN
|
||||
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
|
||||
Q:BSDXRESN=""
|
||||
S BSDXRESN=$P(BSDXRESN,"^")
|
||||
;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
|
||||
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
|
||||
Q
|
||||
;
|
||||
ERR(BSDXI,BSDXERR) ;Error processing
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
I $TL>0 TROLLBACK
|
||||
S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
L -^BSDXAPPT(BSDXPATID)
|
||||
Q
|
||||
;
|
||||
ETRAP ;EP Error trap entry
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
D ^%ZTER
|
||||
;
|
||||
I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
|
||||
;
|
||||
; Log error message and send to client
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
|
||||
Q:$Q 1_U_"Mumps Error" Q
|
||||
;
|
||||
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
|
||||
; Log error message and send to client
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
|
||||
Q
|
||||
;
|
||||
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
|
||||
;
|
||||
DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
|
||||
F %=%:-1:281 S Y=%#4=1+1+Y
|
||||
S Y=$E(X,6,7)+Y#7
|
||||
Q
|
||||
;
|
||||
AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability
|
||||
;SEE SDM1
|
||||
N Y,DFN
|
||||
N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
|
||||
N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
|
||||
S Y=BSDXSCD,DFN=BSDXPATID
|
||||
S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
|
||||
;Determine maximum days for scheduling
|
||||
S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
|
||||
S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
|
||||
S SDDATE=BSDXSTART
|
||||
S SDSDATE=SDDATE,SDDATE=SDDATE\1
|
||||
1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
|
||||
Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
|
||||
S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
|
||||
S X2=SDEDT D C^%DTC S SDEDT=X
|
||||
S Y=BSDXSTART
|
||||
EN1 S (X,SD)=Y,SM=0 D DOW
|
||||
S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")
|
||||
S S=BSDXLEN
|
||||
;Check if BSDXLEN evenly divisible by appointment length
|
||||
S RPMSL=$P(SL,U)
|
||||
I BSDXLEN<RPMSL S BSDXLEN=RPMSL
|
||||
I BSDXLEN#RPMSL'=0 D
|
||||
. S BSDXINC=BSDXLEN\RPMSL
|
||||
. S BSDXINC=BSDXINC+1
|
||||
. S BSDXLEN=RPMSL*BSDXINC
|
||||
S SL=S_U_$P(SL,U,2,99)
|
||||
SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
|
||||
L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
|
||||
S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
|
||||
S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
|
||||
I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
|
||||
I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
|
||||
;
|
||||
SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
|
||||
S SDNOT=1
|
||||
S ABORT=0
|
||||
F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT
|
||||
. S ST=$E(S,I+1) S:ST="" ST=" "
|
||||
. S Y=$E(STR,$F(STR,ST)-2)
|
||||
. I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
|
||||
. I Y="" S ABORT=1 Q
|
||||
. S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST
|
||||
. Q
|
||||
S ^SC(SC,"ST",$P(SD,"."),1)=S
|
||||
L -^SC(SC,"ST",$P(SD,"."),1)
|
||||
Q
|
||||
|
|
|
|||
278
m/BSDX08.m
278
m/BSDX08.m
|
|
@ -1,22 +1,24 @@
|
|||
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
;
|
||||
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
|
||||
;
|
||||
; Change History
|
||||
; 3101022 UJO/SMH v1.42
|
||||
; - Transaction work. As of v 1.7, all work here has been superceded
|
||||
; - Refactoring of AVUPDT - never tested though.
|
||||
; - 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.
|
||||
; - 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.
|
||||
;
|
||||
; 3120625 VEN/SMH v1.7
|
||||
; - Transactions removed. Code refactored to work w/o txns.
|
||||
; - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling
|
||||
; that.
|
||||
; - Minor reformatting because of how KIDS adds tabs.
|
||||
;
|
||||
; Error Reference:
|
||||
; -1~BSDX08: Appt record is locked. Please contact technical support.
|
||||
|
|
@ -28,15 +30,76 @@ BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
|
|||
; -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
|
||||
;Entry point for debugging
|
||||
;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
|
||||
D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
|
||||
Q
|
||||
;
|
||||
APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP
|
||||
UT ; Unit Tests
|
||||
; Test 1: Make normal appointment and cancel it. See if every thing works
|
||||
N ZZZ
|
||||
D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1)
|
||||
S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
|
||||
I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1"
|
||||
I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2"
|
||||
I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3"
|
||||
I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4"
|
||||
;
|
||||
; Test 2: Check for -1
|
||||
; Make appt
|
||||
D APPADD^BSDX07(.ZZZ,3110125.2,3110125.3,4,"Dr Office",10,"Sam's Note",1)
|
||||
; Lock the node in another job
|
||||
S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10
|
||||
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
|
||||
;
|
||||
; Test 3: Check for -100
|
||||
S bsdxdie=1
|
||||
D APPADD^BSDX07(.ZZZ,3110126.2,3110126.3,4,"Dr Office",10,"Sam's Note",1)
|
||||
S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
|
||||
I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
|
||||
K bsdxdie
|
||||
;
|
||||
; Test 4: Restartable transaction
|
||||
S bsdxrestart=1
|
||||
D APPADD^BSDX07(.ZZZ,3110128.2,3110128.3,4,"Dr Office",10,"Sam's Note",1)
|
||||
S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
|
||||
I $P(^DPT(4,"S",3110128.2,0),U,2)'="PC" W "Error in Restartable Transaction",!
|
||||
;
|
||||
; Test 5: for invalid Appointment ID (-2 and -3)
|
||||
D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons")
|
||||
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
|
||||
S BSDXSTART=$E($$NOW^XLFDT,1,12),BSDXEND=BSDXSTART+.0001
|
||||
D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt
|
||||
S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
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
|
||||
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) ; Add appt
|
||||
S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
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)
|
||||
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
|
||||
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:
|
||||
|
|
@ -60,78 +123,70 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP
|
|||
;
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
;
|
||||
; 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
|
||||
;
|
||||
;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
|
||||
N BSDXNOEV
|
||||
S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
|
||||
;
|
||||
;;;test for error inside transaction. See if %ZTER works
|
||||
I $G(BSDXDIE1) N X S X=1/0
|
||||
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
|
||||
;
|
||||
; Lock BSDX node, only to synchronize access to the globals.
|
||||
; It's not expected that the error will ever happen as no filing
|
||||
; is supposed to take 5 seconds.
|
||||
L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
|
||||
;
|
||||
; Start Processing:
|
||||
; First, get data
|
||||
; 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
|
||||
;
|
||||
; Check the resource ID and whether it exists
|
||||
; 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 resource 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
|
||||
;
|
||||
;
|
||||
; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI
|
||||
; Get zero node of resouce
|
||||
N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
||||
S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
||||
; Get Hosp location
|
||||
N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
|
||||
; Error indicator
|
||||
; Error indicator for Hosp Location filing for getting out of routine
|
||||
N BSDXERR S BSDXERR=0
|
||||
;
|
||||
N BSDXC ; Array to pass to BSDXAPI
|
||||
;
|
||||
I BSDXLOC D
|
||||
. S BSDXC("PAT")=BSDXPATID
|
||||
. S BSDXC("CLN")=BSDXLOC
|
||||
. S BSDXC("TYP")=BSDXTYP
|
||||
. S BSDXC("ADT")=BSDXSTART
|
||||
. S BSDXC("CDT")=$$NOW^XLFDT()
|
||||
. S BSDXC("NOT")=BSDXNOT
|
||||
. S:'+$G(BSDXCR) BSDXCR=11 ;Other
|
||||
. S BSDXC("CR")=BSDXCR
|
||||
. S BSDXC("USR")=DUZ
|
||||
. ;
|
||||
. S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message
|
||||
; 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,"-10~BSDX08: $$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT
|
||||
;
|
||||
; Then PIMS:
|
||||
; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
|
||||
; If error happens, must rollback ^BSDXAPPT
|
||||
I BSDXLOC S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI
|
||||
; Rollback BSDXAPPT if error occurs
|
||||
I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID) QUIT
|
||||
; 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
|
||||
. 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
|
||||
. ; Get the appointment node
|
||||
. 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
|
||||
. ; Update Legacy PIMS clinic Availability
|
||||
. D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
|
||||
;
|
||||
TCOMMIT
|
||||
L -^BSDXAPPT(BSDXAPTID)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=""_$C(30)
|
||||
|
|
@ -139,25 +194,80 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP
|
|||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
Q
|
||||
;
|
||||
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()
|
||||
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 I=BSDXSCD
|
||||
; 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)
|
||||
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)
|
||||
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 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
|
||||
S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set
|
||||
Q
|
||||
;
|
||||
APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD) ;
|
||||
;Cancel appointment for patient BSDXDFN in clinic BSDXSC1
|
||||
;at time BSDXSD
|
||||
N BSDXC,%H
|
||||
S BSDXC("PAT")=BSDXPATID
|
||||
S BSDXC("CLN")=BSDXLOC
|
||||
S BSDXC("TYP")=BSDXTYP
|
||||
S BSDXC("ADT")=BSDXSD
|
||||
S %H=$H D YMD^%DTC
|
||||
S BSDXC("CDT")=X+%
|
||||
S BSDXC("NOT")=BSDXNOT
|
||||
S:'+$G(BSDXCR) BSDXCR=11 ;Other
|
||||
S BSDXC("CR")=BSDXCR
|
||||
S BSDXC("USR")=DUZ
|
||||
;
|
||||
S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC)
|
||||
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
|
||||
S BSDXIENS=BSDXAPTID_","
|
||||
S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
|
||||
K BSDXMSG
|
||||
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||
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
|
||||
Q
|
||||
;
|
||||
CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event
|
||||
;when appointments cancelled via PIMS interface.
|
||||
|
|
@ -181,10 +291,9 @@ CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) ;
|
|||
Q:'+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
|
||||
. N BSDXNOD
|
||||
. S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
|
||||
. I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
|
||||
I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER
|
||||
I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT)
|
||||
Q BSDXFOUND
|
||||
;
|
||||
CANEVT3(BSDXRES) ;
|
||||
|
|
@ -199,30 +308,25 @@ CANEVT3(BSDXRES) ;
|
|||
Q
|
||||
;
|
||||
ERR(BSDXI,BSDXERR) ;Error processing
|
||||
; Unlock first
|
||||
L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
|
||||
; If last line is $C(31), we are done. No more errors to send to client.
|
||||
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
I $TL>0 TROLLBACK
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
L -^BSDXAPPT(BSDXAPTID)
|
||||
QUIT
|
||||
;
|
||||
ETRAP ;EP Error trap entry
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
; Rollback, otherwise ^XTER will be empty from future rollback
|
||||
I $TL>0 TROLLBACK
|
||||
D ^%ZTER
|
||||
;
|
||||
; Roll back BSDXAPPT;
|
||||
; NB: What if a Mumps error happens inside fileman in BSDXAPI?
|
||||
; I have decided the M errors are out of scope for me to handle.
|
||||
D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID)
|
||||
;
|
||||
S $EC="" ; Clear Error
|
||||
; Log error message and send to client
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
|
||||
Q:$Q 1_U_"-100~Mumps Error" Q
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 6/21/12 11:03am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:18am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
ENV0100 ;EP Version 1.0 Environment check
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:20am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
257
m/BSDX25.m
257
m/BSDX25.m
|
|
@ -1,137 +1,118 @@
|
|||
BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX25 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C#
|
||||
; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions.
|
||||
; -> Functionality still the same.
|
||||
; -> Unit Tests in UT25^BSDXUT2
|
||||
;
|
||||
;
|
||||
CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
|
||||
UT ; Unit Tests
|
||||
; Make appointment, checkin, then uncheckin
|
||||
N ZZZ
|
||||
N APPTTIME S APPTTIME=$E($$NOW^XLFDT(),1,12)
|
||||
D APPADD^BSDX07(.ZZZ,APPTTIME,APPTTIME+.0001,3,"Dr Office",30,"Sam's Note",1)
|
||||
N APPTID S APPTID=+^BSDXTMP($J,1)
|
||||
N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I")
|
||||
D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT())
|
||||
IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1",!
|
||||
IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 2",!
|
||||
D RMCI^BSDX25(.ZZZ,APPTID)
|
||||
IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
|
||||
IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
|
||||
D RMCI^BSDX25(.ZZZ,APPTID) ; again, test sanity in repeat
|
||||
IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",!
|
||||
IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",!
|
||||
; now test various error conditions
|
||||
; Test Error 1
|
||||
D RMCI^BSDX25(.ZZZ,)
|
||||
IF +^BSDXTMP($J,1)'=-1 WRITE "ERROR IN ETest 1",!
|
||||
; Test Error 2
|
||||
D RMCI^BSDX25(.ZZZ,234987234398)
|
||||
IF +^BSDXTMP($J,1)'=-2 WRITE "ERROR IN Etest 2",!
|
||||
; Tests for 3 to 5 difficult to produce
|
||||
; Error tests follow: Mumps error test; Transaction restartability
|
||||
N bsdxdie S bsdxdie=1
|
||||
D RMCI^BSDX25(.ZZZ,APPTID)
|
||||
IF +^BSDXTMP($J,1)'=-20 WRITE "ERROR IN Etest 3",!
|
||||
K bsdxdie
|
||||
N bsdxrestart S bsdxrestart=1
|
||||
D RMCI^BSDX25(.ZZZ,APPTID)
|
||||
IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 4",!
|
||||
QUIT
|
||||
CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
|
||||
;Entry point for debugging
|
||||
;
|
||||
;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
|
||||
;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
|
||||
Q
|
||||
;
|
||||
CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
|
||||
; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
|
||||
; Called by RPC: BSDX CHECKIN APPOINTMENT
|
||||
;
|
||||
CHECKIN(BSDXY,BSDXAPTID,BSDXCDT) ; ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP Check in appointment
|
||||
; Private to GUI; use BSDXAPI for general API to checkin patients
|
||||
; Parameters:
|
||||
; BSDXY: Global Out
|
||||
; BSDXAPPTID: Appointment ID in ^BSDXAPPT
|
||||
; BSDXAPTID: Appointment ID in ^BSDXAPPT
|
||||
; BSDXCDT: Checkin Date --> Changed
|
||||
; BSDXCC: Clinic Stop IEN (not used)
|
||||
; BSDXPRV: Provider IEN (not used)
|
||||
; BSDXROU: Print Routing Slip? (not used)
|
||||
; BSDXVCL: PCC+ Clinic IEN (not used)
|
||||
; BSDXVFM: PCC+ Form IEN (not used)
|
||||
; BSDXOG: PCC+ Outguide (true or false) (not used)
|
||||
; BSDXOG: PCC+ Outguide (true or false)
|
||||
;
|
||||
; Output:
|
||||
; ADO.net table with 1 column ErrorID, 1 row result
|
||||
; - 0 if all okay
|
||||
; - Another number or text if not
|
||||
;
|
||||
; Error reference:
|
||||
; -1 -> Invalid Appointment ID
|
||||
; -2 -> Invalid Check-in Date
|
||||
; -3 -> Cannot check-in due to Fileman Filer failure
|
||||
; -4 -> Cannot lock ^BSDXAPPT(APPTID)
|
||||
; -10 -> BSDXAPI error
|
||||
; -100 -> Mumps Error
|
||||
;
|
||||
; Turn off SDAM Appointment Events BSDX Protocol Processing
|
||||
|
||||
N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
|
||||
N BSDXNOEV
|
||||
S BSDXNOEV=1 ;Don't execute protocol
|
||||
;
|
||||
; Set min DUZ vars
|
||||
D ^XBKVAR
|
||||
;
|
||||
; $ET
|
||||
N $ET S $ET="G ERROR^BSDX25"
|
||||
;
|
||||
; Test for error trap for Unit Tests
|
||||
I $G(BSDXDIE) N X S X=1/0
|
||||
;
|
||||
N BSDXI S BSDXI=0
|
||||
;
|
||||
S BSDXY=$NAME(^BSDXTMP($J))
|
||||
K @BSDXY
|
||||
;
|
||||
D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
|
||||
S BSDXI=0
|
||||
K ^BSDXTMP($J)
|
||||
S BSDXY="^BSDXTMP("_$J_")"
|
||||
S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
|
||||
;
|
||||
I '+BSDXAPPTID D ERR("-1~Invalid Appointment ID") QUIT
|
||||
I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-1~Invalid Appointment ID") QUIT
|
||||
;
|
||||
; Lock BSDX node, only to synchronize access to the globals.
|
||||
; It's not expected that the error will ever happen as no filing
|
||||
; is supposed to take 5 seconds.
|
||||
L +^BSDXAPPT(BSDXAPPTID):5 E D ERR("-4~Appt record is locked. Please contact technical support.") QUIT
|
||||
;
|
||||
I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q
|
||||
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q
|
||||
; Remove Date formatting v.1.5. Client will send date as FM Date.
|
||||
;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
|
||||
;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
|
||||
S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them
|
||||
I BSDXCDT'>2000000 D ERR("-2~Invalid Check-in Date") QUIT
|
||||
S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them
|
||||
I BSDXCDT=-1 D ERR(70) Q
|
||||
I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
|
||||
;Checkin BSDX APPOINTMENT entry
|
||||
D BSDXCHK(BSDXAPTID,BSDXCDT)
|
||||
S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
|
||||
S BSDXPATID=$P(BSDXNOD,U,5)
|
||||
S BSDXSTART=$P(BSDXNOD,U)
|
||||
;
|
||||
; Some data
|
||||
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) ; Appointment Node
|
||||
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
||||
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Appointment Start Time
|
||||
S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
|
||||
I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q
|
||||
. S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
||||
. S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
|
||||
. I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART)
|
||||
;
|
||||
; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION)
|
||||
N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I")
|
||||
I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist
|
||||
;
|
||||
; Check if we can check-in using BSDXAPI
|
||||
N BSDXERR S BSDXERR=0
|
||||
I BSDXSC1 S BSDXERR=$$CHECKIC1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
|
||||
I BSDXERR D ERR(-10_"~"_$P(BSDXERR,U,2)) QUIT
|
||||
;
|
||||
; Checkin BSDX APPOINTMENT entry
|
||||
; Failure Analysis: If we fail here, no changes were made.
|
||||
N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT)
|
||||
I BSDXERR D ERR("-3~Fileman Filer failed to check-in appt") QUIT
|
||||
;
|
||||
; File check-in using BSDXAPI
|
||||
; Failure Analysis: If we fail here, we need to roll back first check-in.
|
||||
N BSDXERR S BSDXERR=0
|
||||
I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
|
||||
I BSDXERR D QUIT
|
||||
. N % S %=$$BSDXCHK(BSDXAPPTID,"@") ; No Error checking to prevent loop.
|
||||
. D ERR(-10_"~"_$P(BSDXERR,U,2)) ; Send error message to client
|
||||
;
|
||||
L -^BSDXAPPT(BSDXAPPTID)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)="0"_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
Q
|
||||
;
|
||||
BSDXCHK(BSDXAPPTID,BSDXCDT) ; $$ Private Entry Point. File or delete check-in to
|
||||
; BSDX Appointment
|
||||
; Input: BSDXAPPTID -> Appointment ID
|
||||
; BSDXCDT -> Check-in date, or "@" to remove check-in.
|
||||
BSDXCHK(BSDXAPTID,BSDXCDT) ;
|
||||
;
|
||||
; Output: 1^Error for error
|
||||
; 0 for success
|
||||
;
|
||||
Q:$G(BSDXSIMERR1) 1_U_"Simulated Error 1"
|
||||
;
|
||||
N BSDXIENS,BSDXMSG,BSDXFDA ; Filer variables
|
||||
S BSDXIENS=BSDXAPPTID_","
|
||||
S BSDXIENS=BSDXAPTID_","
|
||||
S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
|
||||
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||
Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
|
||||
Q 0
|
||||
Q
|
||||
;
|
||||
RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44
|
||||
; Called by RPC BSDX REMOVE CHECK-IN
|
||||
APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ;
|
||||
;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
|
||||
;at time BSDXSTART
|
||||
S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART)
|
||||
Q
|
||||
;
|
||||
RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
|
||||
; Called by RPC [Fill in later]
|
||||
;
|
||||
; Parameters to pass:
|
||||
; APPTID: IEN in file BSDX APPOINTMENT
|
||||
|
|
@ -146,9 +127,7 @@ RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44
|
|||
; -3~DB has corruption. Call Tech Support. (Resource ID doesn't exist in BSDXAPPT)
|
||||
; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
|
||||
; -5~BSDXAPI Error. Message depends on error.
|
||||
; -6~Data Filing Error in BSDXCHK
|
||||
; -7~Lock not acquired
|
||||
; -100~Mumps Error
|
||||
; -20~Mumps Error
|
||||
;
|
||||
N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
|
||||
;
|
||||
|
|
@ -162,56 +141,39 @@ RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44
|
|||
;
|
||||
S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
|
||||
;
|
||||
TSTART (BSDXI):SERIAL ; Perform Autolocking
|
||||
;
|
||||
;;;test
|
||||
I $g(bsdxdie) S X=8/0
|
||||
;;;
|
||||
I $g(bsdxrestart) k bsdxrestart TRESTART
|
||||
;;;test
|
||||
I $G(BSDXDIE) N X S X=8/0
|
||||
;
|
||||
; Check for Appointment ID (passed and exists in file)
|
||||
I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
|
||||
I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
|
||||
;
|
||||
; Lock
|
||||
; Timeout not expected to happen except in error conditions.
|
||||
L +^BSDXAPPT(BSDXAPPTID):5 E D ERR("-7~Appt record is locked. Please contact technical support.") QUIT
|
||||
;
|
||||
; Get appointment Data
|
||||
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
|
||||
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
||||
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
|
||||
N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID
|
||||
;
|
||||
; If the resource doesn't exist, error out. DB is corrupt.
|
||||
I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT
|
||||
I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT
|
||||
;
|
||||
; Get HL Data
|
||||
N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node
|
||||
N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN
|
||||
I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist
|
||||
;
|
||||
; Is it okay to remove check-in from PIMS?
|
||||
N BSDXERR S BSDXERR=0 ; Scratch variable
|
||||
; $$RMCICK = Remove Check-in Check
|
||||
I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
|
||||
I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT
|
||||
;
|
||||
; For possible rollback, get old check-in date (internal value)
|
||||
N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I")
|
||||
;
|
||||
; Remove checkin from BSDX APPOINTMENT entry
|
||||
; No need to rollback here on failure.
|
||||
N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@")
|
||||
I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT
|
||||
D BSDXCHK(BSDXAPPTID,"@")
|
||||
;
|
||||
; Now, remove checkin from PIMS files 2/44
|
||||
; Restore BSDXCDT into ^BSDXAPPT if we fail.
|
||||
N BSDXERR S BSDXERR=0 ; Scratch variable to hold error message
|
||||
I BSDXSC1 S BSDXERR=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
|
||||
I BSDXERR D QUIT
|
||||
. N % S %=$$BSDXCHK(BSDXAPPTID,BSDXCDT) ; No error checking here.
|
||||
. D ERR("-5~"_$P(BSDXERR,U,2)) ; Send error message to client
|
||||
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
|
||||
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
||||
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
|
||||
N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID
|
||||
;
|
||||
; If the resource doesn't exist, error out. DB is corrupt.
|
||||
I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT
|
||||
I '$D(^BSDXRES(BSDXSC1,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT
|
||||
;
|
||||
; Unlock
|
||||
L -^BSDXAPPT(BSDXAPPTID)
|
||||
N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node
|
||||
S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
|
||||
;
|
||||
N BSDXZ ; Scratch variable to hold error message
|
||||
I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
|
||||
I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT
|
||||
;
|
||||
TCOMMIT ; Save Data into Globals
|
||||
;
|
||||
; Return ADO recordset
|
||||
S BSDXI=BSDXI+1
|
||||
|
|
@ -245,11 +207,9 @@ CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
|
|||
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
|
||||
. N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
|
||||
. S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
|
||||
. I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
|
||||
I BSDXFOUND,+$G(BSDXAPPT) D
|
||||
. N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT)
|
||||
. I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort
|
||||
I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT)
|
||||
Q BSDXFOUND
|
||||
;
|
||||
CHKEVT3(BSDXRES) ;
|
||||
|
|
@ -264,23 +224,16 @@ CHKEVT3(BSDXRES) ;
|
|||
;
|
||||
ERROR ;
|
||||
S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise
|
||||
D ^%ZTER
|
||||
; VEN/SMH: NB: I make a conscious decision not to roll back anything
|
||||
; here in the error trap. Once the error is fixed, users can
|
||||
; undo or redo the check-in.
|
||||
; Individual portions of this routine may choose to do rolling back
|
||||
; of their own (e.g. a failed call to BSDXAPI causes rollback to occur
|
||||
; in CHECKIN and RMCI)
|
||||
;
|
||||
; Log error message and send to client
|
||||
D ERR("-100~Mumps Error")
|
||||
Q:$Q "-100^Mumps Error" Q
|
||||
; 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
|
||||
D ERR("-20~Mumps Error")
|
||||
Q
|
||||
;
|
||||
ERR(BSDXERR) ;Error processing
|
||||
; Unlock first
|
||||
L:$D(BSDXAPPTID) -^BSDXAPPT(BSDXAPPTID)
|
||||
; If last line is $C(31), we are done. No more errors to send to client.
|
||||
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||
I $TLEVEL>0 TROLLBACK
|
||||
S BSDXERR=$G(BSDXERR)
|
||||
S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
|
||||
S BSDXI=$G(BSDXI)+1
|
||||
|
|
|
|||
249
m/BSDX26.m
249
m/BSDX26.m
|
|
@ -1,124 +1,133 @@
|
|||
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
; Licensed under LGPL
|
||||
; Change History:
|
||||
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
|
||||
; 3101205 - UJO/SMH - Extensive refactoring.
|
||||
; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1
|
||||
;
|
||||
; Error Reference:
|
||||
; 1: Appt ID is not a number
|
||||
; 2: Appt IEN is not in ^BSDXAPPT
|
||||
; 3: FM Failure to file WP field in ^BSDXAPPT
|
||||
; 4: BSDXAPI reports failure to change note field in ^SC
|
||||
; 5: Failure to acquire lock on ^BSDXAPPT(APPTID)
|
||||
; 100: Mumps Error
|
||||
;
|
||||
; NB: Normally I use negative numbers for errors; this routine returns
|
||||
; -1 as a successful result! So I needed to use +ve numbers.
|
||||
;
|
||||
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
; Change History:
|
||||
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
|
||||
; --> Thanks to Zach Gonzalez and Rick Marshall
|
||||
; 3101205 - UJO/SMH - Extensive refactoring.
|
||||
;
|
||||
; Error Reference:
|
||||
; -1: Appt ID is not a number
|
||||
; -2: Appt IEN is not in ^BSDXAPPT
|
||||
; -3: FM Failure to file WP field in ^BSDXAPPT
|
||||
;
|
||||
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
|
||||
;Entry point for debugging
|
||||
;
|
||||
;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
|
||||
Q
|
||||
;Entry point for debugging
|
||||
;
|
||||
D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
|
||||
Q
|
||||
UT ; Unit Tests
|
||||
; Test 1: Make sure this damn thing works
|
||||
N ZZZ
|
||||
N %H S %H=$H
|
||||
N NOTE S NOTE="New Note "_%H
|
||||
D EDITAPT(.ZZZ,188,NOTE)
|
||||
I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B
|
||||
; Test 2: Test Errors -1 and -2
|
||||
N ZZZ
|
||||
N NOTE S NOTE="Nothing important"
|
||||
D EDITAPT(.ZZZ,"BLAHBLAH",NOTE)
|
||||
I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B
|
||||
D EDITAPT(.ZZZ,298734322,NOTE)
|
||||
I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B
|
||||
; Test 4: M Error
|
||||
N bsdxdie S bsdxdie=1
|
||||
D EDITAPT(.ZZZ,188,NOTE)
|
||||
I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B
|
||||
k bsdxdie
|
||||
; Test 5: Trestart
|
||||
N bsdxrestart S bsdxrestart=1
|
||||
N %H S %H=$H
|
||||
N NOTE S NOTE="New Note "_%H
|
||||
D EDITAPT(.ZZZ,188,NOTE)
|
||||
I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B
|
||||
; Test 6: for Hosp Location Update
|
||||
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+.001,3,"Dr Office",30,"Old Note",1)
|
||||
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
D EDITAPT(.ZZZ,APPID,"New Note")
|
||||
I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B
|
||||
I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B
|
||||
QUIT
|
||||
;
|
||||
EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited)
|
||||
; Called by RPC: BSDX EDIT APPOINTMENT
|
||||
;
|
||||
; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
|
||||
;
|
||||
; Parameters:
|
||||
; - BSDXY: Global Return (RPC must be set to Global Array)
|
||||
; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
|
||||
; - BSDXNOTE: New note
|
||||
;
|
||||
; Return:
|
||||
; ADO.net Recordset having 1 field: ERRORID
|
||||
; If Okay: -1; otherwise, positive integer with message
|
||||
;
|
||||
; Return Array; set Return and clear array
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
K ^BSDXTMP($J)
|
||||
; ET
|
||||
N $ET S $ET="G ETRAP^BSDX26"
|
||||
; Set up basic DUZ variables
|
||||
D ^XBKVAR
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
; Header Node
|
||||
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
|
||||
;
|
||||
;;;test for error. See if %ZTER works
|
||||
I $G(BSDXDIE) S X=1/0
|
||||
;
|
||||
; Validate Appointment ID
|
||||
I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT
|
||||
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT
|
||||
;
|
||||
; Lock BSDX node, only to synchronize access to the globals.
|
||||
; It's not expected that the error will ever happen as no filing
|
||||
; is supposed to take 5 seconds.
|
||||
L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") QUIT
|
||||
;
|
||||
; Put the WP in decendant fields from the root to file as a WP field
|
||||
S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
||||
;
|
||||
N BSDXMSG ; Message in case of error in filing.
|
||||
;
|
||||
; Save Before State in case we need it for rollback
|
||||
K ^TMP($J)
|
||||
M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID)
|
||||
;
|
||||
; Update note in BSDX APPOINTMENT
|
||||
I $D(BSDXNOTE(.5)) D
|
||||
. D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||
;
|
||||
; Error handling. No need for rollback since nothing else changed.
|
||||
I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
|
||||
;
|
||||
; Now file in file 44:
|
||||
N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
|
||||
N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
|
||||
N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
|
||||
N BSDXRES S BSDXRES=0 ; Result
|
||||
; Update Note only if we have a linked hospital location.
|
||||
I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
|
||||
; If we get an error (denoted by -1 in BSDXRES), return error to client
|
||||
; AND restore the original note
|
||||
I BSDXRES D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
|
||||
;
|
||||
;Return Recordset indicating success
|
||||
L -^BSDXAPPT(BSDXAPTID)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
;
|
||||
K ^TMP($J) ; Done; remove TMP data
|
||||
QUIT
|
||||
;
|
||||
ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
|
||||
M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
|
||||
K ^TMP($J)
|
||||
QUIT
|
||||
;
|
||||
; Called by RPC: BSDX EDIT APPOINTMENT
|
||||
;
|
||||
; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
|
||||
;
|
||||
; Parameters:
|
||||
; - BSDXY: Global Return (RPC must be set to Global Array)
|
||||
; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
|
||||
; - BSDXNOTE: New note
|
||||
;
|
||||
; Return:
|
||||
; ADO.net Recordset having 1 field: ERRORID
|
||||
; If Okay: -1; otherwise, positive integer with message
|
||||
;
|
||||
; Return Array; set Return and clear array
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
K ^BSDXTMP($J)
|
||||
; ET
|
||||
N $ET S $ET="G ETRAP^BSDX26"
|
||||
; Set up basic DUZ variables
|
||||
D ^XBKVAR
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
; Header Node
|
||||
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
|
||||
; Restartable txn for GT.M. Restored vars are Params + BSDXI.
|
||||
TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26"
|
||||
;
|
||||
;;;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
|
||||
;
|
||||
; Validate Appointment ID
|
||||
I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
|
||||
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
|
||||
; Put the WP in decendant fields from the root to file as a WP field
|
||||
S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
||||
N BSDXMSG ; Message in case of error in filing.
|
||||
I $D(BSDXNOTE(.5)) D
|
||||
. D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||
I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
|
||||
;
|
||||
; Now file in file 44:
|
||||
N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
|
||||
N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
|
||||
N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
|
||||
N BSDXRES S BSDXRES=0 ; Result
|
||||
; Update Note only if we have a linked hospital location.
|
||||
I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
|
||||
; If we get an error (denoted by -1 in BSDXRES), return error to client
|
||||
I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT
|
||||
;Return Recordset
|
||||
TCOMMIT
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
QUIT
|
||||
;
|
||||
ERR(BSDXI,BSDXERR) ;Error processing
|
||||
; Unlock first
|
||||
L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
|
||||
; If last line is $C(31), we are done. No more errors to send to client.
|
||||
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
QUIT
|
||||
;
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
I $TL>0 TROLLBACK
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXERR_$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
|
||||
D ^%ZTER
|
||||
;
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
|
||||
QUIT
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
I $TL>0 TROLLBACK
|
||||
D ^%ZTER
|
||||
S $EC=""
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
|
||||
Q
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log: July 15, 2010
|
||||
|
|
|
|||
41
m/BSDX28.m
41
m/BSDX28.m
|
|
@ -1,5 +1,5 @@
|
|||
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:57am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
; Change Log:
|
||||
; HMW 3050721 Added test for inactivated record
|
||||
|
|
@ -37,23 +37,23 @@ DFN ;If DFN is passed as `nnnn, just return that patient
|
|||
. N DOB S DOB=$$FMTE^XLFDT($P(^DPT(BSDXIEN,0),U,3))
|
||||
. S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30)
|
||||
PID ;PID Lookup
|
||||
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
|
||||
; won't work anyways.
|
||||
I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
|
||||
. S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
|
||||
. Q:'$D(^DPT(BSDXIEN,0))
|
||||
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
||||
. S BSDXZ=$P(BSDXDPT,U) ;NAME
|
||||
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
||||
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
||||
. ; Inactivated Chart get an *
|
||||
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
|
||||
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
|
||||
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
||||
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
||||
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
||||
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
||||
. S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
||||
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
|
||||
; won't work anyways.
|
||||
I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
|
||||
. S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
|
||||
. Q:'$D(^DPT(BSDXIEN,0))
|
||||
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
||||
. S BSDXZ=$P(BSDXDPT,U) ;NAME
|
||||
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
||||
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
||||
. ; Inactivated Chart get an *
|
||||
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
|
||||
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
|
||||
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
||||
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
||||
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
||||
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
||||
. S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
||||
;
|
||||
DOB ;DOB Lookup
|
||||
I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D S BSDXY=BSDXRET_$C(31) Q
|
||||
|
|
@ -75,7 +75,8 @@ DOB ;DOB Lookup
|
|||
. . Q
|
||||
. Q
|
||||
;
|
||||
CHART ;Chart# Lookup
|
||||
CHART
|
||||
;Chart# Lookup
|
||||
I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
|
||||
. S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q
|
||||
. . Q:'$D(^DPT(BSDXIEN,0))
|
||||
|
|
|
|||
112
m/BSDX29.m
112
m/BSDX29.m
|
|
@ -1,5 +1,5 @@
|
|||
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
@ -7,15 +7,13 @@ BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
|
|||
; - Beginning and Ending dates passed as FM Dates
|
||||
; v1.42 by WV/SMH on 3101023
|
||||
; - Transaction moved; now restartable too.
|
||||
; --> Thanks to Zach Gonzalez and Rick Marshall.
|
||||
; - Refactoring of major portions of routine
|
||||
; v1.7 by VEN/SMH on 3120622
|
||||
; - Removed transaction code; Locks added in update to prevent concurrent
|
||||
; update
|
||||
;
|
||||
BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
||||
;Entry point for debugging
|
||||
;
|
||||
;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
|
||||
D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
|
||||
Q
|
||||
;
|
||||
BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
||||
|
|
@ -23,33 +21,33 @@ BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
|||
;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
|
||||
;Called by RPC: BSDX COPY APPOINTMENTS
|
||||
;
|
||||
; Parameters:
|
||||
; - BSDXY: Global Return
|
||||
; - BSDXRES: BSDX RESOURCE to copy appointments to
|
||||
; - BSDX44: Hospital Location IEN to copy appointments from
|
||||
; - BSDXBEG: Beginning Date in FM Format
|
||||
; - BSDXEND: End Date in FM Format
|
||||
;
|
||||
; Parameters:
|
||||
; - BSDXY: Global Return
|
||||
; - BSDXRES: BSDX RESOURCE to copy appointments to
|
||||
; - BSDX44: Hospital Location IEN to copy appointments from
|
||||
; - BSDXBEG: Beginning Date in FM Format
|
||||
; - BSDXEND: End Date in FM Format
|
||||
;
|
||||
;Returns ADO Recordset containing TASK_NUMBER and ERRORID
|
||||
;
|
||||
; Return Array
|
||||
; Return Array
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
K ^BSDXTMP($J)
|
||||
; $ET
|
||||
N $ET S $ET="G ETRAP^BSDX29"
|
||||
K ^BSDXTMP($J)
|
||||
; $ET
|
||||
N $ET S $ET="G ETRAP^BSDX29"
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
; Header Node
|
||||
N BSDXI S BSDXI=0
|
||||
; Header Node
|
||||
S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
|
||||
;
|
||||
; Make dates inclusive; add 1 to FM dates
|
||||
S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1)
|
||||
S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1)
|
||||
; Make dates inclusive; add 1 to FM dates
|
||||
S BSDXBEG=BSDXBEG-1
|
||||
S BSDXEND=BSDXEND+1
|
||||
;
|
||||
; Taskman variables
|
||||
N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO
|
||||
; Taskman variables
|
||||
N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
|
||||
; Task Load
|
||||
S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO=""
|
||||
S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
|
||||
S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
|
||||
D ^%ZTLOAD
|
||||
; Set up return ADO.net dataset
|
||||
|
|
@ -63,44 +61,49 @@ ZTMD ;EP - Debug entry point
|
|||
Q
|
||||
;
|
||||
ZTM ;EP - Taskman entry point
|
||||
; Variables set up in ZTSAVE above
|
||||
;
|
||||
; Variables set up in ZTSAVE above
|
||||
;
|
||||
Q:'$D(ZTSK)
|
||||
;
|
||||
; $ET
|
||||
N $ET S $ET="G ZTMERR^BSDX29"
|
||||
;
|
||||
; $ET
|
||||
N $ET S $ET="G ZTMERR^BSDX29"
|
||||
; Txn
|
||||
TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
|
||||
;$O through ^SC(BSDX44,"S",
|
||||
N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments
|
||||
N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc
|
||||
N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc
|
||||
; Set Count
|
||||
S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
|
||||
S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
|
||||
; Loop through dates here.
|
||||
F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D
|
||||
. ; Loop through Entries in each date in the subsubfile.
|
||||
. ; Quit if we are at the end or if a remote process requests a quit.
|
||||
. N BSDXIEN S BSDXIEN=0
|
||||
F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D
|
||||
. ; Loop through Entries in each date in the subsubfile.
|
||||
. ; Quit if we are at the end or if a remote process requests a quit.
|
||||
. N BSDXIEN S BSDXIEN=0
|
||||
. F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D
|
||||
. . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
|
||||
. . Q:'+BSDXNOD ; Quit if no node
|
||||
. . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
|
||||
. . Q:BSDXCAN="C" ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 44
|
||||
. . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
|
||||
. . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
|
||||
. . Q:BSDXCAN="C" ; Quit if appt cancelled
|
||||
. . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
|
||||
. . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
|
||||
. . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
|
||||
. . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
|
||||
. . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
|
||||
. . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
|
||||
. . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record
|
||||
. . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7)
|
||||
;
|
||||
;
|
||||
. . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag
|
||||
. . Q
|
||||
. Q
|
||||
I 'BSDXQUIT TCOMMIT
|
||||
E TROLLBACK
|
||||
S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.")
|
||||
Q
|
||||
;
|
||||
ZTMERR ; For now, error from TM is only in trap; not returned to client.
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
; Rollback before logging the error
|
||||
I $TL>0 TROLLBACK
|
||||
D ^%ZTER
|
||||
S $EC="" ; Clear Error
|
||||
QUIT
|
||||
;
|
||||
XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
||||
|
|
@ -108,12 +111,8 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
|||
;Copy record to BSDX APPOINTMENT file
|
||||
;Return 1 if record copied, otherwise 0
|
||||
;
|
||||
N REF
|
||||
S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique
|
||||
L +@REF:0 E Q 0
|
||||
;
|
||||
;$O Thru ^BSDXAPPT to determine if this appt already added
|
||||
N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD
|
||||
N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2
|
||||
S BSDXIEN=0,BSDXFND=0
|
||||
F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
|
||||
. S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
|
||||
|
|
@ -122,13 +121,12 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
|||
. S BSDXFND=0
|
||||
. I BSDXPAT2=BSDXPAT S BSDXFND=1
|
||||
. Q
|
||||
I BSDXFND L -@REF Q 0
|
||||
Q:BSDXFND 0
|
||||
;
|
||||
;Add to BSDX APPOINTMENT
|
||||
S BSDXEND=BSDXBEG
|
||||
;Calculate ending time from beginning time and duration.
|
||||
S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
|
||||
N BSDXFDA,BSDXIENS
|
||||
S BSDXIENS="+1,"
|
||||
S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
|
||||
S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
|
||||
|
|
@ -138,23 +136,19 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
|||
S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
|
||||
;
|
||||
K BSDXIEN
|
||||
;
|
||||
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
||||
S BSDXIEN=+$G(BSDXIEN(1))
|
||||
I '+BSDXIEN L -@REF Q 0
|
||||
I '+BSDXIEN Q 0
|
||||
;
|
||||
;Add WP field
|
||||
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
|
||||
. D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
|
||||
L -@REF
|
||||
;
|
||||
Q 1
|
||||
;
|
||||
ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
|
||||
; If last line is $C(31), we are done. No more errors to send to client.
|
||||
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
|
|
@ -162,9 +156,9 @@ ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
|
|||
;
|
||||
ETRAP ;EP Error trap entry
|
||||
; No Txn here. So don't rollback anything
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
D ^%ZTER
|
||||
S $EC="" ; Clear error
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
D ^%ZTER
|
||||
S $EC="" ; Clear error
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
|
||||
Q
|
||||
|
|
|
|||
12
m/BSDX2E.m
12
m/BSDX2E.m
|
|
@ -1,5 +1,5 @@
|
|||
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/11/12 9:37am]
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [4/28/11 10:28am]
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
S LINE="",$P(LINE,"*",81)=""
|
||||
|
|
@ -23,7 +23,7 @@ VERSION ;
|
|||
;Is the PIMS requirement present?
|
||||
Q:'$$VERCHK("SD",5.3)
|
||||
; Q:'$$PATCHCK("PIMS*5.3*1003") D
|
||||
Q:'$$VERCHK("BMX",4)
|
||||
Q:'$$VERCHK("BMX",2)
|
||||
;
|
||||
OTHER ;
|
||||
;Other checks
|
||||
|
|
@ -90,7 +90,7 @@ V0200 ;EP Version 1.5 PostInit
|
|||
. S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
|
||||
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
||||
. ; Error message
|
||||
. I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
|
||||
. I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
|
||||
;
|
||||
; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
|
||||
; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
|
||||
|
|
@ -105,7 +105,7 @@ V0200 ;EP Version 1.5 PostInit
|
|||
S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
|
||||
D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||
; If error
|
||||
I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
|
||||
I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
|
||||
;
|
||||
;
|
||||
; Now put in the default values for parameters
|
||||
|
|
@ -116,7 +116,7 @@ V0200 ;EP Version 1.5 PostInit
|
|||
D PUT^XPAR("PKG","BSDX AUTO PRINT RS",1,0,.BSDXERR)
|
||||
I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
|
||||
D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR)
|
||||
I $G(BSDXERR) D MES^XPDUTL("Error: ",BSDXERR)
|
||||
I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
|
||||
QUIT
|
||||
;
|
||||
SORRY(XPX) ;
|
||||
|
|
|
|||
27
m/BSDX30.m
27
m/BSDX30.m
|
|
@ -1,12 +1,12 @@
|
|||
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [7/6/12 11:03am]
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [4/28/11 10:28am]
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP
|
||||
;Entry point for debugging
|
||||
;
|
||||
; D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
|
||||
D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
|
||||
Q
|
||||
;
|
||||
SPACE(BSDXY,BSDXDIC,BSDXVAL) ;EP
|
||||
|
|
@ -48,7 +48,7 @@ ETRAP ;EP Error trap entry
|
|||
;
|
||||
EHRPTD(BSDXY,BSDXWID,BSDXDFN) ;
|
||||
;
|
||||
; D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
|
||||
D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
|
||||
Q
|
||||
;
|
||||
EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
|
||||
|
|
@ -69,9 +69,6 @@ EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
|
|||
Q
|
||||
;
|
||||
PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR
|
||||
; VEN/SMH v1.7 3120706 - Not used in VISTA.
|
||||
; No way right now to synchronize with CPRS.
|
||||
; Code commented out for now.
|
||||
;
|
||||
;Change patient context to patient DFN
|
||||
;on all EHR client sessions associated with user DUZ
|
||||
|
|
@ -80,14 +77,14 @@ PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR
|
|||
;If BSDXWID is "", the context change is sent to
|
||||
;all EHR client sessions belonging to user DUZ.
|
||||
;
|
||||
;Q:'$G(DUZ)
|
||||
Q:'$G(DUZ)
|
||||
;N X
|
||||
;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T
|
||||
;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T
|
||||
;N UID,BRET
|
||||
;S BRET=0,UID=0
|
||||
;F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D
|
||||
;. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
|
||||
;. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
;. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
|
||||
;Q
|
||||
N UID,BRET
|
||||
S BRET=0,UID=0
|
||||
F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D
|
||||
. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
|
||||
. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
|
||||
Q
|
||||
|
|
|
|||
416
m/BSDX31.m
416
m/BSDX31.m
|
|
@ -1,212 +1,220 @@
|
|||
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:39am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;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
|
||||
; - BSDXNOS deletes no-show rather than file 0 for
|
||||
; undoing a no show
|
||||
;
|
||||
; 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
|
||||
; -7: Lock not acquired on ^BSDXAPPT(BSDXAPTID)
|
||||
; -100: M Error
|
||||
;
|
||||
;
|
||||
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; 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
|
||||
;
|
||||
;
|
||||
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
|
||||
;Entry point for debugging
|
||||
;
|
||||
; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
|
||||
Q
|
||||
;
|
||||
;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
|
||||
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)
|
||||
;
|
||||
;;;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
|
||||
;
|
||||
; Lock BSDX node, only to synchronize access to the globals.
|
||||
; It's not expected that the error will ever happen as no filing
|
||||
; is supposed to take 5 seconds.
|
||||
L +^BSDXAPPT(BSDXAPTID):5 E D ERR(-7,"BSDX31: Appt record is locked. Please contact technical support.") Q
|
||||
;
|
||||
; Noshow value check - Must be 1 or 0
|
||||
S BSDXNS=+BSDXNS
|
||||
I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
|
||||
;
|
||||
; 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 BSDXLOC,'$D(^SC(BSDXLOC,0)) S BSDXLOC="" ; Unlink it if it doesn't exist
|
||||
; I can go and then delete it from ^BSDXRES like Mailman code which tries
|
||||
; to be too helpful... but I will postpone that until this is a need.
|
||||
;
|
||||
; Check if it's okay to no-show patient.
|
||||
N BSDXERR S BSDXERR=0 ; Error variable
|
||||
I BSDXLOC S BSDXERR=$$NOSHOWCK^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS)
|
||||
I BSDXERR D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT
|
||||
;
|
||||
; Simulated Error
|
||||
I $G(BSDXSIMERR1) D ERR(-4,"BSDX31: Simulated Error") QUIT
|
||||
; Edit BSDX APPOINTMENT entry No-show field
|
||||
; Failure Analysis: If we fail here, no rollback needed, as this is the 1st
|
||||
; call
|
||||
N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS)
|
||||
I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT
|
||||
;
|
||||
; Edit File 2 "S" node entry
|
||||
; Failure Analysis: If we fail here, we need to rollback the BSDX
|
||||
; Apptointment Entry
|
||||
N BSDXERR S BSDXERR=0 ; 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 QUIT
|
||||
. D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2))
|
||||
. N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; no error checking for filer
|
||||
;
|
||||
; Unlock
|
||||
L -^BSDXAPPT(BSDXAPTID)
|
||||
;
|
||||
; Return data in ADO.net table
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
QUIT
|
||||
;
|
||||
BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT
|
||||
; in v1.7 I delete the no-show value rather than file zero
|
||||
N BSDXFDA,BSDXIENS,BSDXMSG
|
||||
N BSDXVALUE ; What to file: 1 or delete it.
|
||||
I BSDXNS S BSDXVALUE=1
|
||||
E S BSDXVALUE="@"
|
||||
S BSDXIENS=BSDXAPTID_","
|
||||
S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXVALUE ;NOSHOW 1 or 0
|
||||
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||
QUIT:$D(BSDXMSG) -1_U_BSDXMSG("DIERR",1,"TEXT",1)
|
||||
QUIT 0
|
||||
;
|
||||
; 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
|
||||
;
|
||||
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,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
|
||||
;
|
||||
;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
|
||||
;
|
||||
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
|
||||
; Unlock first
|
||||
L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
|
||||
; If last line is $C(31), we are done. No more errors to send to client.
|
||||
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||
S BSDXI=BSDXI+1
|
||||
S ERRTXT=$TR(ERRTXT,"^","~")
|
||||
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,"^","~")
|
||||
I $TL>0 TROLLBACK
|
||||
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
|
||||
D ^%ZTER
|
||||
;
|
||||
; Send to client
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
|
||||
Q:$Q 100_U_"Mumps Error" Q
|
||||
;
|
||||
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
|
||||
;
|
||||
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
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
; Mods by WV/STAR
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/21/12 3:57pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
|
|||
416
m/BSDXAPI.m
416
m/BSDXAPI.m
|
|
@ -1,18 +1,43 @@
|
|||
BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/10/12 5:58pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
|
||||
; mods (many) by WV/SMH
|
||||
; Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
|
||||
; Change history is located in BSDXAPI1 (to save space).
|
||||
;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: (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: (1.42)
|
||||
; - 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)
|
||||
; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
|
||||
; 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.
|
||||
; 2011-01-26 (v.1.5)
|
||||
; More user friendly message if patient already has appointment in $$MAKE:
|
||||
; Spits out pt name and user friendly date.
|
||||
;
|
||||
;
|
||||
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
|
||||
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
|
||||
; for Baby foxes hallucinations.
|
||||
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
|
||||
N BSDR
|
||||
S BSDR("PAT")=DFN ;DFN
|
||||
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
||||
S BSDR("TYP")=TYP ;3 sched or 4 walkin
|
||||
|
|
@ -39,15 +64,35 @@ MAKE(BSDR) ;PEP; call to store appt made
|
|||
; = 0 or null: everything okay
|
||||
; = 1^message: error and reason
|
||||
;
|
||||
N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment
|
||||
I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why.
|
||||
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("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"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
|
||||
;
|
||||
;Otherwise, we continue
|
||||
;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"))
|
||||
;I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") ; v.1.5 more user friendly err msg
|
||||
;
|
||||
N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables
|
||||
; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
|
||||
N BSDXERR ; place to store error message
|
||||
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO QUIT BSDXERR ; If there's an appt in the "S" node of file 2 and it's not cancelled
|
||||
. S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
|
||||
. S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
|
||||
. N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U) ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2)
|
||||
. N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
|
||||
. S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
|
||||
. I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file)
|
||||
. . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
|
||||
. . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt
|
||||
. . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
|
||||
. . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
|
||||
;
|
||||
NEW DIC,DA,Y,X,DD,DO,DLAYGO
|
||||
;
|
||||
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
|
||||
. ; "un-cancel" existing appt in file 2
|
||||
. N BSDXFDA,BSDXIENS,BSDXMSG
|
||||
. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
|
||||
. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
|
||||
. S BSDXFDA(2.98,BSDXIENS,"3")=""
|
||||
|
|
@ -56,37 +101,27 @@ MAKE(BSDR) ;PEP; call to store appt made
|
|||
. S BSDXFDA(2.98,BSDXIENS,"14")=""
|
||||
. S BSDXFDA(2.98,BSDXIENS,"15")=""
|
||||
. S BSDXFDA(2.98,BSDXIENS,"16")=""
|
||||
. S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over
|
||||
. S BSDXFDA(2.98,BSDXIENS,"19")=""
|
||||
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
|
||||
. D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||
Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
|
||||
;
|
||||
Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line
|
||||
;
|
||||
E D ; File new appointment/edit existing appointment in file 2
|
||||
. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
|
||||
E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
|
||||
. N BSDXFDA,BSDXIENS,BSDXMSG
|
||||
. S BSDXIENS="?+2,"_BSDR("PAT")_","
|
||||
. S BSDXIENS(2)=BSDR("ADT")
|
||||
. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
|
||||
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
|
||||
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
|
||||
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
|
||||
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG")
|
||||
Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
|
||||
;
|
||||
Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line
|
||||
;
|
||||
; add appt to file 44. This adds it to the FIRST subfile (Appointment)
|
||||
N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM
|
||||
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
|
||||
; add appt to file 44
|
||||
K DIC,DA,X,Y,DLAYGO,DD,DO
|
||||
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
|
||||
I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
|
||||
. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
|
||||
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
|
||||
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
|
||||
;
|
||||
Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line
|
||||
;
|
||||
; add appt for file 44, second subfile (Appointment/Patient)
|
||||
; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
|
||||
;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
|
||||
;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||
|
|
@ -107,12 +142,6 @@ MAKE(BSDR) ;PEP; call to store appt made
|
|||
;
|
||||
I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
|
||||
;
|
||||
;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line
|
||||
S:$G(BSDXSIMERR5) X=1/0
|
||||
;
|
||||
; Update the Availablilities ; Doesn't fail. Global reads and sets.
|
||||
D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN"),BSDR("PAT"))
|
||||
;
|
||||
; call event driver
|
||||
NEW DFN,SDT,SDCL,SDDA,SDMODE
|
||||
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
|
||||
|
|
@ -120,67 +149,10 @@ MAKE(BSDR) ;PEP; call to store appt made
|
|||
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
|
||||
Q 0
|
||||
;
|
||||
MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP
|
||||
; Input: Same as $$MAKE
|
||||
; Output: 1^error or 0 for success
|
||||
; NB: This subroutine saves no data. Only checks whether it's okay.
|
||||
;
|
||||
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("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"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
|
||||
;
|
||||
; Appt Length check removed in v 1.5
|
||||
;
|
||||
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
|
||||
; More verbose error message in v1.5
|
||||
; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
|
||||
N BSDXERR ; place to store error message
|
||||
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO QUIT BSDXERR ; If there's an appt in the "S" node of file 2 and it's not cancelled
|
||||
. S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
|
||||
. S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
|
||||
. N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U) ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2)
|
||||
. N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
|
||||
. S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
|
||||
. I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file)
|
||||
. . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
|
||||
. . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt
|
||||
. . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
|
||||
. . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
|
||||
Q 0
|
||||
;
|
||||
UNMAKE(BSDR) ; Reverse Make - Private $$
|
||||
; Only used in Emergiencies where Fileman data filing fails.
|
||||
; If previous data exists, which caused an error, it's destroyed.
|
||||
; NB: ^DIK stops for nobody
|
||||
; NB: If Patient Appointment previously existed as cancelled, it's removed.
|
||||
; How can I tell if one previously existed when data is in an intermediate
|
||||
; State? Can I restore it if the other file failed? Restoration can cause
|
||||
; another error. If I restore the global, there will be cross-references
|
||||
; missing (ASDCN specifically).
|
||||
;
|
||||
; Input: Same array as $$MAKE
|
||||
; Output: Always 0
|
||||
NEW DIK,DA
|
||||
S DIK="^DPT("_BSDR("PAT")_",""S"","
|
||||
S DA(1)=BSDR("PAT"),DA=BSDR("ADT")
|
||||
D ^DIK
|
||||
;
|
||||
N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
I 'IEN QUIT 0
|
||||
;
|
||||
NEW DIK,DA
|
||||
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
|
||||
D ^DIK
|
||||
QUIT 0
|
||||
;
|
||||
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
|
||||
; Call like this for DFN 23435 checking in now at Hospital Location 33
|
||||
; for appt at Dec 20, 2009 @ 10:11:59
|
||||
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
|
||||
N BSDR
|
||||
S BSDR("PAT")=DFN ;DFN
|
||||
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
||||
S BSDR("ADT")=APDATE ;Appt Date
|
||||
|
|
@ -203,70 +175,6 @@ CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PAT
|
|||
; = 0 means everything worked
|
||||
; = 1^message means error with reason message
|
||||
;
|
||||
I $G(BSDXDIE2) N X S X=1/0
|
||||
;
|
||||
N BSDXERR S BSDXERR=$$CHECKICK(.BSDR)
|
||||
I BSDXERR Q BSDXERR
|
||||
;
|
||||
; find ien for appt in file 44
|
||||
NEW IEN,DIE,DA,DR
|
||||
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
;
|
||||
; remember before status
|
||||
; Failure analysis: Only ^TMP global is set here.
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
|
||||
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
|
||||
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
||||
;
|
||||
; set checkin; Old Code -- keep for ref VEN/SMH 3 Jul 2012
|
||||
; S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||
; S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
|
||||
; S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
|
||||
; D ^DIE
|
||||
;
|
||||
I $D(BSDXSIMERR3) Q 1_U_"Simulated Error"
|
||||
;
|
||||
; Failure analysis: If this fails, no other changes were made in this routine
|
||||
N BSDXIENS S BSDXIENS=IEN_","_BSDR("ADT")_","_BSDR("CLN")_","
|
||||
N BSDXFDA
|
||||
S BSDXFDA(44.003,BSDXIENS,309)=BSDR("CDT")
|
||||
S BSDXFDA(44.003,BSDXIENS,302)=BSDR("USR")
|
||||
S BSDXFDA(44.003,BSDXIENS,305)=$$NOW^XLFDT()
|
||||
N BSDXERR
|
||||
D UPDATE^DIE("","BSDXFDA","BSDXERR")
|
||||
;
|
||||
I $D(BSDXERR) Q 1_U_"Error checking in appointment to file 44. Error: "_BSDXERR("DIERR",1,"TEXT",1)
|
||||
;
|
||||
; set after status
|
||||
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
||||
;
|
||||
; Point of no Return
|
||||
; call event driver
|
||||
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
|
||||
Q 0
|
||||
;
|
||||
CHECKIC1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKICK -
|
||||
; Check-in Check
|
||||
; Call like this for DFN 23435 checking in now at Hospital Location 33
|
||||
; for appt at Dec 20, 2009 @ 10:11:59
|
||||
; S RESULT=$$CHECKIC1^BSDXAPI(23435,33,3091220.221159)
|
||||
N BSDR
|
||||
S BSDR("PAT")=DFN ;DFN
|
||||
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
||||
S BSDR("ADT")=APDATE ;Appt Date
|
||||
S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
|
||||
S BSDR("USR")=DUZ ;Check-in user defaults to current
|
||||
Q $$CHECKICK(.BSDR)
|
||||
;
|
||||
CHECKICK(BSDR) ; $$ PEP; - Is it okay to check-in patient?
|
||||
; Input: Same as $$CHECKIN
|
||||
; Output: 0 if okay or 1^message if error
|
||||
;
|
||||
I $G(BSDXSIMERR2) Q 1_U_"Simulated Error"
|
||||
;
|
||||
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
|
||||
|
|
@ -276,8 +184,29 @@ CHECKICK(BSDR) ; $$ PEP; - Is it okay to check-in patient?
|
|||
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
|
||||
N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
NEW IEN,DIE,DA,DR
|
||||
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
|
||||
;
|
||||
; remember before status
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
|
||||
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
|
||||
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
||||
;
|
||||
; set checkin
|
||||
S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
|
||||
S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
|
||||
D ^DIE
|
||||
;
|
||||
; set after status
|
||||
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
||||
;
|
||||
; call event driver
|
||||
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
|
||||
Q 0
|
||||
;
|
||||
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
|
||||
|
|
@ -286,7 +215,6 @@ CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - canc
|
|||
; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
|
||||
; because foxes come out during bad weather.
|
||||
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
|
||||
N BSDR
|
||||
S BSDR("PAT")=DFN
|
||||
S BSDR("CLN")=CLIN
|
||||
S BSDR("TYP")=TYP
|
||||
|
|
@ -315,70 +243,6 @@ CANCEL(BSDR) ;PEP; called to cancel appt
|
|||
; = 0 or null: everything okay
|
||||
; = 1^message: error and reason
|
||||
;
|
||||
; Okay to Cancel? Call Cancel Check.
|
||||
N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR)
|
||||
I BSDXCANCK Q BSDXCANCK
|
||||
;
|
||||
; BSDX 1.5 3110125
|
||||
; UJO/SMH - Add ability to remove check-in if the patient is checked in
|
||||
; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in
|
||||
; Lets you remove appointment anyways! Not like RPMS.
|
||||
; Plus... deleting checkin affects S node on 44, which is DELETED anyways!
|
||||
;
|
||||
; 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)
|
||||
; NB: Here only ^TMP globals are set with before values.
|
||||
;
|
||||
; get user who made appt and date appt made from ^SC
|
||||
; because data in ^SC will be deleted
|
||||
; Appointment Length: ditto
|
||||
NEW USER,DATE
|
||||
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)
|
||||
N BSDXLEN S BSDXLEN=$$APPLEN(DFN,SDCL,SDT) ; appt length
|
||||
;
|
||||
; 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
|
||||
;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
|
||||
;D ^DIE
|
||||
N BSDXIENS S BSDXIENS=SDT_","_DFN_","
|
||||
N BSDXFDA
|
||||
S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP")
|
||||
S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR")
|
||||
S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT")
|
||||
S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR")
|
||||
S BSDXFDA(2.98,BSDXIENS,19)=USER
|
||||
S BSDXFDA(2.98,BSDXIENS,20)=DATE
|
||||
S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160)
|
||||
N BSDXERR
|
||||
D FILE^DIE("","BSDXFDA","BSDXERR")
|
||||
I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2"
|
||||
; Failure point 1: If we fail here, nothing has happened yet.
|
||||
;
|
||||
; delete data in ^SC -- this does not (typically) fail. Fileman won't stop
|
||||
NEW DIK,DA
|
||||
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
|
||||
D ^DIK
|
||||
; Failure point 2: not expected to happen here
|
||||
;
|
||||
; Update PIMS availability -- this doesn't fail. Global gets/sets only.
|
||||
D AVUPDTCN^BSDXAPI1(SDCL,SDT,BSDXLEN)
|
||||
;
|
||||
; call event driver -- point of no return
|
||||
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
|
||||
;
|
||||
Q 0
|
||||
;
|
||||
CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment?
|
||||
; Input: .BSDR array as documented in $$CANCEL
|
||||
; Output: 0 or 1^Error message
|
||||
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("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
|
||||
|
|
@ -389,11 +253,45 @@ CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment?
|
|||
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"))
|
||||
;
|
||||
NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
NEW IEN,DIE,DA,DR
|
||||
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")
|
||||
;
|
||||
; Check-out check. New in v1.7
|
||||
I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!"
|
||||
; 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
|
||||
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)
|
||||
;
|
||||
; get user who made appt and date appt made from ^SC
|
||||
; because data in ^SC will be deleted
|
||||
NEW USER,DATE
|
||||
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
|
||||
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
|
||||
S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
|
||||
D ^DIE
|
||||
;
|
||||
; delete data in ^SC
|
||||
NEW DIK,DA
|
||||
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
|
||||
D ^DIK
|
||||
;
|
||||
; call event driver
|
||||
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
|
||||
Q 0
|
||||
;
|
||||
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
|
||||
|
|
@ -403,12 +301,44 @@ CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
|
|||
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
|
||||
Q $S(X:1,1:0)
|
||||
;
|
||||
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
|
||||
NEW X
|
||||
S X=$G(SDIEN) ;ien sent in call
|
||||
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
|
||||
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
|
||||
Q $S(X:1,1:0)
|
||||
RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
|
||||
; PAT = DFN
|
||||
; CLINIC = SC IEN
|
||||
; DATE = FM Date/Time of Appointment
|
||||
;
|
||||
; Returns:
|
||||
; 0 if okay
|
||||
; -1 if failure
|
||||
;
|
||||
; 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)
|
||||
;
|
||||
; remove check-in using filer.
|
||||
N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
|
||||
S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
|
||||
S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
|
||||
S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
|
||||
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)
|
||||
;
|
||||
; set after status
|
||||
S SDDA=$$SCIEN(DFN,SDCL,SDT)
|
||||
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
||||
;
|
||||
; call event driver
|
||||
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
|
||||
QUIT 0
|
||||
;
|
||||
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
|
||||
NEW X,IEN
|
||||
|
|
@ -417,12 +347,30 @@ SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
|
|||
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
|
||||
Q $G(IEN)
|
||||
;
|
||||
APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length
|
||||
; Get either the appointment length or zero
|
||||
N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE)
|
||||
Q:SCIEN $P(^SC(CLINIC,"S",DATE,1,SCIEN,0),U,2)
|
||||
Q 0
|
||||
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
|
||||
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
|
||||
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
|
||||
;
|
||||
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
|
||||
NEW X
|
||||
S X=$G(SDIEN) ;ien sent in call
|
||||
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
|
||||
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change History (BSDXAPI and BSDXAPI1)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 7/6/12 11:07am
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:31am
|
||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
;
|
||||
|
|
@ -17,7 +17,7 @@ ERR(BSDXERR) ;Error processing
|
|||
;
|
||||
PD(BSDXY,HLIEN) ;EP Debugging entry point
|
||||
;
|
||||
;D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
|
||||
D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
|
||||
;
|
||||
Q
|
||||
;
|
||||
|
|
@ -32,7 +32,7 @@ P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location
|
|||
;
|
||||
S BSDXI=0
|
||||
I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
|
||||
D ^XBKVAR
|
||||
D ^XBKVAR
|
||||
N $ET S $ET="G ERROR^BSDXGPRV"
|
||||
K ^BSDXTMP($J)
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
||||
; Licensed under LGPL
|
||||
;
|
||||
; Change Log:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
||||
;
|
||||
;
|
||||
EN ; Run All Unit Tests in this routine
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 3:18pm
|
||||
;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
||||
;
|
||||
EN ; Run all unit tests in this routine
|
||||
D UT25,PIMS
|
||||
|
|
|
|||
Loading…
Reference in New Issue