source: Scheduling/trunk/m/BSDX04.m@ 1083

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

Updated routines version to 1.42
File size: 5.3 KB
Line 
1BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm
2 ;;1.42;BSDX;;Dec 07, 2010
3 ; Change Log:
4 ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
5 ; for i18n
6 ;
7 ;
8CASSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
9 ;
10 ;D DEBUG^%Serenji("CASSCH^BSDX04(.BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH)")
11 ;
12 Q
13 ;
14CASSET ;EP
15 ;Error Trap
16 D ^%ZTER
17 I '$D(BSDXI) N BSDXI S BSDXI=99999
18 S BSDXI=BSDXI+1
19 S ^BSDXTMP($J,BSDXI)=$C(31)
20 Q
21 ;
22CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
23 ;Called by BSDX CREATE ASGND SLOT SCHED
24 ;Create Assigned Slot Schedule recordset
25 ;This call is used both to create a schedule of availability for the calendar display
26 ;and to search for availability in the Find Appointment function
27 ;
28 ;BSDXRES is resource name
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 ;
36 ;BSDXTYPES is |-delimited list of Access Type Names
37 ;If BSDXTYPES is "" then the screen passes all types.
38 ;
39 ;BSDXSRCH is |-delimited search info for the Find Appointment function
40 ;First piece is 1 if we are in a Find Appointment call
41 ;Second piece is weekday info in the format MTWHFSU
42 ;Third piece is AM PM info in the form AP
43 ;If 2nd or 3rd pieces are null, the screen for that piece is skipped
44 ;
45 ;Test lines:
46 ;D CASSCH^BSDX04(.RES,"REMILLARD,MIKE","<fmdate>","<fmdate>") ZW RES
47 ;BSDX CREATE ASGND SLOT SCHED^ROGERS,BUCK^<fmdate>^<fmdate>^2
48 ;S ^HW("BSDX04")=BSDXRES_U_BSDXSTART_U_BSDXEND
49 ;
50 N BSDXERR,BSDXIEN,BSDXDEP,BSDXTYPED,BSDXTYPE,BSDXALO,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXZ,BSDXTMP,BSDXQ,BSDXNOT,BSDXNOD,BSDXAD
51 N BSDXSUBCD
52 S X="CASSET^BSDX04",@^%ZOSF("TRAP")
53 K ^BSDXTMP($J)
54 S BSDXERR=""
55 S BSDXY="^BSDXTMP("_$J_")"
56 S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010SLOTS^T00030RESOURCE^T00010ACCESS_TYPE^T00250NOTE^I00030AVAILABILITYID"_$C(30)
57 S BSDXALO=0,BSDXI=2
58 ;
59 ;Get Access Type IDs
60 N BSDXK,BSDXTYPED,BSDXL
61 I '+BSDXSRCH S BSDXTYPED=""
62 I +BSDXSRCH F BSDXK=1:1:$L(BSDXTYPES,"|") D
63 . S BSDXL=$P(BSDXTYPES,"|",BSDXK)
64 . I BSDXL="" S $P(BSDXTYPED,"|",BSDXK)=0 Q
65 . I '$D(^BSDXTYPE("B",BSDXL)) S $P(BSDXTYPED,"|",BSDXK)=0 Q
66 . S $P(BSDXTYPED,"|",BSDXK)=$O(^BSDXTYPE("B",BSDXL,0))
67 ;
68 D
69 . S BSDXBS=0
70 . S BSDXRESN=BSDXRES
71 . Q:BSDXRESN=""
72 . Q:'$D(^BSDXRES("B",BSDXRESN))
73 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) Q:'+BSDXRESD
74 . Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
75 . D STRES(BSDXRESN,BSDXRESD)
76 . Q
77 ;
78 ;start, end, slots, resource, accesstype, note, availabilityid
79 ;I '+BSDXSRCH,BSDXALO D
80 I BSDXALO D
81 . ;If first block start time > input start time then pad with new block
82 . I BSDXBS>BSDXSTART K BSDXTMP D
83 . . S Y=BSDXSTART X ^DD("DD") S Y=$TR(Y,"@"," ")
84 . . S BSDXTMP=Y
85 . . S Y=BSDXBS X ^DD("DD") S Y=$TR(Y,"@"," ")
86 . . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
87 . . S ^BSDXTMP($J,1)=BSDXTMP
88 . ;
89 . ;If first block start time < input start time then trim
90 . I BSDXBS<BSDXSTART D
91 . . S Y=BSDXSTART
92 . . X ^DD("DD") S Y=$TR(Y,"@"," ")
93 . . S $P(^BSDXTMP($J,2),U,1)=Y
94 . ;
95 . ;If last block end time < input end time then pad end with new block
96 . I BSDXPEND<BSDXEND D
97 . . S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ")
98 . . S BSDXTMP=Y
99 . . S Y=BSDXEND X ^DD("DD") S Y=$TR(Y,"@"," ")
100 . . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
101 . . S ^BSDXTMP($J,BSDXI-1)=BSDXTMP
102 . ;
103 S ^BSDXTMP($J,BSDXI)=$C(31)
104 Q
105 ;
106STRES(BSDXRESN,BSDXRESD) ;
107 ;BSDXRESD is a Resource ID
108 ;$O THRU "ARSCT" XREF OF ^BSDXAB
109 S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
110 S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
111 F S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
112 . S BSDXAD=0 F S BSDXAD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ;BSDXAD Is the AvailabilityID
113 . Q
114 Q
115 ;
116STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ;
117 N BSDXNSTART,BSDXNEND,BSDXNOD,Y,BSDXQ,BSDXZ,BSDXATID,BSDXATOK
118 Q:'$D(^BSDXAB(BSDXAD,0))
119 S BSDXNOD=^BSDXAB(BSDXAD,0)
120 S BSDXATID=$P(BSDXNOD,U,5)
121 ;
122 ;Screen for Access Type
123 ;S BSDXATOK=0
124 ;I BSDXTYPED="" S BSDXATOK=1
125 ;E D
126 ;. F J=1:1:$L(BSDXTYPED,"|") I BSDXATID=$P(BSDXTYPED,"|",J) S BSDXATOK=1 Q
127 ;Q:'BSDXATOK
128 ;
129 ;I +BSDXSRCH
130 ;Screen for Weekday
131 ;
132 ;Screen for AM PM
133 ;
134 S BSDXZ=""
135 S BSDXNSTART=$P(BSDXNOD,U,2)
136 S BSDXNEND=$P(BSDXNOD,U,3)
137 I BSDXNEND'>BSDXSTART Q ;End is less than start
138 I +BSDXBS=0 S BSDXBS=$P(BSDXNOD,U,2) ;First block start time
139 F BSDXQ=2:1:3 D ;Start and End times
140 . S Y=$P(BSDXNOD,U,BSDXQ)
141 . X ^DD("DD") S Y=$TR(Y,"@"," ")
142 . S BSDXZ=BSDXZ_Y_"^"
143 S BSDXZ=BSDXZ_$P(BSDXNOD,U,4)_"^" ;SLOTS
144 S BSDXZ=BSDXZ_BSDXRESN_"^" ;Resource name
145 S BSDXZ=BSDXZ_BSDXATID_"^" ;Access type ID
146 S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAB(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D
147 . S BSDXNOT=BSDXNOT_$G(^BSDXAB(BSDXAD,1,BSDXQ,0))_" "
148 S BSDXZ=BSDXZ_BSDXNOT ;_"^"
149 ;I '+BSDXSRCH,BSDXPEND,BSDXNSTART>BSDXPEND D ;Fill in gap between appointment
150 I BSDXPEND,BSDXNSTART>BSDXPEND D ;Fill in gap between appointment
151 . S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ")
152 . S BSDXTMP=Y
153 . S Y=BSDXNSTART X ^DD("DD") S Y=$TR(Y,"@"," ")
154 . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
155 . S ^BSDXTMP($J,BSDXI-1)=BSDXTMP
156 S BSDXPEND=BSDXNEND
157 S ^BSDXTMP($J,BSDXI)=BSDXZ_"^"_BSDXAD_$C(30)
158 S BSDXI=BSDXI+2
159 S BSDXALO=1 ;At Least One record will be returned
160 Q
Note: See TracBrowser for help on using the repository browser.