source: Scheduling/trunk/m/BSDX02.m@ 954

Last change on this file since 954 was 951, checked in by Sam Habiel, 14 years ago

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason

File size: 3.5 KB
Line 
1BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm
2 ;;1.4;BSDX;;Sep 07, 2010
3 ;
4 ; Change Log
5 ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
6 ;
7 ;
8CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
9 ;Entry point for debugging
10 ;
11 ;D DEBUG^%Serenji("CRSCH^BSDX02(.BSDXY,BSDXRES,BSDXSTART,BSDXEND)")
12 Q
13 ;
14CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
15 ;Called by BSDX CREATE APPT SCHEDULE
16 ;Create Resource Appointment Schedule recordset
17 ;On error, returns 0 in APPOINTMENTID field and error text in NOTE field
18 ;
19 ;$O Thru ^BSDXAPPT("ARSRC", RESOURCE, STARTTIME, APPTID)
20 ;BMXRES is a | delimited list of resource names
21 ;BSDXWKIN - If 1, then return walkins, otherwise skip them
22 ;9-27-2004 Added walkin to returned datatable
23 ;TODO: Change BSDXRES from names to IDs
24 ;
25 N BSDXERR,BSDXIEN,BSDXDEPD,BSDXDEPN,BSDXRESD,BSDXI,BSDXJ,BSDXRESN,BSDXS,BSDXAD,BSDXZ,BSDXQ,BSDXNOD
26 N BSDXPAT,BSDXNOT,BSDXZPCD,BSDXPCD
27 K ^BSDXTMP($J)
28 S BSDXERR=""
29 S BSDXY="^BSDXTMP("_$J_")"
30 S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE"_$C(30)
31 D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
32 ;
33 ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
34 ; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
35 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
36 ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
37 ;
38 S BSDXI=0
39 D STRES
40 ;
41 S BSDXI=BSDXI+1
42 S ^BSDXTMP($J,BSDXI)=$C(31)
43 Q
44 ;
45STRES ;
46 F BSDXJ=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDXJ) D
47 . Q:BSDXRESN=""
48 . Q:'$D(^BSDXRES("B",BSDXRESN))
49 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
50 . Q:'+BSDXRESD
51 . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
52 . S BSDXS=BSDXSTART-.0001
53 . F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
54 . . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD,BSDXRESN)
55 Q
56 ;
57STCOMM(BSDXAD,BSDXRESN) ;
58 ;BSDXAD is the appointment IEN
59 N BSDXC,BSDXQ,BSDXZ,BSDXSUBC,BSDXHRN,BSDXPATD,BSDXATID,BSDXISWK
60 Q:'$D(^BSDXAPPT(BSDXAD,0))
61 S BSDXNOD=^BSDXAPPT(BSDXAD,0)
62 Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
63 S BSDXISWK=0
64 S:$P(BSDXNOD,U,13)="y" BSDXISWK=1
65 I +$G(BSDXWKIN) Q:BSDXISWK ;Don't return walkins if appt is WALKIN and BSDXWKIN is 1
66 S BSDXZ=BSDXAD_"^"
67 F BSDXQ=1:1:4 D
68 . S Y=$P(BSDXNOD,U,BSDXQ)
69 . X ^DD("DD") S Y=$TR(Y,"@"," ")
70 . S BSDXZ=BSDXZ_Y_"^"
71 S BSDXPATD=$P(BSDXNOD,U,5)
72 S BSDXZ=BSDXZ_BSDXPATD_"^" ;PATIENT ID
73 S BSDXPAT=""
74 I BSDXPATD]"",$D(^DPT(BSDXPATD,0)) S BSDXPAT=$P(^DPT(BSDXPATD,0),U)
75 S BSDXZ=BSDXZ_BSDXPAT_"^" ;PATIENT NAME
76 S BSDXZ=BSDXZ_BSDXRESN_"^" ;RESOURCENAME
77 S BSDXZ=BSDXZ_+$P(BSDXNOD,U,10)_"^" ;NOSHOW
78 S BSDXHRN=""
79 I $D(DUZ(2)),DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPATD,41,DUZ(2),0)),U,2) ;HRN
80 S BSDXZ=BSDXZ_BSDXHRN_"^"
81 S BSDXATID=$P(BSDXNOD,U,6)
82 S:'+BSDXATID BSDXATID=0 ;UNKNOWN TYPE
83 S BSDXZ=BSDXZ_BSDXATID_"^"_BSDXISWK_"^"
84 S BSDXI=BSDXI+1
85 S ^BSDXTMP($J,BSDXI)=BSDXZ
86 ;NOTE
87 S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D
88 . S BSDXNOT=$G(^BSDXAPPT(BSDXAD,1,BSDXQ,0))
89 . S:$E(BSDXNOT,$L(BSDXNOT)-1,$L(BSDXNOT))'=" " BSDXNOT=BSDXNOT_" "
90 . S BSDXI=BSDXI+1
91 . S ^BSDXTMP($J,BSDXI)=BSDXNOT
92 S BSDXI=BSDXI+1
93 S ^BSDXTMP($J,BSDXI)=$C(30)
94 Q
95 ;
96ERR(BSDXI,BSDXERR) ;Error processing
97 S BSDXI=BSDXI+1
98 S ^BSDXTMP($J,BSDXI)="0^^^^^^^^^^^"_BSDXERR_$C(30)
99 S BSDXI=BSDXI+1
100 S ^BSDXTMP($J,BSDXI)=$C(31)
101 Q
102 ;
103ETRAP ;EP Error trap entry
104 D ^%ZTER
105 I '$D(BSDXI) N BSDXI S BSDXI=999999
106 S BSDXI=BSDXI+1
107 D ERR(BSDXI,"BSDX31 Error: "_$G(%ZTERROR))
108 Q
Note: See TracBrowser for help on using the repository browser.