Index: Scheduling/trunk/m/BSDX01.m =================================================================== --- Scheduling/trunk/m/BSDX01.m (revision 1515) +++ Scheduling/trunk/m/BSDX01.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:52am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:46pm + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; @@ -282,41 +282,42 @@ ; INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user? - ; Input: BSDXSC - Hospital Location IEN - ; Output: True or False - I '+BSDXSC QUIT 1 ;If not tied to clinic, yes - I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes - ; Jump to Division:Medical Center Division:Inst File Pointer for - ; Institution IEN (and get its internal value) - N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I") - I DIV="" Q 1 ; If clinic has no division, consider it avial to user. - I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic - E Q 0 ; Otherwise, no + ; Input: BSDXSC - Hospital Location IEN + ; Output: True or False + I '+BSDXSC QUIT 1 ;If not tied to clinic, yes + I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes + ; Jump to Division:Medical Center Division:Inst File Pointer for + ; Institution IEN (and get its internal value) + N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I") + I DIV="" Q 1 ; If clinic has no division, consider it avial to user. + I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic + E Q 0 ; Otherwise, no + QUIT INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user? - ; Input BSDXRES - BSDX RESOURCE IEN - ; Output: True of False - Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV -UTINDIV ; Unit Test $$INDIV - W "Testing if they are the same",! - S DUZ(2)=67 - I '$$INDIV(1) W "ERROR",! - I '$$INDIV(2) W "ERROR",! - W "Testing if Div not defined in 44, should be true",! - I '$$INDIV(3) W "ERROR",! - W "Testing empty string. Should be true",! - I '$$INDIV("") W "ERROR",! - W "Testing if they are different",! - S DUZ(2)=899 - I $$INDIV(1) W "ERROR",! - I $$INDIV(2) W "ERROR",! - QUIT -UTINDIV2 ; Unit Test $$INDIV2 - W "Testing if they are the same",! - S DUZ(2)=69 - I $$INDIV2(22)'=0 W "ERROR",! - I $$INDIV2(25)'=1 W "ERROR",! - I $$INDIV2(26)'=1 W "ERROR",! - I $$INDIV2(27)'=1 W "ERROR",! - QUIT - ; + ; Input BSDXRES - BSDX RESOURCE IEN + ; Output: True of False + Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV +UnitTestINDIV + W "Testing if they are the same",! + S DUZ(2)=67 + I '$$INDIV(1) W "ERROR",! + I '$$INDIV(2) W "ERROR",! + W "Testing if Div not defined in 44, should be true",! + I '$$INDIV(3) W "ERROR",! + W "Testing empty string. Should be true",! + I '$$INDIV("") W "ERROR",! + W "Testing if they are different",! + S DUZ(2)=899 + I $$INDIV(1) W "ERROR",! + I $$INDIV(2) W "ERROR",! + QUIT +UnitTestINDIV2 + W "Testing if they are the same",! + S DUZ(2)=69 + I $$INDIV2(22)'=0 W "ERROR",! + I $$INDIV2(25)'=1 W "ERROR",! + I $$INDIV2(26)'=1 W "ERROR",! + I $$INDIV2(27)'=1 W "ERROR",! + QUIT + ; GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6 ; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array @@ -345,5 +346,11 @@ ; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time ; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested - D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR") + ; + ;;EHS/MKH,BAH;;UJO*1.0*143;;30/09/2012;; Update [Fix the performance issue in SchedGUI] + ; START OF CODE CHANGES FOR [UJO*1.0*143] + ; Commented old Line + ;D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR") + DO FIND^DIC(75.1,"","@;5;2;16","QP",DFN,"","B","IF 35[$PIECE(^(0),U,5)&($PIECE(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR") + ; END OF CODE CHANGES FOR [UJO*1.0*143] ; IF $DATA(BSDXERR) GOTO END Index: Scheduling/trunk/m/BSDX02.m =================================================================== --- Scheduling/trunk/m/BSDX02.m (revision 1515) +++ Scheduling/trunk/m/BSDX02.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ;Licensed under LGPL ; Change Log @@ -30,6 +30,5 @@ S BSDXERR="" S BSDXY="^BSDXTMP("_$J_")" - S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME" - S ^(0)=^(0)_"^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30) + S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30) D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP") ; @@ -38,5 +37,5 @@ ; 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 Index: Scheduling/trunk/m/BSDX03.m =================================================================== --- Scheduling/trunk/m/BSDX03.m (revision 1515) +++ Scheduling/trunk/m/BSDX03.m (revision 1563) @@ -1,4 +1,4 @@ BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ;Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX04.m =================================================================== --- Scheduling/trunk/m/BSDX04.m (revision 1515) +++ Scheduling/trunk/m/BSDX04.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/6/12 10:55am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:15am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Change Log: @@ -74,5 +74,5 @@ . 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)) Index: Scheduling/trunk/m/BSDX05.m =================================================================== --- Scheduling/trunk/m/BSDX05.m (revision 1515) +++ Scheduling/trunk/m/BSDX05.m (revision 1563) @@ -1,4 +1,4 @@ BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX06.m =================================================================== --- Scheduling/trunk/m/BSDX06.m (revision 1515) +++ Scheduling/trunk/m/BSDX06.m (revision 1563) @@ -1,4 +1,4 @@ BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Change Log: Index: Scheduling/trunk/m/BSDX07.m =================================================================== --- Scheduling/trunk/m/BSDX07.m (revision 1515) +++ Scheduling/trunk/m/BSDX07.m (revision 1563) @@ -1,284 +1,360 @@ -BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:02pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 - ; Licensed under LGPL - ; - ; Change Log: - ; UJO/SMH - ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US. - ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments - ; v1.42 Oct 30 2010 - Extensive refactoring. - ; v1.5 Mar 15 2011 - End time does not have to have time anymore. - ; It could be midnight of the next day - ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... - ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes - ; - AVUPDT moved to AVUPDTMK in BSDXAPI1 - ; - ; Error Reference: - ; -1: Patient Record is locked. This means something is wrong!!!! - ; -2: Start Time is not a valid Fileman date - ; -3: End Time is not a valid Fileman date - ; v1.5:obsolete::-4: End Time does not have time inside of it. - ; -5: BSDXPATID is not numeric - ; -6: Patient Does not exist in ^DPT - ; -7: Resource Name does not exist in B index of BSDX RESOURCE - ; -8: Resouce doesn't exist in ^BSDXRES - ; -9: Couldn't add appointment to BSDX APPOINTMENT - ; -10: Couldn't add appointment to files 2 and/or 44 - ; -100: Mumps Error - ; +BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 + ; Licensed under LGPL + ; + ; Change Log: + ; UJO/SMH + ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US. + ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments + ; thanks to Rick Marshall and Zach Gonzalez at Oroville. + ; v1.42 Oct 30 2010 - Extensive refactoring. + ; v1.5 Mar 15 2011 - End time does not have to have time anymore. + ; It could be midnight of the next day + ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... + ; + ; Error Reference: + ; -1: Patient Record is locked. This means something is wrong!!!! + ; -2: Start Time is not a valid Fileman date + ; -3: End Time is not a valid Fileman date + ; v1.5:obsolete::-4: End Time does not have time inside of it. + ; -5: BSDXPATID is not numeric + ; -6: Patient Does not exist in ^DPT + ; -7: Resource Name does not exist in B index of BSDX RESOURCE + ; -8: Resouce doesn't exist in ^BSDXRES + ; -9: Couldn't add appointment to BSDX APPOINTMENT + ; -10: Couldn't add appointment to files 2 and/or 44 + ; -100: Mumps Error + APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP - ;Entry point for debugging - ; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") - Q - ; -APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP - ; - ;Called by RPC: BSDX ADD NEW APPOINTMENT - ; - ;Add new appointment to 3 files - ; - BSDX APPOINTMENT - ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic - ; - Patient Appointment Subfile if Resource is linked to clinic - ; - ;Paramters: - ;BSDXY: Global Return (RPC must be set to Global Array) - ;BSDXSTART: FM Start Date - ;BSDXEND: FM End Date - ;BSDXPATID: Patient DFN - ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN) - ;BSDXLEN is the appointment duration in minutes - ;BSDXNOTE is the Appiontment Note - ;BSDXATID is used for 2 purposes: - ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. - ; if BSDXATID = a number, then it is the access type id (used for rebooking) - ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional) - ; - ;Return: - ; ADO.net Recordset having fields: - ; AppointmentID and ErrorNumber - ; - ; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers - ; to sort out. Needs changes on client. - ; - ;Test lines: - ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN - ; - ; Deal with optional arguments - S BSDXRADEXAM=$G(BSDXRADEXAM) - ; - ; Return Array; set Return and clear array - S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; - ; $ET - N $ET S $ET="G ETRAP^BSDX07" - ; - ; Counter - N BSDXI S BSDXI=0 - ; - ; Lock BSDX node, only to synchronize access to the globals. - ; It's not expected that the error will ever happen as no filing - ; is supposed to take 5 seconds. - L +^BSDXPAT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q - ; - ; Header Node - S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30) - ; - ; Turn off SDAM APPT PROTOCOL BSDX Entries - N BSDXNOEV - S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol - ; - ; Set Error Message to be empty - N BSDXERR S BSDXERR=0 - ; - ;;;test for error. See if %ZTER works - I $G(BSDXDIE) N X S X=1/0 - ;;;test - ; - ; -- Start and End Date Processing -- - ; If C# sends the dates with extra zeros, remove them - S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND - ; Are the dates valid? Must be FM Dates > than 2010 - I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q - I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q - ; - ;; If Ending date doesn't have a time, this is an error --rm 1.5 - ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q - ; - ; If the Start Date is greater than the end date, swap dates - N BSDXTMP - I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP - ; - ; Check if the patient exists: - ; - DFN valid number? - ; - Valid Patient in file 2? - I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q - I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q - ; - ;Validate Resource entry - I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q - N BSDXRESD ; Resource IEN - S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) - N BSDXRNOD ; Resouce zero node - S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) - I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q - ; - ; Walk-in (Unscheduled) Appointment? - N BSDXWKIN S BSDXWKIN=0 - I BSDXATID="WALKIN" S BSDXWKIN=1 - ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number - I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" - ; - ; Now, check if PIMS has any issues with us making the appt using MAKECK - N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN - N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK - N BSDXC ; Array to send to MAKE and MAKECK APIs - ; Only if we have a valid Hosp Location - I +BSDXSCD,$D(^SC(BSDXSCD,0)) D - . S BSDXC("PAT")=BSDXPATID - . S BSDXC("CLN")=BSDXSCD - . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins - . S:BSDXWKIN BSDXC("TYP")=4 - . S BSDXC("ADT")=BSDXSTART - . S BSDXC("LEN")=BSDXLEN - . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field - . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI - . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note - . S BSDXC("USR")=DUZ - . S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC) - I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q ; no need for roll back - ; - ; Done with all checks, let's make appointment in BSDX APPOINTMENT - N BSDXAPPTID - S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) - I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q ; no roll back needed! No appts made. - I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here - ; I don't think it's important b/c users can detect right away if the WP - ; filing fails. - ; - I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q ; UT Line - ; - ; Only if we have a valid Hosp Loc can we make an appointment in 2/44 - ; Use BSDXC array from before. - ; FYI: $$MAKE itself calls $$MAKECK to check again for being okay. - ; If an error happens here, we roll back both ^BSDXAPPT and 2/44 by deleting - N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK - I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) - I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q - ; - ; Unlock - L -^BSDXPAT(BSDXPATID) - ; - ;Return Recordset - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - Q + ;Entry point for debugging + D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") + Q + ; +UT ; Unit Tests + N ZZZ + ; Test for bad start date + D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",! + ; Test for bad end date + D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",! + ; Test for end date without time + D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",! + ; Test for mumps error + S bsdxdie=1 + D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",! + K bsdxdie + ; Test for TRESTART + s bsdxrestart=1 + D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",! + k bsdxrestart + ; Test for non-numeric patient + D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",! + ; Test for a non-existent patient + D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",! + ; Test for a non-existent resource name + D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",! + ; Test for corrupted resource + ; Can't test for -8 since it requires DB corruption + ; Test for inability to add appointment to BSDX Appointment + ; Also requires something wrong in the DB + ; Test for inability to add appointment to 2,44 + ; Test by creating a duplicate appointment + D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) + D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) + I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",! + ; Test for normality: + D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1) + ; Does Appt exist? + N APPID S APPID=+$P(^BSDXTMP($J,1),U) + I 'APPID W "Error Making Appt-1" QUIT + I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2" + I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3" + I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4" + QUIT + ; +APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP + ; + ;Called by RPC: BSDX ADD NEW APPOINTMENT + ; + ;Add new appointment to 3 files + ; - BSDX APPOINTMENT + ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic + ; - Patient Appointment Subfile if Resource is linked to clinic + ; + ;Paramters: + ;BSDXY: Global Return (RPC must be set to Global Array) + ;BSDXSTART: FM Start Date + ;BSDXEND: FM End Date + ;BSDXPATID: Patient DFN + ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN) + ;BSDXLEN is the appointment duration in minutes + ;BSDXNOTE is the Appiontment Note + ;BSDXATID is used for 2 purposes: + ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. + ; if BSDXATID = a number, then it is the access type id (used for rebooking) + ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional) + ; + ;Return: + ; ADO.net Recordset having fields: + ; AppointmentID and ErrorNumber + ; + ;Test lines: + ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN + ; + ; Deal with optional arguments + S BSDXRADEXAM=$G(BSDXRADEXAM) + ; Return Array; set Return and clear array + S BSDXY=$NA(^BSDXTMP($J)) + K ^BSDXTMP($J) + ; $ET + N $ET S $ET="G ETRAP^BSDX07" + ; Counter + N BSDXI S BSDXI=0 + ; Lock BSDX node, only to synchronize access to the globals. + ; It's not expected that the error will ever happen as no filing + ; is supposed to take 5 seconds. + L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q + ; Header Node + S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30) + ;Restartable Transaction; restore paramters when starting. + ; (Params restored are what's passed here + BSDXI) + TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07" + ; + ; Turn off SDAM APPT PROTOCOL BSDX Entries + N BSDXNOEV + S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol + ; + ; Set Error Message to be empty + N BSDXERR S BSDXERR=0 + ; + ;;;test for error inside transaction. See if %ZTER works + I $G(bsdxdie) S X=1/0 + ;;;test + ;;;test for TRESTART + I $G(bsdxrestart) K bsdxrestart TRESTART + ;;;test + ; + ; -- Start and End Date Processing -- + ; If C# sends the dates with extra zeros, remove them + S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND + ; Are the dates valid? Must be FM Dates > than 2010 + I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q + I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q + ; + ;; If Ending date doesn't have a time, this is an error --rm 1.5 + ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q + ; + ; If the Start Date is greater than the end date, swap dates + N BSDXTMP + I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP + ; + ; Check if the patient exists: + ; - DFN valid number? + ; - Valid Patient in file 2? + I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q + I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q + ; + ;Validate Resource entry + I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q + N BSDXRESD ; Resource IEN + S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) + N BSDXRNOD ; Resouce zero node + S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) + I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q + ; + ; Walk-in (Unscheduled) Appointment? + N BSDXWKIN S BSDXWKIN=0 + I BSDXATID="WALKIN" S BSDXWKIN=1 + ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number + I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID="" + ; + ; Done with all checks, let's make appointment in BSDX APPOINTMENT + N BSDXAPPTID + S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) + I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q + I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) + ; + ; Then Create Subfiles in 2/44 Appointment + N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN + ; Only if we have a valid Hosp Loc can we make an appointment + I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR) Q + . N BSDXC + . S BSDXC("PAT")=BSDXPATID + . S BSDXC("CLN")=BSDXSCD + . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins + . S:BSDXWKIN BSDXC("TYP")=4 + . S BSDXC("ADT")=BSDXSTART + . S BSDXC("LEN")=BSDXLEN + . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field + . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI + . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note + . S BSDXC("USR")=DUZ + . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) + . Q:BSDXERR + . ;Update RPMS Clinic availability + . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) + . Q + ; + ;Return Recordset + TCOMMIT + L -^BSDXAPPT(BSDXPATID) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + Q +BSDXDEL(BSDXAPPTID) ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN + N DA,DIK + S DIK="^BSDXAPPT(",DA=BSDXAPPTID + D ^DIK + Q + ; STRIP(BSDXZ) ;Replace control characters with spaces - N BSDXI - F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) - Q BSDXZ - ; + N BSDXI + F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) + Q BSDXZ + ; BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY - ;Returns ien in BSDXAPPT or 0 if failed - ;Create entry in BSDX APPOINTMENT - N BSDXAPPTID,BSDXFDA - S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART - S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND - S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID - S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD - S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) - S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT - S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" - S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID - S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM) - N BSDXIEN,BSDXMSG - D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") - S BSDXAPPTID=+$G(BSDXIEN(1)) - Q BSDXAPPTID - ; + ;Returns ien in BSDXAPPT or 0 if failed + ;Create entry in BSDX APPOINTMENT + N BSDXAPPTID + S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART + S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND + S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID + S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD + S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) + S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT + S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" + S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID + S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM + N BSDXIEN,BSDXMSG + D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") + S BSDXAPPTID=+$G(BSDXIEN(1)) + Q BSDXAPPTID + ; BSDXWP(BSDXAPPTID,BSDXNOTE) ; - ;Add WP field - N BSDXMSG - I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" - I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) - I $D(BSDXNOTE(.5)) D - . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") - Q - ; + ;Add WP field + I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" + I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) + I $D(BSDXNOTE(.5)) D + . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") + Q + ; ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP - ;Called by BSDX ADD APPOINTMENT protocol - ;BSDXSC=IEN of clinic in ^SC - ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note - ; - N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND - Q:+$G(BSDXNOEV) - I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) - E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) - Q:'+$G(BSDXRES) - S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0)) - Q:BSDXNOD="" - S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0)) - S BSDXWKIN="" - S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile - S BSDXLEN=$P(BSDXNOD,U,2) - Q:'+BSDXLEN - S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0) - S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN) - Q:'+BSDXAPPTID - S BSDXNOTE=$P(BSDXNOD,U,4) - I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) - D ADDEVT3(BSDXRES) - Q - ; + ;Called by BSDX ADD APPOINTMENT protocol + ;BSDXSC=IEN of clinic in ^SC + ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note + ; + N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES + Q:+$G(BSDXNOEV) + I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) + E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) + Q:'+$G(BSDXRES) + S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0)) + Q:BSDXNOD="" + S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0)) + S BSDXWKIN="" + S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile + S BSDXLEN=$P(BSDXNOD,U,2) + Q:'+BSDXLEN + S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0) + S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN) + Q:'+BSDXAPPTID + S BSDXNOTE=$P(BSDXNOD,U,4) + I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) + D ADDEVT3(BSDXRES) + Q + ; ADDEVT3(BSDXRES) ; - ;Call RaiseEvent to notify GUI clients - N BSDXRESN - S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) - Q:BSDXRESN="" - S BSDXRESN=$P(BSDXRESN,"^") - ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") - D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) - Q - ; -ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set - ; DO NOT USE except as an emergency measure - only if unforseen error occurs - ; Input: - ; Appointment ID to remove from ^BSDXAPPT - ; BSDXC array (see array format in $$MAKE^BSDXAPI) - N % - D BSDXDEL^BSDX07(BSDXAPPTID) - S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0 - QUIT - ; -BSDXDEL(BSDXAPPTID) ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT - ; DO NOT USE except in emergencies to roll back an appointment set - N DA,DIK - S DIK="^BSDXAPPT(",DA=BSDXAPPTID - D ^DIK - Q - ; -ERR(BSDXI,BSDXERR) ;Error processing - different from error trap. - ; Unlock first - L -^BSDXPAT(BSDXPATID) - ; If last line is $C(31), we are done. No more errors to send to client. - I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT - S BSDXI=BSDXI+1 - S BSDXERR=$TR(BSDXERR,"^","~") - S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - Q - ; + ;Call RaiseEvent to notify GUI clients + N BSDXRESN + S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) + Q:BSDXRESN="" + S BSDXRESN=$P(BSDXRESN,"^") + ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","") + D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) + Q + ; +ERR(BSDXI,BSDXERR) ;Error processing + S BSDXI=BSDXI+1 + S BSDXERR=$TR(BSDXERR,"^","~") + I $TL>0 TROLLBACK + S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + L -^BSDXAPPT(BSDXPATID) + Q + ; ETRAP ;EP Error trap entry - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - D ^%ZTER - ; - I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists - ; - ; Log error message and send to client - I '$D(BSDXI) N BSDXI S BSDXI=0 - D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) - Q:$Q 1_U_"Mumps Error" Q - ; + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + ; Rollback, otherwise ^XTER will be empty from future rollback + I $TL>0 TROLLBACK + D ^%ZTER + S $EC="" ; Clear Error + ; Log error message and send to client + I '$D(BSDXI) N BSDXI S BSDXI=0 + D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) + Q + ; +DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR + ; +DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y) + F %=%:-1:281 S Y=%#4=1+1+Y + S Y=$E(X,6,7)+Y#7 + Q + ; +AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability + ;SEE SDM1 + N Y,DFN + N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG + N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I + S Y=BSDXSCD,DFN=BSDXPATID + S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y + ;Determine maximum days for scheduling + S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 + S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) + S SDDATE=BSDXSTART + S SDSDATE=SDDATE,SDDATE=SDDATE\1 +1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC + Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC + S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) + S X2=SDEDT D C^%DTC S SDEDT=X + S Y=BSDXSTART +EN1 S (X,SD)=Y,SM=0 D DOW +S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".") + S S=BSDXLEN + ;Check if BSDXLEN evenly divisible by appointment length + S RPMSL=$P(SL,U) + I 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 Index: Scheduling/trunk/m/BSDX08.m =================================================================== --- Scheduling/trunk/m/BSDX08.m (revision 1515) +++ Scheduling/trunk/m/BSDX08.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL. @@ -6,6 +6,12 @@ ; Change History ; 3101022 UJO/SMH v1.42 - ; - Transaction work. As of v 1.7, all work here has been superceded - ; - Refactoring of AVUPDT - never tested though. + ; - Transaction now restartable. Thanks to + ; --> Zach Gonzalez and Rick Marshall for fix. + ; - Extra TROLLBACK in Lock Statement when lock fails. + ; --> Removed--Rollback is already in ERR tag. + ; - Added new statements to old SD code in AVUPDT to obviate + ; --> need to restore variables in transaction + ; - Refactored this chunk of code. Don't really know whether it + ; --> worked in the first place. Waiting for bug report to know. ; - Refactored all of APPDEL. ; @@ -13,9 +19,5 @@ ; - Added ability to remove checked in appointments. Added a couple ; of units tests for that under UT2. - ; - ; 3120625 VEN/SMH v1.7 - ; - Transactions removed. Code refactored to work w/o txns. - ; - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling - ; that. + ; - Minor reformatting because of how KIDS adds tabs. ; ; Error Reference: @@ -29,13 +31,74 @@ ; -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)") - Q - ; -APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ; Private EP + 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 ;Called by RPC: BSDX CANCEL APPOINTMENT ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles @@ -61,7 +124,15 @@ ; 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 @@ -70,67 +141,51 @@ ; ;;;test for error inside transaction. See if %ZTER works - I $G(BSDXDIE1) N X S X=1/0 + I $G(bsdxdie) S X=1/0 + ;;;test + ;;;test for TRESTART + I $G(bsdxrestart) K bsdxrestart TRESTART + ;;;test ; ; Check appointment ID and whether it exists I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q - ; - ; Lock BSDX node, only to synchronize access to the globals. - ; It's not expected that the error will ever happen as no filing - ; is supposed to take 5 seconds. - L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q ; ; Start Processing: - ; First, get data + ; First, add cancellation date to appt entry in BSDX APPOINTMENT N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Time - ; - ; Check the resource ID and whether it exists + 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 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID - ; If the resource id doesn't exist... + ; If the resouce id doesn't exist... I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT - ; - ; - ; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI ; Get zero node of resouce - N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) + S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Get Hosp location N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4) - ; Error indicator + ; Error indicator for Hosp Location filing for getting out of routine N BSDXERR S BSDXERR=0 - ; - N BSDXC ; Array to pass to BSDXAPI - ; - I BSDXLOC D - . S BSDXC("PAT")=BSDXPATID - . S BSDXC("CLN")=BSDXLOC - . S BSDXC("TYP")=BSDXTYP - . S BSDXC("ADT")=BSDXSTART - . S BSDXC("CDT")=$$NOW^XLFDT() - . S BSDXC("NOT")=BSDXNOT - . S:'+$G(BSDXCR) BSDXCR=11 ;Other - . S BSDXC("CR")=BSDXCR - . S BSDXC("USR")=DUZ - . ; - . S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message - ; If error, quit. No need to rollback as no changes took place. - I BSDXERR D ERR(BSDXI,"-9~BSDX08: BSDXAPI reports that "_$P(BSDXERR,U,2)) QUIT - ; - I $G(BSDXDIE2) N X S X=1/0 - ; - ; Now cancel the appointment for real - ; BSDXAPPT First; no need for rollback if error occured. - N BSDXERR S BSDXERR=$$BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT - I BSDXERR D ERR(BSDXI,"-10~BSDX08: $$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT - ; - ; Then PIMS: - ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability - ; If error happens, must rollback ^BSDXAPPT - I BSDXLOC S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI - ; Rollback BSDXAPPT if error occurs - I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID) QUIT - ; + ; Only file in 2/44 if there is an associated hospital location + I BSDXLOC D QUIT:BSDXERR + . I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT + . ; Get the IEN of the appointment in the "S" node of ^SC + . N BSDXSCIEN + . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) + . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT + . ; Get the appointment node + . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0)) + . I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT + . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) + . ; Cancel through BSDXAPI + . N BSDXZ + . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART) + . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT + . ; Update Legacy PIMS clinic Availability + . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN) + ; + TCOMMIT L -^BSDXAPPT(BSDXAPTID) S BSDXI=BSDXI+1 @@ -140,23 +195,78 @@ Q ; -BSDXCAN(BSDXAPTID) ; $$; Private; Cancel BSDX APPOINTMENT entry - ; Input: Appt IEN in ^BSDXAPPT - ; Output: 0 for success and 1^Msg for failure - N BSDXDATE,BSDXIENS,BSDXFDA,BSDXMSG - S BSDXDATE=$$NOW^XLFDT() +AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability + ;See SDCNP0 + N SD,S ; Start Date + S (SD,S)=BSDXSTART + N I ; Clinic IEN in 44 + S I=BSDXSCD + ; if day has no schedule in legacy PIMS, forget about this update. + Q:'$D(^SC(I,"ST",SD\1,1)) + N SL ; Clinic characteristics node (length of appt, when appts start etc) + S SL=^SC(I,"SL") + N X ; Hour Clinic Display Begins + S X=$P(SL,U,3) + N STARTDAY ; When does the day start? + S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am + N SB ; ?? Who knows? Day Start - 1 divided by 100. + S SB=STARTDAY-1/100 + S X=$P(SL,U,6) ; Now X is Display increments per hour + N HSI ; Slots per hour, try 1 + S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4 + N SI ; Slots per hour, try 2 + S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4 + N STR ; ?? + S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz" + N SDDIF ; Slots per hour diff?? + S SDDIF=$S(HSI<3:8/HSI,1:2) + S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI + S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS + N Y ; Hours since start of Date + S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs + N ST ; ?? + ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour + ; Y\1 -> Hours since start of day; * SI: * slots + S ST=Y#1*SI\.6+(Y\1*SI) + N SS ; how many slots are supposed to be taken by appointment + S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots) + N I + I Y'<1 D ; If Hours since start of Date is greater than 1 + . ; loop through pattern. Tired of documenting. + . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0 + . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" + . . S S=$E(S,1,I)_Y_$E(S,I+2,999) + . . S SS=SS-1 + . . Q:SS'>0 + S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set + Q + ; +APCAN(BSDXZ,BSDXLOC,BSDXDFN,BSDXSD) ; + ;Cancel appointment for patient BSDXDFN in clinic BSDXSC1 + ;at time BSDXSD + N BSDXC,%H + S BSDXC("PAT")=BSDXPATID + S BSDXC("CLN")=BSDXLOC + S BSDXC("TYP")=BSDXTYP + S BSDXC("ADT")=BSDXSD + S %H=$H D YMD^%DTC + S BSDXC("CDT")=X+% + S BSDXC("NOT")=BSDXNOT + S:'+$G(BSDXCR) BSDXCR=11 ;Other + S BSDXC("CR")=BSDXCR + S BSDXC("USR")=DUZ + ; + S BSDXZ=$$CANCEL^BSDXAPI(.BSDXC) + Q + ; +BSDXCAN(BSDXAPTID) ; + ;Cancel BSDX APPOINTMENT entry + N %DT,X,BSDXDATE,Y,BSDXIENS,BSDXFDA,BSDXMSG + S %DT="XT",X="NOW" D ^%DT ; X ^DD("DD") + S BSDXDATE=Y S BSDXIENS=BSDXAPTID_"," S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE + K BSDXMSG D FILE^DIE("","BSDXFDA","BSDXMSG") - I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1) - QUIT 0 - ; -ROLLBACK(BSDXAPTID) ; Proc; Private; Rollback cancellation - ; Input same as $$BSDXCAN - N BSDXIENS S BSDXIENS=BSDXAPTID_"," - N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@" - N BSDXMSG - D FILE^DIE("","BSDXFDA","BSDXMSG") - ;I $D(BSDXMSG) ; Not sure what to do. We are already handling an error. - QUIT + Q ; CANEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CANCEL APPOINTMENT event @@ -182,8 +292,7 @@ Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND - . N BSDXNOD . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q - I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER + I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT) Q BSDXFOUND ; @@ -200,28 +309,23 @@ ; ERR(BSDXI,BSDXERR) ;Error processing - ; Unlock first - L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID) - ; If last line is $C(31), we are done. No more errors to send to client. - I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT S BSDXI=BSDXI+1 S BSDXERR=$TR(BSDXERR,"^","~") + I $TL>0 TROLLBACK S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) + L -^BSDXAPPT(BSDXAPTID) QUIT ; ETRAP ;EP Error trap entry N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + ; Rollback, otherwise ^XTER will be empty from future rollback + I $TL>0 TROLLBACK D ^%ZTER - ; - ; Roll back BSDXAPPT; - ; NB: What if a Mumps error happens inside fileman in BSDXAPI? - ; I have decided the M errors are out of scope for me to handle. - D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID) - ; + S $EC="" ; Clear Error ; Log error message and send to client I '$D(BSDXI) N BSDXI S BSDXI=0 D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE)) - Q:$Q 1_U_"-100~Mumps Error" Q + QUIT ; ;;;NB: This is code that is unused in both original and port. Index: Scheduling/trunk/m/BSDX09.m =================================================================== --- Scheduling/trunk/m/BSDX09.m (revision 1515) +++ Scheduling/trunk/m/BSDX09.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 6/21/12 11:03am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:18am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX11.m =================================================================== --- Scheduling/trunk/m/BSDX11.m (revision 1515) +++ Scheduling/trunk/m/BSDX11.m (revision 1563) @@ -1,4 +1,4 @@ BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX12.m =================================================================== --- Scheduling/trunk/m/BSDX12.m (revision 1515) +++ Scheduling/trunk/m/BSDX12.m (revision 1563) @@ -1,4 +1,4 @@ BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX13.m =================================================================== --- Scheduling/trunk/m/BSDX13.m (revision 1515) +++ Scheduling/trunk/m/BSDX13.m (revision 1563) @@ -1,4 +1,4 @@ BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX14.m =================================================================== --- Scheduling/trunk/m/BSDX14.m (revision 1515) +++ Scheduling/trunk/m/BSDX14.m (revision 1563) @@ -1,4 +1,4 @@ BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX15.m =================================================================== --- Scheduling/trunk/m/BSDX15.m (revision 1515) +++ Scheduling/trunk/m/BSDX15.m (revision 1563) @@ -1,4 +1,4 @@ BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX16.m =================================================================== --- Scheduling/trunk/m/BSDX16.m (revision 1515) +++ Scheduling/trunk/m/BSDX16.m (revision 1563) @@ -1,4 +1,4 @@ BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:20am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX17.m =================================================================== --- Scheduling/trunk/m/BSDX17.m (revision 1515) +++ Scheduling/trunk/m/BSDX17.m (revision 1563) @@ -1,4 +1,4 @@ BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX18.m =================================================================== --- Scheduling/trunk/m/BSDX18.m (revision 1515) +++ Scheduling/trunk/m/BSDX18.m (revision 1563) @@ -1,4 +1,4 @@ BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX19.m =================================================================== --- Scheduling/trunk/m/BSDX19.m (revision 1515) +++ Scheduling/trunk/m/BSDX19.m (revision 1563) @@ -1,4 +1,4 @@ BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX20.m =================================================================== --- Scheduling/trunk/m/BSDX20.m (revision 1515) +++ Scheduling/trunk/m/BSDX20.m (revision 1563) @@ -1,4 +1,4 @@ BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX21.m =================================================================== --- Scheduling/trunk/m/BSDX21.m (revision 1515) +++ Scheduling/trunk/m/BSDX21.m (revision 1563) @@ -1,4 +1,4 @@ BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX22.m =================================================================== --- Scheduling/trunk/m/BSDX22.m (revision 1515) +++ Scheduling/trunk/m/BSDX22.m (revision 1563) @@ -1,4 +1,4 @@ BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX23.m =================================================================== --- Scheduling/trunk/m/BSDX23.m (revision 1515) +++ Scheduling/trunk/m/BSDX23.m (revision 1563) @@ -1,4 +1,4 @@ BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX24.m =================================================================== --- Scheduling/trunk/m/BSDX24.m (revision 1515) +++ Scheduling/trunk/m/BSDX24.m (revision 1563) @@ -1,4 +1,4 @@ BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX25.m =================================================================== --- Scheduling/trunk/m/BSDX25.m (revision 1515) +++ Scheduling/trunk/m/BSDX25.m (revision 1563) @@ -1,27 +1,54 @@ -BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX25 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; ; Change Log: ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C# - ; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions. - ; -> Functionality still the same. - ; -> Unit Tests in UT25^BSDXUT2 - ; - ; -CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP + ; + ; +UT ; Unit Tests + ; Make appointment, checkin, then uncheckin + N ZZZ + N APPTTIME S APPTTIME=$E($$NOW^XLFDT(),1,12) + D APPADD^BSDX07(.ZZZ,APPTTIME,APPTTIME+.0001,3,"Dr Office",30,"Sam's Note",1) + N APPTID S APPTID=+^BSDXTMP($J,1) + N HL S HL=$$GET1^DIQ(9002018.4,APPTID,".07:.04","I") + D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT()) + IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1",! + IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 2",! + D RMCI^BSDX25(.ZZZ,APPTID) + IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",! + IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",! + D RMCI^BSDX25(.ZZZ,APPTID) ; again, test sanity in repeat + IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN UNCHECKIN 1",! + IF $G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 2",! + ; now test various error conditions + ; Test Error 1 + D RMCI^BSDX25(.ZZZ,) + IF +^BSDXTMP($J,1)'=-1 WRITE "ERROR IN ETest 1",! + ; Test Error 2 + D RMCI^BSDX25(.ZZZ,234987234398) + IF +^BSDXTMP($J,1)'=-2 WRITE "ERROR IN Etest 2",! + ; Tests for 3 to 5 difficult to produce + ; Error tests follow: Mumps error test; Transaction restartability + N bsdxdie S bsdxdie=1 + D RMCI^BSDX25(.ZZZ,APPTID) + IF +^BSDXTMP($J,1)'=-20 WRITE "ERROR IN Etest 3",! + K bsdxdie + N bsdxrestart S bsdxrestart=1 + D RMCI^BSDX25(.ZZZ,APPTID) + IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 4",! + QUIT +CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP ;Entry point for debugging ; - ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2)) - Q - ; -CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment - ; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) - ; Called by RPC: BSDX CHECKIN APPOINTMENT - ; + ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2)) + Q + ; +CHECKIN(BSDXY,BSDXAPTID,BSDXCDT) ; ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP Check in appointment ; Private to GUI; use BSDXAPI for general API to checkin patients ; Parameters: ; BSDXY: Global Out - ; BSDXAPPTID: Appointment ID in ^BSDXAPPT + ; BSDXAPTID: Appointment ID in ^BSDXAPPT ; BSDXCDT: Checkin Date --> Changed ; BSDXCC: Clinic Stop IEN (not used) @@ -30,5 +57,5 @@ ; BSDXVCL: PCC+ Clinic IEN (not used) ; BSDXVFM: PCC+ Form IEN (not used) - ; BSDXOG: PCC+ Outguide (true or false) (not used) + ; BSDXOG: PCC+ Outguide (true or false) ; ; Output: @@ -36,76 +63,34 @@ ; - 0 if all okay ; - Another number or text if not - ; - ; Error reference: - ; -1 -> Invalid Appointment ID - ; -2 -> Invalid Check-in Date - ; -3 -> Cannot check-in due to Fileman Filer failure - ; -4 -> Cannot lock ^BSDXAPPT(APPTID) - ; -10 -> BSDXAPI error - ; -100 -> Mumps Error - ; - ; Turn off SDAM Appointment Events BSDX Protocol Processing + + N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol ; - ; Set min DUZ vars - D ^XBKVAR - ; - ; $ET - N $ET S $ET="G ERROR^BSDX25" - ; - ; Test for error trap for Unit Tests - I $G(BSDXDIE) N X S X=1/0 - ; - N BSDXI S BSDXI=0 - ; - S BSDXY=$NAME(^BSDXTMP($J)) - K @BSDXY - ; + D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP") + S BSDXI=0 + K ^BSDXTMP($J) + S BSDXY="^BSDXTMP("_$J_")" S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30) - ; - I '+BSDXAPPTID D ERR("-1~Invalid Appointment ID") QUIT - I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-1~Invalid Appointment ID") QUIT - ; - ; Lock BSDX node, only to synchronize access to the globals. - ; It's not expected that the error will ever happen as no filing - ; is supposed to take 5 seconds. - L +^BSDXAPPT(BSDXAPPTID):5 E D ERR("-4~Appt record is locked. Please contact technical support.") QUIT - ; + I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q + I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q ; Remove Date formatting v.1.5. Client will send date as FM Date. ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@") ;S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y - S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them - I BSDXCDT'>2000000 D ERR("-2~Invalid Check-in Date") QUIT + S BSDXCDT=+BSDXCDT ; Strip off zeros if C# sends them + I BSDXCDT=-1 D ERR(70) Q I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT - ; - ; 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) + ;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) + ; S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="0"_$C(30) @@ -114,23 +99,19 @@ Q ; -BSDXCHK(BSDXAPPTID,BSDXCDT) ; $$ Private Entry Point. File or delete check-in to - ; BSDX Appointment - ; Input: BSDXAPPTID -> Appointment ID - ; BSDXCDT -> Check-in date, or "@" to remove check-in. - ; - ; 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_"," +BSDXCHK(BSDXAPTID,BSDXCDT) ; + ; + S BSDXIENS=BSDXAPTID_"," S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT D FILE^DIE("","BSDXFDA","BSDXMSG") - Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1) - Q 0 - ; -RMCI(BSDXY,BSDXAPPTID) ; Private EP - Remove Check-in from BSDX APPT and 2/44 - ; Called by RPC BSDX REMOVE CHECK-IN + Q + ; +APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ; + ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1 + ;at time BSDXSTART + S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART) + Q + ; +RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44 + ; Called by RPC [Fill in later] ; ; Parameters to pass: @@ -147,7 +128,5 @@ ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES) ; -5~BSDXAPI Error. Message depends on error. - ; -6~Data Filing Error in BSDXCHK - ; -7~Lock not acquired - ; -100~Mumps Error + ; -20~Mumps Error ; N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol @@ -163,6 +142,11 @@ S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset ; + TSTART (BSDXI):SERIAL ; Perform Autolocking + ; ;;;test - I $G(BSDXDIE) N X S X=8/0 + I $g(bsdxdie) S X=8/0 + ;;; + I $g(bsdxrestart) k bsdxrestart TRESTART + ;;;test ; ; Check for Appointment ID (passed and exists in file) @@ -170,47 +154,25 @@ I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT ; - ; Lock - ; Timeout not expected to happen except in error conditions. - L +^BSDXAPPT(BSDXAPPTID):5 E D ERR("-7~Appt record is locked. Please contact technical support.") QUIT - ; - ; Get appointment Data + ; Remove checkin from BSDX APPOINTMENT entry + D BSDXCHK(BSDXAPPTID,"@") + ; + ; Now, remove checkin from PIMS files 2/44 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) - N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN - N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date - N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID + N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN + N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date + N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID ; ; If the resource doesn't exist, error out. DB is corrupt. - I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT - I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT - ; - ; Get HL Data - N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node - N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN - I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist - ; - ; Is it okay to remove check-in from PIMS? - N BSDXERR S BSDXERR=0 ; Scratch variable - ; $$RMCICK = Remove Check-in Check - I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) - I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT - ; - ; For possible rollback, get old check-in date (internal value) - N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I") - ; - ; Remove checkin from BSDX APPOINTMENT entry - ; No need to rollback here on failure. - N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@") - I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT - ; - ; 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) + 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 + ; + N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node + S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION + ; + N BSDXZ ; Scratch variable to hold error message + I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART) + I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT + ; + TCOMMIT ; Save Data into Globals ; ; Return ADO recordset @@ -246,9 +208,7 @@ Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND - . N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" + . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q - I BSDXFOUND,+$G(BSDXAPPT) D - . N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT) - . I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort + I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT) Q BSDXFOUND ; @@ -265,21 +225,14 @@ ERROR ; S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise - D ^%ZTER - ; VEN/SMH: NB: I make a conscious decision not to roll back anything - ; here in the error trap. Once the error is fixed, users can - ; undo or redo the check-in. - ; Individual portions of this routine may choose to do rolling back - ; of their own (e.g. a failed call to BSDXAPI causes rollback to occur - ; in CHECKIN and RMCI) - ; - ; Log error message and send to client - D ERR("-100~Mumps Error") - Q:$Q "-100^Mumps Error" Q + ; Rollback, otherwise ^XTER will be empty from future rollback + I $TL>0 TROLLBACK + D ^%ZTER + S $EC="" ; Clear Error + ; Log error message and send to client + D ERR("-20~Mumps Error") + Q ; ERR(BSDXERR) ;Error processing - ; Unlock first - L:$D(BSDXAPPTID) -^BSDXAPPT(BSDXAPPTID) - ; If last line is $C(31), we are done. No more errors to send to client. - I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT + I $TLEVEL>0 TROLLBACK S BSDXERR=$G(BSDXERR) S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name Index: Scheduling/trunk/m/BSDX26.m =================================================================== --- Scheduling/trunk/m/BSDX26.m (revision 1515) +++ Scheduling/trunk/m/BSDX26.m (revision 1563) @@ -1,124 +1,133 @@ -BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:27am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 - ; Licensed under LGPL - ; Change History: - ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx. - ; 3101205 - UJO/SMH - Extensive refactoring. - ; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1 - ; - ; Error Reference: - ; 1: Appt ID is not a number - ; 2: Appt IEN is not in ^BSDXAPPT - ; 3: FM Failure to file WP field in ^BSDXAPPT - ; 4: BSDXAPI reports failure to change note field in ^SC - ; 5: Failure to acquire lock on ^BSDXAPPT(APPTID) - ; 100: Mumps Error - ; - ; NB: Normally I use negative numbers for errors; this routine returns - ; -1 as a successful result! So I needed to use +ve numbers. - ; +BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 + ; Licensed under LGPL + ; Change History: + ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx. + ; --> Thanks to Zach Gonzalez and Rick Marshall + ; 3101205 - UJO/SMH - Extensive refactoring. + ; + ; Error Reference: + ; -1: Appt ID is not a number + ; -2: Appt IEN is not in ^BSDXAPPT + ; -3: FM Failure to file WP field in ^BSDXAPPT + ; EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP - ;Entry point for debugging - ; - ;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") - Q + ;Entry point for debugging + ; + D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)") + Q +UT ; Unit Tests + ; Test 1: Make sure this damn thing works + N ZZZ + N %H S %H=$H + N NOTE S NOTE="New Note "_%H + D EDITAPT(.ZZZ,188,NOTE) + I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B + ; Test 2: Test Errors -1 and -2 + N ZZZ + N NOTE S NOTE="Nothing important" + D EDITAPT(.ZZZ,"BLAHBLAH",NOTE) + I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B + D EDITAPT(.ZZZ,298734322,NOTE) + I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B + ; Test 4: M Error + N bsdxdie S bsdxdie=1 + D EDITAPT(.ZZZ,188,NOTE) + I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B + k bsdxdie + ; Test 5: Trestart + N bsdxrestart S bsdxrestart=1 + N %H S %H=$H + N NOTE S NOTE="New Note "_%H + D EDITAPT(.ZZZ,188,NOTE) + I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B + ; Test 6: for Hosp Location Update + N DATE S DATE=$$NOW^XLFDT() + S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform + D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1) + N APPID S APPID=+$P(^BSDXTMP($J,1),U) + D EDITAPT(.ZZZ,APPID,"New Note") + I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B + I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B + QUIT + ; EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited) - ; Called by RPC: BSDX EDIT APPOINTMENT - ; - ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file - ; - ; Parameters: - ; - BSDXY: Global Return (RPC must be set to Global Array) - ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT - ; - BSDXNOTE: New note - ; - ; Return: - ; ADO.net Recordset having 1 field: ERRORID - ; If Okay: -1; otherwise, positive integer with message - ; - ; Return Array; set Return and clear array - S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; ET - N $ET S $ET="G ETRAP^BSDX26" - ; Set up basic DUZ variables - D ^XBKVAR - ; Counter - N BSDXI S BSDXI=0 - ; Header Node - S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) - ; - ;;;test for error. See if %ZTER works - I $G(BSDXDIE) S X=1/0 - ; - ; Validate Appointment ID - I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT - I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT - ; - ; Lock BSDX node, only to synchronize access to the globals. - ; It's not expected that the error will ever happen as no filing - ; is supposed to take 5 seconds. - L +^BSDXAPPT(BSDXAPTID):5 E D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") QUIT - ; - ; Put the WP in decendant fields from the root to file as a WP field - S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" - I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) - ; - N BSDXMSG ; Message in case of error in filing. - ; - ; Save Before State in case we need it for rollback - K ^TMP($J) - M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID) - ; - ; Update note in BSDX APPOINTMENT - I $D(BSDXNOTE(.5)) D - . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") - ; - ; Error handling. No need for rollback since nothing else changed. - I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT - ; - ; Now file in file 44: - N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN - N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID - N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT - N BSDXRES S BSDXRES=0 ; Result - ; Update Note only if we have a linked hospital location. - I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5)) - ; If we get an error (denoted by -1 in BSDXRES), return error to client - ; AND restore the original note - I BSDXRES D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT - ; - ;Return Recordset indicating success - L -^BSDXAPPT(BSDXAPTID) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)="-1"_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - ; - K ^TMP($J) ; Done; remove TMP data - QUIT - ; -ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT - M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT") - K ^TMP($J) - QUIT - ; + ; Called by RPC: BSDX EDIT APPOINTMENT + ; + ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file + ; + ; Parameters: + ; - BSDXY: Global Return (RPC must be set to Global Array) + ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT + ; - BSDXNOTE: New note + ; + ; Return: + ; ADO.net Recordset having 1 field: ERRORID + ; If Okay: -1; otherwise, positive integer with message + ; + ; Return Array; set Return and clear array + S BSDXY=$NA(^BSDXTMP($J)) + K ^BSDXTMP($J) + ; ET + N $ET S $ET="G ETRAP^BSDX26" + ; Set up basic DUZ variables + D ^XBKVAR + ; Counter + N BSDXI S BSDXI=0 + ; Header Node + S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30) + ; Restartable txn for GT.M. Restored vars are Params + BSDXI. + TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26" + ; + ;;;test for error inside transaction. See if %ZTER works + I $G(bsdxdie) S X=1/0 + ;;;test + ;;;test for TRESTART + I $G(bsdxrestart) K bsdxrestart TRESTART + ;;;test + ; + ; Validate Appointment ID + I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT + I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT + ; Put the WP in decendant fields from the root to file as a WP field + S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" + I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) + N BSDXMSG ; Message in case of error in filing. + I $D(BSDXNOTE(.5)) D + . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG") + I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT + ; + ; Now file in file 44: + N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN + N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID + N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT + N BSDXRES S BSDXRES=0 ; Result + ; Update Note only if we have a linked hospital location. + I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5)) + ; If we get an error (denoted by -1 in BSDXRES), return error to client + I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT + ;Return Recordset + TCOMMIT + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)="-1"_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + QUIT + ; ERR(BSDXI,BSDXERR) ;Error processing - ; Unlock first - L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID) - ; If last line is $C(31), we are done. No more errors to send to client. - I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT - S BSDXI=BSDXI+1 - S BSDXERR=$TR(BSDXERR,"^","~") - S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - QUIT - ; + S BSDXI=BSDXI+1 + S BSDXERR=$TR(BSDXERR,"^","~") + I $TL>0 TROLLBACK + S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + QUIT + ; ETRAP ;EP Error trap entry - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - D ^%ZTER - ; - I '$D(BSDXI) N BSDXI S BSDXI=0 - D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE)) - QUIT + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + I $TL>0 TROLLBACK + D ^%ZTER + S $EC="" + I '$D(BSDXI) N BSDXI S BSDXI=0 + D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE)) + Q Index: Scheduling/trunk/m/BSDX27.m =================================================================== --- Scheduling/trunk/m/BSDX27.m (revision 1515) +++ Scheduling/trunk/m/BSDX27.m (revision 1563) @@ -1,4 +1,4 @@ BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX28.m =================================================================== --- Scheduling/trunk/m/BSDX28.m (revision 1515) +++ Scheduling/trunk/m/BSDX28.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:57am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Change Log: @@ -38,21 +38,21 @@ . 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 @@ -76,5 +76,6 @@ . 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 Index: Scheduling/trunk/m/BSDX29.m =================================================================== --- Scheduling/trunk/m/BSDX29.m (revision 1515) +++ Scheduling/trunk/m/BSDX29.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; @@ -8,13 +8,11 @@ ; 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 ; @@ -24,31 +22,31 @@ ;Called by RPC: BSDX COPY APPOINTMENTS ; - ; Parameters: - ; - BSDXY: Global Return - ; - BSDXRES: BSDX RESOURCE to copy appointments to - ; - BSDX44: Hospital Location IEN to copy appointments from - ; - BSDXBEG: Beginning Date in FM Format - ; - BSDXEND: End Date in FM Format - ; + ; Parameters: + ; - BSDXY: Global Return + ; - BSDXRES: BSDX RESOURCE to copy appointments to + ; - BSDX44: Hospital Location IEN to copy appointments from + ; - BSDXBEG: Beginning Date in FM Format + ; - BSDXEND: End Date in FM Format + ; ;Returns ADO Recordset containing TASK_NUMBER and ERRORID ; - ; Return Array + ; Return Array S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; $ET - N $ET S $ET="G ETRAP^BSDX29" + K ^BSDXTMP($J) + ; $ET + N $ET S $ET="G ETRAP^BSDX29" ; Counter - N BSDXI S BSDXI=0 - ; Header Node + N BSDXI S BSDXI=0 + ; Header Node S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30) ; - ; Make dates inclusive; add 1 to FM dates - S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1) - S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1) - ; - ; Taskman variables - N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO + ; Make dates inclusive; add 1 to FM dates + S BSDXBEG=BSDXBEG-1 + S BSDXEND=BSDXEND+1 + ; + ; Taskman variables + N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE ; Task Load - S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO="" + S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS" S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")="" D ^%ZTLOAD @@ -64,28 +62,28 @@ ; ZTM ;EP - Taskman entry point - ; Variables set up in ZTSAVE above - ; + ; Variables set up in ZTSAVE above + ; Q:'$D(ZTSK) - ; - ; $ET - N $ET S $ET="G ZTMERR^BSDX29" - ; + ; $ET + N $ET S $ET="G ZTMERR^BSDX29" + ; Txn + TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29" ;$O through ^SC(BSDX44,"S", N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments - N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc + N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc ; Set Count - S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT + S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT ; Loop through dates here. - F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D - . ; Loop through Entries in each date in the subsubfile. - . ; Quit if we are at the end or if a remote process requests a quit. - . N BSDXIEN S BSDXIEN=0 + F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D + . ; Loop through Entries in each date in the subsubfile. + . ; Quit if we are at the end or if a remote process requests a quit. + . N BSDXIEN S BSDXIEN=0 . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node . . Q:'+BSDXNOD ; Quit if no node . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag - . . Q:BSDXCAN="C" ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 44 - . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient - . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes + . . Q:BSDXCAN="C" ; Quit if appt cancelled + . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient + . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made @@ -93,7 +91,9 @@ . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record - . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7) - ; - ; + . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag + . . Q + . Q + I 'BSDXQUIT TCOMMIT + E TROLLBACK S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.") Q @@ -101,5 +101,8 @@ 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 ; @@ -109,10 +112,6 @@ ;Return 1 if record copied, otherwise 0 ; - N REF - S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique - L +@REF:0 E Q 0 - ; ;$O Thru ^BSDXAPPT to determine if this appt already added - N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD + N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2 S BSDXIEN=0,BSDXFND=0 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND @@ -123,5 +122,5 @@ . I BSDXPAT2=BSDXPAT S BSDXFND=1 . Q - I BSDXFND L -@REF Q 0 + Q:BSDXFND 0 ; ;Add to BSDX APPOINTMENT @@ -129,5 +128,4 @@ ;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 @@ -139,21 +137,17 @@ ; K BSDXIEN - ; D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") S BSDXIEN=+$G(BSDXIEN(1)) - I '+BSDXIEN L -@REF Q 0 + I '+BSDXIEN Q 0 ; ;Add WP field I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG") - L -@REF ; Q 1 ; ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing - ; If last line is $C(31), we are done. No more errors to send to client. - I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT - S BSDXI=BSDXI+1 - S BSDXERR=$TR(BSDXERR,"^","~") + S BSDXI=BSDXI+1 + S BSDXERR=$TR(BSDXERR,"^","~") S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) S BSDXI=BSDXI+1 @@ -163,7 +157,7 @@ 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)) Index: Scheduling/trunk/m/BSDX2E.m =================================================================== --- Scheduling/trunk/m/BSDX2E.m (revision 1515) +++ Scheduling/trunk/m/BSDX2E.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/11/12 9:37am] - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [4/28/11 10:28am] + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; @@ -24,5 +24,5 @@ Q:'$$VERCHK("SD",5.3) ; Q:'$$PATCHCK("PIMS*5.3*1003") D - Q:'$$VERCHK("BMX",4) + Q:'$$VERCHK("BMX",2) ; OTHER ; @@ -91,5 +91,5 @@ . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") . ; Error message - . I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1)) + . I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1) ; ; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT @@ -106,5 +106,5 @@ D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG") ; If error - I $D(BSDXMSG) D MES^XPDUTL("Error: ",BSDXMSG("DIERR",1,"TEXT",1)) + I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1) ; ; @@ -117,5 +117,5 @@ I $G(BSDXERR) W $C(7),"Error: ",BSDXERR D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR) - I $G(BSDXERR) D MES^XPDUTL("Error: ",BSDXERR) + I $G(BSDXERR) W $C(7),"Error: ",BSDXERR QUIT ; Index: Scheduling/trunk/m/BSDX30.m =================================================================== --- Scheduling/trunk/m/BSDX30.m (revision 1515) +++ Scheduling/trunk/m/BSDX30.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [7/6/12 11:03am] - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [4/28/11 10:28am] + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; @@ -7,5 +7,5 @@ ;Entry point for debugging ; - ; D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)") + D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)") Q ; @@ -49,5 +49,5 @@ EHRPTD(BSDXY,BSDXWID,BSDXDFN) ; ; - ; D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)") + D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)") Q ; @@ -70,7 +70,4 @@ ; 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 @@ -81,13 +78,13 @@ ;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 Index: Scheduling/trunk/m/BSDX31.m =================================================================== --- Scheduling/trunk/m/BSDX31.m (revision 1515) +++ Scheduling/trunk/m/BSDX31.m (revision 1563) @@ -1,212 +1,220 @@ -BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/10/12 10:39am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 - ; Licensed under LGPL - ; Change Log: - ; v1.42 3101023 WV/SMH - Change transaction to restartable. - ; v1.42 3101206 UJO/SMH - Extensive refactoring - ; v1.7 3120626 VEN/SMH - Removed transactions; extensive refactoring - ; - Moved APTNS (whatever it was) to BSDXAPI1 - ; as $$NOSHOW - ; - Made BSDXNOS extrinsic. - ; - Moved Unit Tests to BSDXUT1 - ; - BSDXNOS deletes no-show rather than file 0 for - ; undoing a no show - ; - ; Error Reference: - ; -1: zero or null Appt ID - ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) - ; -3: No-show flag is invalid - ; -4: Filing of No-show in ^BSDXAPPT failed - ; -5: Filing of No-show in ^DPT failed (BSDXAPI error) - ; -6: Invalid Resource ID - ; -7: Lock not acquired on ^BSDXAPPT(BSDXAPTID) - ; -100: M Error - ; - ; +BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 + ; Licensed under LGPL + ; Change Log: + ; v1.42 Oct 23 2010 WV/SMH + ; - Change transaction to restartable. Thanks to Zach Gonzalez + ; --> and Rick Marshall for their help. + ; v1.42 Dec 6 2010: Extensive refactoring + ; + ; Error Reference: + ; -1: zero or null Appt ID + ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) + ; -3: No-show flag is invalid + ; -4: Filing of No-show in ^BSDXAPPT failed + ; -5: Filing of No-show in ^DPT failed (BSDXAPI error) + ; -100: M Error + ; + ; NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP - ;Entry point for debugging - ; - ; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") - Q - ; + ;Entry point for debugging + ; + D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") + Q + ; +UT ; Unit Tests + ; Test 1: Sanity Check + N ZZZ ; Garbage return variable + N DATE S DATE=$$NOW^XLFDT() + S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform + D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1) + N APPID S APPID=+$P(^BSDXTMP($J,1),U) + D NOSHOW(.ZZZ,APPID,1) + I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B + I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B + ; Test 2: Undo noshow + D NOSHOW(.ZZZ,APPID,0) + I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B + I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B + ; Test 3: -1 + D NOSHOW(.ZZZ,"",0) + I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B + ; Test 4: -2 + D NOSHOW(.ZZZ,2938748233,0) + I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B + ; Test 5: -3 + D NOSHOW(.ZZZ,APPID,3) + I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",! B + ; Test 6: Mumps error (-100) + s bsdxdie=1 + D NOSHOW(.ZZZ,APPID,1) + I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",! B + k bsdxdie + ; Test 7: Restartable transaction + s bsdxrestart=1 + D NOSHOW(.ZZZ,APPID,1) + I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",! B + QUIT NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient - ; Called by RPC: BSDX NOSHOW - ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 - ; - ; Parameters: - ; BSDXY: Global Return - ; BSDXAPTID is entry number in BSDX APPOINTMENT file - ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO - ; - ; Returns ADO.net record set with fields - ; - ERRORID; ERRORTEXT - ; ERRORID of 1 is okay - ; Anything else is an error. - ; - ; Return Array; set and clear - S BSDXY=$NA(^BSDXTMP($J)) - K ^BSDXTMP($J) - ; - ; $ET - N $ET S $ET="G ETRAP^BSDX31" - ; - ; Basline vars - D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist - ; - ; Counter - N BSDXI S BSDXI=0 - ; - ; Header Node - S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30) - ; - ;;;test for error. See if %ZTER works - I $G(BSDXDIE) N X S X=1/0 - ;;;TEST - ; - ; Turn off SDAM APPT PROTOCOL BSDX Entries - N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol - ; - ; Appointment ID check - I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q - I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q - ; - ; Lock BSDX node, only to synchronize access to the globals. - ; It's not expected that the error will ever happen as no filing - ; is supposed to take 5 seconds. - L +^BSDXAPPT(BSDXAPTID):5 E D ERR(-7,"BSDX31: Appt record is locked. Please contact technical support.") Q - ; - ; Noshow value check - Must be 1 or 0 - S BSDXNS=+BSDXNS - I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q - ; - ; Get Some data - N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node - N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN - N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time - N BSDXRES S BSDXRES=$P(BSDXNOD,U,7) ; Resource ID - ; - ; Check if Resource ID is missing or invalid - I BSDXRES="" D ERR(-6,"BSDX31: Invalid Resource") QUIT - I '$D(^BSDXRES(BSDXRES,0)) D ERR(-6,"BSDX31: Invalid Resource") QUIT - ; - ; Get the Hospital Location - N BSDXRESNOD S BSDXRESNOD=^BSDXRES(BSDXRES,0) - N BSDXLOC S BSDXLOC=$P(BSDXRESNOD,U,4) ;HOSPITAL LOCATION - I BSDXLOC,'$D(^SC(BSDXLOC,0)) S BSDXLOC="" ; Unlink it if it doesn't exist - ; I can go and then delete it from ^BSDXRES like Mailman code which tries - ; to be too helpful... but I will postpone that until this is a need. - ; - ; Check if it's okay to no-show patient. - N BSDXERR S BSDXERR=0 ; Error variable - I BSDXLOC S BSDXERR=$$NOSHOWCK^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS) - I BSDXERR D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT - ; - ; Simulated Error - I $G(BSDXSIMERR1) D ERR(-4,"BSDX31: Simulated Error") QUIT - ; Edit BSDX APPOINTMENT entry No-show field - ; Failure Analysis: If we fail here, no rollback needed, as this is the 1st - ; call - N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS) - I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT - ; - ; Edit File 2 "S" node entry - ; Failure Analysis: If we fail here, we need to rollback the BSDX - ; Apptointment Entry - N BSDXERR S BSDXERR=0 ; Error variable - ; If HL exist, (resource is linked to PIMS), file no show in File 2 - I BSDXLOC S BSDXERR=$$NOSHOW^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS) - I BSDXERR D QUIT - . D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) - . N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; no error checking for filer - ; - ; Unlock - L -^BSDXAPPT(BSDXAPTID) - ; - ; Return data in ADO.net table - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - QUIT - ; -BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT - ; in v1.7 I delete the no-show value rather than file zero - N BSDXFDA,BSDXIENS,BSDXMSG - N BSDXVALUE ; What to file: 1 or delete it. - I BSDXNS S BSDXVALUE=1 - E S BSDXVALUE="@" - S BSDXIENS=BSDXAPTID_"," - S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXVALUE ;NOSHOW 1 or 0 - D FILE^DIE("","BSDXFDA","BSDXMSG") - QUIT:$D(BSDXMSG) -1_U_BSDXMSG("DIERR",1,"TEXT",1) - QUIT 0 - ; + ; Called by RPC: BSDX NOSHOW + ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 + ; + ; Parameters: + ; BSDXY: Global Return + ; BSDXAPTID is entry number in BSDX APPOINTMENT file + ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO + ; + ; Returns ADO.net record set with fields + ; - ERRORID; ERRORTEXT + ; ERRORID of 1 is okay + ; Anything else is an error. + ; + ; Return Array; set and clear + S BSDXY=$NA(^BSDXTMP($J)) + K ^BSDXTMP($J) + ; $ET + N $ET S $ET="G ETRAP^BSDX31" + ; Basline vars + D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist + ; Counter + N BSDXI S BSDXI=0 + ; Header Node + S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30) + ; Begin transaction + TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29" + ;;;test for error inside transaction. See if %ZTER works + I $G(bsdxdie) S X=1/0 + ;;;TEST + ;;;test for TRESTART + I $G(bsdxrestart) K bsdxrestart TRESTART + ;;;test + ; Turn off SDAM APPT PROTOCOL BSDX Entries + N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol + ; Appointment ID check + I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q + I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q + ; Noshow value check - Must be 1 or 0 + S BSDXNS=+BSDXNS + I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q + ; Get Some data + N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node + N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN + N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time + ; Edit BSDX APPOINTMENT entry + N BSDXMSG ; + D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field + I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q + ; Edit File 2 "S" node entry + N BSDXZ,BSDXERR ; Error variables to control looping + S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID + ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2 + I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q + . S BSDXNOD=^BSDXRES(BSDXSC1,0) + . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION + . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) + ; + TCOMMIT + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + QUIT + ; +APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; + ; update file 2 info + ;Set noshow for patient BSDXDFN in clinic BSDXSC1 + ;at time BSDXSD + N BSDXC,%H,BSDXCDT,BSDXIEN + N BSDXIENS,BSDXFDA,BSDXMSG + S %H=$H D YMD^%DTC + S BSDXCDT=X+% + ; + S BSDXIENS=BSDXSD_","_BSDXDFN_"," + I +BSDXNS D + . S BSDXFDA(2.98,BSDXIENS,3)="N" + . S BSDXFDA(2.98,BSDXIENS,14)=DUZ + . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT + E D + . S BSDXFDA(2.98,BSDXIENS,3)="" + . S BSDXFDA(2.98,BSDXIENS,14)="" + . S BSDXFDA(2.98,BSDXIENS,15)="" + K BSDXIEN + D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") + S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) + Q + ; +BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ; + ; + N BSDXFDA,BSDXIENS + S BSDXIENS=BSDXAPTID_"," + S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW + D FILE^DIE("","BSDXFDA","BSDXMSG") + QUIT + ; NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event - ;when appointments NOSHOW via PIMS interface. - ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients - ; - Q:+$G(BSDXNOEV) - Q:'+$G(BSDXSC) - Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" - N BSDXSTAT,BSDXFOUND,BSDXRES - S BSDXSTAT=1 - S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 - S BSDXFOUND=0 - I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) - I BSDXFOUND D NOSEVT3(BSDXRES) Q - I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) - I BSDXFOUND D NOSEVT3(BSDXRES) - Q - ; + ;when appointments NOSHOW via PIMS interface. + ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients + ; + Q:+$G(BSDXNOEV) + Q:'+$G(BSDXSC) + Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" + N BSDXSTAT,BSDXFOUND,BSDXRES + S BSDXSTAT=1 + S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 + S BSDXFOUND=0 + I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) + I BSDXFOUND D NOSEVT3(BSDXRES) Q + I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) + I BSDXFOUND D NOSEVT3(BSDXRES) + Q + ; NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; - ;Get appointment id in BSDXAPT - ;If found, call BSDXNOS(BSDXAPPT) and return 1 - ;else return 0 - N BSDXFOUND,BSDXAPPT,BSDXNOD - S BSDXFOUND=0 - Q:'+$G(BSDXRES) BSDXFOUND - Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND - S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND - . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" - . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q - I BSDXFOUND,+$G(BSDXAPPT) N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPPT,BSDXSTAT) - I BSDXMSG D ^%ZTER ; Last ditch error handling. This is supposed to be silently called from the protocol file. - Q BSDXFOUND - ; + ;Get appointment id in BSDXAPT + ;If found, call BSDXNOS(BSDXAPPT) and return 1 + ;else return 0 + N BSDXFOUND,BSDXAPPT + S BSDXFOUND=0 + Q:'+$G(BSDXRES) BSDXFOUND + Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND + S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND + . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" + . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q + I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) + Q BSDXFOUND + ; NOSEVT3(BSDXRES) ; - ;Call RaiseEvent to notify GUI clients - ; - N BSDXRESN - S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) - Q:BSDXRESN="" - S BSDXRESN=$P(BSDXRESN,"^") - D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) - Q - ; - ; + ;Call RaiseEvent to notify GUI clients + ; + N BSDXRESN + S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) + Q:BSDXRESN="" + S BSDXRESN=$P(BSDXRESN,"^") + D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) + Q + ; + ; ERR(BSDXERID,ERRTXT) ;Error processing - ; Unlock first - L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID) - ; If last line is $C(31), we are done. No more errors to send to client. - I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT - S BSDXI=BSDXI+1 - S ERRTXT=$TR(ERRTXT,"^","~") - S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) - S BSDXI=BSDXI+1 - S ^BSDXTMP($J,BSDXI)=$C(31) - QUIT - ; + S BSDXI=BSDXI+1 + S ERRTXT=$TR(ERRTXT,"^","~") + I $TL>0 TROLLBACK + S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) + S BSDXI=BSDXI+1 + S ^BSDXTMP($J,BSDXI)=$C(31) + QUIT + ; ETRAP ;EP Error trap entry - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - D ^%ZTER - ; - ; Send to client - I '$D(BSDXI) N BSDXI S BSDXI=0 - D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE)) - Q:$Q 100_U_"Mumps Error" Q - ; + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + ; Rollback, otherwise ^XTER will be empty from future rollback + I $TL>0 TROLLBACK + D ^%ZTER + S $EC="" ; Clear Error + ; Send to client + I '$D(BSDXI) N BSDXI S BSDXI=0 + D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE)) + QUIT + ; IMHERE(BSDXRES) ;EP - ;Entry point for BSDX IM HERE remote procedure - S BSDXRES=1 - Q - ; + ;Entry point for BSDX IM HERE remote procedure + S BSDXRES=1 + Q + ; Index: Scheduling/trunk/m/BSDX32.m =================================================================== --- Scheduling/trunk/m/BSDX32.m (revision 1515) +++ Scheduling/trunk/m/BSDX32.m (revision 1563) @@ -1,4 +1,4 @@ BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX33.m =================================================================== --- Scheduling/trunk/m/BSDX33.m (revision 1515) +++ Scheduling/trunk/m/BSDX33.m (revision 1563) @@ -1,4 +1,4 @@ BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Mods by WV/STAR Index: Scheduling/trunk/m/BSDX34.m =================================================================== --- Scheduling/trunk/m/BSDX34.m (revision 1515) +++ Scheduling/trunk/m/BSDX34.m (revision 1563) @@ -1,4 +1,4 @@ BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDX35.m =================================================================== --- Scheduling/trunk/m/BSDX35.m (revision 1515) +++ Scheduling/trunk/m/BSDX35.m (revision 1563) @@ -1,4 +1,4 @@ -BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/21/12 3:57pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDXAPI.m =================================================================== --- Scheduling/trunk/m/BSDXAPI.m (revision 1515) +++ Scheduling/trunk/m/BSDXAPI.m (revision 1563) @@ -1,10 +1,36 @@ -BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/10/12 5:58pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; - ; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW - ; mods (many) by WV/SMH - ; Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH - ; Change history is located in BSDXAPI1 (to save space). + ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW + ;local mods (many) by WV/SMH + ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH + ; Change History: + ; 2010-11-5: (1.42) + ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment. + ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API. + ; 2010-11-12: (1.42) + ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well. + ; 2010-12-5 (1.42) + ; Added an entry point to update the patient note in file 44. + ; 2010-12-6 (1.42) + ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI") + ; 2010-12-8 (1.42) + ; Removed restriction on max appt length. Even though this restriction + ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I + ; will ignore it here too. + ; 2011-01-25 (v.1.5) + ; Added entry point $$RMCI to remove checked in appointments. + ; In $$CANCEL, if the appointment is checked in, delete check-in rather than + ; spitting an error message to the user saying 'Delete the check-in' + ; Changed all lines that look like this: + ; I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + ; to: + ; I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) + ; to allow for date at midnight which does not have a dot at the end. + ; 2011-01-26 (v.1.5) + ; More user friendly message if patient already has appointment in $$MAKE: + ; Spits out pt name and user friendly date. + ; ; MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment @@ -13,5 +39,4 @@ ; 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 @@ -40,90 +65,4 @@ ; = 1^message: error and reason ; - N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment - I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why. - ; - ;Otherwise, we continue - ; - 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 - . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," - . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") - . S BSDXFDA(2.98,BSDXIENS,"3")="" - . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") - . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 - . S BSDXFDA(2.98,BSDXIENS,"14")="" - . S BSDXFDA(2.98,BSDXIENS,"15")="" - . S BSDXFDA(2.98,BSDXIENS,"16")="" - . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over - . S BSDXFDA(2.98,BSDXIENS,"19")="" - . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT - . D FILE^DIE("","BSDXFDA","BSDXMSG") - Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) - ; - Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line - ; - E D ; File new appointment/edit existing appointment in file 2 - . S BSDXIENS="?+2,"_BSDR("PAT")_"," - . S BSDXIENS(2)=BSDR("ADT") - . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") - . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") - . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 - . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT - . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG") - Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) - ; - Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line - ; - ; add appt to file 44. This adds it to the FIRST subfile (Appointment) - N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM - 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," - ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") - ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") - ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 - ;D FILE^DICN - ; - N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_"," - N BSDXFDA - S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT") - S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN") - S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150) - S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR") - S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".") - N BSDXERR - D UPDATE^DIE("","BSDXFDA","","BSDXERR") - ; - 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 - S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) - 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")) @@ -132,8 +71,8 @@ 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 ($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")) - ; More verbose error message in v1.5 + ;I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") ; v.1.5 more user friendly err msg + ; ; Following block to give an error message to user if there is already an appointment for patient. More verbose than others. N BSDXERR ; place to store error message @@ -149,31 +88,65 @@ . . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U) . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic + ; + NEW DIC,DA,Y,X,DD,DO,DLAYGO + ; + I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D + . ; "un-cancel" existing appt in file 2 + . N BSDXFDA,BSDXIENS,BSDXMSG + . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," + . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") + . S BSDXFDA(2.98,BSDXIENS,"3")="" + . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") + . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 + . S BSDXFDA(2.98,BSDXIENS,"14")="" + . S BSDXFDA(2.98,BSDXIENS,"15")="" + . S BSDXFDA(2.98,BSDXIENS,"16")="" + . 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 + . 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 + 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 + ; + ; 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," + ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") + ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") + ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 + ;D FILE^DICN + ; + N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_"," + N BSDXFDA + S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT") + S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN") + S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150) + S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR") + S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".") + N BSDXERR + D UPDATE^DIE("","BSDXFDA","","BSDXERR") + ; + 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) + ; + ; call event driver + NEW DFN,SDT,SDCL,SDDA,SDMODE + S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 + S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) 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 @@ -181,5 +154,4 @@ ; 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 @@ -203,68 +175,4 @@ ; = 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")) @@ -277,6 +185,27 @@ ; ; find ien for appt in file 44 - N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + NEW IEN,DIE,DA,DR + S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") + ; + ; remember before status + NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL + S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN + S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) + ; + ; set checkin + S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," + S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN + S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT + D ^DIE + ; + ; set after status + S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) + ; + ; call event driver + D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) Q 0 ; @@ -287,5 +216,4 @@ ; 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 @@ -316,68 +244,4 @@ ; = 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")) @@ -390,9 +254,43 @@ I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) ; - NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + NEW IEN,DIE,DA,DR + S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") ; - ; Check-out check. New in v1.7 - I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!" + ; BSDX 1.5 3110125 + ; UJO/SMH - Add ability to remove check-in if the patient is checked in + ; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") + ; Remove check-in if the patient is checked in. + N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure + I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + I BSDXRESULT Q BSDXRESULT + ; + ; remember before status + NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL + S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN + S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) + ; + ; get user who made appt and date appt made from ^SC + ; because data in ^SC will be deleted + NEW USER,DATE + S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) + S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) + ; + ; update file 2 info + NEW DIE,DA,DR + S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT + S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE + S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) + D ^DIE + ; + ; delete data in ^SC + NEW DIK,DA + S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," + S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN + D ^DIK + ; + ; call event driver + D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) Q 0 ; @@ -404,4 +302,54 @@ Q $S(X:1,1:0) ; +RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$ + ; PAT = DFN + ; CLINIC = SC IEN + ; DATE = FM Date/Time of Appointment + ; + ; Returns: + ; 0 if okay + ; -1 if failure + ; + ; Call like this: $$RMCI(233,33,3110102.1130) + ; + ; Move my variables into the ones used by SDAPIs (just a convenience) + NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL + S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT) + ; + I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 + ; + ; remember before status + S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) + ; + ; remove check-in using filer. + N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_"," + S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN + S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER + S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED + N BSDXERR + D FILE^DIE("","BSDXFDA","BSDXERR") + I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1) + ; + ; set after status + S SDDA=$$SCIEN(DFN,SDCL,SDT) + S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL + D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) + ; + ; call event driver + D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) + QUIT 0 + ; +SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC + NEW X,IEN + S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D + . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled + . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X + Q $G(IEN) + ; +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 @@ -411,18 +359,18 @@ Q $S(X:1,1:0) ; -SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC - NEW X,IEN - S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D - . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled - . 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:"??") - ; +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 Index: Scheduling/trunk/m/BSDXAPI1.m =================================================================== --- Scheduling/trunk/m/BSDXAPI1.m (revision 1515) +++ Scheduling/trunk/m/BSDXAPI1.m (revision 1563) @@ -1,4 +1,4 @@ BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.7;BSDX;;Oct 04, 2012;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDXGPRV.m =================================================================== --- Scheduling/trunk/m/BSDXGPRV.m (revision 1515) +++ Scheduling/trunk/m/BSDXGPRV.m (revision 1563) @@ -1,4 +1,4 @@ -BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 7/6/12 11:07am - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 +BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:31am + ;;1.6;BSDX;;Aug 31, 2011;Build 25 ; Licensed under LGPL ; @@ -18,5 +18,5 @@ 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 @@ -33,5 +33,5 @@ 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) Index: Scheduling/trunk/m/BSDXUT.m =================================================================== --- Scheduling/trunk/m/BSDXUT.m (revision 1515) +++ Scheduling/trunk/m/BSDXUT.m (revision 1563) @@ -1,4 +1,4 @@ BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.7;BSDX;;Oct 04, 2012;Build 25 ; Licensed under LGPL ; Index: Scheduling/trunk/m/BSDXUT1.m =================================================================== --- Scheduling/trunk/m/BSDXUT1.m (revision 1515) +++ Scheduling/trunk/m/BSDXUT1.m (revision 1563) @@ -1,4 +1,4 @@ BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.7;BSDX;;Oct 04, 2012;Build 25 ; ; Index: Scheduling/trunk/m/BSDXUT2.m =================================================================== --- Scheduling/trunk/m/BSDXUT2.m (revision 1515) +++ Scheduling/trunk/m/BSDXUT2.m (revision 1563) @@ -1,4 +1,4 @@ BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 3:18pm - ;;1.7T2;BSDX;;Jul 11, 2012;Build 18 + ;;1.7;BSDX;;Oct 04, 2012;Build 25 ; EN ; Run all unit tests in this routine