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

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

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