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

Last change on this file since 700 was 614, checked in by Sam Habiel, 15 years ago

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