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

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

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