iSharkFly-Open
/
VistA-Scheduling
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Updated version numbers

This commit is contained in:
sam 2010-07-18 13:58:35 +00:00
parent d8fd8d3dc0
commit 4e8c1bcdba
37 changed files with 471 additions and 471 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
m/BSDX01.m
View File

@ -1,5 +1,5 @@
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:04pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point

10
m/BSDX02.m
View File

@ -1,8 +1,8 @@
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
; Change Log
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
;
;
CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
@ -34,7 +34,7 @@ CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
;
;
S BSDXI=0
D STRES
;

2
m/BSDX03.m
View File

@ -1,5 +1,5 @@
BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
Q

20
m/BSDX04.m
View File

@ -1,8 +1,8 @@
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
; Change Log:
; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
; for i18n
;;1.3T1;BSDX;;Jul 18, 2010
; Change Log:
; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
; for i18n
;
;
CASSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
@ -26,12 +26,12 @@ CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
;and to search for availability in the Find Appointment function
;
;BSDXRES is resource name
;
;//smh
; BSDXSTART and BSDXEND both passed in FM Format.
; BSDXSTART is the Date Portion of FM Date
; BSDXEND -- pass date and h,m,s as well
;//smh
;
;//smh
; BSDXSTART and BSDXEND both passed in FM Format.
; BSDXSTART is the Date Portion of FM Date
; BSDXEND -- pass date and h,m,s as well
;//smh
;
;BSDXTYPES is |-delimited list of Access Type Names
;If BSDXTYPES is "" then the screen passes all types.

8
m/BSDX05.m
View File

@ -1,12 +1,12 @@
BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
; Change Log:
; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
;
APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
;Called by BSDX APPT BLOCKS OVERLAP
; July 11 2010 - pass FM Dates for Start and End rather than US Dates
; July 11 2010 - pass FM Dates for Start and End rather than US Dates
;(Duplicates old qryAppointmentBlocksOverlapB)
;BSDXRES is resource name
;

8
m/BSDX06.m
View File

@ -1,8 +1,8 @@
BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
; Change Log:
; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
; dates in FM format for i18n
;;1.3T1;BSDX;;Jul 18, 2010
; Change Log:
; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
; dates in FM format for i18n
;
;
TPBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP

22
m/BSDX07.m
View File

@ -1,9 +1,9 @@
BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:11pm
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
; Change Log:
; UJO/SMH
; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; UJO/SMH
; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
;
;
APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
@ -44,7 +44,7 @@ ENDBG ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^2^PEDIATRICIAN,DEM
L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI+1,"Another user is working with this patient's record. Please try again later") Q
;
TSTART
; v1.3 - date passed in as FM Date, not US date.
; v1.3 - date passed in as FM Date, not US date.
;Check input data for errors
; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
@ -52,11 +52,11 @@ ENDBG ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^2^PEDIATRICIAN,DEM
; I BSDXSTART=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid Start Time") Q
; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
; I BSDXEND=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
;
; If C# sends the dates with extra zeros, remove them
;
; If C# sends the dates with extra zeros, remove them
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
;
I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
;
I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
I '+BSDXPATID,'$D(^DPT(BSDXPATID,0)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Patient ID") Q
;Validate Resource entry
@ -177,7 +177,7 @@ ADDEVT3(BSDXRES) ;
;
ERR(BSDXI,BSDXERR) ;Error processing
D ^%ZTER ;XXX: remove after we figure out the cause of error
S BSDXI=BSDXI+1
S BSDXI=BSDXI+1
S BSDXERR=$TR(BSDXERR,"^","~")
TROLLBACK
S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)

2
m/BSDX08.m
View File

@ -1,5 +1,5 @@
BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP

18
m/BSDX09.m
View File

@ -1,14 +1,14 @@
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:26pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; UJO/TH - v 1.3 on 3100714 - Extra Demographics:
; - Email
; - Cell Phone
; - Country
; - + refactoring of routine
; Change Log:
; UJO/TH - v 1.3 on 3100714 - Extra Demographics:
; - Email
; - Cell Phone
; - Country
; - + refactoring of routine
;
; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead
; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead
;
GETREGA(BSDXRET,BSDXPAT) ;EP
;
@ -17,7 +17,7 @@ GETREGA(BSDXRET,BSDXPAT) ;EP
; 13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
; 20 DATAREVIEWED^
; 21 RegistrationComments
; 22 EMAIL ADDRESS^PHONE NUMBER [CELLULAR]^COUNTRY
; 22 EMAIL ADDRESS^PHONE NUMBER [CELLULAR]^COUNTRY
;
;For patient with ien BSDXPAT
;K ^BSDXTMP($J)

