From dfc37db849ba13b4e5281eb210ca80d6c365448e Mon Sep 17 00:00:00 2001 From: tariq Date: Sat, 1 Jun 2013 14:54:38 +0000 Subject: [PATCH] Ayman Ghaith : adding the correct routines which not has the transactions. --- m/BSDX01.m | 99 ++++---- m/BSDX02.m | 9 +- m/BSDX03.m | 2 +- m/BSDX04.m | 6 +- m/BSDX05.m | 2 +- m/BSDX06.m | 2 +- m/BSDX07.m | 630 ++++++++++++++++++++++----------------------------- m/BSDX08.m | 278 +++++++---------------- m/BSDX09.m | 4 +- m/BSDX11.m | 2 +- m/BSDX12.m | 2 +- m/BSDX13.m | 2 +- m/BSDX14.m | 2 +- m/BSDX15.m | 2 +- m/BSDX16.m | 2 +- m/BSDX17.m | 2 +- m/BSDX18.m | 2 +- m/BSDX19.m | 2 +- m/BSDX20.m | 2 +- m/BSDX21.m | 2 +- m/BSDX22.m | 2 +- m/BSDX23.m | 2 +- m/BSDX24.m | 2 +- m/BSDX25.m | 253 ++++++++++++--------- m/BSDX26.m | 249 ++++++++++---------- m/BSDX27.m | 2 +- m/BSDX28.m | 41 ++-- m/BSDX29.m | 112 ++++----- m/BSDX2E.m | 12 +- m/BSDX30.m | 27 ++- m/BSDX31.m | 416 +++++++++++++++++----------------- m/BSDX32.m | 2 +- m/BSDX33.m | 2 +- m/BSDX34.m | 2 +- m/BSDX35.m | 4 +- m/BSDXAPI.m | 416 +++++++++++++++++++--------------- m/BSDXAPI1.m | 2 +- m/BSDXGPRV.m | 8 +- m/BSDXUT.m | 2 +- m/BSDXUT1.m | 2 +- m/BSDXUT2.m | 2 +- 41 files changed, 1264 insertions(+), 1350 deletions(-) diff --git a/m/BSDX01.m b/m/BSDX01.m index ed37030..b22fdb9 100644 --- a/m/BSDX01.m +++ b/m/BSDX01.m @@ -1,13 +1,15 @@ -BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:46pm - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1/29/13 12:53pm + ;;1.7;BSDX;;Jun 01, 2013;Build 2 ; Licensed under LGPL ; SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)") ; Q - ; -SUINFO(BSDXY,BSDXDUZ) ;EP + ;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]. + ;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 ;Returns ADO Recordset having column MANAGER ;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE @@ -20,11 +22,14 @@ SUINFO(BSDXY,BSDXDUZ) ;EP S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30) ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys 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 BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30) - S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR + S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR Q DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point ; @@ -281,44 +286,43 @@ GP(BSDXY,PARAM) ; Get Param - EP QUIT ; INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user? - ; Input: BSDXSC - Hospital Location IEN - ; Output: True or False - I '+BSDXSC QUIT 1 ;If not tied to clinic, yes - I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes - ; Jump to Division:Medical Center Division:Inst File Pointer for - ; Institution IEN (and get its internal value) - N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I") - I DIV="" Q 1 ; If clinic has no division, consider it avial to user. - I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic - E Q 0 ; Otherwise, no - QUIT + ; Input: BSDXSC - Hospital Location IEN + ; Output: True or False + I '+BSDXSC QUIT 1 ;If not tied to clinic, yes + I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes + ; Jump to Division:Medical Center Division:Inst File Pointer for + ; Institution IEN (and get its internal value) + N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I") + I DIV="" Q 1 ; If clinic has no division, consider it avial to user. + I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic + E Q 0 ; Otherwise, no INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user? - ; Input BSDXRES - BSDX RESOURCE IEN - ; Output: True of False - Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV -UnitTestINDIV - W "Testing if they are the same",! - S DUZ(2)=67 - I '$$INDIV(1) W "ERROR",! - I '$$INDIV(2) W "ERROR",! - W "Testing if Div not defined in 44, should be true",! - I '$$INDIV(3) W "ERROR",! - W "Testing empty string. Should be true",! - I '$$INDIV("") W "ERROR",! - W "Testing if they are different",! - S DUZ(2)=899 - I $$INDIV(1) W "ERROR",! - I $$INDIV(2) W "ERROR",! - QUIT -UnitTestINDIV2 - W "Testing if they are the same",! - S DUZ(2)=69 - I $$INDIV2(22)'=0 W "ERROR",! - I $$INDIV2(25)'=1 W "ERROR",! - I $$INDIV2(26)'=1 W "ERROR",! - I $$INDIV2(27)'=1 W "ERROR",! - QUIT - ; + ; Input BSDXRES - BSDX RESOURCE IEN + ; Output: True of False + Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV +UTINDIV ; Unit Test $$INDIV + W "Testing if they are the same",! + S DUZ(2)=67 + I '$$INDIV(1) W "ERROR",! + I '$$INDIV(2) W "ERROR",! + W "Testing if Div not defined in 44, should be true",! + I '$$INDIV(3) W "ERROR",! + W "Testing empty string. Should be true",! + I '$$INDIV("") W "ERROR",! + W "Testing if they are different",! + S DUZ(2)=899 + I $$INDIV(1) W "ERROR",! + I $$INDIV(2) W "ERROR",! + QUIT +UTINDIV2 ; Unit Test $$INDIV2 + W "Testing if they are the same",! + S DUZ(2)=69 + I $$INDIV2(22)'=0 W "ERROR",! + I $$INDIV2(25)'=1 W "ERROR",! + I $$INDIV2(26)'=1 W "ERROR",! + I $$INDIV2(27)'=1 W "ERROR",! + QUIT + ; 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 ; @@ -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 ; 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 - ; - ;;EHS/MKH,BAH;;UJO*1.0*143;;30/09/2012;; Update [Fix the performance issue in SchedGUI] - ; START OF CODE CHANGES FOR [UJO*1.0*143] + ;;EHS/MKH,BAH;;BSDX 1.7;;30/09/2012;; Update [Fix the performance issue in SchedGUI] + ; START OF CODE CHANGES FOR [BSDX 1.7] ; 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") - ; END OF CODE CHANGES FOR [UJO*1.0*143] + ; END OF CODE CHANGES FOR [BSDX 1.7] ; IF $DATA(BSDXERR) GOTO END ; diff --git a/m/BSDX02.m b/m/BSDX02.m index 089b499..c4dee9d 100644 --- a/m/BSDX02.m +++ b/m/BSDX02.m @@ -1,5 +1,5 @@ -BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ;Licensed under LGPL ; Change Log ; 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) S BSDXERR="" 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") ; ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y ; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q - ; + ; S BSDXI=0 D STRES ; diff --git a/m/BSDX03.m b/m/BSDX03.m index 6d35825..da67496 100644 --- a/m/BSDX03.m +++ b/m/BSDX03.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX04.m b/m/BSDX04.m index b5cb8f1..26b9d93 100644 --- a/m/BSDX04.m +++ b/m/BSDX04.m @@ -1,5 +1,5 @@ -BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:15am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/6/12 10:55am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; Change Log: ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates @@ -73,7 +73,7 @@ CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP -- RPC: BSDX CRE . S BSDXRESN=$P(BSDXRES,"|",BSDXCOUN) . Q:BSDXRESN="" . Q:'$D(^BSDXRES("B",BSDXRESN)) - . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) + . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) . Q:'+BSDXRESD . Q:'$D(^BSDXAB("ARSCT",BSDXRESD)) . S BSDXBS=0 diff --git a/m/BSDX05.m b/m/BSDX05.m index 897fab9..1e459cb 100644 --- a/m/BSDX05.m +++ b/m/BSDX05.m @@ -1,5 +1,5 @@ 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 ; ; Change Log: diff --git a/m/BSDX06.m b/m/BSDX06.m index 8722464..df978f9 100644 --- a/m/BSDX06.m +++ b/m/BSDX06.m @@ -1,5 +1,5 @@ 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 ; Change Log: ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get diff --git a/m/BSDX07.m b/m/BSDX07.m index ff56397..041af07 100644 --- a/m/BSDX07.m +++ b/m/BSDX07.m @@ -1,360 +1,284 @@ -BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 - ; Licensed under LGPL - ; - ; Change Log: - ; UJO/SMH - ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US. - ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments - ; thanks to Rick Marshall and Zach Gonzalez at Oroville. - ; v1.42 Oct 30 2010 - Extensive refactoring. - ; v1.5 Mar 15 2011 - End time does not have to have time anymore. - ; It could be midnight of the next day - ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... - ; - ; Error Reference: - ; -1: Patient Record is locked. This means something is wrong!!!! - ; -2: Start Time is not a valid Fileman date - ; -3: End Time is not a valid Fileman date - ; v1.5:obsolete::-4: End Time does not have time inside of it. - ; -5: BSDXPATID is not numeric - ; -6: Patient Does not exist in ^DPT - ; -7: Resource Name does not exist in B index of BSDX RESOURCE - ; -8: Resouce doesn't exist in ^BSDXRES - ; -9: Couldn't add appointment to BSDX APPOINTMENT - ; -10: Couldn't add appointment to files 2 and/or 44 - ; -100: Mumps Error - +BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:02pm + ;;1.7;BSDX;;Jun 01, 2013;Build 24 + ; Licensed under LGPL + ; + ; Change Log: + ; UJO/SMH + ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US. + ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments + ; v1.42 Oct 30 2010 - Extensive refactoring. + ; v1.5 Mar 15 2011 - End time does not have to have time anymore. + ; It could be midnight of the next day + ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... + ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes + ; - AVUPDT moved to AVUPDTMK in BSDXAPI1 + ; + ; Error Reference: + ; -1: Patient Record is locked. This means something is wrong!!!! + ; -2: Start Time is not a valid Fileman date + ; -3: End Time is not a valid Fileman date + ; v1.5:obsolete::-4: End Time does not have time inside of it. + ; -5: BSDXPATID is not numeric + ; -6: Patient Does not exist in ^DPT + ; -7: Resource Name does not exist in B index of BSDX RESOURCE + ; -8: Resouce doesn't exist in ^BSDXRES + ; -9: Couldn't add appointment to BSDX APPOINTMENT + ; -10: Couldn't add appointment to files 2 and/or 44 + ; -100: Mumps Error + ; APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP - ;Entry point for debugging - D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") - Q - ; -UT ; Unit Tests - N ZZZ - ; Test for bad start date - D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",! - ; Test for bad end date - D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",! - ; Test for end date without time - D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",! - ; Test for mumps error - S bsdxdie=1 - D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",! - K bsdxdie - ; Test for TRESTART - s bsdxrestart=1 - D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",! - k bsdxrestart - ; Test for non-numeric patient - D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",! - ; Test for a non-existent patient - D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",! - ; Test for a non-existent resource name - D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",! - ; Test for corrupted resource - ; Can't test for -8 since it requires DB corruption - ; Test for inability to add appointment to BSDX Appointment - ; Also requires something wrong in the DB - ; Test for inability to add appointment to 2,44 - ; Test by creating a duplicate appointment - D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) - D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) - I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",! - ; Test for normality: - D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1) - ; Does Appt exist? - N APPID S APPID=+$P(^BSDXTMP($J,1),U) - I 'APPID W "Error Making Appt-1" QUIT - I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2" - I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3" - I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4" - QUIT - ; -APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP - ; - ;Called by RPC: BSDX ADD NEW APPOINTMENT - ; - ;Add new appointment to 3 files - ; - BSDX APPOINTMENT - ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic - ; - Patient Appointment Subfile if Resource is linked to clinic - ; - ;Paramters: - ;BSDXY: Global Return (RPC must be set to Global Array) - ;BSDXSTART: FM Start Date - ;BSDXEND: FM End Date - ;BSDXPATID: Patient DFN - ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN) - ;BSDXLEN is the appointment duration in minutes - ;BSDXNOTE is the Appiontment Note - ;BSDXATID is used for 2 purposes: - ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. - ; if BSDXATID = a number, then it is the access type id (used for rebooking) - ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional) - ; - ;Return: - ; ADO.net Recordset having fields: - ; AppointmentID and ErrorNumber - ; - ;Test lines: - ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN - ; - ; Deal with optional arguments - S BSDXRADEXAM=$G(BSDXRADEXAM) - ; Return Array; set Return and clear array - S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; $ET - N $ET S $ET="G ETRAP^BSDX07" - ; Counter - N BSDXI S BSDXI=0 - ; Lock BSDX node, only to synchronize access to the globals. - ; It's not expected that the error will ever happen as no filing - ; is supposed to take 5 seconds. - L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q - ; Header Node - S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30) - ;Restartable Transaction; restore paramters when starting. - ; (Params restored are what's passed here + BSDXI) - TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07" - ; - ; Turn off SDAM APPT PROTOCOL BSDX Entries - N BSDXNOEV - S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol - ; - ; Set Error Message to be empty - N BSDXERR S BSDXERR=0 - ; - ;;;test for error inside transaction. See if %ZTER works - I $G(bsdxdie) S X=1/0 - ;;;test - ;;;test for TRESTART - I $G(bsdxrestart) K bsdxrestart TRESTART - ;;;test - ; - ; -- Start and End Date Processing -- - ; If C# sends the dates with extra zeros, remove them - S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND - ; Are the dates valid? Must be FM Dates > than 2010 - I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q - I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q - ; - ;; If Ending date doesn't have a time, this is an error --rm 1.5 - ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q - ; - ; If the Start Date is greater than the end date, swap dates - N BSDXTMP - I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP - ; - ; Check if the patient exists: - ; - DFN valid number? - ; - Valid Patient in file 2? - I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q - I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q - ; - ;Validate Resource entry - I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q - N BSDXRESD ; Resource IEN - S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) - N BSDXRNOD ; Resouce zero node - S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) - I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q - ; - ; Walk-in (Unscheduled) Appointment? - N BSDXWKIN S BSDXWKIN=0 - I BSDXATID="WALKIN" S BSDXWKIN=1 - ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number - I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" - ; - ; Done with all checks, let's make appointment in BSDX APPOINTMENT - N BSDXAPPTID - S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) - I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q - I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) - ; - ; Then Create Subfiles in 2/44 Appointment - N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN - ; Only if we have a valid Hosp Loc can we make an appointment - I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR) Q - . N BSDXC - . S BSDXC("PAT")=BSDXPATID - . S BSDXC("CLN")=BSDXSCD - . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins - . S:BSDXWKIN BSDXC("TYP")=4 - . S BSDXC("ADT")=BSDXSTART - . S BSDXC("LEN")=BSDXLEN - . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field - . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI - . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note - . S BSDXC("USR")=DUZ - . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) - . Q:BSDXERR - . ;Update RPMS Clinic availability - . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) - . Q - ; - ;Return Recordset - TCOMMIT - L -^BSDXAPPT(BSDXPATID) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - Q -BSDXDEL(BSDXAPPTID) ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN - N DA,DIK - S DIK="^BSDXAPPT(",DA=BSDXAPPTID - D ^DIK - Q - ; + ;Entry point for debugging + ; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") + Q + ; +APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP + ; + ;Called by RPC: BSDX ADD NEW APPOINTMENT + ; + ;Add new appointment to 3 files + ; - BSDX APPOINTMENT + ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic + ; - Patient Appointment Subfile if Resource is linked to clinic + ; + ;Paramters: + ;BSDXY: Global Return (RPC must be set to Global Array) + ;BSDXSTART: FM Start Date + ;BSDXEND: FM End Date + ;BSDXPATID: Patient DFN + ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN) + ;BSDXLEN is the appointment duration in minutes + ;BSDXNOTE is the Appiontment Note + ;BSDXATID is used for 2 purposes: + ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. + ; if BSDXATID = a number, then it is the access type id (used for rebooking) + ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional) + ; + ;Return: + ; ADO.net Recordset having fields: + ; AppointmentID and ErrorNumber + ; + ; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers + ; to sort out. Needs changes on client. + ; + ;Test lines: + ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN + ; + ; Deal with optional arguments + S BSDXRADEXAM=$G(BSDXRADEXAM) + ; + ; Return Array; set Return and clear array + S BSDXY=$NA(^BSDXTMP($J)) + K ^BSDXTMP($J) + ; + ; $ET + N $ET S $ET="G ETRAP^BSDX07" + ; + ; Counter + N BSDXI S BSDXI=0 + ; + ; Lock BSDX node, only to synchronize access to the globals. + ; It's not expected that the error will ever happen as no filing + ; is supposed to take 5 seconds. + L +^BSDXPAT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q + ; + ; Header Node + S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30) + ; + ; Turn off SDAM APPT PROTOCOL BSDX Entries + N BSDXNOEV + S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol + ; + ; Set Error Message to be empty + N BSDXERR S BSDXERR=0 + ; + ;;;test for error. See if %ZTER works + I $G(BSDXDIE) N X S X=1/0 + ;;;test + ; + ; -- Start and End Date Processing -- + ; If C# sends the dates with extra zeros, remove them + S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND + ; Are the dates valid? Must be FM Dates > than 2010 + I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q + I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q + ; + ;; If Ending date doesn't have a time, this is an error --rm 1.5 + ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q + ; + ; If the Start Date is greater than the end date, swap dates + N BSDXTMP + I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP + ; + ; Check if the patient exists: + ; - DFN valid number? + ; - Valid Patient in file 2? + I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q + I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q + ; + ;Validate Resource entry + I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q + N BSDXRESD ; Resource IEN + S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) + N BSDXRNOD ; Resouce zero node + S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) + I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q + ; + ; Walk-in (Unscheduled) Appointment? + N BSDXWKIN S BSDXWKIN=0 + I BSDXATID="WALKIN" S BSDXWKIN=1 + ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number + I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" + ; + ; Now, check if PIMS has any issues with us making the appt using MAKECK + N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN + N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK + N BSDXC ; Array to send to MAKE and MAKECK APIs + ; Only if we have a valid Hosp Location + I +BSDXSCD,$D(^SC(BSDXSCD,0)) D + . S BSDXC("PAT")=BSDXPATID + . S BSDXC("CLN")=BSDXSCD + . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins + . S:BSDXWKIN BSDXC("TYP")=4 + . S BSDXC("ADT")=BSDXSTART + . S BSDXC("LEN")=BSDXLEN + . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field + . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI + . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note + . S BSDXC("USR")=DUZ + . S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC) + I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back + ; + ; Done with all checks, let's make appointment in BSDX APPOINTMENT + N BSDXAPPTID + S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) + I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q ; no roll back needed! No appts made. + I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here + ; I don't think it's important b/c users can detect right away if the WP + ; filing fails. + ; + I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q ; UT Line + ; + ; Only if we have a valid Hosp Loc can we make an appointment in 2/44 + ; Use BSDXC array from before. + ; FYI: $$MAKE itself calls $$MAKECK to check again for being okay. + ; If an error happens here, we roll back both ^BSDXAPPT and 2/44 by deleting + N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK + I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) + I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q + ; + ; Unlock + L -^BSDXPAT(BSDXPATID) + ; + ;Return Recordset + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + Q STRIP(BSDXZ) ;Replace control characters with spaces - N BSDXI - F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) - Q BSDXZ - ; + N BSDXI + F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) + Q BSDXZ + ; BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY - ;Returns ien in BSDXAPPT or 0 if failed - ;Create entry in BSDX APPOINTMENT - N BSDXAPPTID - S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART - S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND - S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID - S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD - S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) - S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT - S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" - S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID - S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM - N BSDXIEN,BSDXMSG - D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") - S BSDXAPPTID=+$G(BSDXIEN(1)) - Q BSDXAPPTID - ; + ;Returns ien in BSDXAPPT or 0 if failed + ;Create entry in BSDX APPOINTMENT + N BSDXAPPTID,BSDXFDA + S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART + S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND + S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID + S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD + S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) + S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT + S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" + S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID + S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM) + N BSDXIEN,BSDXMSG + D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") + S BSDXAPPTID=+$G(BSDXIEN(1)) + Q BSDXAPPTID + ; BSDXWP(BSDXAPPTID,BSDXNOTE) ; - ;Add WP field - I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" - I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) - I $D(BSDXNOTE(.5)) D - . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") - Q - ; + ;Add WP field + N BSDXMSG + I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" + I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) + I $D(BSDXNOTE(.5)) D + . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") + Q + ; ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP - ;Called by BSDX ADD APPOINTMENT protocol - ;BSDXSC=IEN of clinic in ^SC - ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note - ; - N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES - Q:+$G(BSDXNOEV) - I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) - E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) - Q:'+$G(BSDXRES) - S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0)) - Q:BSDXNOD="" - S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0)) - S BSDXWKIN="" - S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile - S BSDXLEN=$P(BSDXNOD,U,2) - Q:'+BSDXLEN - S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0) - S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN) - Q:'+BSDXAPPTID - S BSDXNOTE=$P(BSDXNOD,U,4) - I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) - D ADDEVT3(BSDXRES) - Q - ; + ;Called by BSDX ADD APPOINTMENT protocol + ;BSDXSC=IEN of clinic in ^SC + ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note + ; + N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND + Q:+$G(BSDXNOEV) + I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) + E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) + Q:'+$G(BSDXRES) + S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0)) + Q:BSDXNOD="" + S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0)) + S BSDXWKIN="" + S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile + S BSDXLEN=$P(BSDXNOD,U,2) + Q:'+BSDXLEN + S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0) + S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN) + Q:'+BSDXAPPTID + S BSDXNOTE=$P(BSDXNOD,U,4) + I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) + D ADDEVT3(BSDXRES) + Q + ; ADDEVT3(BSDXRES) ; - ;Call RaiseEvent to notify GUI clients - N BSDXRESN - S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) - Q:BSDXRESN="" - S BSDXRESN=$P(BSDXRESN,"^") - ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") - D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) - Q - ; -ERR(BSDXI,BSDXERR) ;Error processing - S BSDXI=BSDXI+1 - S BSDXERR=$TR(BSDXERR,"^","~") - I $TL>0 TROLLBACK - S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - L -^BSDXAPPT(BSDXPATID) - Q - ; + ;Call RaiseEvent to notify GUI clients + N BSDXRESN + S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) + Q:BSDXRESN="" + S BSDXRESN=$P(BSDXRESN,"^") + ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") + D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) + Q + ; +ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set + ; DO NOT USE except as an emergency measure - only if unforseen error occurs + ; Input: + ; Appointment ID to remove from ^BSDXAPPT + ; BSDXC array (see array format in $$MAKE^BSDXAPI) + N % + D BSDXDEL^BSDX07(BSDXAPPTID) + S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0 + QUIT + ; +BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT + ; DO NOT USE except in emergencies to roll back an appointment set + N DA,DIK + S DIK="^BSDXAPPT(",DA=BSDXAPPTID + D ^DIK + Q + ; +ERR(BSDXI,BSDXERR) ;Error processing - different from error trap. + ; Unlock first + L -^BSDXPAT(BSDXPATID) + ; If last line is $C(31), we are done. No more errors to send to client. + I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT + S BSDXI=BSDXI+1 + S BSDXERR=$TR(BSDXERR,"^","~") + S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + Q + ; ETRAP ;EP Error trap entry - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - ; Rollback, otherwise ^XTER will be empty from future rollback - I $TL>0 TROLLBACK - D ^%ZTER - S $EC="" ; Clear Error - ; Log error message and send to client - I '$D(BSDXI) N BSDXI S BSDXI=0 - D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) - Q - ; -DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR - ; -DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y) - F %=%:-1:281 S Y=%#4=1+1+Y - S Y=$E(X,6,7)+Y#7 - Q - ; -AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability - ;SEE SDM1 - N Y,DFN - N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG - N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I - S Y=BSDXSCD,DFN=BSDXPATID - S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y - ;Determine maximum days for scheduling - S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 - S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) - S SDDATE=BSDXSTART - S SDSDATE=SDDATE,SDDATE=SDDATE\1 -1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC - Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC - S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) - S X2=SDEDT D C^%DTC S SDEDT=X - S Y=BSDXSTART -EN1 S (X,SD)=Y,SM=0 D DOW -S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".") - S S=BSDXLEN - ;Check if BSDXLEN evenly divisible by appointment length - S RPMSL=$P(SL,U) - I BSDXLEN9 - 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 + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + D ^%ZTER + ; + I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists + ; + ; Log error message and send to client + I '$D(BSDXI) N BSDXI S BSDXI=0 + D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) + Q:$Q 1_U_"Mumps Error" Q + ; diff --git a/m/BSDX08.m b/m/BSDX08.m index bed9241..c4c4704 100644 --- a/m/BSDX08.m +++ b/m/BSDX08.m @@ -1,24 +1,22 @@ -BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL. ; ; Change History ; 3101022 UJO/SMH v1.42 - ; - Transaction now restartable. Thanks to - ; --> Zach Gonzalez and Rick Marshall for fix. - ; - Extra TROLLBACK in Lock Statement when lock fails. - ; --> Removed--Rollback is already in ERR tag. - ; - Added new statements to old SD code in AVUPDT to obviate - ; --> need to restore variables in transaction - ; - Refactored this chunk of code. Don't really know whether it - ; --> worked in the first place. Waiting for bug report to know. + ; - Transaction work. As of v 1.7, all work here has been superceded + ; - Refactoring of AVUPDT - never tested though. ; - Refactored all of APPDEL. ; ; 3111125 UJO/SMH v1.5 ; - Added ability to remove checked in appointments. Added a couple ; of units tests for that under UT2. - ; - Minor reformatting because of how KIDS adds tabs. + ; + ; 3120625 VEN/SMH v1.7 + ; - Transactions removed. Code refactored to work w/o txns. + ; - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling + ; that. ; ; Error Reference: ; -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 ; -8^BSDX08: Unable to find associated PIMS appointment for this patient ; -9^BSDX08: BSDXAPI returned an error: (error) + ; -10^BSDX08: $$BSDXCAN failed (Fileman filing error) ; -100~BSDX08 Error: (Mumps Error) ; APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP ;Entry point for debugging - D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)") + ;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)") Q ; -UT ; Unit Tests - ; Test 1: Make normal appointment and cancel it. See if every thing works - N ZZZ - D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1) - S APPID=+$P(^BSDXTMP($J,1),U) - D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note") - I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1" - I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2" - I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3" - I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4" - ; - ; Test 2: Check for -1 - ; Make appt - D APPADD^BSDX07(.ZZZ,3110125.2,3110125.3,4,"Dr Office",10,"Sam's Note",1) - ; Lock the node in another job - S APPID=+$P(^BSDXTMP($J,1),U) - ; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10 - D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note") - ; - ; Test 3: Check for -100 - S bsdxdie=1 - D APPADD^BSDX07(.ZZZ,3110126.2,3110126.3,4,"Dr Office",10,"Sam's Note",1) - S APPID=+$P(^BSDXTMP($J,1),U) - D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons") - I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",! - K bsdxdie - ; - ; Test 4: Restartable transaction - S bsdxrestart=1 - D APPADD^BSDX07(.ZZZ,3110128.2,3110128.3,4,"Dr Office",10,"Sam's Note",1) - S APPID=+$P(^BSDXTMP($J,1),U) - D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons") - I $P(^DPT(4,"S",3110128.2,0),U,2)'="PC" W "Error in Restartable Transaction",! - ; - ; Test 5: for invalid Appointment ID (-2 and -3) - D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons") - I $P(^BSDXTMP($J,1),"~")'=-2 W "Error in -2",! - D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons") - I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",! -UT2 ; More unit Tests - ; - ; Test 6: for Cancelling walkin and checked-in appointments - S BSDXSTART=$E($$NOW^XLFDT,1,12),BSDXEND=BSDXSTART+.0001 - D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt - S APPID=+$P(^BSDXTMP($J,1),U) - I APPID=0 W "Error in test 6",! - D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; check-in - D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; Delete appt - I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",! - ; - ; Test 7: for cancelling walkin and checked-in appointments - S BSDXSTART=$E($$NOW^XLFDT,1,12)+.0001,BSDXEND=BSDXSTART+.0001 - D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt - S APPID=+$P(^BSDXTMP($J,1),U) - I APPID=0 W "Error in test 6",! - D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin - S BSDXRES=$O(^BSDXRES("B","Dr Office","")) - S BSDXCLN=$P(^BSDXRES(BSDXRES,0),U,4) - S BSDXRESULT=$$RMCI^BSDXAPI(4,BSDXCLN,BSDXSTART) ; remove checkin - D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt - I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",! - QUIT -APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP +APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP ;Called by RPC: BSDX CANCEL APPOINTMENT ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles ;Input Parameters: @@ -123,70 +60,78 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP ; ; Counter N BSDXI S BSDXI=0 + ; ; Header Node S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) ; - ; Lock BSDX node, only to synchronize access to the globals. - ; It's not expected that the error will ever happen as no filing - ; is supposed to take 5 seconds. - L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q - ; - ;Restartable Transaction; restore paramters when starting. - ; (Params restored are what's passed here + BSDXI) - TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08" - ; ; Turn off SDAM APPT PROTOCOL BSDX Entries N BSDXNOEV S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol ; ;;;test for error inside transaction. See if %ZTER works - I $G(bsdxdie) S X=1/0 - ;;;test - ;;;test for TRESTART - I $G(bsdxrestart) K bsdxrestart TRESTART - ;;;test + I $G(BSDXDIE1) N X S X=1/0 ; ; Check appointment ID and whether it exists I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q + ; + ; Lock BSDX node, only to synchronize access to the globals. + ; It's not expected that the error will ever happen as no filing + ; is supposed to take 5 seconds. + L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q ; ; Start Processing: - ; First, add cancellation date to appt entry in BSDX APPOINTMENT + ; First, get data N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time - D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT ; - ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability + ; Check the resource ID and whether it exists N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID - ; If the resouce id doesn't exist... + ; If the resource id doesn't exist... I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT + ; + ; + ; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI ; Get zero node of resouce - S BSDXNOD=^BSDXRES(BSDXSC1,0) + N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Get Hosp location N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4) - ; Error indicator for Hosp Location filing for getting out of routine + ; Error indicator N BSDXERR S BSDXERR=0 - ; Only file in 2/44 if there is an associated hospital location - I BSDXLOC D QUIT:BSDXERR - . I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT - . ; Get the IEN of the appointment in the "S" node of ^SC - . N BSDXSCIEN - . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) - . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT - . ; Get the appointment node - . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0)) - . I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT - . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) - . ; Cancel through BSDXAPI - . N BSDXZ - . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART) - . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT - . ; Update Legacy PIMS clinic Availability - . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN) + ; + N BSDXC ; Array to pass to BSDXAPI + ; + I BSDXLOC D + . S BSDXC("PAT")=BSDXPATID + . S BSDXC("CLN")=BSDXLOC + . S BSDXC("TYP")=BSDXTYP + . S BSDXC("ADT")=BSDXSTART + . S BSDXC("CDT")=$$NOW^XLFDT() + . S BSDXC("NOT")=BSDXNOT + . S:'+$G(BSDXCR) BSDXCR=11 ;Other + . S BSDXC("CR")=BSDXCR + . S BSDXC("USR")=DUZ + . ; + . S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message + ; If error, quit. No need to rollback as no changes took place. + I BSDXERR D ERR(BSDXI,"-9~BSDX08: BSDXAPI reports that "_$P(BSDXERR,U,2)) QUIT + ; + I $G(BSDXDIE2) N X S X=1/0 + ; + ; Now cancel the appointment for real + ; BSDXAPPT First; no need for rollback if error occured. + N BSDXERR S BSDXERR=$$BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT + I BSDXERR D ERR(BSDXI,"-10~BSDX08: $$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT + ; + ; Then PIMS: + ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability + ; If error happens, must rollback ^BSDXAPPT + I BSDXLOC S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI + ; Rollback BSDXAPPT if error occurs + I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID) QUIT ; - TCOMMIT L -^BSDXAPPT(BSDXAPTID) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=""_$C(30) @@ -194,80 +139,25 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP S ^BSDXTMP($J,BSDXI)=$C(31) Q ; -AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability - ;See SDCNP0 - N SD,S ; Start Date - S (SD,S)=BSDXSTART - N I ; Clinic IEN in 44 - S I=BSDXSCD - ; if day has no schedule in legacy PIMS, forget about this update. - Q:'$D(^SC(I,"ST",SD\1,1)) - N SL ; Clinic characteristics node (length of appt, when appts start etc) - S SL=^SC(I,"SL") - N X ; Hour Clinic Display Begins - S X=$P(SL,U,3) - N STARTDAY ; When does the day start? - S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am - N SB ; ?? Who knows? Day Start - 1 divided by 100. - S SB=STARTDAY-1/100 - S X=$P(SL,U,6) ; Now X is Display increments per hour - N HSI ; Slots per hour, try 1 - S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4 - N SI ; Slots per hour, try 2 - S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4 - N STR ; ?? - S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz" - N SDDIF ; Slots per hour diff?? - S SDDIF=$S(HSI<3:8/HSI,1:2) - S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI - S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS - N Y ; Hours since start of Date - S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs - N ST ; ?? - ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour - ; Y\1 -> Hours since start of day; * SI: * slots - S ST=Y#1*SI\.6+(Y\1*SI) - N SS ; how many slots are supposed to be taken by appointment - S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots) - N I - I Y'<1 D ; If Hours since start of Date is greater than 1 - . ; loop through pattern. Tired of documenting. - . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0 - . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" - . . S S=$E(S,1,I)_Y_$E(S,I+2,999) - . . S SS=SS-1 - . . Q:SS'>0 - S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set - Q - ; -APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD) ; - ;Cancel appointment for patient BSDXDFN in clinic BSDXSC1 - ;at time BSDXSD - N BSDXC,%H - S BSDXC("PAT")=BSDXPATID - S BSDXC("CLN")=BSDXLOC - S BSDXC("TYP")=BSDXTYP - S BSDXC("ADT")=BSDXSD - S %H=$H D YMD^%DTC - S BSDXC("CDT")=X+% - S BSDXC("NOT")=BSDXNOT - S:'+$G(BSDXCR) BSDXCR=11 ;Other - S BSDXC("CR")=BSDXCR - S BSDXC("USR")=DUZ - ; - S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC) - Q - ; -BSDXCAN(BSDXAPTID) ; - ;Cancel BSDX APPOINTMENT entry - N %DT,X,BSDXDATE,Y,BSDXIENS,BSDXFDA,BSDXMSG - S %DT="XT",X="NOW" D ^%DT ; X ^DD("DD") - S BSDXDATE=Y +BSDXCAN(BSDXAPTID) ; $$; Private; Cancel BSDX APPOINTMENT entry + ; Input: Appt IEN in ^BSDXAPPT + ; Output: 0 for success and 1^Msg for failure + N BSDXDATE,BSDXIENS,BSDXFDA,BSDXMSG + S BSDXDATE=$$NOW^XLFDT() S BSDXIENS=BSDXAPTID_"," S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE - K BSDXMSG D FILE^DIE("","BSDXFDA","BSDXMSG") - Q + I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1) + QUIT 0 + ; +ROLLBACK(BSDXAPTID) ; Proc; Private; Rollback cancellation + ; Input same as $$BSDXCAN + N BSDXIENS S BSDXIENS=BSDXAPTID_"," + N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@" + N BSDXMSG + D FILE^DIE("","BSDXFDA","BSDXMSG") + ;I $D(BSDXMSG) ; Not sure what to do. We are already handling an error. + QUIT ; CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event ;when appointments cancelled via PIMS interface. @@ -291,9 +181,10 @@ CANEVT1(BSDXRES,BSDXSTART,BSDXPAT) ; Q:'+BSDXRES BSDXFOUND Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND + . N BSDXNOD . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q - I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT) + I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER Q BSDXFOUND ; CANEVT3(BSDXRES) ; @@ -308,25 +199,30 @@ CANEVT3(BSDXRES) ; Q ; ERR(BSDXI,BSDXERR) ;Error processing + ; Unlock first + L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID) + ; If last line is $C(31), we are done. No more errors to send to client. + I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT S BSDXI=BSDXI+1 S BSDXERR=$TR(BSDXERR,"^","~") - I $TL>0 TROLLBACK S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) - L -^BSDXAPPT(BSDXAPTID) QUIT ; ETRAP ;EP Error trap entry N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - ; Rollback, otherwise ^XTER will be empty from future rollback - I $TL>0 TROLLBACK D ^%ZTER - 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 I '$D(BSDXI) N BSDXI S BSDXI=0 D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE)) - QUIT + Q:$Q 1_U_"-100~Mumps Error" Q ; ;;;NB: This is code that is unused in both original and port. ; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple diff --git a/m/BSDX09.m b/m/BSDX09.m index c022fea..3aa112c 100644 --- a/m/BSDX09.m +++ b/m/BSDX09.m @@ -1,5 +1,5 @@ -BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:18am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 6/21/12 11:03am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; ; Change Log: diff --git a/m/BSDX11.m b/m/BSDX11.m index 0ac0978..6143981 100644 --- a/m/BSDX11.m +++ b/m/BSDX11.m @@ -1,5 +1,5 @@ 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 ; ENV0100 ;EP Version 1.0 Environment check diff --git a/m/BSDX12.m b/m/BSDX12.m index c84ebbf..c5be857 100644 --- a/m/BSDX12.m +++ b/m/BSDX12.m @@ -1,5 +1,5 @@ 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 ; ; Change Log: diff --git a/m/BSDX13.m b/m/BSDX13.m index bcfe1ac..6aede4c 100644 --- a/m/BSDX13.m +++ b/m/BSDX13.m @@ -1,5 +1,5 @@ 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 ; ; Change Log: diff --git a/m/BSDX14.m b/m/BSDX14.m index d0bfba1..2834633 100644 --- a/m/BSDX14.m +++ b/m/BSDX14.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX15.m b/m/BSDX15.m index d00aaa8..a5d1c85 100644 --- a/m/BSDX15.m +++ b/m/BSDX15.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX16.m b/m/BSDX16.m index 75a8dff..2084938 100644 --- a/m/BSDX16.m +++ b/m/BSDX16.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX17.m b/m/BSDX17.m index e07c701..b327d65 100644 --- a/m/BSDX17.m +++ b/m/BSDX17.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX18.m b/m/BSDX18.m index b135519..d870a5d 100644 --- a/m/BSDX18.m +++ b/m/BSDX18.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX19.m b/m/BSDX19.m index 34d44b3..32bb68f 100644 --- a/m/BSDX19.m +++ b/m/BSDX19.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX20.m b/m/BSDX20.m index a4434d3..eb0acf7 100644 --- a/m/BSDX20.m +++ b/m/BSDX20.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX21.m b/m/BSDX21.m index 8227b69..e829dd2 100644 --- a/m/BSDX21.m +++ b/m/BSDX21.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX22.m b/m/BSDX22.m index 2e567fb..2f8fbba 100644 --- a/m/BSDX22.m +++ b/m/BSDX22.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX23.m b/m/BSDX23.m index 151ae86..2017e62 100644 --- a/m/BSDX23.m +++ b/m/BSDX23.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX24.m b/m/BSDX24.m index 4b266ff..d0a5f1a 100644 --- a/m/BSDX24.m +++ b/m/BSDX24.m @@ -1,5 +1,5 @@ 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 ; ; diff --git a/m/BSDX25.m b/m/BSDX25.m index 22cf832..ca4ad12 100644 --- a/m/BSDX25.m +++ b/m/BSDX25.m @@ -1,118 +1,137 @@ -BSDX25 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; ; Change Log: ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C# + ; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions. + ; -> Functionality still the same. + ; -> Unit Tests in UT25^BSDXUT2 ; ; -UT ; Unit Tests - ; Make appointment, checkin, then uncheckin - N ZZZ - N APPTTIME S APPTTIME=$E($$NOW^XLFDT(),1,12) - D APPADD^BSDX07(.ZZZ,APPTTIME,APPTTIME+.0001,3,"Dr Office",30,"Sam's Note",1) - N APPTID S APPTID=+^BSDXTMP($J,1) - N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I") - D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT()) - IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1",! - IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 2",! - D RMCI^BSDX25(.ZZZ,APPTID) - IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",! - IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",! - D RMCI^BSDX25(.ZZZ,APPTID) ; again, test sanity in repeat - IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",! - IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",! - ; now test various error conditions - ; Test Error 1 - D RMCI^BSDX25(.ZZZ,) - IF +^BSDXTMP($J,1)'=-1 WRITE "ERROR IN ETest 1",! - ; Test Error 2 - D RMCI^BSDX25(.ZZZ,234987234398) - IF +^BSDXTMP($J,1)'=-2 WRITE "ERROR IN Etest 2",! - ; Tests for 3 to 5 difficult to produce - ; Error tests follow: Mumps error test; Transaction restartability - N bsdxdie S bsdxdie=1 - D RMCI^BSDX25(.ZZZ,APPTID) - IF +^BSDXTMP($J,1)'=-20 WRITE "ERROR IN Etest 3",! - K bsdxdie - N bsdxrestart S bsdxrestart=1 - D RMCI^BSDX25(.ZZZ,APPTID) - IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 4",! - QUIT -CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP +CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP ;Entry point for debugging ; - ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,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 ; -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 ; Parameters: ; BSDXY: Global Out - ; BSDXAPTID: Appointment ID in ^BSDXAPPT + ; BSDXAPPTID: Appointment ID in ^BSDXAPPT ; BSDXCDT: Checkin Date --> Changed ; BSDXCC: Clinic Stop IEN (not used) ; BSDXPRV: Provider IEN (not used) ; BSDXROU: Print Routing Slip? (not used) ; BSDXVCL: PCC+ Clinic IEN (not used) ; BSDXVFM: PCC+ Form IEN (not used) - ; BSDXOG: PCC+ Outguide (true or false) + ; BSDXOG: PCC+ Outguide (true or false) (not used) ; ; Output: ; ADO.net table with 1 column ErrorID, 1 row result ; - 0 if all okay ; - 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 S BSDXNOEV=1 ;Don't execute protocol ; - D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP") - S BSDXI=0 - K ^BSDXTMP($J) - S BSDXY="^BSDXTMP("_$J_")" + ; Set min DUZ vars + D ^XBKVAR + ; + ; $ET + N $ET S $ET="G ERROR^BSDX25" + ; + ; Test for error trap for Unit Tests + I $G(BSDXDIE) N X S X=1/0 + ; + N BSDXI S BSDXI=0 + ; + S BSDXY=$NAME(^BSDXTMP($J)) + K @BSDXY + ; 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. ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@") ;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y - S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them - I BSDXCDT=-1 D ERR(70) Q + S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them + I BSDXCDT'>2000000 D ERR("-2~Invalid Check-in Date") QUIT 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 - I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q - . S BSDXNOD=^BSDXRES(BSDXSC1,0) - . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION - . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART) + ; Some data + N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) ; Appointment Node + N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN + N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Appointment Start Time ; + ; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION) + N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I") + I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist + ; + ; Check if we can check-in using BSDXAPI + N BSDXERR S BSDXERR=0 + I BSDXSC1 S BSDXERR=$$CHECKIC1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART) + I BSDXERR D ERR(-10_"~"_$P(BSDXERR,U,2)) QUIT + ; + ; Checkin BSDX APPOINTMENT entry + ; Failure Analysis: If we fail here, no changes were made. + N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT) + I BSDXERR D ERR("-3~Fileman Filer failed to check-in appt") QUIT + ; + ; File check-in using BSDXAPI + ; Failure Analysis: If we fail here, we need to roll back first check-in. + N BSDXERR S BSDXERR=0 + I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART) + I BSDXERR D QUIT + . N % S %=$$BSDXCHK(BSDXAPPTID,"@") ; No Error checking to prevent loop. + . D ERR(-10_"~"_$P(BSDXERR,U,2)) ; Send error message to client + ; + L -^BSDXAPPT(BSDXAPPTID) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="0"_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) Q ; -BSDXCHK(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 D FILE^DIE("","BSDXFDA","BSDXMSG") - Q + Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1) + Q 0 ; -APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ; - ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1 - ;at time BSDXSTART - S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART) - Q - ; -RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44 - ; Called by RPC [Fill in later] +RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44 + ; Called by RPC BSDX REMOVE CHECK-IN ; ; Parameters to pass: ; 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) ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES) ; -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 ; @@ -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 ; - TSTART (BSDXI):SERIAL ; Perform Autolocking - ; - ;;;test - I $g(bsdxdie) S X=8/0 - ;;; - I $g(bsdxrestart) k bsdxrestart TRESTART ;;;test + I $G(BSDXDIE) N X S X=8/0 ; ; Check for Appointment ID (passed and exists in file) I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT ; - ; Remove checkin from BSDX APPOINTMENT entry - D BSDXCHK(BSDXAPPTID,"@") + ; Lock + ; Timeout not expected to happen except in error conditions. + L +^BSDXAPPT(BSDXAPPTID):5 E D ERR("-7~Appt record is locked. Please contact technical support.") QUIT ; - ; Now, remove checkin from PIMS files 2/44 + ; Get appointment Data N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) - N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN - N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date - N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID + N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN + N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date + N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID ; ; If the resource doesn't exist, error out. DB is corrupt. - I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT - I '$D(^BSDXRES(BSDXSC1,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT + I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT + I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT ; - N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node - S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION + ; Get HL Data + N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node + N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN + I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist ; - N BSDXZ ; Scratch variable to hold error message - I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART) - I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT - ; - TCOMMIT ; Save Data into Globals + ; Is it okay to remove check-in from PIMS? + N BSDXERR S BSDXERR=0 ; Scratch variable + ; $$RMCICK = Remove Check-in Check + I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) + I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT + ; + ; For possible rollback, get old check-in date (internal value) + N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I") + ; + ; Remove checkin from BSDX APPOINTMENT entry + ; No need to rollback here on failure. + N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@") + I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT + ; + ; 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 S BSDXI=BSDXI+1 @@ -207,9 +245,11 @@ CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; Q:'+$G(BSDXRES) BSDXFOUND Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND - . 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 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 ; CHKEVT3(BSDXRES) ; @@ -224,16 +264,23 @@ CHKEVT3(BSDXRES) ; ; ERROR ; S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise - ; Rollback, otherwise ^XTER will be empty from future rollback - I $TL>0 TROLLBACK - D ^%ZTER - S $EC="" ; Clear Error - ; Log error message and send to client - D ERR("-20~Mumps Error") - Q + D ^%ZTER + ; VEN/SMH: NB: I make a conscious decision not to roll back anything + ; here in the error trap. Once the error is fixed, users can + ; undo or redo the check-in. + ; Individual portions of this routine may choose to do rolling back + ; of their own (e.g. a failed call to BSDXAPI causes rollback to occur + ; in CHECKIN and RMCI) + ; + ; Log error message and send to client + D ERR("-100~Mumps Error") + Q:$Q "-100^Mumps Error" Q ; 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=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name S BSDXI=$G(BSDXI)+1 diff --git a/m/BSDX26.m b/m/BSDX26.m index b045aba..471928d 100644 --- a/m/BSDX26.m +++ b/m/BSDX26.m @@ -1,133 +1,124 @@ -BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 - ; Licensed under LGPL - ; Change History: - ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx. - ; --> Thanks to Zach Gonzalez and Rick Marshall - ; 3101205 - UJO/SMH - Extensive refactoring. - ; - ; Error Reference: - ; -1: Appt ID is not a number - ; -2: Appt IEN is not in ^BSDXAPPT - ; -3: FM Failure to file WP field in ^BSDXAPPT - ; +BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 + ; Licensed under LGPL + ; Change History: + ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx. + ; 3101205 - UJO/SMH - Extensive refactoring. + ; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1 + ; + ; Error Reference: + ; 1: Appt ID is not a number + ; 2: Appt IEN is not in ^BSDXAPPT + ; 3: FM Failure to file WP field in ^BSDXAPPT + ; 4: BSDXAPI reports failure to change note field in ^SC + ; 5: Failure to acquire lock on ^BSDXAPPT(APPTID) + ; 100: Mumps Error + ; + ; NB: Normally I use negative numbers for errors; this routine returns + ; -1 as a successful result! So I needed to use +ve numbers. + ; EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP - ;Entry point for debugging - ; - D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") - Q -UT ; Unit Tests - ; Test 1: Make sure this damn thing works - N ZZZ - N %H S %H=$H - N NOTE S NOTE="New Note "_%H - D EDITAPT(.ZZZ,188,NOTE) - I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B - ; Test 2: Test Errors -1 and -2 - N ZZZ - N NOTE S NOTE="Nothing important" - D EDITAPT(.ZZZ,"BLAHBLAH",NOTE) - I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B - D EDITAPT(.ZZZ,298734322,NOTE) - I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B - ; Test 4: M Error - N bsdxdie S bsdxdie=1 - D EDITAPT(.ZZZ,188,NOTE) - I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B - k bsdxdie - ; Test 5: Trestart - N bsdxrestart S bsdxrestart=1 - N %H S %H=$H - N NOTE S NOTE="New Note "_%H - D EDITAPT(.ZZZ,188,NOTE) - I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B - ; Test 6: for Hosp Location Update - N DATE S DATE=$$NOW^XLFDT() - S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform - D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1) - N APPID S APPID=+$P(^BSDXTMP($J,1),U) - D EDITAPT(.ZZZ,APPID,"New Note") - I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B - I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B - QUIT - ; + ;Entry point for debugging + ; + ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") + Q EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited) - ; Called by RPC: BSDX EDIT APPOINTMENT - ; - ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file - ; - ; Parameters: - ; - BSDXY: Global Return (RPC must be set to Global Array) - ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT - ; - BSDXNOTE: New note - ; - ; Return: - ; ADO.net Recordset having 1 field: ERRORID - ; If Okay: -1; otherwise, positive integer with message - ; - ; Return Array; set Return and clear array - S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; ET - N $ET S $ET="G ETRAP^BSDX26" - ; Set up basic DUZ variables - D ^XBKVAR - ; Counter - N BSDXI S BSDXI=0 - ; Header Node - S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) - ; Restartable txn for GT.M. Restored vars are Params + BSDXI. - TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26" - ; - ;;;test for error inside transaction. See if %ZTER works - I $G(bsdxdie) S X=1/0 - ;;;test - ;;;test for TRESTART - I $G(bsdxrestart) K bsdxrestart TRESTART - ;;;test - ; - ; Validate Appointment ID - I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT - I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT - ; Put the WP in decendant fields from the root to file as a WP field - S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" - I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) - N BSDXMSG ; Message in case of error in filing. - I $D(BSDXNOTE(.5)) D - . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") - I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT - ; - ; Now file in file 44: - N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN - N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID - N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT - N BSDXRES S BSDXRES=0 ; Result - ; Update Note only if we have a linked hospital location. - I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5)) - ; If we get an error (denoted by -1 in BSDXRES), return error to client - I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT - ;Return Recordset - TCOMMIT - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)="-1"_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - QUIT - ; + ; Called by RPC: BSDX EDIT APPOINTMENT + ; + ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file + ; + ; Parameters: + ; - BSDXY: Global Return (RPC must be set to Global Array) + ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT + ; - BSDXNOTE: New note + ; + ; Return: + ; ADO.net Recordset having 1 field: ERRORID + ; If Okay: -1; otherwise, positive integer with message + ; + ; Return Array; set Return and clear array + S BSDXY=$NA(^BSDXTMP($J)) + K ^BSDXTMP($J) + ; ET + N $ET S $ET="G ETRAP^BSDX26" + ; Set up basic DUZ variables + D ^XBKVAR + ; Counter + N BSDXI S BSDXI=0 + ; Header Node + S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) + ; + ;;;test for error. See if %ZTER works + I $G(BSDXDIE) S X=1/0 + ; + ; Validate Appointment ID + I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT + I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT + ; + ; Lock BSDX node, only to synchronize access to the globals. + ; It's not expected that the error will ever happen as no filing + ; is supposed to take 5 seconds. + L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") QUIT + ; + ; Put the WP in decendant fields from the root to file as a WP field + S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" + I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) + ; + N BSDXMSG ; Message in case of error in filing. + ; + ; Save Before State in case we need it for rollback + K ^TMP($J) + M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID) + ; + ; Update note in BSDX APPOINTMENT + I $D(BSDXNOTE(.5)) D + . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") + ; + ; Error handling. No need for rollback since nothing else changed. + I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT + ; + ; Now file in file 44: + N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN + N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID + N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT + N BSDXRES S BSDXRES=0 ; Result + ; Update Note only if we have a linked hospital location. + I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5)) + ; If we get an error (denoted by -1 in BSDXRES), return error to client + ; AND restore the original note + I BSDXRES D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT + ; + ;Return Recordset indicating success + L -^BSDXAPPT(BSDXAPTID) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)="-1"_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + ; + K ^TMP($J) ; Done; remove TMP data + QUIT + ; +ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT + M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT") + K ^TMP($J) + QUIT + ; ERR(BSDXI,BSDXERR) ;Error processing - S BSDXI=BSDXI+1 - S BSDXERR=$TR(BSDXERR,"^","~") - I $TL>0 TROLLBACK - S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - QUIT - ; + ; Unlock first + L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID) + ; If last line is $C(31), we are done. No more errors to send to client. + I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT + S BSDXI=BSDXI+1 + S BSDXERR=$TR(BSDXERR,"^","~") + S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + QUIT + ; ETRAP ;EP Error trap entry - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - I $TL>0 TROLLBACK - D ^%ZTER - S $EC="" - I '$D(BSDXI) N BSDXI S BSDXI=0 - D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE)) - Q + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + D ^%ZTER + ; + I '$D(BSDXI) N BSDXI S BSDXI=0 + D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE)) + QUIT diff --git a/m/BSDX27.m b/m/BSDX27.m index 0792c51..6e8387c 100644 --- a/m/BSDX27.m +++ b/m/BSDX27.m @@ -1,5 +1,5 @@ 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 ; ; Change Log: July 15, 2010 diff --git a/m/BSDX28.m b/m/BSDX28.m index c47e69c..0221a8d 100644 --- a/m/BSDX28.m +++ b/m/BSDX28.m @@ -1,5 +1,5 @@ -BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:57am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; Change Log: ; HMW 3050721 Added test for inactivated record @@ -37,23 +37,23 @@ DFN ;If DFN is passed as `nnnn, just return that patient . N DOB S DOB=$$FMTE^XLFDT($P(^DPT(BSDXIEN,0),U,3)) . S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30) PID ;PID Lookup - ; If this ID exists, go get it. If "UJOPID" index doesn't exist, - ; won't work anyways. - I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT - . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,"")) - . Q:'$D(^DPT(BSDXIEN,0)) - . S BSDXDPT=$G(^DPT(BSDXIEN,0)) - . S BSDXZ=$P(BSDXDPT,U) ;NAME - . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART - . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2 - . ; Inactivated Chart get an * - . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q - . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN - . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID - . S Y=$P(BSDXDPT,U,3) X ^DD("DD") - . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB - . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN - . S BSDXRET=BSDXRET_BSDXZ_$C(30) + ; If this ID exists, go get it. If "UJOPID" index doesn't exist, + ; won't work anyways. + I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT + . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,"")) + . Q:'$D(^DPT(BSDXIEN,0)) + . S BSDXDPT=$G(^DPT(BSDXIEN,0)) + . S BSDXZ=$P(BSDXDPT,U) ;NAME + . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART + . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2 + . ; Inactivated Chart get an * + . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q + . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN + . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID + . S Y=$P(BSDXDPT,U,3) X ^DD("DD") + . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB + . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN + . S BSDXRET=BSDXRET_BSDXZ_$C(30) ; DOB ;DOB Lookup I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D S BSDXY=BSDXRET_$C(31) Q @@ -75,8 +75,7 @@ DOB ;DOB Lookup . . Q . Q ; -CHART - ;Chart# Lookup +CHART ;Chart# Lookup I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q . S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q . . Q:'$D(^DPT(BSDXIEN,0)) diff --git a/m/BSDX29.m b/m/BSDX29.m index 6ab6278..ee744bb 100644 --- a/m/BSDX29.m +++ b/m/BSDX29.m @@ -1,5 +1,5 @@ -BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; ; 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 ; v1.42 by WV/SMH on 3101023 ; - Transaction moved; now restartable too. - ; --> Thanks to Zach Gonzalez and Rick Marshall. ; - Refactoring of major portions of routine + ; v1.7 by VEN/SMH on 3120622 + ; - Removed transaction code; Locks added in update to prevent concurrent + ; update ; BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP ;Entry point for debugging ; - D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)") + ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)") Q ; BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP @@ -21,33 +23,33 @@ BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive ;Called by RPC: BSDX COPY APPOINTMENTS ; - ; Parameters: - ; - BSDXY: Global Return - ; - BSDXRES: BSDX RESOURCE to copy appointments to - ; - BSDX44: Hospital Location IEN to copy appointments from - ; - BSDXBEG: Beginning Date in FM Format - ; - BSDXEND: End Date in FM Format - ; + ; Parameters: + ; - BSDXY: Global Return + ; - BSDXRES: BSDX RESOURCE to copy appointments to + ; - BSDX44: Hospital Location IEN to copy appointments from + ; - BSDXBEG: Beginning Date in FM Format + ; - BSDXEND: End Date in FM Format + ; ;Returns ADO Recordset containing TASK_NUMBER and ERRORID ; - ; Return Array + ; Return Array S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; $ET - N $ET S $ET="G ETRAP^BSDX29" + K ^BSDXTMP($J) + ; $ET + N $ET S $ET="G ETRAP^BSDX29" ; Counter - N BSDXI S BSDXI=0 - ; Header Node + N BSDXI S BSDXI=0 + ; Header Node S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30) ; - ; Make dates inclusive; add 1 to FM dates - S BSDXBEG=BSDXBEG-1 - S BSDXEND=BSDXEND+1 + ; Make dates inclusive; add 1 to FM dates + S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1) + S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1) ; - ; Taskman variables - N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE + ; Taskman variables + N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO ; 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")="" D ^%ZTLOAD ; Set up return ADO.net dataset @@ -61,49 +63,44 @@ ZTMD ;EP - Debug entry point Q ; ZTM ;EP - Taskman entry point - ; Variables set up in ZTSAVE above - ; + ; Variables set up in ZTSAVE above + ; Q:'$D(ZTSK) - ; $ET - N $ET S $ET="G ZTMERR^BSDX29" - ; Txn - TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29" + ; + ; $ET + N $ET S $ET="G ZTMERR^BSDX29" + ; ;$O through ^SC(BSDX44,"S", N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments - N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc + N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc ; Set Count - S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT + S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT ; Loop through dates here. - F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D - . ; Loop through Entries in each date in the subsubfile. - . ; Quit if we are at the end or if a remote process requests a quit. - . N BSDXIEN S BSDXIEN=0 + F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D + . ; Loop through Entries in each date in the subsubfile. + . ; Quit if we are at the end or if a remote process requests a quit. + . N BSDXIEN S BSDXIEN=0 . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node . . Q:'+BSDXNOD ; Quit if no node . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag - . . Q:BSDXCAN="C" ; Quit if appt cancelled - . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient - . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes + . . Q:BSDXCAN="C" ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 44 + . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient + . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made . . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record - . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag - . . Q - . Q - I 'BSDXQUIT TCOMMIT - E TROLLBACK + . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7) + ; + ; S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.") Q ; ZTMERR ; For now, error from TM is only in trap; not returned to client. N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - ; Rollback before logging the error - I $TL>0 TROLLBACK D ^%ZTER - S $EC="" ; Clear Error QUIT ; XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP @@ -111,8 +108,12 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP ;Copy record to BSDX APPOINTMENT file ;Return 1 if record copied, otherwise 0 ; + N REF + S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique + L +@REF:0 E Q 0 + ; ;$O Thru ^BSDXAPPT to determine if this appt already added - N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2 + N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD S BSDXIEN=0,BSDXFND=0 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0)) @@ -121,12 +122,13 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP . S BSDXFND=0 . I BSDXPAT2=BSDXPAT S BSDXFND=1 . Q - Q:BSDXFND 0 + I BSDXFND L -@REF Q 0 ; ;Add to BSDX APPOINTMENT S BSDXEND=BSDXBEG ;Calculate ending time from beginning time and duration. S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN) + N BSDXFDA,BSDXIENS S BSDXIENS="+1," S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND @@ -136,19 +138,23 @@ XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE ; K BSDXIEN + ; D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") S BSDXIEN=+$G(BSDXIEN(1)) - I '+BSDXIEN Q 0 + I '+BSDXIEN L -@REF Q 0 ; ;Add WP field I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") + L -@REF ; Q 1 ; ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing + ; If last line is $C(31), we are done. No more errors to send to client. + I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT S BSDXI=BSDXI+1 - S BSDXERR=$TR(BSDXERR,"^","~") + S BSDXERR=$TR(BSDXERR,"^","~") S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) @@ -156,9 +162,9 @@ ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing ; ETRAP ;EP Error trap entry ; No Txn here. So don't rollback anything - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - D ^%ZTER - S $EC="" ; Clear error + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + D ^%ZTER + S $EC="" ; Clear error I '$D(BSDXI) N BSDXI S BSDXI=0 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE)) Q diff --git a/m/BSDX2E.m b/m/BSDX2E.m index f33bbdf..bbd6922 100644 --- a/m/BSDX2E.m +++ b/m/BSDX2E.m @@ -1,5 +1,5 @@ -BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [4/28/11 10:28am] - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/11/12 9:37am] + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; S LINE="",$P(LINE,"*",81)="" @@ -23,7 +23,7 @@ VERSION ; ;Is the PIMS requirement present? Q:'$$VERCHK("SD",5.3) ; Q:'$$PATCHCK("PIMS*5.3*1003") D - Q:'$$VERCHK("BMX",2) + Q:'$$VERCHK("BMX",4) ; OTHER ; ;Other checks @@ -90,7 +90,7 @@ V0200 ;EP Version 1.5 PostInit . S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") . ; Error message - . I $D(BSDXMSG) 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 ; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC @@ -105,7 +105,7 @@ V0200 ;EP Version 1.5 PostInit S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@" D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG") ; If error - I $D(BSDXMSG) 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 @@ -116,7 +116,7 @@ V0200 ;EP Version 1.5 PostInit D PUT^XPAR("PKG","BSDX AUTO PRINT RS",1,0,.BSDXERR) I $G(BSDXERR) W $C(7),"Error: ",BSDXERR D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR) - I $G(BSDXERR) W $C(7),"Error: ",BSDXERR + I $G(BSDXERR) D MES^XPDUTL("Error: ",BSDXERR) QUIT ; SORRY(XPX) ; diff --git a/m/BSDX30.m b/m/BSDX30.m index e4fbe8a..01ae3f2 100644 --- a/m/BSDX30.m +++ b/m/BSDX30.m @@ -1,12 +1,12 @@ -BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [4/28/11 10:28am] - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [7/6/12 11:03am] + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; ; SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP ;Entry point for debugging ; - D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)") + ; D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)") Q ; SPACE(BSDXY,BSDXDIC,BSDXVAL) ;EP @@ -48,7 +48,7 @@ ETRAP ;EP Error trap entry ; EHRPTD(BSDXY,BSDXWID,BSDXDFN) ; ; - D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)") + ; D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)") Q ; EHRPT(BSDXY,BSDXWID,BSDXDFN) ; @@ -69,6 +69,9 @@ EHRPT(BSDXY,BSDXWID,BSDXDFN) ; Q ; PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR + ; VEN/SMH v1.7 3120706 - Not used in VISTA. + ; No way right now to synchronize with CPRS. + ; Code commented out for now. ; ;Change patient context to patient DFN ;on all EHR client sessions associated with user DUZ @@ -77,14 +80,14 @@ PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR ;If BSDXWID is "", the context change is sent to ;all EHR client sessions belonging to user DUZ. ; - Q:'$G(DUZ) + ;Q:'$G(DUZ) ;N X ;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T ;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T - N UID,BRET - S BRET=0,UID=0 - F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D - . Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID) - . I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") - . D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID) - Q + ;N UID,BRET + ;S BRET=0,UID=0 + ;F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D + ;. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID) + ;. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") + ;. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID) + ;Q diff --git a/m/BSDX31.m b/m/BSDX31.m index a7dd4ba..59a25f3 100644 --- a/m/BSDX31.m +++ b/m/BSDX31.m @@ -1,220 +1,212 @@ -BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 - ; Licensed under LGPL - ; Change Log: - ; v1.42 Oct 23 2010 WV/SMH - ; - Change transaction to restartable. Thanks to Zach Gonzalez - ; --> and Rick Marshall for their help. - ; v1.42 Dec 6 2010: Extensive refactoring - ; - ; Error Reference: - ; -1: zero or null Appt ID - ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) - ; -3: No-show flag is invalid - ; -4: Filing of No-show in ^BSDXAPPT failed - ; -5: Filing of No-show in ^DPT failed (BSDXAPI error) - ; -100: M Error - ; - ; +BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:39am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 + ; Licensed under LGPL + ; Change Log: + ; v1.42 3101023 WV/SMH - Change transaction to restartable. + ; v1.42 3101206 UJO/SMH - Extensive refactoring + ; v1.7 3120626 VEN/SMH - Removed transactions; extensive refactoring + ; - Moved APTNS (whatever it was) to BSDXAPI1 + ; as $$NOSHOW + ; - Made BSDXNOS extrinsic. + ; - Moved Unit Tests to BSDXUT1 + ; - BSDXNOS deletes no-show rather than file 0 for + ; undoing a no show + ; + ; Error Reference: + ; -1: zero or null Appt ID + ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) + ; -3: No-show flag is invalid + ; -4: Filing of No-show in ^BSDXAPPT failed + ; -5: Filing of No-show in ^DPT failed (BSDXAPI error) + ; -6: Invalid Resource ID + ; -7: Lock not acquired on ^BSDXAPPT(BSDXAPTID) + ; -100: M Error + ; + ; NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP - ;Entry point for debugging - ; - D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") - Q - ; -UT ; Unit Tests - ; Test 1: Sanity Check - N ZZZ ; Garbage return variable - N DATE S DATE=$$NOW^XLFDT() - S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform - D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1) - N APPID S APPID=+$P(^BSDXTMP($J,1),U) - D NOSHOW(.ZZZ,APPID,1) - I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B - I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B - ; Test 2: Undo noshow - D NOSHOW(.ZZZ,APPID,0) - I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B - I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B - ; Test 3: -1 - D NOSHOW(.ZZZ,"",0) - I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B - ; Test 4: -2 - D NOSHOW(.ZZZ,2938748233,0) - I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B - ; Test 5: -3 - D NOSHOW(.ZZZ,APPID,3) - I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",! B - ; Test 6: Mumps error (-100) - s bsdxdie=1 - D NOSHOW(.ZZZ,APPID,1) - I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",! B - k bsdxdie - ; Test 7: Restartable transaction - s bsdxrestart=1 - D NOSHOW(.ZZZ,APPID,1) - I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",! B - QUIT + ;Entry point for debugging + ; + ; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") + Q + ; NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient - ; Called by RPC: BSDX NOSHOW - ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 - ; - ; Parameters: - ; BSDXY: Global Return - ; BSDXAPTID is entry number in BSDX APPOINTMENT file - ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO - ; - ; Returns ADO.net record set with fields - ; - ERRORID; ERRORTEXT - ; ERRORID of 1 is okay - ; Anything else is an error. - ; - ; Return Array; set and clear - S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; $ET - N $ET S $ET="G ETRAP^BSDX31" - ; Basline vars - D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist - ; Counter - N BSDXI S BSDXI=0 - ; Header Node - S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30) - ; Begin transaction - TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29" - ;;;test for error inside transaction. See if %ZTER works - I $G(bsdxdie) S X=1/0 - ;;;TEST - ;;;test for TRESTART - I $G(bsdxrestart) K bsdxrestart TRESTART - ;;;test - ; Turn off SDAM APPT PROTOCOL BSDX Entries - N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol - ; Appointment ID check - I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q - I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q - ; Noshow value check - Must be 1 or 0 - S BSDXNS=+BSDXNS - I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q - ; Get Some data - N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node - N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN - N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time - ; Edit BSDX APPOINTMENT entry - N BSDXMSG ; - D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field - I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q - ; Edit File 2 "S" node entry - N BSDXZ,BSDXERR ; Error variables to control looping - S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID - ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2 - I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q - . S BSDXNOD=^BSDXRES(BSDXSC1,0) - . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION - . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) - ; - TCOMMIT - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - QUIT - ; -APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; - ; update file 2 info - ;Set noshow for patient BSDXDFN in clinic BSDXSC1 - ;at time BSDXSD - N BSDXC,%H,BSDXCDT,BSDXIEN - N BSDXIENS,BSDXFDA,BSDXMSG - S %H=$H D YMD^%DTC - S BSDXCDT=X+% - ; - S BSDXIENS=BSDXSD_","_BSDXDFN_"," - I +BSDXNS D - . S BSDXFDA(2.98,BSDXIENS,3)="N" - . S BSDXFDA(2.98,BSDXIENS,14)=DUZ - . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT - E D - . S BSDXFDA(2.98,BSDXIENS,3)="" - . S BSDXFDA(2.98,BSDXIENS,14)="" - . S BSDXFDA(2.98,BSDXIENS,15)="" - K BSDXIEN - D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") - S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) - Q - ; -BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ; - ; - N BSDXFDA,BSDXIENS - S BSDXIENS=BSDXAPTID_"," - S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW - D FILE^DIE("","BSDXFDA","BSDXMSG") - QUIT - ; + ; Called by RPC: BSDX NOSHOW + ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 + ; + ; Parameters: + ; BSDXY: Global Return + ; BSDXAPTID is entry number in BSDX APPOINTMENT file + ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO + ; + ; Returns ADO.net record set with fields + ; - ERRORID; ERRORTEXT + ; ERRORID of 1 is okay + ; Anything else is an error. + ; + ; Return Array; set and clear + S BSDXY=$NA(^BSDXTMP($J)) + K ^BSDXTMP($J) + ; + ; $ET + N $ET S $ET="G ETRAP^BSDX31" + ; + ; Basline vars + D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist + ; + ; Counter + N BSDXI S BSDXI=0 + ; + ; Header Node + S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30) + ; + ;;;test for error. See if %ZTER works + I $G(BSDXDIE) N X S X=1/0 + ;;;TEST + ; + ; Turn off SDAM APPT PROTOCOL BSDX Entries + N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol + ; + ; Appointment ID check + I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q + I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q + ; + ; Lock BSDX node, only to synchronize access to the globals. + ; It's not expected that the error will ever happen as no filing + ; is supposed to take 5 seconds. + L +^BSDXAPPT(BSDXAPTID):5 E D ERR(-7,"BSDX31: Appt record is locked. Please contact technical support.") Q + ; + ; Noshow value check - Must be 1 or 0 + S BSDXNS=+BSDXNS + I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q + ; + ; Get Some data + N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node + N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN + N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time + N BSDXRES S BSDXRES=$P(BSDXNOD,U,7) ; Resource ID + ; + ; Check if Resource ID is missing or invalid + I BSDXRES="" D ERR(-6,"BSDX31: Invalid Resource") QUIT + I '$D(^BSDXRES(BSDXRES,0)) D ERR(-6,"BSDX31: Invalid Resource") QUIT + ; + ; Get the Hospital Location + N BSDXRESNOD S BSDXRESNOD=^BSDXRES(BSDXRES,0) + N BSDXLOC S BSDXLOC=$P(BSDXRESNOD,U,4) ;HOSPITAL LOCATION + I BSDXLOC,'$D(^SC(BSDXLOC,0)) S BSDXLOC="" ; Unlink it if it doesn't exist + ; I can go and then delete it from ^BSDXRES like Mailman code which tries + ; to be too helpful... but I will postpone that until this is a need. + ; + ; Check if it's okay to no-show patient. + N BSDXERR S BSDXERR=0 ; Error variable + I BSDXLOC S BSDXERR=$$NOSHOWCK^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS) + I BSDXERR D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT + ; + ; Simulated Error + I $G(BSDXSIMERR1) D ERR(-4,"BSDX31: Simulated Error") QUIT + ; Edit BSDX APPOINTMENT entry No-show field + ; Failure Analysis: If we fail here, no rollback needed, as this is the 1st + ; call + N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS) + I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT + ; + ; Edit File 2 "S" node entry + ; Failure Analysis: If we fail here, we need to rollback the BSDX + ; Apptointment Entry + N BSDXERR S BSDXERR=0 ; Error variable + ; If HL exist, (resource is linked to PIMS), file no show in File 2 + I BSDXLOC S BSDXERR=$$NOSHOW^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS) + I BSDXERR D QUIT + . D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) + . N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; no error checking for filer + ; + ; Unlock + L -^BSDXAPPT(BSDXAPTID) + ; + ; Return data in ADO.net table + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + QUIT + ; +BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT + ; in v1.7 I delete the no-show value rather than file zero + N BSDXFDA,BSDXIENS,BSDXMSG + N BSDXVALUE ; What to file: 1 or delete it. + I BSDXNS S BSDXVALUE=1 + E S BSDXVALUE="@" + S BSDXIENS=BSDXAPTID_"," + S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXVALUE ;NOSHOW 1 or 0 + D FILE^DIE("","BSDXFDA","BSDXMSG") + QUIT:$D(BSDXMSG) -1_U_BSDXMSG("DIERR",1,"TEXT",1) + QUIT 0 + ; NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event - ;when appointments NOSHOW via PIMS interface. - ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients - ; - Q:+$G(BSDXNOEV) - Q:'+$G(BSDXSC) - Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" - N BSDXSTAT,BSDXFOUND,BSDXRES - S BSDXSTAT=1 - S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 - S BSDXFOUND=0 - I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) - I BSDXFOUND D NOSEVT3(BSDXRES) Q - I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) - I BSDXFOUND D NOSEVT3(BSDXRES) - Q - ; + ;when appointments NOSHOW via PIMS interface. + ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients + ; + Q:+$G(BSDXNOEV) + Q:'+$G(BSDXSC) + Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" + N BSDXSTAT,BSDXFOUND,BSDXRES + S BSDXSTAT=1 + S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 + S BSDXFOUND=0 + I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) + I BSDXFOUND D NOSEVT3(BSDXRES) Q + I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) + I BSDXFOUND D NOSEVT3(BSDXRES) + Q + ; NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; - ;Get appointment id in BSDXAPT - ;If found, call BSDXNOS(BSDXAPPT) and return 1 - ;else return 0 - N BSDXFOUND,BSDXAPPT - S BSDXFOUND=0 - Q:'+$G(BSDXRES) BSDXFOUND - Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND - S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND - . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" - . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q - I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) - Q BSDXFOUND - ; + ;Get appointment id in BSDXAPT + ;If found, call BSDXNOS(BSDXAPPT) and return 1 + ;else return 0 + N BSDXFOUND,BSDXAPPT,BSDXNOD + S BSDXFOUND=0 + Q:'+$G(BSDXRES) BSDXFOUND + Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND + S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND + . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" + . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q + I BSDXFOUND,+$G(BSDXAPPT) N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPPT,BSDXSTAT) + I BSDXMSG D ^%ZTER ; Last ditch error handling. This is supposed to be silently called from the protocol file. + Q BSDXFOUND + ; NOSEVT3(BSDXRES) ; - ;Call RaiseEvent to notify GUI clients - ; - N BSDXRESN - S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) - Q:BSDXRESN="" - S BSDXRESN=$P(BSDXRESN,"^") - D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) - Q - ; - ; + ;Call RaiseEvent to notify GUI clients + ; + N BSDXRESN + S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) + Q:BSDXRESN="" + S BSDXRESN=$P(BSDXRESN,"^") + D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) + Q + ; + ; ERR(BSDXERID,ERRTXT) ;Error processing - S BSDXI=BSDXI+1 - S ERRTXT=$TR(ERRTXT,"^","~") - I $TL>0 TROLLBACK - S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - QUIT - ; + ; Unlock first + L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID) + ; If last line is $C(31), we are done. No more errors to send to client. + I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT + S BSDXI=BSDXI+1 + S ERRTXT=$TR(ERRTXT,"^","~") + S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + QUIT + ; ETRAP ;EP Error trap entry - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - ; Rollback, otherwise ^XTER will be empty from future rollback - I $TL>0 TROLLBACK - D ^%ZTER - S $EC="" ; Clear Error - ; Send to client - I '$D(BSDXI) N BSDXI S BSDXI=0 - D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE)) - QUIT - ; + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + D ^%ZTER + ; + ; Send to client + I '$D(BSDXI) N BSDXI S BSDXI=0 + D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE)) + Q:$Q 100_U_"Mumps Error" Q + ; IMHERE(BSDXRES) ;EP - ;Entry point for BSDX IM HERE remote procedure - S BSDXRES=1 - Q - ; + ;Entry point for BSDX IM HERE remote procedure + S BSDXRES=1 + Q + ; diff --git a/m/BSDX32.m b/m/BSDX32.m index b8333fa..1661bde 100644 --- a/m/BSDX32.m +++ b/m/BSDX32.m @@ -1,5 +1,5 @@ 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 ; ; Change Log: diff --git a/m/BSDX33.m b/m/BSDX33.m index 1350405..9c33f3d 100644 --- a/m/BSDX33.m +++ b/m/BSDX33.m @@ -1,5 +1,5 @@ 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 ; Mods by WV/STAR ; diff --git a/m/BSDX34.m b/m/BSDX34.m index 146fbbd..9a3b47e 100644 --- a/m/BSDX34.m +++ b/m/BSDX34.m @@ -1,5 +1,5 @@ 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 ; ; Change Log: diff --git a/m/BSDX35.m b/m/BSDX35.m index 3f9f478..d7fa3cc 100644 --- a/m/BSDX35.m +++ b/m/BSDX35.m @@ -1,5 +1,5 @@ -BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/21/12 3:57pm + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; ; diff --git a/m/BSDXAPI.m b/m/BSDXAPI.m index 4424e2d..ddcece7 100644 --- a/m/BSDXAPI.m +++ b/m/BSDXAPI.m @@ -1,43 +1,18 @@ -BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/10/12 5:58pm + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; - ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW - ;local mods (many) by WV/SMH - ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH - ; Change History: - ; 2010-11-5: (1.42) - ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment. - ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API. - ; 2010-11-12: (1.42) - ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well. - ; 2010-12-5 (1.42) - ; Added an entry point to update the patient note in file 44. - ; 2010-12-6 (1.42) - ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI") - ; 2010-12-8 (1.42) - ; Removed restriction on max appt length. Even though this restriction - ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I - ; will ignore it here too. - ; 2011-01-25 (v.1.5) - ; Added entry point $$RMCI to remove checked in appointments. - ; In $$CANCEL, if the appointment is checked in, delete check-in rather than - ; spitting an error message to the user saying 'Delete the check-in' - ; Changed all lines that look like this: - ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) - ; to: - ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) - ; to allow for date at midnight which does not have a dot at the end. - ; 2011-01-26 (v.1.5) - ; More user friendly message if patient already has appointment in $$MAKE: - ; Spits out pt name and user friendly date. - ; + ; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW + ; mods (many) by WV/SMH + ; Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH + ; Change history is located in BSDXAPI1 (to save space). ; MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment ; Call like this for DFN 23435 having an appointment at Hospital Location 33 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt ; for Baby foxes hallucinations. ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") + N BSDR S BSDR("PAT")=DFN ;DFN S BSDR("CLN")=CLIN ;Hosp Loc IEN S BSDR("TYP")=TYP ;3 sched or 4 walkin @@ -64,35 +39,15 @@ MAKE(BSDR) ;PEP; call to store appt made ; = 0 or null: everything okay ; = 1^message: error and reason ; - 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")) + N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment + I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why. ; - ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details. - I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) - ;I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") ; v.1.5 more user friendly err msg + ;Otherwise, we continue ; - ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others. - N BSDXERR ; place to store error message - I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO QUIT BSDXERR ; If there's an appt in the "S" node of file 2 and it's not cancelled - . S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") " - . S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT")) - . N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U) ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2) - . N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic - . S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic - . I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file) - . . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,"")) - . . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt - . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U) - . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic - ; - NEW DIC,DA,Y,X,DD,DO,DLAYGO + N BSDXFDA,BSDXIENS,BSDXMSG ; FILE/UPDATE^DIE variables ; I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D . ; "un-cancel" existing appt in file 2 - . N BSDXFDA,BSDXIENS,BSDXMSG . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") . S BSDXFDA(2.98,BSDXIENS,"3")="" @@ -101,27 +56,37 @@ MAKE(BSDR) ;PEP; call to store appt made . S BSDXFDA(2.98,BSDXIENS,"14")="" . S BSDXFDA(2.98,BSDXIENS,"15")="" . S BSDXFDA(2.98,BSDXIENS,"16")="" + . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over . S BSDXFDA(2.98,BSDXIENS,"19")="" . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT . D FILE^DIE("","BSDXFDA","BSDXMSG") - . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) - E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") - . N BSDXFDA,BSDXIENS,BSDXMSG + Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) + ; + Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line + ; + E D ; File new appointment/edit existing appointment in file 2 . S BSDXIENS="?+2,"_BSDR("PAT")_"," . S BSDXIENS(2)=BSDR("ADT") . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT - . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") - ; add appt to file 44 - K DIC,DA,X,Y,DLAYGO,DD,DO + . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG") + Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) + ; + Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line + ; + ; add appt to file 44. This adds it to the FIRST subfile (Appointment) + N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT") . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN ; + Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line + ; + ; add appt for file 44, second subfile (Appointment/Patient) ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," @@ -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) ; + ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line + S:$G(BSDXSIMERR5) X=1/0 + ; + ; Update the Availablilities ; Doesn't fail. Global reads and sets. + D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN"),BSDR("PAT")) + ; ; call event driver NEW DFN,SDT,SDCL,SDDA,SDMODE S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 @@ -149,10 +120,67 @@ MAKE(BSDR) ;PEP; call to store appt made D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) Q 0 ; +MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP + ; Input: Same as $$MAKE + ; Output: 1^error or 0 for success + ; NB: This subroutine saves no data. Only checks whether it's okay. + ; + I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) + I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) + I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) + I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds + I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + ; + ; Appt Length check removed in v 1.5 + ; + I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) + ; More verbose error message in v1.5 + ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others. + N BSDXERR ; place to store error message + I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO QUIT BSDXERR ; If there's an appt in the "S" node of file 2 and it's not cancelled + . S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") " + . S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT")) + . N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U) ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2) + . N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic + . S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic + . I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file) + . . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,"")) + . . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt + . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U) + . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic + Q 0 + ; +UNMAKE(BSDR) ; Reverse Make - Private $$ + ; Only used in Emergiencies where Fileman data filing fails. + ; If previous data exists, which caused an error, it's destroyed. + ; NB: ^DIK stops for nobody + ; NB: If Patient Appointment previously existed as cancelled, it's removed. + ; How can I tell if one previously existed when data is in an intermediate + ; State? Can I restore it if the other file failed? Restoration can cause + ; another error. If I restore the global, there will be cross-references + ; missing (ASDCN specifically). + ; + ; Input: Same array as $$MAKE + ; Output: Always 0 + NEW DIK,DA + S DIK="^DPT("_BSDR("PAT")_",""S""," + S DA(1)=BSDR("PAT"),DA=BSDR("ADT") + D ^DIK + ; + N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + I 'IEN QUIT 0 + ; + NEW DIK,DA + S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," + S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN + D ^DIK + QUIT 0 + ; CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in ; Call like this for DFN 23435 checking in now at Hospital Location 33 ; for appt at Dec 20, 2009 @ 10:11:59 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) + N BSDR S BSDR("PAT")=DFN ;DFN S BSDR("CLN")=CLIN ;Hosp Loc IEN S BSDR("ADT")=APDATE ;Appt Date @@ -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 ; = 1^message means error with reason message ; + I $G(BSDXDIE2) N X S X=1/0 + ; + N BSDXERR S BSDXERR=$$CHECKICK(.BSDR) + I BSDXERR Q BSDXERR + ; + ; find ien for appt in file 44 + NEW IEN,DIE,DA,DR + S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + ; + ; remember before status + ; Failure analysis: Only ^TMP global is set here. + NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE + S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN + S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) + ; + ; set checkin; Old Code -- keep for ref VEN/SMH 3 Jul 2012 + ; S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," + ; S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN + ; S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT + ; D ^DIE + ; + I $D(BSDXSIMERR3) Q 1_U_"Simulated Error" + ; + ; Failure analysis: If this fails, no other changes were made in this routine + N BSDXIENS S BSDXIENS=IEN_","_BSDR("ADT")_","_BSDR("CLN")_"," + N BSDXFDA + S BSDXFDA(44.003,BSDXIENS,309)=BSDR("CDT") + S BSDXFDA(44.003,BSDXIENS,302)=BSDR("USR") + S BSDXFDA(44.003,BSDXIENS,305)=$$NOW^XLFDT() + N BSDXERR + D UPDATE^DIE("","BSDXFDA","BSDXERR") + ; + I $D(BSDXERR) Q 1_U_"Error checking in appointment to file 44. Error: "_BSDXERR("DIERR",1,"TEXT",1) + ; + ; set after status + S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) + ; + ; Point of no Return + ; call event driver + D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) + Q 0 + ; +CHECKIC1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKICK - + ; Check-in Check + ; Call like this for DFN 23435 checking in now at Hospital Location 33 + ; for appt at Dec 20, 2009 @ 10:11:59 + ; S RESULT=$$CHECKIC1^BSDXAPI(23435,33,3091220.221159) + N BSDR + S BSDR("PAT")=DFN ;DFN + S BSDR("CLN")=CLIN ;Hosp Loc IEN + S BSDR("ADT")=APDATE ;Appt Date + S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now + S BSDR("USR")=DUZ ;Check-in user defaults to current + Q $$CHECKICK(.BSDR) + ; +CHECKICK(BSDR) ; $$ PEP; - Is it okay to check-in patient? + ; Input: Same as $$CHECKIN + ; Output: 0 if okay or 1^message if error + ; + I $G(BSDXSIMERR2) Q 1_U_"Simulated Error" + ; I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds @@ -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")) ; ; find ien for appt in file 44 - NEW IEN,DIE,DA,DR - S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") - ; - ; remember before status - NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL - S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN - S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL - D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) - ; - ; set checkin - S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," - S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN - S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT - D ^DIE - ; - ; set after status - S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) - S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL - D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) - ; - ; call event driver - D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) Q 0 ; CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment @@ -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) ; because foxes come out during bad weather. ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") + N BSDR S BSDR("PAT")=DFN S BSDR("CLN")=CLIN S BSDR("TYP")=TYP @@ -243,6 +315,70 @@ CANCEL(BSDR) ;PEP; called to cancel appt ; = 0 or null: everything okay ; = 1^message: error and reason ; + ; Okay to Cancel? Call Cancel Check. + N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR) + I BSDXCANCK Q BSDXCANCK + ; + ; BSDX 1.5 3110125 + ; UJO/SMH - Add ability to remove check-in if the patient is checked in + ; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in + ; Lets you remove appointment anyways! Not like RPMS. + ; Plus... deleting checkin affects S node on 44, which is DELETED anyways! + ; + ; remember before status + NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE + NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN + S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) + ; NB: Here only ^TMP globals are set with before values. + ; + ; get user who made appt and date appt made from ^SC + ; because data in ^SC will be deleted + ; Appointment Length: ditto + NEW USER,DATE + S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) + S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) + N BSDXLEN S BSDXLEN=$$APPLEN(DFN,SDCL,SDT) ; appt length + ; + ; update file 2 info --old code; keep for reference + ;NEW DIE,DA,DR + ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT + ;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE + ;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) + ;D ^DIE + N BSDXIENS S BSDXIENS=SDT_","_DFN_"," + N BSDXFDA + S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP") + S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR") + S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT") + S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR") + S BSDXFDA(2.98,BSDXIENS,19)=USER + S BSDXFDA(2.98,BSDXIENS,20)=DATE + S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160) + N BSDXERR + D FILE^DIE("","BSDXFDA","BSDXERR") + I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2" + ; Failure point 1: If we fail here, nothing has happened yet. + ; + ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop + NEW DIK,DA + S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," + S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN + D ^DIK + ; Failure point 2: not expected to happen here + ; + ; Update PIMS availability -- this doesn't fail. Global gets/sets only. + D AVUPDTCN^BSDXAPI1(SDCL,SDT,BSDXLEN) + ; + ; call event driver -- point of no return + D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) + ; + Q 0 + ; +CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment? + ; Input: .BSDR array as documented in $$CANCEL + ; Output: 0 or 1^Error message I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) @@ -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(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) ; - NEW IEN,DIE,DA,DR - S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + NEW IEN 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") ; - ; BSDX 1.5 3110125 - ; UJO/SMH - Add ability to remove check-in if the patient is checked in - ; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") - ; Remove check-in if the patient is checked in. - N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure - I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) - I BSDXRESULT Q BSDXRESULT - ; - ; remember before status - NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL - S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN - S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL - D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) - ; - ; get user who made appt and date appt made from ^SC - ; because data in ^SC will be deleted - NEW USER,DATE - S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) - S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) - ; - ; update file 2 info - NEW DIE,DA,DR - S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT - S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE - S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) - D ^DIE - ; - ; delete data in ^SC - NEW DIK,DA - S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," - S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN - D ^DIK - ; - ; call event driver - D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) + ; Check-out check. New in v1.7 + I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!" Q 0 ; 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) Q $S(X:1,1:0) ; -RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$ - ; PAT = DFN - ; CLINIC = SC IEN - ; DATE = FM Date/Time of Appointment - ; - ; Returns: - ; 0 if okay - ; -1 if failure - ; - ; Call like this: $$RMCI(233,33,3110102.1130) - ; - ; Move my variables into the ones used by SDAPIs (just a convenience) - NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL - S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT) - ; - I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 - ; - ; remember before status - S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL - D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) - ; - ; remove check-in using filer. - N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_"," - S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN - S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER - S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED - N BSDXERR - D FILE^DIE("","BSDXFDA","BSDXERR") - I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1) - ; - ; set after status - S SDDA=$$SCIEN(DFN,SDCL,SDT) - S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL - D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) - ; - ; call event driver - D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) - QUIT 0 +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) ; SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC 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 Q $G(IEN) ; +APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length + ; Get either the appointment length or zero + N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) + Q:SCIEN $P(^SC(CLINIC,"S",DATE,1,SCIEN,0),U,2) + Q 0 APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") ; -CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out - NEW X - S X=$G(SDIEN) ;ien sent in call - I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 - S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) - Q $S(X:1,1:0) - ; -UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE - ; PAT = DFN - ; CLINIC = SC IEN - ; DATE = FM Date/Time of Appointment - ; - ; Returns: - ; 0 if okay - ; -1 if failure - N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC - I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 - N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_"," - S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150) - N BSDXERR - D FILE^DIE("","BSDXFDA","BSDXERR") - I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1) - QUIT 0 diff --git a/m/BSDXAPI1.m b/m/BSDXAPI1.m index 64ea85b..7e14a88 100644 --- a/m/BSDXAPI1.m +++ b/m/BSDXAPI1.m @@ -1,5 +1,5 @@ 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 ; ; Change History (BSDXAPI and BSDXAPI1) diff --git a/m/BSDXGPRV.m b/m/BSDXGPRV.m index 81a6daa..d3d9413 100644 --- a/m/BSDXGPRV.m +++ b/m/BSDXGPRV.m @@ -1,5 +1,5 @@ -BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:31am - ;;1.6;BSDX;;Aug 31, 2011;Build 25 +BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 7/6/12 11:07am + ;;1.7;BSDX;;Jun 01, 2013;Build 24 ; Licensed under LGPL ; ; @@ -17,7 +17,7 @@ ERR(BSDXERR) ;Error processing ; PD(BSDXY,HLIEN) ;EP Debugging entry point ; - D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130") + ;D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130") ; Q ; @@ -32,7 +32,7 @@ P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location ; S BSDXI=0 I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT - D ^XBKVAR + D ^XBKVAR N $ET S $ET="G ERROR^BSDXGPRV" K ^BSDXTMP($J) S BSDXY=$NA(^BSDXTMP($J)) diff --git a/m/BSDXUT.m b/m/BSDXUT.m index 891daaa..2c9e4f1 100644 --- a/m/BSDXUT.m +++ b/m/BSDXUT.m @@ -1,5 +1,5 @@ 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 ; ; Change Log: diff --git a/m/BSDXUT1.m b/m/BSDXUT1.m index f9ecfa7..a80f5dd 100644 --- a/m/BSDXUT1.m +++ b/m/BSDXUT1.m @@ -1,5 +1,5 @@ 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 diff --git a/m/BSDXUT2.m b/m/BSDXUT2.m index 1391099..72d414b 100644 --- a/m/BSDXUT2.m +++ b/m/BSDXUT2.m @@ -1,5 +1,5 @@ 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 D UT25,PIMS