Index: /Scheduling/trunk/m/BSDX07.m =================================================================== --- /Scheduling/trunk/m/BSDX07.m (revision 1450) +++ /Scheduling/trunk/m/BSDX07.m (revision 1451) @@ -1,3 +1,3 @@ -BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/18/12 5:12pm +BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/19/12 5:34pm ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; Licensed under LGPL @@ -28,43 +28,76 @@ APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP ;Entry point for debugging - D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") - Q - ; -UT ; Unit Tests - ; Set-up - Create Clinics + ; D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") + Q + ; +UT ; Unit Tests - Assumes you have Patients with DFNs 1,2 and 3 + ; Set-up - Create Clinics N RESNAM S RESNAM="UTCLINIC" - N HLRESIENS ; holds output of UTCR^BSDX35 - HL IEN^Resource IEN - D - . N $ET S $ET="D ^%ZTER B" + N HLRESIENS ; holds output of UTCR^BSDX35 - HL IEN^Resource IEN + D + . N $ET S $ET="D ^%ZTER B" . S HLRESIENS=$$UTCR^BSDX35(RESNAM) - . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - ; - N HLIEN,RESIEN - S HLIEN=$P(HLRESIENS,U) - S RESIEN=$P(HLRESIENS,U,2) - ; - ; Get start and end times - N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time - N APPTTIME S APPTTIME=$P(TIMES,U) - N ENDTIME S ENDTIME=$P(TIMES,U,2) - ; - N ZZZ + . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen + ; + N HLIEN,RESIEN + S HLIEN=$P(HLRESIENS,U) + S RESIEN=$P(HLRESIENS,U,2) + ; + ; Get start and end times + N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time + N APPTTIME S APPTTIME=$P(TIMES,U) + N ENDTIME S ENDTIME=$P(TIMES,U,2) + ; + N ZZZ,DFN ; Test for normality: - D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) + S DFN=3 + D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,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)'=APPTTIME W "Error Making Appt-2" - I '$D(^DPT(3,"S",APPTTIME)) W "Error Making Appt-3" - I '$D(^SC(HLIEN,"S",APPTTIME)) W "Error Making Appt-4" - ; - ; Do it again for a different patient - D APPADD(.ZZZ,APPTTIME,ENDTIME,2,RESNAM,30,"Sam's Note",1) - N APPID S APPID=+$P(^BSDXTMP($J,1),U) B + I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-3" + I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-4" + ; + ; Do it again for a different patient + S DFN=2 + D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) + N APPID S APPID=+$P(^BSDXTMP($J,1),U) I 'APPID W "Error Making Appt-5" QUIT I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-6" - I '$D(^DPT(2,"S",APPTTIME)) W "Error Making Appt-7" - I '$D(^SC(HLIEN,"S",APPTTIME)) W "Error Making Appt-8" - ; + I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-7" + I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-8" + ; + ; Again for a different patient (4) + S DFN=4 + D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1) + N APPID S APPID=+$P(^BSDXTMP($J,1),U) + I 'APPID W "Error Making Appt-9" QUIT + I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-10" + I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-11" + I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-12" + ; + ; Delete appointment set for Patient 4 (made above) + N BSDX,DFN + S DFN=4 + S BSDX("PAT")=DFN + S BSDX("CLN")=HLIEN + S BSDX("ADT")=APPTTIME + D BSDXDEL^BSDX07(APPID) + S %=$$UNMAKE^BSDXAPI(.BSDX) + I +$G(^BSDXAPPT(APPID,0)) W "Error in deleting appointment-1",! + I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-2",! + I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-3",! + ; + ; Delete appointment set for Patient 1 (not made)... needs to not crash + D + . N $ET S $ET="D ^%ZTER S $EC="""" W ""Failure to del non-existent appt"",!" + . D BSDXDEL^BSDX07(9999999) + . N BSDX + . S BSDX("PAT")=1 + . S BSDX("CLN")=HLIEN + . S BSDX("ADT")=APPTTIME + . S %=$$UNMAKE^BSDXAPI(.BSDX) + ; ; Test for bad start date D APPADD(.ZZZ,2100123,3100123.3,2,RESNAM,30,"Sam's Note",1) @@ -81,9 +114,9 @@ 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,APPTTIME,ENDTIME,3,RESNAM,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 TRESTART -- retired in v 1.7 + ; S BSDXRESTART=1 + ; D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,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,APPTTIME,ENDTIME,"CAT,DOG",RESNAM,30,"Sam's Note",1) @@ -97,12 +130,12 @@ ; Test for corrupted resource ; Can't test for -8 since it requires DB corruption - ; Test for inability to add appointment to BSDX Appointment + ; Test for inability to add appointment to BSDX Appointment (-9) ; Also requires something wrong in the DB ; Test for inability to add appointment to 2,44 ; Test by creating a duplicate appointment - ; Get start and end times - N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time - N APPTTIME S APPTTIME=$P(TIMES,U) - N ENDTIME S ENDTIME=$P(TIMES,U,2) + ; Get start and end times + N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time + N APPTTIME S APPTTIME=$P(TIMES,U) + N ENDTIME S ENDTIME=$P(TIMES,U,2) D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) @@ -111,280 +144,293 @@ ; 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 - ; + ; + ;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) + ; + ; 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 + ; + ; -- 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 ; 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) ; TODO: check for error and rollback + ; + ; Only if we have a valid Hosp Loc can we make an appointment in 2/44 + ; Use BSDXC array from before. + ; NB: $$MAKE itself calls $$MAKECK to check again for being okay. + I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q + . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) + . Q:BSDXERR + . ;Update RPMS Clinic availability + . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) + ; + ;Return Recordset + 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 STRIP(BSDXZ) ;Replace control characters with spaces - N BSDXI - F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) - Q BSDXZ - ; + N BSDXI + F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999) + Q BSDXZ + ; BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY - ;Returns ien in BSDXAPPT or 0 if failed - ;Create entry in BSDX APPOINTMENT - N BSDXAPPTID - S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART - S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND - S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID - S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD - S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ) - S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT - S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" - S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID - S BSDXFDA(9002018.4,"+1,",.14)=$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)=$G(BSDXRADEXAM) + N BSDXIEN,BSDXMSG + D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") + S BSDXAPPTID=+$G(BSDXIEN(1)) + Q BSDXAPPTID + ; BSDXWP(BSDXAPPTID,BSDXNOTE) ; - ;Add WP field - I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" - I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) - I $D(BSDXNOTE(.5)) D - . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") - Q - ; + ;Add WP field + N BSDXMSG + I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" + I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0) + I $D(BSDXNOTE(.5)) D + . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG") + Q + ; ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP - ;Called by BSDX ADD APPOINTMENT protocol - ;BSDXSC=IEN of clinic in ^SC - ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note - ; - N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES - Q:+$G(BSDXNOEV) - I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) - E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) - Q:'+$G(BSDXRES) - S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0)) - Q:BSDXNOD="" - S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0)) - S BSDXWKIN="" - S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile - S BSDXLEN=$P(BSDXNOD,U,2) - Q:'+BSDXLEN - S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0) - S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN) - Q:'+BSDXAPPTID - S BSDXNOTE=$P(BSDXNOD,U,4) - I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) - D ADDEVT3(BSDXRES) - Q - ; + ;Called by BSDX ADD APPOINTMENT protocol + ;BSDXSC=IEN of clinic in ^SC + ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note + ; + N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES + 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 - ; + ;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 - ; + 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) + L -^BSDXAPPT(BSDXPATID) + 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) + 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 + ; ETRAP ;EP Error trap entry - N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap - ; Rollback, otherwise ^XTER will be empty from future rollback - I $TL>0 TROLLBACK - D ^%ZTER - S $EC="" ; Clear Error - ; Log error message and send to client - I '$D(BSDXI) N BSDXI S BSDXI=0 - D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) - Q - ; + N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap + 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 - ; + 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 + ;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 +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/BSDXAPI.m =================================================================== --- /Scheduling/trunk/m/BSDXAPI.m (revision 1450) +++ /Scheduling/trunk/m/BSDXAPI.m (revision 1451) @@ -1,4 +1,4 @@ -BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/18/12 5:31pm - ;;1.6;BSDX;;Aug 31, 2011;Build 18 +BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/19/12 5:42pm + ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; Licensed under LGPL ; @@ -32,8 +32,10 @@ ; More user friendly message if patient already has appointment in $$MAKE: ; Spits out pt name and user friendly date. - ; 2012-06-18 (v 1.7) + ; 2012-06-18 (v 1.7) ; Removing transacions. Means that code SHOULD NOT fail. Took all checks - ; out for making an appointment to MAKECK. We call this first to make sure - ; that the appointment is okay to make before committing to make it. + ; out for making an appointment to MAKECK. We call this first to make sure + ; that the appointment is okay to make before committing to make it. We + ; still have the provision to delete the data though if we fail when we + ; actually make the appointment ; MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment @@ -70,11 +72,11 @@ 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 - ; - NEW DIC,DA,Y,X,DD,DO,DLAYGO + ; + ;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 - . N BSDXFDA,BSDXIENS,BSDXMSG . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") @@ -88,7 +90,7 @@ . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT . D FILE^DIE("","BSDXFDA","BSDXMSG") - . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) - E D - . N BSDXFDA,BSDXIENS,BSDXMSG + Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) + ; + E D ; File new appointment/edit existing appointment in file 2 . S BSDXIENS="?+2,"_BSDR("PAT")_"," . S BSDXIENS(2)=BSDR("ADT") @@ -97,8 +99,9 @@ . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT - . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") - I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") - ; add appt to file 44 - K DIC,DA,X,Y,DLAYGO,DD,DO + . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXMSG") + Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1) + ; + ; add appt to file 44. This adds it to the FIRST subfile (Appointment) + N DIC,DA,Y,X,DD,DO,DLAYGO 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") @@ -106,6 +109,6 @@ . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN - - ; + ; + ; 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 @@ -136,4 +139,8 @@ ; 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")) @@ -142,6 +149,6 @@ 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 - ; + ; Appt Length check removed in v 1.5 + ; I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) ; More verbose error message in v1.5 @@ -160,23 +167,25 @@ . . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic Q 0 - ; + ; UNMAKE(BSDR) ; Reverse Make - Private $$ - ; Only used in Emergiencies where Fileman data filing fails. - ; If previous data exists, which caused an error, it's destroyed. - N BSDXFDA,BSDXIENS - S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," - S BSDXFDA(2.98,BSDXIENS,".01")="@" - ; - I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),1)) QUIT 0 ; No stuff in HL file - N X S X=0 F S X=$O(^SC(BSDR("CLN"),"S",BSDR("ADT"),1,X)) Q:'X Q:+^(X,0)=BSDR("PAT") - ; - I 'X QUIT 0 ; Patient doesn't have appointment - ; - S BSDXIENS=X_","_BSDR("ADT")_","_BSDR("CLN")_"," - S BSDXFDA(44.003,BSDXIENS,.01)="@" - N BSDXMSG - D FILE^DIE("","BSDXFDA","BSDXMSG") - I $D(BSDXMSG) S $EC=",U1," ; If we get an error here, we are REALLY out of control - QUIT 0 + ; 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 + ; Input: Same array as $$MAKE + ; Output: Always 0 + NEW DIK,DA + S DIK="^DPT("_BSDR("PAT")_",""S""," + S DA(1)=BSDR("PAT"),DA=BSDX("ADT") + D ^DIK + ; + N IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) + I 'IEN QUIT 0 + ; + NEW DIK,DA + S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," + S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN + D ^DIK + QUIT 0 + ; CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in ; Call like this for DFN 23435 checking in now at Hospital Location 33