2
m/BSDX11.m
View File

@ -1,5 +1,5 @@
BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
ENV0100 ;EP Version 1.0 Environment check
I '$G(IOM) D HOME^%ZIS

18
m/BSDX12.m
View File

@ -1,9 +1,9 @@
BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
; Change Log:
; v 1.3 - i18n support - 3100718
; BSDXSTART and BSDXEND passed in FM Dates, not US dates
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; v 1.3 - i18n support - 3100718
; BSDXSTART and BSDXEND passed in FM Dates, not US dates
;
;
AVADD(BSDXY,BSDXSTART,BSDXEND,BSDXTYPID,BSDXRES,BSDXSLOTS,BSDXNOTE) ;EP
@ -25,16 +25,16 @@ AVADD(BSDXY,BSDXSTART,BSDXEND,BSDXTYPID,BSDXRES,BSDXSLOTS,BSDXNOTE) ;EP
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020AVAILABILITYID^I00020ERRORID"_$C(30)
;Check input data for errors
; i18n - FM Dates passed in
; i18n - FM Dates passed in
; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
; I BSDXSTART=-1 D ERR(70) Q
; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
; I BSDXEND=-1 D ERR(70) Q
; Make sure dates are canonical and don't contain extra zeros
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
;
; Make sure dates are canonical and don't contain extra zeros
S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
;
I $L(BSDXEND,".")=1 D ERR(70) Q
I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
;Validate Access Type

8
m/BSDX13.m
View File

@ -1,8 +1,8 @@
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
; Change Log:
; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH
Q
AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
;Entry point for debugging

2
m/BSDX14.m
View File

@ -1,5 +1,5 @@
BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
ACCTYPD(BSDXY,BSDXVAL) ;EP

2
m/BSDX15.m
View File

@ -1,5 +1,5 @@
BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
GRPTYP(BSDXY) ;EP

2
m/BSDX16.m
View File

@ -1,5 +1,5 @@
BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
RSRCD(BSDXY,BSDXVAL) ;EP

2
m/BSDX17.m
View File

@ -1,5 +1,5 @@
BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
SCHUSRD(BSDXY) ;EP

2
m/BSDX18.m
View File

@ -1,5 +1,5 @@
BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
DELRUD(BSDXY,BSDXIEN) ;EP

2
m/BSDX19.m
View File

@ -1,5 +1,5 @@
BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
ADDRGD(BSDXY,BSDXVAL) ;EP

2
m/BSDX20.m
View File

@ -1,5 +1,5 @@
BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
DELRGID(BSDXY,BSDXIEN) ;EP

2
m/BSDX21.m
View File

@ -1,5 +1,5 @@
BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
ADDAGD(BSDXY,BSDXVAL) ;EP

2
m/BSDX22.m
View File

@ -1,5 +1,5 @@
BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
DELAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP

2
m/BSDX23.m
View File

@ -1,5 +1,5 @@
BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
EVENT(BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) ;EP

2
m/BSDX24.m
View File

@ -1,5 +1,5 @@
BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
Q

2
m/BSDX25.m
View File

@ -1,5 +1,5 @@
BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP

2
m/BSDX26.m
View File

@ -1,5 +1,5 @@
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP

12
m/BSDX27.m
View File

@ -1,8 +1,8 @@
BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
; Change Log: July 15, 2010
; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log: July 15, 2010
; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag
;
;
Q
@ -184,8 +184,8 @@ CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
;BSDXBEG and BSDXEND are in external date form.
;Called by BSDX CLINIC LETTERS
;
; July 10, 2010 -- to support i18n, we pass dates from client in
; locale-neutral Fileman format. No need to convert it.
; July 10, 2010 -- to support i18n, we pass dates from client in
; locale-neutral Fileman format. No need to convert it.
N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
N BSDXSTRT

68
m/BSDX28.m
View File

@ -1,12 +1,12 @@
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; Change Log:
; HMW 3050721 Added test for inactivated record
; V1.3 WV/SMH 3100714
; - add PID search
; - return PID instead of SSN (change header and logic)
; - Change Error trap to new style.
; V1.3 WV/SMH 3100714
; - add PID search
; - return PID instead of SSN (change header and logic)
; - Change Error trap to new style.
;
PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
;
@ -14,11 +14,11 @@ PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
;Supports DOB Lookup, Primary Long ID lookup
;
N $ET S $ET="G ERROR^BSDX28"
; rm ctrl chars
; rm ctrl chars
S BSDXP=$TR(BSDXP,$C(13),"")
S BSDXP=$TR(BSDXP,$C(10),"")
S BSDXP=$TR(BSDXP,$C(9),"")
; num of pts to find
; num of pts to find
S:BSDXC="" BSDXC=10
N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
@ -27,25 +27,25 @@ PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
S BSDXRET="T00030NAME^T00030HRN^T00030PID^D00030DOB^T00030IEN"_$C(30)
I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
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)
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)
;
DOB ;DOB Lookup
I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D S BSDXY=BSDXRET_$C(31) Q
@ -59,7 +59,7 @@ DOB ;DOB Lookup
. . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
@ -67,8 +67,8 @@ DOB ;DOB Lookup
. . Q
. Q
;
CHART
;Chart# Lookup
CHART
;Chart# Lookup
I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
. S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q
. . Q:'$D(^DPT(BSDXIEN,0))
@ -77,14 +77,14 @@ CHART
. . S BSDXHRN=BSDXP ;CHART
. . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
. . Q
. Q
;
;
SSN ;SSN Lookup
I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
. S BSDXIEN=0 F S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN D Q
@ -95,7 +95,7 @@ SSN ;SSN Lookup
. . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
@ -125,7 +125,7 @@ SSN ;SSN Lookup
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN

16
m/BSDX29.m
View File

@ -1,8 +1,8 @@
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
; Change Log:
; v1.3 by WV/SMH on 3100713
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; v1.3 by WV/SMH on 3100713
; - Beginning and Ending dates passed as FM Dates
;
BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
@ -16,8 +16,8 @@ BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
;
;Returns ADO Recordset formatted fields containing count of records copied and error message:
;
; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n
;
; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n
;
;
S BSDXY="^BSDXTMP("_$J_")"
@ -27,8 +27,8 @@ BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00020ERRORID"_$C(30)
;
;Convert beginning and ending dates
;
;TODO:Validate FM Dates coming through
;
;TODO:Validate FM Dates coming through
;
S BSDXBEG=BSDXBEG-1
S BSDXEND=BSDXEND+1

64
m/BSDX2E.m
View File

@ -1,5 +1,5 @@
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm]
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
S LINE="",$P(LINE,"*",81)=""
S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED
@ -59,52 +59,52 @@ PATCHCK(XPXPCH) ;
;
V0200 ;EP Version 1.3 PostInit
;Add Protocol items to SDAM APPOINTMENT EVENTS protocol
;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
;
N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG
;
; 1st, add the BSDX event protocols
; Get SDAM APPOINTMENT EVENTS IEN in 101
;
; 1st, add the BSDX event protocols
; Get SDAM APPOINTMENT EVENTS IEN in 101
S BSDXDA=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
Q:'+BSDXDA
; Add each of those protocols unless they already exist.
; Add each of those protocols unless they already exist.
S BSDXDAT="BSDX ADD APPOINTMENT;10.2^BSDX CANCEL APPOINTMENT;10.4^BSDX CHECKIN APPOINTMENT;10.6^BSDX NOSHOW APPOINTMENT;10.8"
; For each
F J=1:1:$L(BSDXDAT,U) D
; For each
F J=1:1:$L(BSDXDAT,U) D
. K BSDXIEN,BSDXMSG,BSDXFDA
. ; Get Item
. ; Get Item
. S BSDXNOD=$P(BSDXDAT,U,J)
. ; Get Item Name (BSDX ADD APPOINTMENT)
. S BSDXDA1=$P(BSDXNOD,";")
. ; Get Item Sequence (10.2)
. S BSDXDA1=$P(BSDXNOD,";")
. ; Get Item Sequence (10.2)
. S BSDXSEQ=$P(BSDXNOD,";",2)
. ; Get Item Reference (Item is already in the protocol file)
. ; Get Item Reference (Item is already in the protocol file)
. S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0))
. ; Quit if not found
. ; Quit if not found
. Q:'+BSDXDA1
. ; Quit if already exists in the SDAM protocol
. ; Quit if already exists in the SDAM protocol
. Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1))
. ; Go ahead and save it.
. ; Go ahead and save it.
. S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1
. S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
. ; Error message
. I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
;
; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
N SDEVTIENS S SDEVTIENS=","_BSDXDA_","
; Subfile entry for ORU...
N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT")
; Subfile entry for DVBA...
N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT")
; Deletion code
N BSDXFDA,BSDXMSG
S:ORUIEN>0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@"
S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
; If error
I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
. ; Error message
. I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
;
; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
N SDEVTIENS S SDEVTIENS=","_BSDXDA_","
; Subfile entry for ORU...
N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT")
; Subfile entry for DVBA...
N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT")
; Deletion code
N BSDXFDA,BSDXMSG
S:ORUIEN>0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@"
S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
; If error
I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
QUIT
;
SORRY(XPX) ;

