Ayman Ghaith : adding the correct routines which not has the transactions.
This commit is contained in:
tariq
parent
231a703ade
commit
dfc37db849
99
m/BSDX01.m
99
m/BSDX01.m
|
|
@ -1,13 +1,15 @@
|
||||||
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:46pm
|
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1/29/13 12:53pm
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 2
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
||||||
;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
|
;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;EHS/WAT;UJOK*1.0*4 ;JAN 24,2013;Update [Updating the SUINFO function by adding a new parameter "USERKEY" that holds the name of the user key].
|
||||||
SUINFO(BSDXY,BSDXDUZ) ;EP
|
;EHS/WAT;UJO*2.0*31 ;JAN 24,2013;Update [Updating the SUINFO function by adding a new parameter "USERKEY" that holds the name of the user key].
|
||||||
|
;SUINFO(BSDXY,BSDXDUZ) ;EP
|
||||||
|
SUINFO(BSDXY,BSDXDUZ,USERKEY) ;EP
|
||||||
;Called by BSDX SCHEDULING USER INFO
|
;Called by BSDX SCHEDULING USER INFO
|
||||||
;Returns ADO Recordset having column MANAGER
|
;Returns ADO Recordset having column MANAGER
|
||||||
;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
|
;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
|
||||||
|
|
@ -20,11 +22,14 @@ SUINFO(BSDXY,BSDXDUZ) ;EP
|
||||||
S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30)
|
S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30)
|
||||||
;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
|
;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
|
||||||
I '+BSDXDUZ S BSDXDUZ=DUZ
|
I '+BSDXDUZ S BSDXDUZ=DUZ
|
||||||
S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
|
;EHS/WAT;UJOK*1.0*4 ;JAN 24,2013; Update [Updating the argument sent to $$APSEC function from hard coded string "BSDXZMGR" to "USERKEY" variable].
|
||||||
|
;EHS/WAT;UJO*2.0*31 ;JAN 24,2013; Update [Updating the argument sent to $$APSEC function from hard coded string "BSDXZMGR" to "USERKEY" variable].
|
||||||
|
;S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ);
|
||||||
|
S BSDXMGR=$$APSEC(USERKEY,BSDXDUZ)
|
||||||
S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
|
S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
|
S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
|
||||||
S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
|
S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
|
||||||
Q
|
Q
|
||||||
DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
||||||
;
|
;
|
||||||
|
|
@ -281,44 +286,43 @@ GP(BSDXY,PARAM) ; Get Param - EP
|
||||||
QUIT
|
QUIT
|
||||||
;
|
;
|
||||||
INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
|
INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
|
||||||
; Input: BSDXSC - Hospital Location IEN
|
; Input: BSDXSC - Hospital Location IEN
|
||||||
; Output: True or False
|
; Output: True or False
|
||||||
I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
|
I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
|
||||||
I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
|
I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
|
||||||
; Jump to Division:Medical Center Division:Inst File Pointer for
|
; Jump to Division:Medical Center Division:Inst File Pointer for
|
||||||
; Institution IEN (and get its internal value)
|
; Institution IEN (and get its internal value)
|
||||||
N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
|
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="" 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
|
I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
|
||||||
E Q 0 ; Otherwise, no
|
E Q 0 ; Otherwise, no
|
||||||
QUIT
|
|
||||||
INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
|
INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
|
||||||
; Input BSDXRES - BSDX RESOURCE IEN
|
; Input BSDXRES - BSDX RESOURCE IEN
|
||||||
; Output: True of False
|
; Output: True of False
|
||||||
Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
|
Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
|
||||||
UnitTestINDIV
|
UTINDIV ; Unit Test $$INDIV
|
||||||
W "Testing if they are the same",!
|
W "Testing if they are the same",!
|
||||||
S DUZ(2)=67
|
S DUZ(2)=67
|
||||||
I '$$INDIV(1) W "ERROR",!
|
I '$$INDIV(1) W "ERROR",!
|
||||||
I '$$INDIV(2) W "ERROR",!
|
I '$$INDIV(2) W "ERROR",!
|
||||||
W "Testing if Div not defined in 44, should be true",!
|
W "Testing if Div not defined in 44, should be true",!
|
||||||
I '$$INDIV(3) W "ERROR",!
|
I '$$INDIV(3) W "ERROR",!
|
||||||
W "Testing empty string. Should be true",!
|
W "Testing empty string. Should be true",!
|
||||||
I '$$INDIV("") W "ERROR",!
|
I '$$INDIV("") W "ERROR",!
|
||||||
W "Testing if they are different",!
|
W "Testing if they are different",!
|
||||||
S DUZ(2)=899
|
S DUZ(2)=899
|
||||||
I $$INDIV(1) W "ERROR",!
|
I $$INDIV(1) W "ERROR",!
|
||||||
I $$INDIV(2) W "ERROR",!
|
I $$INDIV(2) W "ERROR",!
|
||||||
QUIT
|
QUIT
|
||||||
UnitTestINDIV2
|
UTINDIV2 ; Unit Test $$INDIV2
|
||||||
W "Testing if they are the same",!
|
W "Testing if they are the same",!
|
||||||
S DUZ(2)=69
|
S DUZ(2)=69
|
||||||
I $$INDIV2(22)'=0 W "ERROR",!
|
I $$INDIV2(22)'=0 W "ERROR",!
|
||||||
I $$INDIV2(25)'=1 W "ERROR",!
|
I $$INDIV2(25)'=1 W "ERROR",!
|
||||||
I $$INDIV2(26)'=1 W "ERROR",!
|
I $$INDIV2(26)'=1 W "ERROR",!
|
||||||
I $$INDIV2(27)'=1 W "ERROR",!
|
I $$INDIV2(27)'=1 W "ERROR",!
|
||||||
QUIT
|
QUIT
|
||||||
;
|
;
|
||||||
GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
|
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
|
; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
|
||||||
;
|
;
|
||||||
|
|
@ -345,13 +349,12 @@ GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Pati
|
||||||
; File 75.1 = RAD/NUC MED ORDERS
|
; File 75.1 = RAD/NUC MED ORDERS
|
||||||
; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
|
; 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
|
; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
|
||||||
;
|
;;EHS/MKH,BAH;;BSDX 1.7;;30/09/2012;; Update [Fix the performance issue in SchedGUI]
|
||||||
;;EHS/MKH,BAH;;UJO*1.0*143;;30/09/2012;; Update [Fix the performance issue in SchedGUI]
|
; START OF CODE CHANGES FOR [BSDX 1.7]
|
||||||
; START OF CODE CHANGES FOR [UJO*1.0*143]
|
|
||||||
; Commented old Line
|
; 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")
|
;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","BSDXE>>RR")
|
||||||
DO FIND^DIC(75.1,"","@;5;2;16","QP",DFN,"","B","IF 35[$PIECE(^(0),U,5)&($PIECE(^(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]
|
; END OF CODE CHANGES FOR [BSDX 1.7]
|
||||||
;
|
;
|
||||||
IF $DATA(BSDXERR) GOTO END
|
IF $DATA(BSDXERR) GOTO END
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm
|
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
;Licensed under LGPL
|
;Licensed under LGPL
|
||||||
; Change Log
|
; Change Log
|
||||||
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
|
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
|
||||||
|
|
@ -29,14 +29,15 @@ CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
|
||||||
K ^BSDXTMP($J)
|
K ^BSDXTMP($J)
|
||||||
S BSDXERR=""
|
S BSDXERR=""
|
||||||
S BSDXY="^BSDXTMP("_$J_")"
|
S BSDXY="^BSDXTMP("_$J_")"
|
||||||
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)
|
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)
|
||||||
D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
|
D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
|
||||||
;
|
;
|
||||||
; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
|
; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
|
||||||
; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
||||||
; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
|
; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
|
||||||
; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
||||||
;
|
;
|
||||||
S BSDXI=0
|
S BSDXI=0
|
||||||
D STRES
|
D STRES
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am
|
BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
;Licensed under LGPL
|
;Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:15am
|
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/6/12 10:55am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
; Change Log:
|
; Change Log:
|
||||||
; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
|
; 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)
|
. S BSDXRESN=$P(BSDXRES,"|",BSDXCOUN)
|
||||||
. Q:BSDXRESN=""
|
. Q:BSDXRESN=""
|
||||||
. Q:'$D(^BSDXRES("B",BSDXRESN))
|
. Q:'$D(^BSDXRES("B",BSDXRESN))
|
||||||
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
|
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
|
||||||
. Q:'+BSDXRESD
|
. Q:'+BSDXRESD
|
||||||
. Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
|
. Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
|
||||||
. S BSDXBS=0
|
. S BSDXBS=0
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
|
BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
|
BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
; Change Log:
|
; Change Log:
|
||||||
; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
|
; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
|
||||||
|
|
|
||||||
630
m/BSDX07.m
630
m/BSDX07.m
|
|
@ -1,360 +1,284 @@
|
||||||
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
|
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:02pm
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
; UJO/SMH
|
; UJO/SMH
|
||||||
; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
|
; 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 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.42 Oct 30 2010 - Extensive refactoring.
|
; v1.5 Mar 15 2011 - End time does not have to have time anymore.
|
||||||
; v1.5 Mar 15 2011 - End time does not have to have time anymore.
|
; It could be midnight of the next day
|
||||||
; It could be midnight of the next day
|
; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
|
||||||
; 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!!!!
|
; Error Reference:
|
||||||
; -2: Start Time is not a valid Fileman date
|
; -1: Patient Record is locked. This means something is wrong!!!!
|
||||||
; -3: End Time is not a valid Fileman date
|
; -2: Start Time is not a valid Fileman date
|
||||||
; v1.5:obsolete::-4: End Time does not have time inside of it.
|
; -3: End Time is not a valid Fileman date
|
||||||
; -5: BSDXPATID is not numeric
|
; v1.5:obsolete::-4: End Time does not have time inside of it.
|
||||||
; -6: Patient Does not exist in ^DPT
|
; -5: BSDXPATID is not numeric
|
||||||
; -7: Resource Name does not exist in B index of BSDX RESOURCE
|
; -6: Patient Does not exist in ^DPT
|
||||||
; -8: Resouce doesn't exist in ^BSDXRES
|
; -7: Resource Name does not exist in B index of BSDX RESOURCE
|
||||||
; -9: Couldn't add appointment to BSDX APPOINTMENT
|
; -8: Resouce doesn't exist in ^BSDXRES
|
||||||
; -10: Couldn't add appointment to files 2 and/or 44
|
; -9: Couldn't add appointment to BSDX APPOINTMENT
|
||||||
; -100: Mumps Error
|
; -10: Couldn't add appointment to files 2 and/or 44
|
||||||
|
; -100: Mumps Error
|
||||||
|
;
|
||||||
APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
|
APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
|
||||||
;Entry point for debugging
|
;Entry point for debugging
|
||||||
D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
|
; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
UT ; Unit Tests
|
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP
|
||||||
N ZZZ
|
;
|
||||||
; Test for bad start date
|
;Called by RPC: BSDX ADD NEW APPOINTMENT
|
||||||
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",!
|
;Add new appointment to 3 files
|
||||||
; Test for bad end date
|
; - BSDX APPOINTMENT
|
||||||
D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1)
|
; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
|
||||||
I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
|
; - Patient Appointment Subfile if Resource is linked to clinic
|
||||||
; Test for end date without time
|
;
|
||||||
D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1)
|
;Paramters:
|
||||||
I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
|
;BSDXY: Global Return (RPC must be set to Global Array)
|
||||||
; Test for mumps error
|
;BSDXSTART: FM Start Date
|
||||||
S bsdxdie=1
|
;BSDXEND: FM End Date
|
||||||
D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1)
|
;BSDXPATID: Patient DFN
|
||||||
I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
|
;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
|
||||||
K bsdxdie
|
;BSDXLEN is the appointment duration in minutes
|
||||||
; Test for TRESTART
|
;BSDXNOTE is the Appiontment Note
|
||||||
s bsdxrestart=1
|
;BSDXATID is used for 2 purposes:
|
||||||
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
|
; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
|
||||||
I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
|
; if BSDXATID = a number, then it is the access type id (used for rebooking)
|
||||||
k bsdxrestart
|
;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
|
||||||
; Test for non-numeric patient
|
;
|
||||||
D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1)
|
;Return:
|
||||||
I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
|
; ADO.net Recordset having fields:
|
||||||
; Test for a non-existent patient
|
; AppointmentID and ErrorNumber
|
||||||
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",!
|
; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
|
||||||
; Test for a non-existent resource name
|
; to sort out. Needs changes on client.
|
||||||
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 lines:
|
||||||
; Test for corrupted resource
|
;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
|
||||||
; Can't test for -8 since it requires DB corruption
|
;
|
||||||
; Test for inability to add appointment to BSDX Appointment
|
; Deal with optional arguments
|
||||||
; Also requires something wrong in the DB
|
S BSDXRADEXAM=$G(BSDXRADEXAM)
|
||||||
; Test for inability to add appointment to 2,44
|
;
|
||||||
; Test by creating a duplicate appointment
|
; Return Array; set Return and clear array
|
||||||
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
|
S BSDXY=$NA(^BSDXTMP($J))
|
||||||
D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
|
K ^BSDXTMP($J)
|
||||||
I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
|
;
|
||||||
; Test for normality:
|
; $ET
|
||||||
D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1)
|
N $ET S $ET="G ETRAP^BSDX07"
|
||||||
; Does Appt exist?
|
;
|
||||||
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
|
; Counter
|
||||||
I 'APPID W "Error Making Appt-1" QUIT
|
N BSDXI S BSDXI=0
|
||||||
I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2"
|
;
|
||||||
I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3"
|
; Lock BSDX node, only to synchronize access to the globals.
|
||||||
I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
|
; It's not expected that the error will ever happen as no filing
|
||||||
QUIT
|
; 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
|
||||||
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
|
;
|
||||||
;
|
; Header Node
|
||||||
;Called by RPC: BSDX ADD NEW APPOINTMENT
|
S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
|
||||||
;
|
;
|
||||||
;Add new appointment to 3 files
|
; Turn off SDAM APPT PROTOCOL BSDX Entries
|
||||||
; - BSDX APPOINTMENT
|
N BSDXNOEV
|
||||||
; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
|
S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
|
||||||
; - Patient Appointment Subfile if Resource is linked to clinic
|
;
|
||||||
;
|
; Set Error Message to be empty
|
||||||
;Paramters:
|
N BSDXERR S BSDXERR=0
|
||||||
;BSDXY: Global Return (RPC must be set to Global Array)
|
;
|
||||||
;BSDXSTART: FM Start Date
|
;;;test for error. See if %ZTER works
|
||||||
;BSDXEND: FM End Date
|
I $G(BSDXDIE) N X S X=1/0
|
||||||
;BSDXPATID: Patient DFN
|
;;;test
|
||||||
;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
|
;
|
||||||
;BSDXLEN is the appointment duration in minutes
|
; -- Start and End Date Processing --
|
||||||
;BSDXNOTE is the Appiontment Note
|
; If C# sends the dates with extra zeros, remove them
|
||||||
;BSDXATID is used for 2 purposes:
|
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
|
||||||
; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
|
; Are the dates valid? Must be FM Dates > than 2010
|
||||||
; if BSDXATID = a number, then it is the access type id (used for rebooking)
|
I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
|
||||||
;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
|
I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
|
||||||
;
|
;
|
||||||
;Return:
|
;; If Ending date doesn't have a time, this is an error --rm 1.5
|
||||||
; ADO.net Recordset having fields:
|
; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
|
||||||
; AppointmentID and ErrorNumber
|
;
|
||||||
;
|
; If the Start Date is greater than the end date, swap dates
|
||||||
;Test lines:
|
N BSDXTMP
|
||||||
;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
|
I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
|
||||||
;
|
;
|
||||||
; Deal with optional arguments
|
; Check if the patient exists:
|
||||||
S BSDXRADEXAM=$G(BSDXRADEXAM)
|
; - DFN valid number?
|
||||||
; Return Array; set Return and clear array
|
; - Valid Patient in file 2?
|
||||||
S BSDXY=$NA(^BSDXTMP($J))
|
I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
|
||||||
K ^BSDXTMP($J)
|
I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
|
||||||
; $ET
|
;
|
||||||
N $ET S $ET="G ETRAP^BSDX07"
|
;Validate Resource entry
|
||||||
; Counter
|
I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
|
||||||
N BSDXI S BSDXI=0
|
N BSDXRESD ; Resource IEN
|
||||||
; Lock BSDX node, only to synchronize access to the globals.
|
S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
|
||||||
; It's not expected that the error will ever happen as no filing
|
N BSDXRNOD ; Resouce zero node
|
||||||
; is supposed to take 5 seconds.
|
S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
|
||||||
L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
|
I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
|
||||||
; Header Node
|
;
|
||||||
S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
|
; Walk-in (Unscheduled) Appointment?
|
||||||
;Restartable Transaction; restore paramters when starting.
|
N BSDXWKIN S BSDXWKIN=0
|
||||||
; (Params restored are what's passed here + BSDXI)
|
I BSDXATID="WALKIN" S BSDXWKIN=1
|
||||||
TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
|
; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
|
||||||
;
|
I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
|
||||||
; Turn off SDAM APPT PROTOCOL BSDX Entries
|
;
|
||||||
N BSDXNOEV
|
; Now, check if PIMS has any issues with us making the appt using MAKECK
|
||||||
S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
|
N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN
|
||||||
;
|
N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
|
||||||
; Set Error Message to be empty
|
N BSDXC ; Array to send to MAKE and MAKECK APIs
|
||||||
N BSDXERR S BSDXERR=0
|
; Only if we have a valid Hosp Location
|
||||||
;
|
I +BSDXSCD,$D(^SC(BSDXSCD,0)) D
|
||||||
;;;test for error inside transaction. See if %ZTER works
|
. S BSDXC("PAT")=BSDXPATID
|
||||||
I $G(bsdxdie) S X=1/0
|
. S BSDXC("CLN")=BSDXSCD
|
||||||
;;;test
|
. S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
|
||||||
;;;test for TRESTART
|
. S:BSDXWKIN BSDXC("TYP")=4
|
||||||
I $G(bsdxrestart) K bsdxrestart TRESTART
|
. S BSDXC("ADT")=BSDXSTART
|
||||||
;;;test
|
. S BSDXC("LEN")=BSDXLEN
|
||||||
;
|
. S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
|
||||||
; -- Start and End Date Processing --
|
. S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
|
||||||
; If C# sends the dates with extra zeros, remove them
|
. S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
|
||||||
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
|
. S BSDXC("USR")=DUZ
|
||||||
; Are the dates valid? Must be FM Dates > than 2010
|
. S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC)
|
||||||
I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
|
I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back
|
||||||
I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
|
;
|
||||||
;
|
; Done with all checks, let's make appointment in BSDX APPOINTMENT
|
||||||
;; If Ending date doesn't have a time, this is an error --rm 1.5
|
N BSDXAPPTID
|
||||||
; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
|
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.
|
||||||
; If the Start Date is greater than the end date, swap dates
|
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here
|
||||||
N BSDXTMP
|
; I don't think it's important b/c users can detect right away if the WP
|
||||||
I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
|
; filing fails.
|
||||||
;
|
;
|
||||||
; Check if the patient exists:
|
I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q ; UT Line
|
||||||
; - DFN valid number?
|
;
|
||||||
; - Valid Patient in file 2?
|
; Only if we have a valid Hosp Loc can we make an appointment in 2/44
|
||||||
I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
|
; Use BSDXC array from before.
|
||||||
I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
|
; 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
|
||||||
;Validate Resource entry
|
N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
|
||||||
I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
|
I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
|
||||||
N BSDXRESD ; Resource IEN
|
I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
|
||||||
S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
|
;
|
||||||
N BSDXRNOD ; Resouce zero node
|
; Unlock
|
||||||
S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
|
L -^BSDXPAT(BSDXPATID)
|
||||||
I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
|
;
|
||||||
;
|
;Return Recordset
|
||||||
; Walk-in (Unscheduled) Appointment?
|
S BSDXI=BSDXI+1
|
||||||
N BSDXWKIN S BSDXWKIN=0
|
S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
|
||||||
I BSDXATID="WALKIN" S BSDXWKIN=1
|
S BSDXI=BSDXI+1
|
||||||
; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
|
Q
|
||||||
;
|
|
||||||
; 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
|
STRIP(BSDXZ) ;Replace control characters with spaces
|
||||||
N BSDXI
|
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)
|
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
|
Q BSDXZ
|
||||||
;
|
;
|
||||||
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY
|
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY
|
||||||
;Returns ien in BSDXAPPT or 0 if failed
|
;Returns ien in BSDXAPPT or 0 if failed
|
||||||
;Create entry in BSDX APPOINTMENT
|
;Create entry in BSDX APPOINTMENT
|
||||||
N BSDXAPPTID
|
N BSDXAPPTID,BSDXFDA
|
||||||
S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
|
S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
|
||||||
S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
|
S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
|
||||||
S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
|
S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
|
||||||
S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
|
S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
|
||||||
S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
|
S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
|
||||||
S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
|
S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
|
||||||
S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
|
S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
|
||||||
S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
|
S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
|
||||||
S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM
|
S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM)
|
||||||
N BSDXIEN,BSDXMSG
|
N BSDXIEN,BSDXMSG
|
||||||
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
||||||
S BSDXAPPTID=+$G(BSDXIEN(1))
|
S BSDXAPPTID=+$G(BSDXIEN(1))
|
||||||
Q BSDXAPPTID
|
Q BSDXAPPTID
|
||||||
;
|
;
|
||||||
BSDXWP(BSDXAPPTID,BSDXNOTE) ;
|
BSDXWP(BSDXAPPTID,BSDXNOTE) ;
|
||||||
;Add WP field
|
;Add WP field
|
||||||
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
N BSDXMSG
|
||||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||||
I $D(BSDXNOTE(.5)) D
|
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
||||||
. D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
I $D(BSDXNOTE(.5)) D
|
||||||
Q
|
. D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||||
;
|
Q
|
||||||
|
;
|
||||||
ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
|
ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
|
||||||
;Called by BSDX ADD APPOINTMENT protocol
|
;Called by BSDX ADD APPOINTMENT protocol
|
||||||
;BSDXSC=IEN of clinic in ^SC
|
;BSDXSC=IEN of clinic in ^SC
|
||||||
;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
|
;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
|
||||||
;
|
;
|
||||||
N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
|
N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND
|
||||||
Q:+$G(BSDXNOEV)
|
Q:+$G(BSDXNOEV)
|
||||||
I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
|
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))
|
E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
|
||||||
Q:'+$G(BSDXRES)
|
Q:'+$G(BSDXRES)
|
||||||
S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
|
S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
|
||||||
Q:BSDXNOD=""
|
Q:BSDXNOD=""
|
||||||
S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
|
S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
|
||||||
S BSDXWKIN=""
|
S BSDXWKIN=""
|
||||||
S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
|
S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
|
||||||
S BSDXLEN=$P(BSDXNOD,U,2)
|
S BSDXLEN=$P(BSDXNOD,U,2)
|
||||||
Q:'+BSDXLEN
|
Q:'+BSDXLEN
|
||||||
S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
|
S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
|
||||||
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
|
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
|
||||||
Q:'+BSDXAPPTID
|
Q:'+BSDXAPPTID
|
||||||
S BSDXNOTE=$P(BSDXNOD,U,4)
|
S BSDXNOTE=$P(BSDXNOD,U,4)
|
||||||
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
|
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
|
||||||
D ADDEVT3(BSDXRES)
|
D ADDEVT3(BSDXRES)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ADDEVT3(BSDXRES) ;
|
ADDEVT3(BSDXRES) ;
|
||||||
;Call RaiseEvent to notify GUI clients
|
;Call RaiseEvent to notify GUI clients
|
||||||
N BSDXRESN
|
N BSDXRESN
|
||||||
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
|
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
|
||||||
Q:BSDXRESN=""
|
Q:BSDXRESN=""
|
||||||
S BSDXRESN=$P(BSDXRESN,"^")
|
S BSDXRESN=$P(BSDXRESN,"^")
|
||||||
;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
|
;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
|
||||||
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
|
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ERR(BSDXI,BSDXERR) ;Error processing
|
ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
|
||||||
S BSDXI=BSDXI+1
|
; DO NOT USE except as an emergency measure - only if unforseen error occurs
|
||||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
; Input:
|
||||||
I $TL>0 TROLLBACK
|
; Appointment ID to remove from ^BSDXAPPT
|
||||||
S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
|
; BSDXC array (see array format in $$MAKE^BSDXAPI)
|
||||||
S BSDXI=BSDXI+1
|
N %
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
D BSDXDEL^BSDX07(BSDXAPPTID)
|
||||||
L -^BSDXAPPT(BSDXPATID)
|
S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
|
||||||
Q
|
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
|
||||||
|
;
|
||||||
ETRAP ;EP Error trap entry
|
ETRAP ;EP Error trap entry
|
||||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||||
; Rollback, otherwise ^XTER will be empty from future rollback
|
D ^%ZTER
|
||||||
I $TL>0 TROLLBACK
|
;
|
||||||
D ^%ZTER
|
I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
|
||||||
S $EC="" ; Clear Error
|
;
|
||||||
; Log error message and send to client
|
; Log error message and send to client
|
||||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||||
D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
|
D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
|
||||||
Q
|
Q:$Q 1_U_"Mumps Error" 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,24 +1,22 @@
|
||||||
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
|
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
;
|
;
|
||||||
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
|
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
|
||||||
;
|
;
|
||||||
; Change History
|
; Change History
|
||||||
; 3101022 UJO/SMH v1.42
|
; 3101022 UJO/SMH v1.42
|
||||||
; - Transaction now restartable. Thanks to
|
; - Transaction work. As of v 1.7, all work here has been superceded
|
||||||
; --> Zach Gonzalez and Rick Marshall for fix.
|
; - Refactoring of AVUPDT - never tested though.
|
||||||
; - 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.
|
; - Refactored all of APPDEL.
|
||||||
;
|
;
|
||||||
; 3111125 UJO/SMH v1.5
|
; 3111125 UJO/SMH v1.5
|
||||||
; - Added ability to remove checked in appointments. Added a couple
|
; - Added ability to remove checked in appointments. Added a couple
|
||||||
; of units tests for that under UT2.
|
; of units tests for that under UT2.
|
||||||
; - Minor reformatting because of how KIDS adds tabs.
|
;
|
||||||
|
; 3120625 VEN/SMH v1.7
|
||||||
|
; - Transactions removed. Code refactored to work w/o txns.
|
||||||
|
; - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling
|
||||||
|
; that.
|
||||||
;
|
;
|
||||||
; Error Reference:
|
; Error Reference:
|
||||||
; -1~BSDX08: Appt record is locked. Please contact technical support.
|
; -1~BSDX08: Appt record is locked. Please contact technical support.
|
||||||
|
|
@ -30,76 +28,15 @@ BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
|
||||||
; -7~BSDX08: Patient does not have an appointment in PIMS Clinic
|
; -7~BSDX08: Patient does not have an appointment in PIMS Clinic
|
||||||
; -8^BSDX08: Unable to find associated PIMS appointment for this patient
|
; -8^BSDX08: Unable to find associated PIMS appointment for this patient
|
||||||
; -9^BSDX08: BSDXAPI returned an error: (error)
|
; -9^BSDX08: BSDXAPI returned an error: (error)
|
||||||
|
; -10^BSDX08: $$BSDXCAN failed (Fileman filing error)
|
||||||
; -100~BSDX08 Error: (Mumps Error)
|
; -100~BSDX08 Error: (Mumps Error)
|
||||||
;
|
;
|
||||||
APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
|
APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
|
||||||
;Entry point for debugging
|
;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
|
Q
|
||||||
;
|
;
|
||||||
UT ; Unit Tests
|
APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP
|
||||||
; 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
|
;Called by RPC: BSDX CANCEL APPOINTMENT
|
||||||
;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
|
;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
|
||||||
;Input Parameters:
|
;Input Parameters:
|
||||||
|
|
@ -123,70 +60,78 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
|
||||||
;
|
;
|
||||||
; Counter
|
; Counter
|
||||||
N BSDXI S BSDXI=0
|
N BSDXI S BSDXI=0
|
||||||
|
;
|
||||||
; Header Node
|
; Header Node
|
||||||
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
|
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
|
; Turn off SDAM APPT PROTOCOL BSDX Entries
|
||||||
N BSDXNOEV
|
N BSDXNOEV
|
||||||
S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
|
S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
|
||||||
;
|
;
|
||||||
;;;test for error inside transaction. See if %ZTER works
|
;;;test for error inside transaction. See if %ZTER works
|
||||||
I $G(bsdxdie) S X=1/0
|
I $G(BSDXDIE1) N X S X=1/0
|
||||||
;;;test
|
|
||||||
;;;test for TRESTART
|
|
||||||
I $G(bsdxrestart) K bsdxrestart TRESTART
|
|
||||||
;;;test
|
|
||||||
;
|
;
|
||||||
; Check appointment ID and whether it exists
|
; Check appointment ID and whether it exists
|
||||||
I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
|
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
|
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:
|
; Start Processing:
|
||||||
; First, add cancellation date to appt entry in BSDX APPOINTMENT
|
; First, get data
|
||||||
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
|
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
|
||||||
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID
|
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID
|
||||||
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time
|
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time
|
||||||
D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT
|
|
||||||
;
|
;
|
||||||
; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
|
; Check the resource ID and whether it exists
|
||||||
N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
|
N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
|
||||||
; If the resouce id doesn't exist...
|
; If the resource id doesn't exist...
|
||||||
I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
|
I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
|
||||||
I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
|
I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
|
||||||
|
;
|
||||||
|
;
|
||||||
|
; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI
|
||||||
; Get zero node of resouce
|
; Get zero node of resouce
|
||||||
S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
||||||
; Get Hosp location
|
; Get Hosp location
|
||||||
N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
|
N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
|
||||||
; Error indicator for Hosp Location filing for getting out of routine
|
; Error indicator
|
||||||
N BSDXERR S BSDXERR=0
|
N BSDXERR S BSDXERR=0
|
||||||
; Only file in 2/44 if there is an associated hospital location
|
;
|
||||||
I BSDXLOC D QUIT:BSDXERR
|
N BSDXC ; Array to pass to BSDXAPI
|
||||||
. I '$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
|
I BSDXLOC D
|
||||||
. N BSDXSCIEN
|
. S BSDXC("PAT")=BSDXPATID
|
||||||
. S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
|
. S BSDXC("CLN")=BSDXLOC
|
||||||
. I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT
|
. S BSDXC("TYP")=BSDXTYP
|
||||||
. ; Get the appointment node
|
. S BSDXC("ADT")=BSDXSTART
|
||||||
. S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0))
|
. S BSDXC("CDT")=$$NOW^XLFDT()
|
||||||
. I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT
|
. S BSDXC("NOT")=BSDXNOT
|
||||||
. N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2)
|
. S:'+$G(BSDXCR) BSDXCR=11 ;Other
|
||||||
. ; Cancel through BSDXAPI
|
. S BSDXC("CR")=BSDXCR
|
||||||
. N BSDXZ
|
. S BSDXC("USR")=DUZ
|
||||||
. 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
|
. S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message
|
||||||
. ; Update Legacy PIMS clinic Availability
|
; If error, quit. No need to rollback as no changes took place.
|
||||||
. D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
|
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
|
||||||
;
|
;
|
||||||
TCOMMIT
|
|
||||||
L -^BSDXAPPT(BSDXAPTID)
|
L -^BSDXAPPT(BSDXAPTID)
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)=""_$C(30)
|
S ^BSDXTMP($J,BSDXI)=""_$C(30)
|
||||||
|
|
@ -194,80 +139,25 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability
|
BSDXCAN(BSDXAPTID) ; $$; Private; Cancel BSDX APPOINTMENT entry
|
||||||
;See SDCNP0
|
; Input: Appt IEN in ^BSDXAPPT
|
||||||
N SD,S ; Start Date
|
; Output: 0 for success and 1^Msg for failure
|
||||||
S (SD,S)=BSDXSTART
|
N BSDXDATE,BSDXIENS,BSDXFDA,BSDXMSG
|
||||||
N I ; Clinic IEN in 44
|
S BSDXDATE=$$NOW^XLFDT()
|
||||||
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 BSDXIENS=BSDXAPTID_","
|
||||||
S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
|
S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
|
||||||
K BSDXMSG
|
|
||||||
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||||
Q
|
I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1)
|
||||||
|
QUIT 0
|
||||||
|
;
|
||||||
|
ROLLBACK(BSDXAPTID) ; Proc; Private; Rollback cancellation
|
||||||
|
; Input same as $$BSDXCAN
|
||||||
|
N BSDXIENS S BSDXIENS=BSDXAPTID_","
|
||||||
|
N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@"
|
||||||
|
N BSDXMSG
|
||||||
|
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||||
|
;I $D(BSDXMSG) ; Not sure what to do. We are already handling an error.
|
||||||
|
QUIT
|
||||||
;
|
;
|
||||||
CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event
|
CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event
|
||||||
;when appointments cancelled via PIMS interface.
|
;when appointments cancelled via PIMS interface.
|
||||||
|
|
@ -291,9 +181,10 @@ CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) ;
|
||||||
Q:'+BSDXRES BSDXFOUND
|
Q:'+BSDXRES BSDXFOUND
|
||||||
Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) 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 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 $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
|
||||||
I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT)
|
I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER
|
||||||
Q BSDXFOUND
|
Q BSDXFOUND
|
||||||
;
|
;
|
||||||
CANEVT3(BSDXRES) ;
|
CANEVT3(BSDXRES) ;
|
||||||
|
|
@ -308,25 +199,30 @@ CANEVT3(BSDXRES) ;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ERR(BSDXI,BSDXERR) ;Error processing
|
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 BSDXI=BSDXI+1
|
||||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||||
I $TL>0 TROLLBACK
|
|
||||||
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
L -^BSDXAPPT(BSDXAPTID)
|
|
||||||
QUIT
|
QUIT
|
||||||
;
|
;
|
||||||
ETRAP ;EP Error trap entry
|
ETRAP ;EP Error trap entry
|
||||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
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
|
D ^%ZTER
|
||||||
S $EC="" ; Clear Error
|
;
|
||||||
|
; 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)
|
||||||
|
;
|
||||||
; Log error message and send to client
|
; Log error message and send to client
|
||||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||||
D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
|
D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
|
||||||
QUIT
|
Q:$Q 1_U_"-100~Mumps Error" Q
|
||||||
;
|
;
|
||||||
;;;NB: This is code that is unused in both original and port.
|
;;;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
|
; ; 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 ; ; 4/28/11 10:18am
|
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 6/21/12 11:03am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
|
BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
ENV0100 ;EP Version 1.0 Environment check
|
ENV0100 ;EP Version 1.0 Environment check
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
|
BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:20am
|
BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:20am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
|
BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
|
BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
|
BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
|
BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
253
m/BSDX25.m
253
m/BSDX25.m
|
|
@ -1,118 +1,137 @@
|
||||||
BSDX25 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
|
BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C#
|
; 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
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
UT ; Unit Tests
|
CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
|
||||||
; 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
|
;Entry point for debugging
|
||||||
;
|
;
|
||||||
;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))
|
;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))
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
CHECKIN(BSDXY,BSDXAPTID,BSDXCDT) ; ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP Check in appointment
|
CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
|
||||||
|
; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
|
||||||
|
; Called by RPC: BSDX CHECKIN APPOINTMENT
|
||||||
|
;
|
||||||
; Private to GUI; use BSDXAPI for general API to checkin patients
|
; Private to GUI; use BSDXAPI for general API to checkin patients
|
||||||
; Parameters:
|
; Parameters:
|
||||||
; BSDXY: Global Out
|
; BSDXY: Global Out
|
||||||
; BSDXAPTID: Appointment ID in ^BSDXAPPT
|
; BSDXAPPTID: Appointment ID in ^BSDXAPPT
|
||||||
; BSDXCDT: Checkin Date --> Changed
|
; BSDXCDT: Checkin Date --> Changed
|
||||||
; BSDXCC: Clinic Stop IEN (not used)
|
; BSDXCC: Clinic Stop IEN (not used)
|
||||||
; BSDXPRV: Provider IEN (not used)
|
; BSDXPRV: Provider IEN (not used)
|
||||||
; BSDXROU: Print Routing Slip? (not used)
|
; BSDXROU: Print Routing Slip? (not used)
|
||||||
; BSDXVCL: PCC+ Clinic IEN (not used)
|
; BSDXVCL: PCC+ Clinic IEN (not used)
|
||||||
; BSDXVFM: PCC+ Form IEN (not used)
|
; BSDXVFM: PCC+ Form IEN (not used)
|
||||||
; BSDXOG: PCC+ Outguide (true or false)
|
; BSDXOG: PCC+ Outguide (true or false) (not used)
|
||||||
;
|
;
|
||||||
; Output:
|
; Output:
|
||||||
; ADO.net table with 1 column ErrorID, 1 row result
|
; ADO.net table with 1 column ErrorID, 1 row result
|
||||||
; - 0 if all okay
|
; - 0 if all okay
|
||||||
; - Another number or text if not
|
; - Another number or text if not
|
||||||
|
;
|
||||||
N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
|
; 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 BSDXNOEV
|
N BSDXNOEV
|
||||||
S BSDXNOEV=1 ;Don't execute protocol
|
S BSDXNOEV=1 ;Don't execute protocol
|
||||||
;
|
;
|
||||||
D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
|
; Set min DUZ vars
|
||||||
S BSDXI=0
|
D ^XBKVAR
|
||||||
K ^BSDXTMP($J)
|
;
|
||||||
S BSDXY="^BSDXTMP("_$J_")"
|
; $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
|
||||||
|
;
|
||||||
S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
|
S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
|
||||||
I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q
|
;
|
||||||
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q
|
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
|
||||||
|
;
|
||||||
; Remove Date formatting v.1.5. Client will send date as FM Date.
|
; Remove Date formatting v.1.5. Client will send date as FM Date.
|
||||||
;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
|
;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
|
||||||
;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
|
;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
|
||||||
S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them
|
S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them
|
||||||
I BSDXCDT=-1 D ERR(70) Q
|
I BSDXCDT'>2000000 D ERR("-2~Invalid Check-in Date") QUIT
|
||||||
I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
|
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)
|
|
||||||
;
|
;
|
||||||
S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
|
; Some data
|
||||||
I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q
|
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) ; Appointment Node
|
||||||
. S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
||||||
. S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
|
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Appointment Start Time
|
||||||
. 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 BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)="0"_$C(30)
|
S ^BSDXTMP($J,BSDXI)="0"_$C(30)
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
BSDXCHK(BSDXAPTID,BSDXCDT) ;
|
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.
|
||||||
;
|
;
|
||||||
S BSDXIENS=BSDXAPTID_","
|
; 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 BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
|
S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
|
||||||
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||||
Q
|
Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
|
||||||
|
Q 0
|
||||||
;
|
;
|
||||||
APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ;
|
RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44
|
||||||
;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
|
; Called by RPC BSDX REMOVE CHECK-IN
|
||||||
;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:
|
; Parameters to pass:
|
||||||
; APPTID: IEN in file BSDX APPOINTMENT
|
; APPTID: IEN in file BSDX APPOINTMENT
|
||||||
|
|
@ -127,7 +146,9 @@ RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
|
||||||
; -3~DB has corruption. Call Tech Support. (Resource ID doesn't exist in BSDXAPPT)
|
; -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)
|
; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
|
||||||
; -5~BSDXAPI Error. Message depends on error.
|
; -5~BSDXAPI Error. Message depends on error.
|
||||||
; -20~Mumps Error
|
; -6~Data Filing Error in BSDXCHK
|
||||||
|
; -7~Lock not acquired
|
||||||
|
; -100~Mumps Error
|
||||||
;
|
;
|
||||||
N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
|
N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
|
||||||
;
|
;
|
||||||
|
|
@ -141,39 +162,56 @@ RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
|
||||||
;
|
;
|
||||||
S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
|
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
|
;;;test
|
||||||
|
I $G(BSDXDIE) N X S X=8/0
|
||||||
;
|
;
|
||||||
; Check for Appointment ID (passed and exists in file)
|
; Check for Appointment ID (passed and exists in file)
|
||||||
I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
|
I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT
|
||||||
I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
|
I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
|
||||||
;
|
;
|
||||||
; Remove checkin from BSDX APPOINTMENT entry
|
; Lock
|
||||||
D BSDXCHK(BSDXAPPTID,"@")
|
; 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
|
||||||
;
|
;
|
||||||
; Now, remove checkin from PIMS files 2/44
|
; Get appointment Data
|
||||||
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
|
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
|
||||||
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
||||||
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
|
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date
|
||||||
N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID
|
N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID
|
||||||
;
|
;
|
||||||
; If the resource doesn't exist, error out. DB is corrupt.
|
; If the resource doesn't exist, error out. DB is corrupt.
|
||||||
I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT
|
I 'BSDXRESID 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
|
I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT
|
||||||
;
|
;
|
||||||
N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node
|
; Get HL Data
|
||||||
S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
|
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
|
||||||
;
|
;
|
||||||
N BSDXZ ; Scratch variable to hold error message
|
; Is it okay to remove check-in from PIMS?
|
||||||
I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
|
N BSDXERR S BSDXERR=0 ; Scratch variable
|
||||||
I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT
|
; $$RMCICK = Remove Check-in Check
|
||||||
;
|
I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART)
|
||||||
TCOMMIT ; Save Data into Globals
|
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
|
||||||
|
;
|
||||||
|
; 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
|
||||||
|
;
|
||||||
|
; Unlock
|
||||||
|
L -^BSDXAPPT(BSDXAPPTID)
|
||||||
;
|
;
|
||||||
; Return ADO recordset
|
; Return ADO recordset
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
|
|
@ -207,9 +245,11 @@ CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
|
||||||
Q:'+$G(BSDXRES) BSDXFOUND
|
Q:'+$G(BSDXRES) BSDXFOUND
|
||||||
Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) 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 BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
|
||||||
. S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
|
. 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 $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
|
||||||
I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT)
|
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
|
||||||
Q BSDXFOUND
|
Q BSDXFOUND
|
||||||
;
|
;
|
||||||
CHKEVT3(BSDXRES) ;
|
CHKEVT3(BSDXRES) ;
|
||||||
|
|
@ -224,16 +264,23 @@ CHKEVT3(BSDXRES) ;
|
||||||
;
|
;
|
||||||
ERROR ;
|
ERROR ;
|
||||||
S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise
|
S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise
|
||||||
; Rollback, otherwise ^XTER will be empty from future rollback
|
D ^%ZTER
|
||||||
I $TL>0 TROLLBACK
|
; VEN/SMH: NB: I make a conscious decision not to roll back anything
|
||||||
D ^%ZTER
|
; here in the error trap. Once the error is fixed, users can
|
||||||
S $EC="" ; Clear Error
|
; undo or redo the check-in.
|
||||||
; Log error message and send to client
|
; Individual portions of this routine may choose to do rolling back
|
||||||
D ERR("-20~Mumps Error")
|
; of their own (e.g. a failed call to BSDXAPI causes rollback to occur
|
||||||
Q
|
; in CHECKIN and RMCI)
|
||||||
|
;
|
||||||
|
; Log error message and send to client
|
||||||
|
D ERR("-100~Mumps Error")
|
||||||
|
Q:$Q "-100^Mumps Error" Q
|
||||||
;
|
;
|
||||||
ERR(BSDXERR) ;Error processing
|
ERR(BSDXERR) ;Error processing
|
||||||
I $TLEVEL>0 TROLLBACK
|
; 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
|
||||||
S BSDXERR=$G(BSDXERR)
|
S BSDXERR=$G(BSDXERR)
|
||||||
S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
|
S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
|
||||||
S BSDXI=$G(BSDXI)+1
|
S BSDXI=$G(BSDXI)+1
|
||||||
|
|
|
||||||
249
m/BSDX26.m
249
m/BSDX26.m
|
|
@ -1,133 +1,124 @@
|
||||||
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
|
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
; Change History:
|
; Change History:
|
||||||
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
|
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
|
||||||
; --> Thanks to Zach Gonzalez and Rick Marshall
|
; 3101205 - UJO/SMH - Extensive refactoring.
|
||||||
; 3101205 - UJO/SMH - Extensive refactoring.
|
; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1
|
||||||
;
|
;
|
||||||
; Error Reference:
|
; Error Reference:
|
||||||
; -1: Appt ID is not a number
|
; 1: Appt ID is not a number
|
||||||
; -2: Appt IEN is not in ^BSDXAPPT
|
; 2: Appt IEN is not in ^BSDXAPPT
|
||||||
; -3: FM Failure to file WP field 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.
|
||||||
|
;
|
||||||
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
|
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
|
||||||
;Entry point for debugging
|
;Entry point for debugging
|
||||||
;
|
;
|
||||||
D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
|
;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
|
||||||
Q
|
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)
|
EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited)
|
||||||
; Called by RPC: BSDX EDIT APPOINTMENT
|
; Called by RPC: BSDX EDIT APPOINTMENT
|
||||||
;
|
;
|
||||||
; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
|
; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
|
||||||
;
|
;
|
||||||
; Parameters:
|
; Parameters:
|
||||||
; - BSDXY: Global Return (RPC must be set to Global Array)
|
; - BSDXY: Global Return (RPC must be set to Global Array)
|
||||||
; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
|
; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
|
||||||
; - BSDXNOTE: New note
|
; - BSDXNOTE: New note
|
||||||
;
|
;
|
||||||
; Return:
|
; Return:
|
||||||
; ADO.net Recordset having 1 field: ERRORID
|
; ADO.net Recordset having 1 field: ERRORID
|
||||||
; If Okay: -1; otherwise, positive integer with message
|
; If Okay: -1; otherwise, positive integer with message
|
||||||
;
|
;
|
||||||
; Return Array; set Return and clear array
|
; Return Array; set Return and clear array
|
||||||
S BSDXY=$NA(^BSDXTMP($J))
|
S BSDXY=$NA(^BSDXTMP($J))
|
||||||
K ^BSDXTMP($J)
|
K ^BSDXTMP($J)
|
||||||
; ET
|
; ET
|
||||||
N $ET S $ET="G ETRAP^BSDX26"
|
N $ET S $ET="G ETRAP^BSDX26"
|
||||||
; Set up basic DUZ variables
|
; Set up basic DUZ variables
|
||||||
D ^XBKVAR
|
D ^XBKVAR
|
||||||
; Counter
|
; Counter
|
||||||
N BSDXI S BSDXI=0
|
N BSDXI S BSDXI=0
|
||||||
; Header Node
|
; Header Node
|
||||||
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
|
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. See if %ZTER works
|
||||||
;
|
I $G(BSDXDIE) S X=1/0
|
||||||
;;;test for error inside transaction. See if %ZTER works
|
;
|
||||||
I $G(bsdxdie) S X=1/0
|
; Validate Appointment ID
|
||||||
;;;test
|
I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT
|
||||||
;;;test for TRESTART
|
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT
|
||||||
I $G(bsdxrestart) K bsdxrestart TRESTART
|
;
|
||||||
;;;test
|
; Lock BSDX node, only to synchronize access to the globals.
|
||||||
;
|
; It's not expected that the error will ever happen as no filing
|
||||||
; Validate Appointment ID
|
; is supposed to take 5 seconds.
|
||||||
I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
|
L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") 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
|
; Put the WP in decendant fields from the root to file as a WP field
|
||||||
S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
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
|
N BSDXMSG ; Message in case of error in filing.
|
||||||
. 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
|
; Save Before State in case we need it for rollback
|
||||||
;
|
K ^TMP($J)
|
||||||
; Now file in file 44:
|
M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID)
|
||||||
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
|
; Update note in BSDX APPOINTMENT
|
||||||
N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
|
I $D(BSDXNOTE(.5)) D
|
||||||
N BSDXRES S BSDXRES=0 ; Result
|
. D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||||
; Update Note only if we have a linked hospital location.
|
;
|
||||||
I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
|
; Error handling. No need for rollback since nothing else changed.
|
||||||
; If we get an error (denoted by -1 in BSDXRES), return error to client
|
I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
|
||||||
I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT
|
;
|
||||||
;Return Recordset
|
; Now file in file 44:
|
||||||
TCOMMIT
|
N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
|
||||||
S BSDXI=BSDXI+1
|
N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
|
||||||
S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
|
N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
|
||||||
S BSDXI=BSDXI+1
|
N BSDXRES S BSDXRES=0 ; Result
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
; Update Note only if we have a linked hospital location.
|
||||||
QUIT
|
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
|
||||||
|
;
|
||||||
ERR(BSDXI,BSDXERR) ;Error processing
|
ERR(BSDXI,BSDXERR) ;Error processing
|
||||||
S BSDXI=BSDXI+1
|
; Unlock first
|
||||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
|
||||||
I $TL>0 TROLLBACK
|
; If last line is $C(31), we are done. No more errors to send to client.
|
||||||
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||||
QUIT
|
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
||||||
;
|
S BSDXI=BSDXI+1
|
||||||
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
ETRAP ;EP Error trap entry
|
ETRAP ;EP Error trap entry
|
||||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||||
I $TL>0 TROLLBACK
|
D ^%ZTER
|
||||||
D ^%ZTER
|
;
|
||||||
S $EC=""
|
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
|
||||||
D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
|
QUIT
|
||||||
Q
|
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
|
BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log: July 15, 2010
|
; Change Log: July 15, 2010
|
||||||
|
|
|
||||||
41
m/BSDX28.m
41
m/BSDX28.m
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
|
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:57am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
; Change Log:
|
; Change Log:
|
||||||
; HMW 3050721 Added test for inactivated record
|
; 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))
|
. 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)
|
. S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30)
|
||||||
PID ;PID Lookup
|
PID ;PID Lookup
|
||||||
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
|
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
|
||||||
; won't work anyways.
|
; won't work anyways.
|
||||||
I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
|
I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
|
||||||
. S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
|
. S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
|
||||||
. Q:'$D(^DPT(BSDXIEN,0))
|
. Q:'$D(^DPT(BSDXIEN,0))
|
||||||
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
|
||||||
. S BSDXZ=$P(BSDXDPT,U) ;NAME
|
. S BSDXZ=$P(BSDXDPT,U) ;NAME
|
||||||
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
|
||||||
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
|
||||||
. ; Inactivated Chart get an *
|
. ; Inactivated Chart get an *
|
||||||
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
|
. 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,2)=BSDXHRN
|
||||||
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
|
||||||
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
|
||||||
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
|
||||||
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
|
||||||
. S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
. S BSDXRET=BSDXRET_BSDXZ_$C(30)
|
||||||
;
|
;
|
||||||
DOB ;DOB Lookup
|
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
|
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,8 +75,7 @@ DOB ;DOB Lookup
|
||||||
. . Q
|
. . Q
|
||||||
. Q
|
. Q
|
||||||
;
|
;
|
||||||
CHART
|
CHART ;Chart# Lookup
|
||||||
;Chart# Lookup
|
|
||||||
I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
|
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
|
. 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))
|
. . Q:'$D(^DPT(BSDXIEN,0))
|
||||||
|
|
|
||||||
112
m/BSDX29.m
112
m/BSDX29.m
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
|
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
@ -7,13 +7,15 @@ BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
|
||||||
; - Beginning and Ending dates passed as FM Dates
|
; - Beginning and Ending dates passed as FM Dates
|
||||||
; v1.42 by WV/SMH on 3101023
|
; v1.42 by WV/SMH on 3101023
|
||||||
; - Transaction moved; now restartable too.
|
; - Transaction moved; now restartable too.
|
||||||
; --> Thanks to Zach Gonzalez and Rick Marshall.
|
|
||||||
; - Refactoring of major portions of routine
|
; - 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
|
BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
||||||
;Entry point for debugging
|
;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
|
Q
|
||||||
;
|
;
|
||||||
BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
||||||
|
|
@ -21,33 +23,33 @@ BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
||||||
;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
|
;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
|
||||||
;Called by RPC: BSDX COPY APPOINTMENTS
|
;Called by RPC: BSDX COPY APPOINTMENTS
|
||||||
;
|
;
|
||||||
; Parameters:
|
; Parameters:
|
||||||
; - BSDXY: Global Return
|
; - BSDXY: Global Return
|
||||||
; - BSDXRES: BSDX RESOURCE to copy appointments to
|
; - BSDXRES: BSDX RESOURCE to copy appointments to
|
||||||
; - BSDX44: Hospital Location IEN to copy appointments from
|
; - BSDX44: Hospital Location IEN to copy appointments from
|
||||||
; - BSDXBEG: Beginning Date in FM Format
|
; - BSDXBEG: Beginning Date in FM Format
|
||||||
; - BSDXEND: End Date in FM Format
|
; - BSDXEND: End Date in FM Format
|
||||||
;
|
;
|
||||||
;Returns ADO Recordset containing TASK_NUMBER and ERRORID
|
;Returns ADO Recordset containing TASK_NUMBER and ERRORID
|
||||||
;
|
;
|
||||||
; Return Array
|
; Return Array
|
||||||
S BSDXY=$NA(^BSDXTMP($J))
|
S BSDXY=$NA(^BSDXTMP($J))
|
||||||
K ^BSDXTMP($J)
|
K ^BSDXTMP($J)
|
||||||
; $ET
|
; $ET
|
||||||
N $ET S $ET="G ETRAP^BSDX29"
|
N $ET S $ET="G ETRAP^BSDX29"
|
||||||
; Counter
|
; Counter
|
||||||
N BSDXI S BSDXI=0
|
N BSDXI S BSDXI=0
|
||||||
; Header Node
|
; Header Node
|
||||||
S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
|
S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
|
||||||
;
|
;
|
||||||
; Make dates inclusive; add 1 to FM dates
|
; Make dates inclusive; add 1 to FM dates
|
||||||
S BSDXBEG=BSDXBEG-1
|
S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1)
|
||||||
S BSDXEND=BSDXEND+1
|
S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1)
|
||||||
;
|
;
|
||||||
; Taskman variables
|
; Taskman variables
|
||||||
N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
|
N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO
|
||||||
; Task Load
|
; Task Load
|
||||||
S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
|
S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO=""
|
||||||
S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
|
S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
|
||||||
D ^%ZTLOAD
|
D ^%ZTLOAD
|
||||||
; Set up return ADO.net dataset
|
; Set up return ADO.net dataset
|
||||||
|
|
@ -61,49 +63,44 @@ ZTMD ;EP - Debug entry point
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZTM ;EP - Taskman entry point
|
ZTM ;EP - Taskman entry point
|
||||||
; Variables set up in ZTSAVE above
|
; Variables set up in ZTSAVE above
|
||||||
;
|
;
|
||||||
Q:'$D(ZTSK)
|
Q:'$D(ZTSK)
|
||||||
; $ET
|
;
|
||||||
N $ET S $ET="G ZTMERR^BSDX29"
|
; $ET
|
||||||
; Txn
|
N $ET S $ET="G ZTMERR^BSDX29"
|
||||||
TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
|
;
|
||||||
;$O through ^SC(BSDX44,"S",
|
;$O through ^SC(BSDX44,"S",
|
||||||
N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments
|
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
|
; Set Count
|
||||||
S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
|
S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
|
||||||
; Loop through dates here.
|
; Loop through dates here.
|
||||||
F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D
|
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.
|
. ; Loop through Entries in each date in the subsubfile.
|
||||||
. ; Quit if we are at the end or if a remote process requests a quit.
|
. ; Quit if we are at the end or if a remote process requests a quit.
|
||||||
. N BSDXIEN S BSDXIEN=0
|
. N BSDXIEN S BSDXIEN=0
|
||||||
. F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D
|
. 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
|
. . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
|
||||||
. . Q:'+BSDXNOD ; Quit if no node
|
. . Q:'+BSDXNOD ; Quit if no node
|
||||||
. . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
|
. . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
|
||||||
. . Q:BSDXCAN="C" ; Quit if appt cancelled
|
. . 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 BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
|
||||||
. . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
|
. . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
|
||||||
. . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
|
. . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
|
||||||
. . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
|
. . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
|
||||||
. . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
|
. . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
|
||||||
. . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
|
. . 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 +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
|
. . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7)
|
||||||
. . Q
|
;
|
||||||
. Q
|
;
|
||||||
I 'BSDXQUIT TCOMMIT
|
|
||||||
E TROLLBACK
|
|
||||||
S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.")
|
S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZTMERR ; For now, error from TM is only in trap; not returned to client.
|
ZTMERR ; For now, error from TM is only in trap; not returned to client.
|
||||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||||
; Rollback before logging the error
|
|
||||||
I $TL>0 TROLLBACK
|
|
||||||
D ^%ZTER
|
D ^%ZTER
|
||||||
S $EC="" ; Clear Error
|
|
||||||
QUIT
|
QUIT
|
||||||
;
|
;
|
||||||
XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
||||||
|
|
@ -111,8 +108,12 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
||||||
;Copy record to BSDX APPOINTMENT file
|
;Copy record to BSDX APPOINTMENT file
|
||||||
;Return 1 if record copied, otherwise 0
|
;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
|
;$O Thru ^BSDXAPPT to determine if this appt already added
|
||||||
N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2
|
N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD
|
||||||
S BSDXIEN=0,BSDXFND=0
|
S BSDXIEN=0,BSDXFND=0
|
||||||
F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
|
F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
|
||||||
. S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
|
. S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
|
||||||
|
|
@ -121,12 +122,13 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
||||||
. S BSDXFND=0
|
. S BSDXFND=0
|
||||||
. I BSDXPAT2=BSDXPAT S BSDXFND=1
|
. I BSDXPAT2=BSDXPAT S BSDXFND=1
|
||||||
. Q
|
. Q
|
||||||
Q:BSDXFND 0
|
I BSDXFND L -@REF Q 0
|
||||||
;
|
;
|
||||||
;Add to BSDX APPOINTMENT
|
;Add to BSDX APPOINTMENT
|
||||||
S BSDXEND=BSDXBEG
|
S BSDXEND=BSDXBEG
|
||||||
;Calculate ending time from beginning time and duration.
|
;Calculate ending time from beginning time and duration.
|
||||||
S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
|
S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
|
||||||
|
N BSDXFDA,BSDXIENS
|
||||||
S BSDXIENS="+1,"
|
S BSDXIENS="+1,"
|
||||||
S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
|
S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
|
||||||
S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
|
S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
|
||||||
|
|
@ -136,19 +138,23 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
||||||
S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
|
S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
|
||||||
;
|
;
|
||||||
K BSDXIEN
|
K BSDXIEN
|
||||||
|
;
|
||||||
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
||||||
S BSDXIEN=+$G(BSDXIEN(1))
|
S BSDXIEN=+$G(BSDXIEN(1))
|
||||||
I '+BSDXIEN Q 0
|
I '+BSDXIEN L -@REF Q 0
|
||||||
;
|
;
|
||||||
;Add WP field
|
;Add WP field
|
||||||
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
|
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
|
||||||
. D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
|
. D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
|
||||||
|
L -@REF
|
||||||
;
|
;
|
||||||
Q 1
|
Q 1
|
||||||
;
|
;
|
||||||
ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
|
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 BSDXI=BSDXI+1
|
||||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||||
S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
|
S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
|
|
@ -156,9 +162,9 @@ ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
|
||||||
;
|
;
|
||||||
ETRAP ;EP Error trap entry
|
ETRAP ;EP Error trap entry
|
||||||
; No Txn here. So don't rollback anything
|
; No Txn here. So don't rollback anything
|
||||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||||
D ^%ZTER
|
D ^%ZTER
|
||||||
S $EC="" ; Clear error
|
S $EC="" ; Clear error
|
||||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||||
D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
|
D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
|
||||||
Q
|
Q
|
||||||
|
|
|
||||||
12
m/BSDX2E.m
12
m/BSDX2E.m
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [4/28/11 10:28am]
|
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/11/12 9:37am]
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
S LINE="",$P(LINE,"*",81)=""
|
S LINE="",$P(LINE,"*",81)=""
|
||||||
|
|
@ -23,7 +23,7 @@ VERSION ;
|
||||||
;Is the PIMS requirement present?
|
;Is the PIMS requirement present?
|
||||||
Q:'$$VERCHK("SD",5.3)
|
Q:'$$VERCHK("SD",5.3)
|
||||||
; Q:'$$PATCHCK("PIMS*5.3*1003") D
|
; Q:'$$PATCHCK("PIMS*5.3*1003") D
|
||||||
Q:'$$VERCHK("BMX",2)
|
Q:'$$VERCHK("BMX",4)
|
||||||
;
|
;
|
||||||
OTHER ;
|
OTHER ;
|
||||||
;Other checks
|
;Other checks
|
||||||
|
|
@ -90,7 +90,7 @@ V0200 ;EP Version 1.5 PostInit
|
||||||
. S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
|
. S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
|
||||||
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
||||||
. ; Error message
|
. ; Error message
|
||||||
. I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
|
. I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
|
||||||
;
|
;
|
||||||
; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
|
; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
|
||||||
; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
|
; 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)="@"
|
S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
|
||||||
D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
|
D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||||
; If error
|
; If error
|
||||||
I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
|
I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1))
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
; Now put in the default values for parameters
|
; 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)
|
D PUT^XPAR("PKG","BSDX AUTO PRINT RS",1,0,.BSDXERR)
|
||||||
I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
|
I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
|
||||||
D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR)
|
D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR)
|
||||||
I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
|
I $G(BSDXERR) D MES^XPDUTL("Error: ",BSDXERR)
|
||||||
QUIT
|
QUIT
|
||||||
;
|
;
|
||||||
SORRY(XPX) ;
|
SORRY(XPX) ;
|
||||||
|
|
|
||||||
27
m/BSDX30.m
27
m/BSDX30.m
|
|
@ -1,12 +1,12 @@
|
||||||
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [4/28/11 10:28am]
|
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [7/6/12 11:03am]
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP
|
SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP
|
||||||
;Entry point for debugging
|
;Entry point for debugging
|
||||||
;
|
;
|
||||||
D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
|
; D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
SPACE(BSDXY,BSDXDIC,BSDXVAL) ;EP
|
SPACE(BSDXY,BSDXDIC,BSDXVAL) ;EP
|
||||||
|
|
@ -48,7 +48,7 @@ ETRAP ;EP Error trap entry
|
||||||
;
|
;
|
||||||
EHRPTD(BSDXY,BSDXWID,BSDXDFN) ;
|
EHRPTD(BSDXY,BSDXWID,BSDXDFN) ;
|
||||||
;
|
;
|
||||||
D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
|
; D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
|
EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
|
||||||
|
|
@ -69,6 +69,9 @@ EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR
|
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
|
;Change patient context to patient DFN
|
||||||
;on all EHR client sessions associated with user DUZ
|
;on all EHR client sessions associated with user DUZ
|
||||||
|
|
@ -77,14 +80,14 @@ PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR
|
||||||
;If BSDXWID is "", the context change is sent to
|
;If BSDXWID is "", the context change is sent to
|
||||||
;all EHR client sessions belonging to user DUZ.
|
;all EHR client sessions belonging to user DUZ.
|
||||||
;
|
;
|
||||||
Q:'$G(DUZ)
|
;Q:'$G(DUZ)
|
||||||
;N X
|
;N X
|
||||||
;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T
|
;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T
|
||||||
;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T
|
;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T
|
||||||
N UID,BRET
|
;N UID,BRET
|
||||||
S BRET=0,UID=0
|
;S BRET=0,UID=0
|
||||||
F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D
|
;F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D
|
||||||
. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
|
;. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
|
||||||
. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
;. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||||
. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
|
;. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
|
||||||
Q
|
;Q
|
||||||
|
|
|
||||||
416
m/BSDX31.m
416
m/BSDX31.m
|
|
@ -1,220 +1,212 @@
|
||||||
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am
|
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:39am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
; Change Log:
|
; Change Log:
|
||||||
; v1.42 Oct 23 2010 WV/SMH
|
; v1.42 3101023 WV/SMH - Change transaction to restartable.
|
||||||
; - Change transaction to restartable. Thanks to Zach Gonzalez
|
; v1.42 3101206 UJO/SMH - Extensive refactoring
|
||||||
; --> and Rick Marshall for their help.
|
; v1.7 3120626 VEN/SMH - Removed transactions; extensive refactoring
|
||||||
; v1.42 Dec 6 2010: Extensive refactoring
|
; - Moved APTNS (whatever it was) to BSDXAPI1
|
||||||
;
|
; as $$NOSHOW
|
||||||
; Error Reference:
|
; - Made BSDXNOS extrinsic.
|
||||||
; -1: zero or null Appt ID
|
; - Moved Unit Tests to BSDXUT1
|
||||||
; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
|
; - BSDXNOS deletes no-show rather than file 0 for
|
||||||
; -3: No-show flag is invalid
|
; undoing a no show
|
||||||
; -4: Filing of No-show in ^BSDXAPPT failed
|
;
|
||||||
; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
|
; Error Reference:
|
||||||
; -100: M Error
|
; -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
|
||||||
|
;
|
||||||
|
;
|
||||||
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
|
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
|
||||||
;Entry point for debugging
|
;Entry point for debugging
|
||||||
;
|
;
|
||||||
D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
|
; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
|
||||||
Q
|
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
|
NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient
|
||||||
; Called by RPC: BSDX NOSHOW
|
; Called by RPC: BSDX NOSHOW
|
||||||
; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
|
; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
|
||||||
;
|
;
|
||||||
; Parameters:
|
; Parameters:
|
||||||
; BSDXY: Global Return
|
; BSDXY: Global Return
|
||||||
; BSDXAPTID is entry number in BSDX APPOINTMENT file
|
; BSDXAPTID is entry number in BSDX APPOINTMENT file
|
||||||
; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
|
; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
|
||||||
;
|
;
|
||||||
; Returns ADO.net record set with fields
|
; Returns ADO.net record set with fields
|
||||||
; - ERRORID; ERRORTEXT
|
; - ERRORID; ERRORTEXT
|
||||||
; ERRORID of 1 is okay
|
; ERRORID of 1 is okay
|
||||||
; Anything else is an error.
|
; Anything else is an error.
|
||||||
;
|
;
|
||||||
; Return Array; set and clear
|
; Return Array; set and clear
|
||||||
S BSDXY=$NA(^BSDXTMP($J))
|
S BSDXY=$NA(^BSDXTMP($J))
|
||||||
K ^BSDXTMP($J)
|
K ^BSDXTMP($J)
|
||||||
; $ET
|
;
|
||||||
N $ET S $ET="G ETRAP^BSDX31"
|
; $ET
|
||||||
; Basline vars
|
N $ET S $ET="G ETRAP^BSDX31"
|
||||||
D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
|
;
|
||||||
; Counter
|
; Basline vars
|
||||||
N BSDXI S BSDXI=0
|
D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
|
||||||
; Header Node
|
;
|
||||||
S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
|
; Counter
|
||||||
; Begin transaction
|
N BSDXI S BSDXI=0
|
||||||
TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29"
|
;
|
||||||
;;;test for error inside transaction. See if %ZTER works
|
; Header Node
|
||||||
I $G(bsdxdie) S X=1/0
|
S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
|
||||||
;;;TEST
|
;
|
||||||
;;;test for TRESTART
|
;;;test for error. See if %ZTER works
|
||||||
I $G(bsdxrestart) K bsdxrestart TRESTART
|
I $G(BSDXDIE) N X S X=1/0
|
||||||
;;;test
|
;;;TEST
|
||||||
; Turn off SDAM APPT PROTOCOL BSDX Entries
|
;
|
||||||
N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
|
; Turn off SDAM APPT PROTOCOL BSDX Entries
|
||||||
; Appointment ID check
|
N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
|
||||||
I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
|
;
|
||||||
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
|
; Appointment ID check
|
||||||
; Noshow value check - Must be 1 or 0
|
I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
|
||||||
S BSDXNS=+BSDXNS
|
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
|
||||||
I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
|
;
|
||||||
; Get Some data
|
; Lock BSDX node, only to synchronize access to the globals.
|
||||||
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
|
; It's not expected that the error will ever happen as no filing
|
||||||
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
; is supposed to take 5 seconds.
|
||||||
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time
|
L +^BSDXAPPT(BSDXAPTID):5 E D ERR(-7,"BSDX31: Appt record is locked. Please contact technical support.") Q
|
||||||
; Edit BSDX APPOINTMENT entry
|
;
|
||||||
N BSDXMSG ;
|
; Noshow value check - Must be 1 or 0
|
||||||
D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field
|
S BSDXNS=+BSDXNS
|
||||||
I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q
|
I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
|
||||||
; Edit File 2 "S" node entry
|
;
|
||||||
N BSDXZ,BSDXERR ; Error variables to control looping
|
; Get Some data
|
||||||
S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
|
N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
|
||||||
; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2
|
N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
|
||||||
I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q
|
N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time
|
||||||
. S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
N BSDXRES S BSDXRES=$P(BSDXNOD,U,7) ; Resource ID
|
||||||
. S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
|
;
|
||||||
. I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
|
; Check if Resource ID is missing or invalid
|
||||||
;
|
I BSDXRES="" D ERR(-6,"BSDX31: Invalid Resource") QUIT
|
||||||
TCOMMIT
|
I '$D(^BSDXRES(BSDXRES,0)) D ERR(-6,"BSDX31: Invalid Resource") QUIT
|
||||||
S BSDXI=BSDXI+1
|
;
|
||||||
S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
|
; Get the Hospital Location
|
||||||
S BSDXI=BSDXI+1
|
N BSDXRESNOD S BSDXRESNOD=^BSDXRES(BSDXRES,0)
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
N BSDXLOC S BSDXLOC=$P(BSDXRESNOD,U,4) ;HOSPITAL LOCATION
|
||||||
QUIT
|
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
|
||||||
APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ;
|
; to be too helpful... but I will postpone that until this is a need.
|
||||||
; update file 2 info
|
;
|
||||||
;Set noshow for patient BSDXDFN in clinic BSDXSC1
|
; Check if it's okay to no-show patient.
|
||||||
;at time BSDXSD
|
N BSDXERR S BSDXERR=0 ; Error variable
|
||||||
N BSDXC,%H,BSDXCDT,BSDXIEN
|
I BSDXLOC S BSDXERR=$$NOSHOWCK^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS)
|
||||||
N BSDXIENS,BSDXFDA,BSDXMSG
|
I BSDXERR D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT
|
||||||
S %H=$H D YMD^%DTC
|
;
|
||||||
S BSDXCDT=X+%
|
; Simulated Error
|
||||||
;
|
I $G(BSDXSIMERR1) D ERR(-4,"BSDX31: Simulated Error") QUIT
|
||||||
S BSDXIENS=BSDXSD_","_BSDXDFN_","
|
; Edit BSDX APPOINTMENT entry No-show field
|
||||||
I +BSDXNS D
|
; Failure Analysis: If we fail here, no rollback needed, as this is the 1st
|
||||||
. S BSDXFDA(2.98,BSDXIENS,3)="N"
|
; call
|
||||||
. S BSDXFDA(2.98,BSDXIENS,14)=DUZ
|
N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS)
|
||||||
. S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
|
I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT
|
||||||
E D
|
;
|
||||||
. S BSDXFDA(2.98,BSDXIENS,3)=""
|
; Edit File 2 "S" node entry
|
||||||
. S BSDXFDA(2.98,BSDXIENS,14)=""
|
; Failure Analysis: If we fail here, we need to rollback the BSDX
|
||||||
. S BSDXFDA(2.98,BSDXIENS,15)=""
|
; Apptointment Entry
|
||||||
K BSDXIEN
|
N BSDXERR S BSDXERR=0 ; Error variable
|
||||||
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
; If HL exist, (resource is linked to PIMS), file no show in File 2
|
||||||
S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
|
I BSDXLOC S BSDXERR=$$NOSHOW^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS)
|
||||||
Q
|
I BSDXERR D QUIT
|
||||||
;
|
. D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2))
|
||||||
BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ;
|
. N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; no error checking for filer
|
||||||
;
|
;
|
||||||
N BSDXFDA,BSDXIENS
|
; Unlock
|
||||||
S BSDXIENS=BSDXAPTID_","
|
L -^BSDXAPPT(BSDXAPTID)
|
||||||
S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
|
;
|
||||||
D FILE^DIE("","BSDXFDA","BSDXMSG")
|
; Return data in ADO.net table
|
||||||
QUIT
|
S BSDXI=BSDXI+1
|
||||||
;
|
S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
|
||||||
|
S BSDXI=BSDXI+1
|
||||||
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT
|
||||||
|
; 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
|
||||||
|
;
|
||||||
NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event
|
NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event
|
||||||
;when appointments NOSHOW via PIMS interface.
|
;when appointments NOSHOW via PIMS interface.
|
||||||
;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
|
;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
|
||||||
;
|
;
|
||||||
Q:+$G(BSDXNOEV)
|
Q:+$G(BSDXNOEV)
|
||||||
Q:'+$G(BSDXSC)
|
Q:'+$G(BSDXSC)
|
||||||
Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
|
Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
|
||||||
N BSDXSTAT,BSDXFOUND,BSDXRES
|
N BSDXSTAT,BSDXFOUND,BSDXRES
|
||||||
S BSDXSTAT=1
|
S BSDXSTAT=1
|
||||||
S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
|
S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
|
||||||
S BSDXFOUND=0
|
S BSDXFOUND=0
|
||||||
I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
|
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 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 $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
|
||||||
I BSDXFOUND D NOSEVT3(BSDXRES)
|
I BSDXFOUND D NOSEVT3(BSDXRES)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
|
NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
|
||||||
;Get appointment id in BSDXAPT
|
;Get appointment id in BSDXAPT
|
||||||
;If found, call BSDXNOS(BSDXAPPT) and return 1
|
;If found, call BSDXNOS(BSDXAPPT) and return 1
|
||||||
;else return 0
|
;else return 0
|
||||||
N BSDXFOUND,BSDXAPPT
|
N BSDXFOUND,BSDXAPPT,BSDXNOD
|
||||||
S BSDXFOUND=0
|
S BSDXFOUND=0
|
||||||
Q:'+$G(BSDXRES) BSDXFOUND
|
Q:'+$G(BSDXRES) BSDXFOUND
|
||||||
Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) 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 BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
|
||||||
. 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 $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
|
||||||
I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
|
I BSDXFOUND,+$G(BSDXAPPT) N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPPT,BSDXSTAT)
|
||||||
Q BSDXFOUND
|
I BSDXMSG D ^%ZTER ; Last ditch error handling. This is supposed to be silently called from the protocol file.
|
||||||
;
|
Q BSDXFOUND
|
||||||
|
;
|
||||||
NOSEVT3(BSDXRES) ;
|
NOSEVT3(BSDXRES) ;
|
||||||
;Call RaiseEvent to notify GUI clients
|
;Call RaiseEvent to notify GUI clients
|
||||||
;
|
;
|
||||||
N BSDXRESN
|
N BSDXRESN
|
||||||
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
|
S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
|
||||||
Q:BSDXRESN=""
|
Q:BSDXRESN=""
|
||||||
S BSDXRESN=$P(BSDXRESN,"^")
|
S BSDXRESN=$P(BSDXRESN,"^")
|
||||||
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
|
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
ERR(BSDXERID,ERRTXT) ;Error processing
|
ERR(BSDXERID,ERRTXT) ;Error processing
|
||||||
S BSDXI=BSDXI+1
|
; Unlock first
|
||||||
S ERRTXT=$TR(ERRTXT,"^","~")
|
L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
|
||||||
I $TL>0 TROLLBACK
|
; If last line is $C(31), we are done. No more errors to send to client.
|
||||||
S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
|
I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
||||||
S BSDXI=BSDXI+1
|
S BSDXI=BSDXI+1
|
||||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
S ERRTXT=$TR(ERRTXT,"^","~")
|
||||||
QUIT
|
S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
|
||||||
;
|
S BSDXI=BSDXI+1
|
||||||
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
ETRAP ;EP Error trap entry
|
ETRAP ;EP Error trap entry
|
||||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||||
; Rollback, otherwise ^XTER will be empty from future rollback
|
D ^%ZTER
|
||||||
I $TL>0 TROLLBACK
|
;
|
||||||
D ^%ZTER
|
; Send to client
|
||||||
S $EC="" ; Clear Error
|
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||||
; Send to client
|
D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
|
||||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
Q:$Q 100_U_"Mumps Error" Q
|
||||||
D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
|
;
|
||||||
QUIT
|
|
||||||
;
|
|
||||||
IMHERE(BSDXRES) ;EP
|
IMHERE(BSDXRES) ;EP
|
||||||
;Entry point for BSDX IM HERE remote procedure
|
;Entry point for BSDX IM HERE remote procedure
|
||||||
S BSDXRES=1
|
S BSDXRES=1
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
|
BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
; Mods by WV/STAR
|
; Mods by WV/STAR
|
||||||
;
|
;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/21/12 3:57pm
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
416
m/BSDXAPI.m
416
m/BSDXAPI.m
|
|
@ -1,43 +1,18 @@
|
||||||
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am
|
BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/10/12 5:58pm
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
|
; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
|
||||||
;local mods (many) by WV/SMH
|
; mods (many) by WV/SMH
|
||||||
;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
|
; Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
|
||||||
; Change History:
|
; Change history is located in BSDXAPI1 (to save space).
|
||||||
; 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
|
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
|
; 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
|
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
|
||||||
; for Baby foxes hallucinations.
|
; for Baby foxes hallucinations.
|
||||||
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
|
; 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("PAT")=DFN ;DFN
|
||||||
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
||||||
S BSDR("TYP")=TYP ;3 sched or 4 walkin
|
S BSDR("TYP")=TYP ;3 sched or 4 walkin
|
||||||
|
|
@ -64,35 +39,15 @@ MAKE(BSDR) ;PEP; call to store appt made
|
||||||
; = 0 or null: everything okay
|
; = 0 or null: everything okay
|
||||||
; = 1^message: error and reason
|
; = 1^message: error and reason
|
||||||
;
|
;
|
||||||
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
|
N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment
|
||||||
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
|
I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why.
|
||||||
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"))
|
|
||||||
;
|
;
|
||||||
;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.
|
;Otherwise, we continue
|
||||||
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
|
|
||||||
;
|
;
|
||||||
; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
|
N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables
|
||||||
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
|
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
|
||||||
. ; "un-cancel" existing appt in file 2
|
. ; "un-cancel" existing appt in file 2
|
||||||
. N BSDXFDA,BSDXIENS,BSDXMSG
|
|
||||||
. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
|
. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
|
||||||
. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
|
. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"3")=""
|
. S BSDXFDA(2.98,BSDXIENS,"3")=""
|
||||||
|
|
@ -101,27 +56,37 @@ MAKE(BSDR) ;PEP; call to store appt made
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"14")=""
|
. S BSDXFDA(2.98,BSDXIENS,"14")=""
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"15")=""
|
. S BSDXFDA(2.98,BSDXIENS,"15")=""
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"16")=""
|
. 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,"19")=""
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
|
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
|
||||||
. D FILE^DIE("","BSDXFDA","BSDXMSG")
|
. D FILE^DIE("","BSDXFDA","BSDXMSG")
|
||||||
. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
|
Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
|
||||||
E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
|
;
|
||||||
. N BSDXFDA,BSDXIENS,BSDXMSG
|
Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line
|
||||||
|
;
|
||||||
|
E D ; File new appointment/edit existing appointment in file 2
|
||||||
. S BSDXIENS="?+2,"_BSDR("PAT")_","
|
. S BSDXIENS="?+2,"_BSDR("PAT")_","
|
||||||
. S BSDXIENS(2)=BSDR("ADT")
|
. S BSDXIENS(2)=BSDR("ADT")
|
||||||
. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
|
. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
|
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
|
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
|
||||||
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
|
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
|
||||||
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
|
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG")
|
||||||
; add appt to file 44
|
Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
|
||||||
K DIC,DA,X,Y,DLAYGO,DD,DO
|
;
|
||||||
|
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
|
||||||
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
|
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")
|
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="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
|
||||||
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
|
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
|
||||||
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
|
. 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
|
; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
|
||||||
;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
|
;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
|
||||||
;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||||
|
|
@ -142,6 +107,12 @@ 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)
|
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
|
; call event driver
|
||||||
NEW DFN,SDT,SDCL,SDDA,SDMODE
|
NEW DFN,SDT,SDCL,SDDA,SDMODE
|
||||||
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
|
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
|
||||||
|
|
@ -149,10 +120,67 @@ MAKE(BSDR) ;PEP; call to store appt made
|
||||||
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
|
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
|
||||||
Q 0
|
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
|
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
|
; Call like this for DFN 23435 checking in now at Hospital Location 33
|
||||||
; for appt at Dec 20, 2009 @ 10:11:59
|
; for appt at Dec 20, 2009 @ 10:11:59
|
||||||
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
|
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
|
||||||
|
N BSDR
|
||||||
S BSDR("PAT")=DFN ;DFN
|
S BSDR("PAT")=DFN ;DFN
|
||||||
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
||||||
S BSDR("ADT")=APDATE ;Appt Date
|
S BSDR("ADT")=APDATE ;Appt Date
|
||||||
|
|
@ -175,6 +203,70 @@ CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PAT
|
||||||
; = 0 means everything worked
|
; = 0 means everything worked
|
||||||
; = 1^message means error with reason message
|
; = 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(^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 '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
|
||||||
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
|
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
|
||||||
|
|
@ -184,29 +276,8 @@ CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PAT
|
||||||
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
|
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
|
; find ien for appt in file 44
|
||||||
NEW IEN,DIE,DA,DR
|
N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||||
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")
|
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
|
Q 0
|
||||||
;
|
;
|
||||||
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
|
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
|
||||||
|
|
@ -215,6 +286,7 @@ 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)
|
; 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.
|
; because foxes come out during bad weather.
|
||||||
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
|
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
|
||||||
|
N BSDR
|
||||||
S BSDR("PAT")=DFN
|
S BSDR("PAT")=DFN
|
||||||
S BSDR("CLN")=CLIN
|
S BSDR("CLN")=CLIN
|
||||||
S BSDR("TYP")=TYP
|
S BSDR("TYP")=TYP
|
||||||
|
|
@ -243,6 +315,70 @@ CANCEL(BSDR) ;PEP; called to cancel appt
|
||||||
; = 0 or null: everything okay
|
; = 0 or null: everything okay
|
||||||
; = 1^message: error and reason
|
; = 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(^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 '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
|
||||||
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
|
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
|
||||||
|
|
@ -253,45 +389,11 @@ CANCEL(BSDR) ;PEP; called to cancel appt
|
||||||
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
|
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"))
|
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
|
||||||
;
|
;
|
||||||
NEW IEN,DIE,DA,DR
|
NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||||
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
|
||||||
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
|
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
|
||||||
;
|
;
|
||||||
; BSDX 1.5 3110125
|
; Check-out check. New in v1.7
|
||||||
; UJO/SMH - Add ability to remove check-in if the patient is checked in
|
I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!"
|
||||||
; 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
|
Q 0
|
||||||
;
|
;
|
||||||
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
|
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
|
||||||
|
|
@ -301,44 +403,12 @@ 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)
|
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
|
||||||
Q $S(X:1,1:0)
|
Q $S(X:1,1:0)
|
||||||
;
|
;
|
||||||
RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
|
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
|
||||||
; PAT = DFN
|
NEW X
|
||||||
; CLINIC = SC IEN
|
S X=$G(SDIEN) ;ien sent in call
|
||||||
; DATE = FM Date/Time of Appointment
|
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)
|
||||||
; Returns:
|
Q $S(X:1,1:0)
|
||||||
; 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
|
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
|
||||||
NEW X,IEN
|
NEW X,IEN
|
||||||
|
|
@ -347,30 +417,12 @@ SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
|
||||||
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
|
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
|
||||||
Q $G(IEN)
|
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)
|
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)
|
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
|
||||||
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
|
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
|
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
|
||||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change History (BSDXAPI and BSDXAPI1)
|
; Change History (BSDXAPI and BSDXAPI1)
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:31am
|
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 7/6/12 11:07am
|
||||||
;;1.6;BSDX;;Aug 31, 2011;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
@ -17,7 +17,7 @@ ERR(BSDXERR) ;Error processing
|
||||||
;
|
;
|
||||||
PD(BSDXY,HLIEN) ;EP Debugging entry point
|
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
|
Q
|
||||||
;
|
;
|
||||||
|
|
@ -32,7 +32,7 @@ P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location
|
||||||
;
|
;
|
||||||
S BSDXI=0
|
S BSDXI=0
|
||||||
I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
|
I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
|
||||||
D ^XBKVAR
|
D ^XBKVAR
|
||||||
N $ET S $ET="G ERROR^BSDXGPRV"
|
N $ET S $ET="G ERROR^BSDXGPRV"
|
||||||
K ^BSDXTMP($J)
|
K ^BSDXTMP($J)
|
||||||
S BSDXY=$NA(^BSDXTMP($J))
|
S BSDXY=$NA(^BSDXTMP($J))
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
|
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
|
||||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
; Licensed under LGPL
|
; Licensed under LGPL
|
||||||
;
|
;
|
||||||
; Change Log:
|
; Change Log:
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm
|
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm
|
||||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
EN ; Run All Unit Tests in this routine
|
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
|
BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 3:18pm
|
||||||
;;1.7;BSDX;;Oct 04, 2012;Build 25
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
||||||
;
|
;
|
||||||
EN ; Run all unit tests in this routine
|
EN ; Run all unit tests in this routine
|
||||||
D UT25,PIMS
|
D UT25,PIMS
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue