Changeset 888
- Timestamp:
- Jul 18, 2010, 9:58:35 AM (14 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 37 edited
-
BSDX01.m (modified) (1 diff)
-
BSDX02.m (modified) (2 diffs)
-
BSDX03.m (modified) (1 diff)
-
BSDX04.m (modified) (2 diffs)
-
BSDX05.m (modified) (1 diff)
-
BSDX06.m (modified) (1 diff)
-
BSDX07.m (modified) (4 diffs)
-
BSDX08.m (modified) (1 diff)
-
BSDX09.m (modified) (2 diffs)
-
BSDX11.m (modified) (1 diff)
-
BSDX12.m (modified) (3 diffs)
-
BSDX13.m (modified) (1 diff)
-
BSDX14.m (modified) (1 diff)
-
BSDX15.m (modified) (1 diff)
-
BSDX16.m (modified) (1 diff)
-
BSDX17.m (modified) (1 diff)
-
BSDX18.m (modified) (1 diff)
-
BSDX19.m (modified) (1 diff)
-
BSDX20.m (modified) (1 diff)
-
BSDX21.m (modified) (1 diff)
-
BSDX22.m (modified) (1 diff)
-
BSDX23.m (modified) (1 diff)
-
BSDX24.m (modified) (1 diff)
-
BSDX25.m (modified) (1 diff)
-
BSDX26.m (modified) (1 diff)
-
BSDX27.m (modified) (2 diffs)
-
BSDX28.m (modified) (9 diffs)
-
BSDX29.m (modified) (3 diffs)
-
BSDX2E.m (modified) (2 diffs)
-
BSDX30.m (modified) (1 diff)
-
BSDX31.m (modified) (1 diff)
-
BSDX32.m (modified) (1 diff)
-
BSDX33.m (modified) (4 diffs)
-
BSDX34.m (modified) (4 diffs)
-
BSDX35.m (modified) (1 diff)
-
BSDXAPI.m (modified) (1 diff)
-
BSDXGPRV.m (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX01.m
r883 r888 1 1 BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:04pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX02.m
r874 r888 1 1 BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; 4 ; Change Log 5 ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n 6 6 ; 7 7 ; … … 35 35 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y 36 36 ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q 37 37 ; 38 38 S BSDXI=0 39 39 D STRES -
Scheduling/trunk/m/BSDX03.m
r614 r888 1 1 BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX04.m
r874 r888 1 1 BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; Change Log: 4 ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates 5 ; for i18n 6 6 ; 7 7 ; … … 27 27 ; 28 28 ;BSDXRES is resource name 29 30 31 32 33 34 29 ; 30 ;//smh 31 ; BSDXSTART and BSDXEND both passed in FM Format. 32 ; BSDXSTART is the Date Portion of FM Date 33 ; BSDXEND -- pass date and h,m,s as well 34 ;//smh 35 35 ; 36 36 ;BSDXTYPES is |-delimited list of Access Type Names -
Scheduling/trunk/m/BSDX05.m
r874 r888 1 1 BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 5 4 ; Change Log: 5 ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates 6 6 ; 7 7 APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP 8 8 ;Called by BSDX APPT BLOCKS OVERLAP 9 9 ; July 11 2010 - pass FM Dates for Start and End rather than US Dates 10 10 ;(Duplicates old qryAppointmentBlocksOverlapB) 11 11 ;BSDXRES is resource name -
Scheduling/trunk/m/BSDX06.m
r874 r888 1 1 BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; Change Log: 4 ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get 5 ; dates in FM format for i18n 6 6 ; 7 7 ; -
Scheduling/trunk/m/BSDX07.m
r883 r888 1 1 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:11pm 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 6 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; 4 ; Change Log: 5 ; UJO/SMH 6 ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US. 7 7 ; 8 8 ; … … 45 45 ; 46 46 TSTART 47 47 ; v1.3 - date passed in as FM Date, not US date. 48 48 ;Check input data for errors 49 49 ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@") … … 53 53 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y 54 54 ; I BSDXEND=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q 55 56 55 ; 56 ; If C# sends the dates with extra zeros, remove them 57 57 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND 58 59 58 ; 59 I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q 60 60 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP 61 61 I '+BSDXPATID,'$D(^DPT(BSDXPATID,0)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Patient ID") Q … … 178 178 ERR(BSDXI,BSDXERR) ;Error processing 179 179 D ^%ZTER ;XXX: remove after we figure out the cause of error 180 180 S BSDXI=BSDXI+1 181 181 S BSDXERR=$TR(BSDXERR,"^","~") 182 182 TROLLBACK -
Scheduling/trunk/m/BSDX08.m
r614 r888 1 1 BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX09.m
r883 r888 1 1 BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:26pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 5 6 7 8 9 4 ; Change Log: 5 ; UJO/TH - v 1.3 on 3100714 - Extra Demographics: 6 ; - Email 7 ; - Cell Phone 8 ; - Country 9 ; - + refactoring of routine 10 10 ; 11 11 ; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead 12 12 ; 13 13 GETREGA(BSDXRET,BSDXPAT) ;EP … … 18 18 ; 20 DATAREVIEWED^ 19 19 ; 21 RegistrationComments 20 20 ; 22 EMAIL ADDRESS^PHONE NUMBER [CELLULAR]^COUNTRY 21 21 ; 22 22 ;For patient with ien BSDXPAT -
Scheduling/trunk/m/BSDX11.m
r614 r888 1 1 BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ENV0100 ;EP Version 1.0 Environment check -
Scheduling/trunk/m/BSDX12.m
r883 r888 1 1 BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 6 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; 4 ; Change Log: 5 ; v 1.3 - i18n support - 3100718 6 ; BSDXSTART and BSDXEND passed in FM Dates, not US dates 7 7 ; 8 8 ; … … 26 26 S ^BSDXTMP($J,0)="I00020AVAILABILITYID^I00020ERRORID"_$C(30) 27 27 ;Check input data for errors 28 28 ; i18n - FM Dates passed in 29 29 ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@") 30 30 ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@") … … 33 33 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y 34 34 ; I BSDXEND=-1 D ERR(70) Q 35 36 37 35 ; Make sure dates are canonical and don't contain extra zeros 36 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND 37 ; 38 38 I $L(BSDXEND,".")=1 D ERR(70) Q 39 39 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP -
Scheduling/trunk/m/BSDX13.m
r883 r888 1 1 BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; 4 ; Change Log: 5 ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH 6 6 Q 7 7 AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP -
Scheduling/trunk/m/BSDX14.m
r614 r888 1 1 BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX15.m
r614 r888 1 1 BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX16.m
r614 r888 1 1 BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX17.m
r614 r888 1 1 BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX18.m
r614 r888 1 1 BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX19.m
r614 r888 1 1 BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX20.m
r614 r888 1 1 BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX21.m
r773 r888 1 1 BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX22.m
r614 r888 1 1 BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX23.m
r614 r888 1 1 BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX24.m
r614 r888 1 1 BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX25.m
r614 r888 1 1 BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX26.m
r614 r888 1 1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX27.m
r874 r888 1 1 BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; 4 ; Change Log: July 15, 2010 5 ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag 6 6 ; 7 7 ; … … 185 185 ;Called by BSDX CLINIC LETTERS 186 186 ; 187 188 187 ; July 10, 2010 -- to support i18n, we pass dates from client in 188 ; locale-neutral Fileman format. No need to convert it. 189 189 N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT 190 190 N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN -
Scheduling/trunk/m/BSDX28.m
r883 r888 1 1 BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; Change Log: 5 5 ; HMW 3050721 Added test for inactivated record 6 7 8 9 6 ; V1.3 WV/SMH 3100714 7 ; - add PID search 8 ; - return PID instead of SSN (change header and logic) 9 ; - Change Error trap to new style. 10 10 ; 11 11 PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup … … 15 15 ; 16 16 N $ET S $ET="G ERROR^BSDX28" 17 17 ; rm ctrl chars 18 18 S BSDXP=$TR(BSDXP,$C(13),"") 19 19 S BSDXP=$TR(BSDXP,$C(10),"") 20 20 S BSDXP=$TR(BSDXP,$C(9),"") 21 21 ; num of pts to find 22 22 S:BSDXC="" BSDXC=10 23 23 N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE … … 28 28 I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q 29 29 I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q 30 31 PID 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 30 31 PID ;PID Lookup 32 ; If this ID exists, go get it. If "UJOPID" index doesn't exist, 33 ; won't work anyways. 34 I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT 35 . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,"")) 36 . Q:'$D(^DPT(BSDXIEN,0)) 37 . S BSDXDPT=$G(^DPT(BSDXIEN,0)) 38 . S BSDXZ=$P(BSDXDPT,U) ;NAME 39 . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART 40 . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2 41 . ; Inactivated Chart get an * 42 . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q 43 . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN 44 . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID 45 . S Y=$P(BSDXDPT,U,3) X ^DD("DD") 46 . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB 47 . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN 48 . S BSDXRET=BSDXRET_BSDXZ_$C(30) 49 49 ; 50 50 DOB ;DOB Lookup … … 60 60 . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated 61 61 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN 62 62 . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID 63 63 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD") 64 64 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB … … 68 68 . Q 69 69 ; 70 CHART 71 70 CHART 71 ;Chart# Lookup 72 72 I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q 73 73 . S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q … … 78 78 . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated 79 79 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN 80 80 . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID 81 81 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD") 82 82 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB … … 85 85 . . Q 86 86 . Q 87 87 ; 88 88 SSN ;SSN Lookup 89 89 I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q … … 96 96 . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated 97 97 . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN 98 98 . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID 99 99 . . S Y=$P(BSDXDPT,U,3) X ^DD("DD") 100 100 . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB … … 126 126 . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN 127 127 . S BSDXDPT=$G(^DPT(BSDXIEN,0)) 128 128 . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID 129 129 . S Y=$P(BSDXDPT,U,3) X ^DD("DD") 130 130 . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB -
Scheduling/trunk/m/BSDX29.m
r883 r888 1 1 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; 4 ; Change Log: 5 ; v1.3 by WV/SMH on 3100713 6 6 ; - Beginning and Ending dates passed as FM Dates 7 7 ; … … 17 17 ; 18 18 ;Returns ADO Recordset formatted fields containing count of records copied and error message: 19 20 19 ; 20 ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n 21 21 ; 22 22 ; … … 28 28 ; 29 29 ;Convert beginning and ending dates 30 31 30 ; 31 ;TODO:Validate FM Dates coming through 32 32 ; 33 33 S BSDXBEG=BSDXBEG-1 -
Scheduling/trunk/m/BSDX2E.m
r885 r888 1 1 BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm] 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 S LINE="",$P(LINE,"*",81)="" … … 60 60 V0200 ;EP Version 1.3 PostInit 61 61 ;Add Protocol items to SDAM APPOINTMENT EVENTS protocol 62 62 ;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS 63 63 ; 64 64 N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG 65 66 67 65 ; 66 ; 1st, add the BSDX event protocols 67 ; Get SDAM APPOINTMENT EVENTS IEN in 101 68 68 S BSDXDA=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0)) 69 69 Q:'+BSDXDA 70 70 ; Add each of those protocols unless they already exist. 71 71 S BSDXDAT="BSDX ADD APPOINTMENT;10.2^BSDX CANCEL APPOINTMENT;10.4^BSDX CHECKIN APPOINTMENT;10.6^BSDX NOSHOW APPOINTMENT;10.8" 72 73 72 ; For each 73 F J=1:1:$L(BSDXDAT,U) D 74 74 . K BSDXIEN,BSDXMSG,BSDXFDA 75 75 . ; Get Item 76 76 . S BSDXNOD=$P(BSDXDAT,U,J) 77 77 . ; Get Item Name (BSDX ADD APPOINTMENT) 78 79 78 . S BSDXDA1=$P(BSDXNOD,";") 79 . ; Get Item Sequence (10.2) 80 80 . S BSDXSEQ=$P(BSDXNOD,";",2) 81 81 . ; Get Item Reference (Item is already in the protocol file) 82 82 . S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0)) 83 83 . ; Quit if not found 84 84 . Q:'+BSDXDA1 85 85 . ; Quit if already exists in the SDAM protocol 86 86 . Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1)) 87 87 . ; Go ahead and save it. 88 88 . S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1 89 89 . S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ 90 90 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 91 . ; Error message 92 . I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1) 93 ; 94 ; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT 95 ; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC 96 N SDEVTIENS S SDEVTIENS=","_BSDXDA_"," 97 ; Subfile entry for ORU... 98 N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT") 99 ; Subfile entry for DVBA... 100 N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT") 101 ; Deletion code 102 N BSDXFDA,BSDXMSG 103 S:ORUIEN>0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@" 104 S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@" 105 D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG") 106 ; If error 107 I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1) 108 108 QUIT 109 109 ; -
Scheduling/trunk/m/BSDX30.m
r614 r888 1 1 BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007 1:54 PM ] 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX31.m
r614 r888 1 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX32.m
r614 r888 1 1 BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX33.m
r874 r888 1 1 BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 6 7 8 9 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; Mods by WV/STAR 4 ; 5 ; Change Log: 6 ; July 13, 2010 7 ; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT) 8 ; also adds i18 support - Dates passed in FM format from application 9 ; in tag SETRBK and RBNEXT 10 10 ; 11 11 ; … … 35 35 I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q 36 36 ; 37 38 37 ; i18n fix 38 ; S X=BSDXDATE,%DT="XT" D ^%DT 39 39 ; I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q 40 40 ; 41 41 ; S BSDXDATE=$P(Y,".") 42 42 ; 43 43 S BSDXFND=0 … … 53 53 E S Y=BSDXFND X ^DD("DD") S BSDXFND=Y 54 54 S BSDXI=BSDXI+1 55 56 57 55 ;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it 56 S BSDXFND=$TR(BSDXFND,"@"," ") 57 ;//smh end fix 58 58 S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31) 59 59 Q … … 84 84 I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q 85 85 ; i18n (v 1.3) 86 86 ;S X=BSDXDATE,%DT="XT" D ^%DT 87 87 ;I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q 88 88 ;S BSDXDATE=Y -
Scheduling/trunk/m/BSDX34.m
r874 r888 1 1 BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm 2 ;;1.3 ;IHS WINDOWS SCHEDULING;;NOV 01, 20073 4 5 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ; 4 ; Change Log: 5 ; July 10 2010: 6 6 ; CANCLIN AND RBCLIN: Dates passed in FM format for i18n 7 7 ; … … 28 28 ;Used in generating cancellation letters for a clinic 29 29 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.) 30 30 ;v 1.3 BSDXBEG and BSDXEND are in fm format 31 31 ;Called by BSDX CANCEL CLINIC LIST 32 32 N BSDXCAN … … 44 44 ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above 45 45 ;Jul 11 2010 (smh): 46 46 ;for i18n, pass BSDXBEG and BSDXEND in FM format. 47 47 ; 48 48 S X="RBERR^BSDX34",@^%ZOSF("TRAP") … … 52 52 ;Convert beginning and ending dates 53 53 ;TODO: Validation of date to make sure it's a right FM Date 54 55 54 S BSDXBEG=$P(BSDXBEG,".") 55 S BSDXEND=$P(BSDXEND,".") 56 56 S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999" 57 57 S BSDXEND=BSDXEND_".9999" 58 58 ; 59 59 I BSDXCLST="" D RBERR Q 60 60 ; -
Scheduling/trunk/m/BSDX35.m
r614 r888 1 1 BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;; 2.0;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDXAPI.m
r742 r888 1 BSDXAPI 2 ;;2.1;BSDX;;24JUL2009 3 4 5 6 7 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) 8 9 10 11 12 13 14 15 16 17 18 19 20 21 MAKE(BSDR) 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 CHECKIN1(DFN,CLIN,APDATE) 97 98 99 100 101 102 103 104 105 106 107 CHECKIN(BSDR) 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 CANCEL(BSDR) 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 CI(PAT,CLINIC,DATE,SDIEN) 236 237 238 239 240 241 242 SCIEN(PAT,CLINIC,DATE) 243 244 245 246 247 248 249 APPTYP(PAT,DATE) 250 251 252 253 CO(PAT,CLINIC,DATE,SDIEN) 254 255 256 257 258 259 260 1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm 2 ;;1.3T1;BSDX;;Jul 18, 2010 3 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW 4 ;local mods (many) by WV/SMH 5 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH 6 ; 7 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment 8 ; Call like this for DFN 23435 having an appointment at Hospital Location 33 9 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt 10 ; for Baby foxes hallucinations. 11 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") 12 S BSDR("PAT")=DFN ;DFN 13 S BSDR("CLN")=CLIN ;Hosp Loc IEN 14 S BSDR("TYP")=TYP ;3 sched or 4 walkin 15 S BSDR("ADT")=DATE ;Appointment date in FM format 16 S BSDR("LEN")=LEN ;Appt len upto 240 (min) 17 S BSDR("INFO")=INFO ;Reason for appt - up to 150 char 18 S BSDR("USR")=DUZ ;Person who made appt - current user 19 Q $$MAKE(.BSDR) 20 ; 21 MAKE(BSDR) ;PEP; call to store appt made 22 ; 23 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY) 24 ; 25 ; Input Array - 26 ; BSDR("PAT") = ien of patient in file 2 27 ; BSDR("CLN") = ien of clinic in file 44 28 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins 29 ; BSDR("ADT") = appointment date and time 30 ; BSDR("LEN") = appointment length in minutes (5-120) 31 ; BSDR("OI") = reason for appt - up to 150 characters 32 ; BSDR("USR") = user who made appt 33 ; 34 ;Output: error status and message 35 ; = 0 or null: everything okay 36 ; = 1^message: error and reason 37 ; 38 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 39 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 40 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) 41 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 42 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 43 ; 44 I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) 45 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 46 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") 47 ; 48 NEW DIC,DA,Y,X,DD,DO,DLAYGO 49 ; 50 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D 51 . ; "un-cancel" existing appt in file 2 52 . N BSDXFDA,BSDXIENS,BSDXMSG 53 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," 54 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") 55 . S BSDXFDA(2.98,BSDXIENS,"3")="" 56 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 57 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 58 . S BSDXFDA(2.98,BSDXIENS,"14")="" 59 . S BSDXFDA(2.98,BSDXIENS,"15")="" 60 . S BSDXFDA(2.98,BSDXIENS,"16")="" 61 . S BSDXFDA(2.98,BSDXIENS,"19")="" 62 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 63 . D FILE^DIE("","BSDXFDA","BSDXMSG") 64 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) 65 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 66 . N BSDXFDA,BSDXIENS,BSDXMSG 67 . S BSDXIENS="?+2,"_BSDR("PAT")_"," 68 . S BSDXIENS(2)=BSDR("ADT") 69 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") 70 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 71 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 72 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 73 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") 74 ; add appt to file 44 75 K DIC,DA,X,Y,DLAYGO,DD,DO 76 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" 77 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") 78 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") 79 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 80 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 81 ; 82 K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM 83 S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 84 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") 85 S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") 86 S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 87 D FILE^DICN 88 ; 89 ; call event driver 90 NEW DFN,SDT,SDCL,SDDA,SDMODE 91 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 92 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 93 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) 94 Q 0 95 ; 96 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in 97 ; Call like this for DFN 23435 checking in now at Hospital Location 33 98 ; for appt at Dec 20, 2009 @ 10:11:59 99 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) 100 S BSDR("PAT")=DFN ;DFN 101 S BSDR("CLN")=CLIN ;Hosp Loc IEN 102 S BSDR("ADT")=APDATE ;Appt Date 103 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now 104 S BSDR("USR")=DUZ ;Check-in user defaults to current 105 Q $$CHECKIN(.BSDR) 106 ; 107 CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002 108 ; 109 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY) 110 ; 111 ; Input array - 112 ; BSDR("PAT") = ien of patient in file 2 113 ; BSDR("CLN") = ien of clinic in file 44 114 ; BSDR("ADT") = appt date/time 115 ; BSDR("CDT") = checkin date/time 116 ; BSDR("USR") = checkin user 117 ; 118 ; Output value - 119 ; = 0 means everything worked 120 ; = 1^message means error with reason message 121 ; 122 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 123 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 124 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 125 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 126 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds 127 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) 128 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 129 ; 130 ; find ien for appt in file 44 131 NEW IEN,DIE,DA,DR 132 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 133 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 134 ; 135 ; remember before status 136 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL 137 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 138 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 139 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 140 ; 141 ; set checkin 142 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 143 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 144 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT 145 D ^DIE 146 ; 147 ; set after status 148 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 149 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 150 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 151 ; 152 ; call event driver 153 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) 154 Q 0 155 ; 156 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment 157 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33, 158 ; cancellation initiated by patient ("PC" rather than clinic "C"), 159 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather) 160 ; because foxes come out during bad weather. 161 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") 162 S BSDR("PAT")=DFN 163 S BSDR("CLN")=CLIN 164 S BSDR("TYP")=TYP 165 S BSDR("ADT")=APDATE 166 S BSDR("CDT")=$$NOW^XLFDT 167 S BSDR("USR")=DUZ 168 S BSDR("CR")=REASON 169 S BSDR("NOT")=INFO 170 Q $$CANCEL(.BSDR) 171 ; 172 CANCEL(BSDR) ;PEP; called to cancel appt 173 ; 174 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY) 175 ; 176 ; Input Array - 177 ; BSDR("PAT") = ien of patient in file 2 178 ; BSDR("CLN") = ien of clinic in file 44 179 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled 180 ; BSDR("ADT") = appointment date and time 181 ; BSDR("CDT") = cancel date and time 182 ; BSDR("USR") = user who canceled appt 183 ; BSDR("CR") = cancel reason - pointer to file 409.2 184 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters 185 ; 186 ;Output: error status and message 187 ; = 0 or null: everything okay 188 ; = 1^message: error and reason 189 ; 190 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 191 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 192 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) 193 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 194 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 195 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds 196 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) 197 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) 198 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) 199 ; 200 NEW IEN,DIE,DA,DR 201 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 202 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 203 ; 204 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") 205 ; 206 ; remember before status 207 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL 208 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 209 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 210 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) 211 ; 212 ; get user who made appt and date appt made from ^SC 213 ; because data in ^SC will be deleted 214 NEW USER,DATE 215 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) 216 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) 217 ; 218 ; update file 2 info 219 NEW DIE,DA,DR 220 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT 221 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE 222 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) 223 D ^DIE 224 ; 225 ; delete data in ^SC 226 NEW DIK,DA 227 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 228 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 229 D ^DIK 230 ; 231 ; call event driver 232 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) 233 Q 0 234 ; 235 CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in 236 NEW X 237 S X=$G(SDIEN) ;ien sent in call 238 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 239 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U) 240 Q $S(X:1,1:0) 241 ; 242 SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC 243 NEW X,IEN 244 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D 245 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled 246 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X 247 Q $G(IEN) 248 ; 249 APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) 250 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) 251 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") 252 ; 253 CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out 254 NEW X 255 S X=$G(SDIEN) ;ien sent in call 256 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 257 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) 258 Q $S(X:1,1:0) 259 ; 260 -
Scheduling/trunk/m/BSDXGPRV.m
r803 r888 1 1 BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 6/10/10 9:01pm 2 ;;1. 1;IHS WINDOWS SCHEDULING;;NOV 01, 20072 ;;1.3T1;BSDX;;Jul 18, 2010 3 3 ; 4 4 ; … … 8 8 ; 9 9 ERR(BSDXERR) ;Error processing 10 10 D ^%ZTER 11 11 S BSDXI=BSDXI+1 12 13 12 S ^BSDXTMP($J,BSDXI)=BSDXERR 13 S BSDXI=BSDXI+1 14 14 S ^BSDXTMP($J,BSDXI)=$C(31) 15 15 Q … … 21 21 Q 22 22 ; 23 P(BSDXY,HLIEN) 24 25 26 27 28 29 23 P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location 24 ; Input: HLIEN - Hospital Location IEN 25 ; Output: ADO Datatable with columns: 26 ; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT 27 ; If there are providers in the PROVIDER multiple of file 44 28 ; (Hospital Location) return them; 29 ; If no providers in PROVIDER multiple of file 44, return nothing 30 30 ; Called by BSDX HOSP LOC PROVIDERS 31 31 ; 32 32 S BSDXI=0 33 33 I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT 34 34 D ^XBKVAR 35 35 N $ET S $ET="G ERROR^BSDXGPRV" 36 36 K ^BSDXTMP($J) 37 37 S BSDXY=$NA(^BSDXTMP($J)) 38 38 S $P(^BSDXTMP($J,BSDXI),U,1)="I00020HOSPITAL_LOCATION_ID" 39 40 41 42 39 S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN" 40 S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME" 41 S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT" 42 S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30) 43 43 ; 44 45 46 47 48 49 50 51 52 53 54 55 56 44 N OUTPUT 45 D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple 46 ; No results 47 I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT 48 ; if results, get them 49 N I S I="" 50 F S I=$O(OUTPUT(44.1,I)) Q:I="" D 51 . S BSDXI=BSDXI+1 52 . S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN ; HL IEN 53 . S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN 54 . S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME 55 . S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO 56 . S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30) 57 57 S BSDXI=BSDXI+1 58 58 S ^BSDXTMP($J,BSDXI)=$C(31)
Note:
See TracChangeset
for help on using the changeset viewer.