2
m/BSDX30.m
View File

@ -1,5 +1,5 @@
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007 1:54 PM ]
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP

2
m/BSDX31.m
View File

@ -1,5 +1,5 @@
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP

2
m/BSDX32.m
View File

@ -1,5 +1,5 @@
BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
ERROR ;

30
m/BSDX33.m
View File

@ -1,12 +1,12 @@
BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
; Mods by WV/STAR
;
; Change Log:
; July 13, 2010
; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT)
; also adds i18 support - Dates passed in FM format from application
; in tag SETRBK and RBNEXT
;;1.3T1;BSDX;;Jul 18, 2010
; Mods by WV/STAR
;
; Change Log:
; July 13, 2010
; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT)
; also adds i18 support - Dates passed in FM format from application
; in tag SETRBK and RBNEXT
;
;
Q
@ -34,11 +34,11 @@ RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
;
; i18n fix
; S X=BSDXDATE,%DT="XT" D ^%DT
; i18n fix
; S X=BSDXDATE,%DT="XT" D ^%DT
; I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q
;
; S BSDXDATE=$P(Y,".")
; S BSDXDATE=$P(Y,".")
;
S BSDXFND=0
F S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE)) Q:'+BSDXDATE D Q:BSDXFND
@ -52,9 +52,9 @@ RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
I BSDXFND=0 S BSDXFND=""
E S Y=BSDXFND X ^DD("DD") S BSDXFND=Y
S BSDXI=BSDXI+1
;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it
S BSDXFND=$TR(BSDXFND,"@"," ")
;//smh end fix
;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it
S BSDXFND=$TR(BSDXFND,"@"," ")
;//smh end fix
S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31)
Q
SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP
@ -83,7 +83,7 @@ SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP
I '+BSDXAPPT
I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q
; i18n (v 1.3)
;S X=BSDXDATE,%DT="XT" D ^%DT
;S X=BSDXDATE,%DT="XT" D ^%DT
;I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q
;S BSDXDATE=Y
S BSDXIENS=BSDXAPPT_","

18
m/BSDX34.m
View File

@ -1,8 +1,8 @@
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm
;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
; Change Log:
; July 10 2010:
;;1.3T1;BSDX;;Jul 18, 2010
;
; Change Log:
; July 10 2010:
; CANCLIN AND RBCLIN: Dates passed in FM format for i18n
;
Q
@ -27,7 +27,7 @@ CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
;Used in generating cancellation letters for a clinic
;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
;v 1.3 BSDXBEG and BSDXEND are in fm format
;v 1.3 BSDXBEG and BSDXEND are in fm format
;Called by BSDX CANCEL CLINIC LIST
N BSDXCAN
S BSDXCAN=1
@ -43,7 +43,7 @@ RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above
;Jul 11 2010 (smh):
;for i18n, pass BSDXBEG and BSDXEND in FM format.
;for i18n, pass BSDXBEG and BSDXEND in FM format.
;
S X="RBERR^BSDX34",@^%ZOSF("TRAP")
;
@ -51,11 +51,11 @@ RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
N %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY
;Convert beginning and ending dates
;TODO: Validation of date to make sure it's a right FM Date
S BSDXBEG=$P(BSDXBEG,".")
S BSDXEND=$P(BSDXEND,".")
S BSDXBEG=$P(BSDXBEG,".")
S BSDXEND=$P(BSDXEND,".")
S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
S BSDXEND=BSDXEND_".9999"
;
;
I BSDXCLST="" D RBERR Q
;
;

