source: Scheduling/branches/Radiology-Support/m/BSDX04.m@ 1165

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

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