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

Last change on this file since 953 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: 5.3 KB
Line 
1BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm
2 ;;1.4;BSDX;;Sep 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.