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

Last change on this file since 1581 was 1563, checked in by Tariq Hamkari, 12 years ago

updated the BSDX version to 1.7

  • fix "BSDX01.m" routine , it was take too long time to retrieve patient radiology exams.
File size: 5.8 KB
Line 
1BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:15am
2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
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.