2
m/BSDX35.m
View File

@ -1,5 +1,5 @@
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
Q

520
m/BSDXAPI.m
View File

@ -1,260 +1,260 @@
BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm
;;2.1;BSDX;;24JUL2009
;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
;
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
; Call like this for DFN 23435 having an appointment at Hospital Location 33
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
; for Baby foxes hallucinations.
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
S BSDR("PAT")=DFN ;DFN
S BSDR("CLN")=CLIN ;Hosp Loc IEN
S BSDR("TYP")=TYP ;3 sched or 4 walkin
S BSDR("ADT")=DATE ;Appointment date in FM format
S BSDR("LEN")=LEN ;Appt len upto 240 (min)
S BSDR("INFO")=INFO ;Reason for appt - up to 150 char
S BSDR("USR")=DUZ ;Person who made appt - current user
Q $$MAKE(.BSDR)
;
MAKE(BSDR) ;PEP; call to store appt made
;
; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
; BSDR("ADT") = appointment date and time
; BSDR("LEN") = appointment length in minutes (5-120)
; BSDR("OI") = reason for appt - up to 150 characters
; BSDR("USR") = user who made appt
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
;
I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'="C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
;
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
;
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
;
; 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
;
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
; Call like this for DFN 23435 checking in now at Hospital Location 33
; for appt at Dec 20, 2009 @ 10:11:59
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
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 $$CHECKIN(.BSDR)
;
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
;
; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
;
; Input array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("ADT") = appt date/time
; BSDR("CDT") = checkin date/time
; BSDR("USR") = checkin user
;
; Output value -
; = 0 means everything worked
; = 1^message means error with reason message
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
;
; find ien for appt in file 44
NEW IEN,DIE,DA,DR
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
; set checkin
S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
D ^DIE
;
; set after status
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
; call event driver
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
Q 0
;
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
; cancellation initiated by patient ("PC" rather than clinic "C"),
; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
; because foxes come out during bad weather.
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
S BSDR("PAT")=DFN
S BSDR("CLN")=CLIN
S BSDR("TYP")=TYP
S BSDR("ADT")=APDATE
S BSDR("CDT")=$$NOW^XLFDT
S BSDR("USR")=DUZ
S BSDR("CR")=REASON
S BSDR("NOT")=INFO
Q $$CANCEL(.BSDR)
;
CANCEL(BSDR) ;PEP; called to cancel appt
;
; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
; BSDR("ADT") = appointment date and time
; BSDR("CDT") = cancel date and time
; BSDR("USR") = user who canceled appt
; BSDR("CR") = cancel reason - pointer to file 409.2
; BSDR("NOT") = cancel remarks - optional notes to 160 characters
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
;
NEW IEN,DIE,DA,DR
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
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")
;
; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
;
; get user who made appt and date appt made from ^SC
; because data in ^SC will be deleted
NEW USER,DATE
S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
;
; update file 2 info
NEW DIE,DA,DR
S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
D ^DIE
;
; delete data in ^SC
NEW DIK,DA
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
D ^DIK
;
; call event driver
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
Q 0
;
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
NEW X
S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
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)
;
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
;
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
NEW X
S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
Q $S(X:1,1:0)
;
BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm
;;1.3T1;BSDX;;Jul 18, 2010
;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
;
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
; Call like this for DFN 23435 having an appointment at Hospital Location 33
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
; for Baby foxes hallucinations.
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
S BSDR("PAT")=DFN ;DFN
S BSDR("CLN")=CLIN ;Hosp Loc IEN
S BSDR("TYP")=TYP ;3 sched or 4 walkin
S BSDR("ADT")=DATE ;Appointment date in FM format
S BSDR("LEN")=LEN ;Appt len upto 240 (min)
S BSDR("INFO")=INFO ;Reason for appt - up to 150 char
S BSDR("USR")=DUZ ;Person who made appt - current user
Q $$MAKE(.BSDR)
;
MAKE(BSDR) ;PEP; call to store appt made
;
; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
; BSDR("ADT") = appointment date and time
; BSDR("LEN") = appointment length in minutes (5-120)
; BSDR("OI") = reason for appt - up to 150 characters
; BSDR("USR") = user who made appt
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
;
I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'="C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
;
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
;
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
;
; 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
;
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
; Call like this for DFN 23435 checking in now at Hospital Location 33
; for appt at Dec 20, 2009 @ 10:11:59
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
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 $$CHECKIN(.BSDR)
;
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
;
; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
;
; Input array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("ADT") = appt date/time
; BSDR("CDT") = checkin date/time
; BSDR("USR") = checkin user
;
; Output value -
; = 0 means everything worked
; = 1^message means error with reason message
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
;
; find ien for appt in file 44
NEW IEN,DIE,DA,DR
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
; set checkin
S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
D ^DIE
;
; set after status
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
; call event driver
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
Q 0
;
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
; cancellation initiated by patient ("PC" rather than clinic "C"),
; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
; because foxes come out during bad weather.
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
S BSDR("PAT")=DFN
S BSDR("CLN")=CLIN
S BSDR("TYP")=TYP
S BSDR("ADT")=APDATE
S BSDR("CDT")=$$NOW^XLFDT
S BSDR("USR")=DUZ
S BSDR("CR")=REASON
S BSDR("NOT")=INFO
Q $$CANCEL(.BSDR)
;
CANCEL(BSDR) ;PEP; called to cancel appt
;
; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
; BSDR("ADT") = appointment date and time
; BSDR("CDT") = cancel date and time
; BSDR("USR") = user who canceled appt
; BSDR("CR") = cancel reason - pointer to file 409.2
; BSDR("NOT") = cancel remarks - optional notes to 160 characters
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
;
NEW IEN,DIE,DA,DR
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
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")
;
; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
;
; get user who made appt and date appt made from ^SC
; because data in ^SC will be deleted
NEW USER,DATE
S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
;
; update file 2 info
NEW DIE,DA,DR
S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
D ^DIE
;
; delete data in ^SC
NEW DIK,DA
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
D ^DIK
;
; call event driver
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
Q 0
;
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
NEW X
S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
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)
;
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
;
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
NEW X
S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
Q $S(X:1,1:0)
;

60
m/BSDXGPRV.m
View File

@ -1,5 +1,5 @@
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 6/10/10 9:01pm
;;1.1;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;;1.3T1;BSDX;;Jul 18, 2010
;
;
ERROR ;
@ -7,10 +7,10 @@ ERROR ;
Q
;
ERR(BSDXERR) ;Error processing
D ^%ZTER
D ^%ZTER
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXERR
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXERR
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
@ -20,40 +20,40 @@ PD(BSDXY,HLIEN) ;EP Debugging entry point
;
Q
;
P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location
; Input: HLIEN - Hospital Location IEN
; Output: ADO Datatable with columns:
; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT
; If there are providers in the PROVIDER multiple of file 44
; (Hospital Location) return them;
; If no providers in PROVIDER multiple of file 44, return nothing
P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location
; Input: HLIEN - Hospital Location IEN
; Output: ADO Datatable with columns:
; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT
; If there are providers in the PROVIDER multiple of file 44
; (Hospital Location) return them;
; If no providers in PROVIDER multiple of file 44, return nothing
; Called by BSDX HOSP LOC PROVIDERS
;
S BSDXI=0
I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
D ^XBKVAR
N $ET S $ET="G ERROR^BSDXGPRV"
N $ET S $ET="G ERROR^BSDXGPRV"
K ^BSDXTMP($J)
S BSDXY=$NA(^BSDXTMP($J))
S $P(^BSDXTMP($J,BSDXI),U,1)="I00020HOSPITAL_LOCATION_ID"
S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN"
S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME"
S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT"
S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN"
S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME"
S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT"
S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
;
N OUTPUT
D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple
; No results
I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT
; if results, get them
N I S I=""
F S I=$O(OUTPUT(44.1,I)) Q:I="" D
. S BSDXI=BSDXI+1
. S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN ; HL IEN
. S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN
. S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME
. S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO
. S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
N OUTPUT
D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple
; No results
I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT
; if results, get them
N I S I=""
F S I=$O(OUTPUT(44.1,I)) Q:I="" D
. S BSDXI=BSDXI+1
. S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN ; HL IEN
. S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN
. S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME
. S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO
. S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
QUIT