source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARC03.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1PRSARC03 ;WOIFO/JAH - Recess Tracking Functions ;10/25/06
2 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5NEWSTART(OUT,PRSDT) ; change alternate work schedule start date.
6 ;
7 N FD,LD,ALLFY,GOOD,LINE,LISTI
8 S OUT=0
9 S FD=$P(PRSFYRNG,U,1)
10 S LD=$P(PRSFYRNG,U,2)
11 S ALLFY=$$ALLFYAWS^PRSARC04()
12 I ALLFY<0 S OUT=1 Q
13 I ALLFY=1 D
14 . S PRSDT=$P(PRSFY,U,5)
15 E D
16 . S PRSDT=$$AWSTART(FD,LD,"Enter Date 9 mo. AWS begins")
17 . I PRSDT'>0 S OUT=1
18 Q:OUT
19 ; convert start to 1st day of pp and
20 ; update the PRSFY var with new start date info
21 N D1,DAY S D1=PRSDT D PP^PRSAPPU
22 I DAY'=1 N X1,X2,X,%H S X1=D1,X2=-(DAY-1) D C^%DTC S PRSDT=X
23 S $P(PRSFY,U,12)=PPE
24 S $P(PRSFY,U,10)=$E(PRSDT,4,5)_"/"_$E(PRSDT,6,7)_"/"_$E(PRSDT,2,3)
25 S $P(PRSFY,U,11)=PRSDT
26 ;
27 ;
28 S PRSFSCYR=$$GETFSCYR^PRSARC04(PRSDT)
29 I PRSDT<2006 S OUT=1
30 ;
31 ;GET total available hours based on fiscal year and start date.
32 ;
33 S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
34 ;
35 ; clean out old list data and rebuild everything
36 ;
37 D CLEAN^VALM10
38 S (LISTI,LINE)=0
39 K ^TMP("PRSARC",$J) ; array-all items in list, incl. non selectable
40 ; items such as month headings.
41 K ^TMP("PRSLI",$J) ; index of all selectable items in the list.
42 K ^TMP("PRSSW",$J) ; index of items selected as recess weeks.
43 K ^TMP("PRSRW",$J) ; index of recess weeks with hours.
44 D MAIN^PRSARC06(.PRSLSTRT,.LISTI,.LINE,PRSDT,PRSFYRNG)
45 D HDR^PRSARC
46 S PRSWKLST=LISTI-1
47 S VALMCNT=LINE
48 ;
49 Q
50 ;
51AWSTART(FD,LD,PROMPT) ;function returns date within range FD-LD using PROMPT.
52 ;
53 ; since %DT will not restrict the valid date to a range we can use
54 ; %DT to create the lower bound and then check the upper bound
55 ; after exit from %DT. range is first and last day of FY.
56 N PRSDT,Y,DIRUT,DIR,X
57 S DIR("A")=PROMPT
58 S DIR(0)="D^"_FD_":"_LD_":EX"
59 D ^DIR
60 S PRSDT=Y
61 I $D(DIRUT) S PRSDT=0
62 Q PRSDT
63 ;
64FYRDATA(RWIEN) ; build a record of data for the Fiscal Year Recess for the viewer
65 ; INPUT: Recess record IEN
66 ;
67 ; OUTPUT: SELFY-selected fiscal year data (11 ^ piece string)
68 ; 1) 4 digit yr 2) ex.FY06-07 3) external 1st day
69 ; 4) external last day 5) FM 1st day 6) FM last day
70 ; 7) first pp 8) last pp 9) 458.8 IEN if exists
71 ; 10) ext AWS start date 11) FM date AWS start
72 ; 12) AWS start pay period
73 ;
74 N NODE3,FY,RANGE,ST,EN,EXTRANGE,FYE,X,Y,EXTSTDT,SELFY,STDT
75 S NODE3=$G(^PRST(458.8,RWIEN,3))
76 S FY=$P(NODE3,U,1)
77 S RANGE=$$FYDAYS^PRSARC04(FY)
78 S ST=$P(RANGE,U)
79 S EN=$P(RANGE,U,2)
80 S ST=$E(ST,4,5)_"/"_$E(ST,6,7)_"/"_$E(ST,2,3)
81 S EN=$E(EN,4,5)_"/"_$E(EN,6,7)_"/"_$E(EN,2,3)
82 S EXTRANGE=ST_U_EN
83 S FYE=$$GETFSCYR^PRSARC04(FY-1700_"0101")
84 S SELFY=FY_U_$P(FYE,U,3)_U_EXTRANGE_U_RANGE
85 S X=$P(NODE3,U,2)
86 D ^%DT
87 S STDT=Y
88 N D1,DAY S D1=STDT D PP^PRSAPPU
89 S EXTSTDT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
90 S SELFY=SELFY_U_RWIEN_U_EXTSTDT_U_STDT_U_PPE
91 Q SELFY
92VWMSG(MSG) ; roll and scroll message from listmanager call.
93 D FULL^VALM1
94 I MSG=1 D
95 . W !!,"This is a view only option. You may not make any changes to the"
96 . W !,"recess schedule. The Recess Hours Summary action is available.",!
97 . S OUT=$$ASK^PRSLIB00(1)
98 E D
99 . I 'PRSVIEW W !!,"Recess Schedule not saved." S OUT=$$ASK^PRSLIB00(1)
100 Q
101OTHERHRS(CTHW1,CTHW2,PRSNURSE) ; are any tour hours selected different than
102 ; current tour hours.
103 N ITEM,D1,TH,MISMATCH,K,PP4Y,PPE,PPI,Y,DAY,W1TMP,W2TMP
104 S (MISMATCH,ITEM)=0
105 F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0!MISMATCH D
106 . ; Get item out of selectable items index
107 . S D1=$G(WKSFM(ITEM)) D PP^PRSAPPU
108 . I $G(PPI)>0 D
109 .. K TH D TOURHRS^PRSARC07(.TH,PPI,PRSNURSE,"")
110 .. S W1TMP=$G(TH("W1"))
111 .. S W2TMP=$G(TH("W2"))
112 .. I W1TMP>0,W1TMP'=CTHW1 S MISMATCH=1 Q
113 .. I W2TMP>0,W2TMP'=CTHW2 S MISMATCH=1 Q
114 Q MISMATCH
115 ;
116GETFLWKS(IEN,PRSDT) ; Get weeks/recess hours from 458.8 and any posted recess
117 ; by way of the TT8b string. Update the list columns.
118 ;
119 ; INPUT: IEN from file 458.8
120 ;
121 N RW,RWDATA,REW,RWD1,D1,TMPDT,LSTITEM,RH,PPI,STR8B,PAD,RCPOSTED
122 N X1,X2,X,%H S X1=PRSDT,X2=-1 D C^%DTC S TMPDT=X
123 ;
124 F S TMPDT=$O(^PRST(458.8,IEN,1,"AC",TMPDT)) Q:TMPDT'>0 D
125 . S RW=$O(^PRST(458.8,IEN,1,"AC",TMPDT,0))
126 . S RWDATA=^PRST(458.8,IEN,1,RW,0)
127 . S RH=$P(RWDATA,U,2)
128 . S RWD1=$P(RWDATA,U,3)
129 . S REW=$P(RWDATA,U,4)
130 . ; Get item number for week out of selectable items index
131 . S LSTITEM=$G(^TMP("PRSLI",$J,+RWDATA))
132 . D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$J($P(RWDATA,U,2),15,2))
133 . D FLDCTRL^VALM10(LSTITEM,"RECESS HOURS",,,1)
134 . S ^TMP("PRSRW",$J,+RWDATA)=LSTITEM_U_RH_U_RWD1_U_REW
135 ;D RPOSTED
136 Q
137RPOSTED ; Get weeks posted
138 ; get 8b from 5 node unless corrected timecard--then re decomp
139 ;
140 N WKDT,RW,STARTDT,STR8B,PAD,RCPOSTED,LSTITEM,RW
141 S STARTDT=PRSDT
142 N X1,X2,X,%H S X1=PRSDT,X2=-1 D C^%DTC S WKDT=X
143 F S WKDT=$O(FMWKS(WKDT)) Q:WKDT'>0 D
144 . S RW=$G(FMWKS(WKDT))
145 . S PPI=+$G(^PRST(458,"AD",WKDT))
146 . Q:PPI'>0
147 . S STR8B=$$GET8B^PRSPUT3(PPI,+PRSNURSE)
148 .; pad 8B for function
149 . S PAD="12345678901234567890123456789012"
150 . S RCPOSTED=$$CD8B^PRSU1B2(PAD_STR8B,"RS^3^RN^3",1)
151 . S RCPOSTED=$P(RCPOSTED,U,$S(RW#2:1,1:2))
152 . Q:RCPOSTED'>0
153 . S LSTITEM=$G(^TMP("PRSLI",$J,RW))
154 . D FLDTEXT^VALM10(LSTITEM,"RECESS POSTED",$J(RCPOSTED,7,2))
155 . I +$G(^TMP("PRSRW",$J,+RW)) D
156 .. S $P(^TMP("PRSRW",$J,+RW),U,5)=RCPOSTED
157 . E D
158 .. S ^TMP("PRSRW",$J,RW)=LSTITEM_U_U_U_U_RCPOSTED
159 Q
160EVEODDWK(ODD,EVEN) ; CHECK SELECTION INDEX FOR ODD AND EVEN PP WEEKS
161 N ITEM
162 S (ODD,EVEN)=0
163 S ITEM=0
164 F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0!(ODD&EVEN) D
165 . I ITEM#2 S ODD=1
166 . E S EVEN=1
167 Q
168CHANGE(IEN) ; funtion true if file record is different than current data
169 ;
170 S VALMBCK="R"
171 Q:$G(IEN)'>0 0
172 N RW,RWDATA,REW,RH,RWD1,PRSFILED,ITEM,PRSLIST,WK
173 S RW=0,PRSFILED="",PRSLIST=""
174 F S RW=$O(^PRST(458.8,IEN,1,RW)) Q:RW'>0 D
175 . S RWDATA=^PRST(458.8,IEN,1,RW,0)
176 . S WK=+RWDATA
177 . S RH=$P(RWDATA,U,2)
178 . S RWD1=$P(RWDATA,U,3)
179 . S REW=$P(RWDATA,U,4)
180 . S PRSFILED=PRSFILED_WK_U_RH_U
181 ;
182 S ITEM=0
183 F S ITEM=$O(^TMP("PRSRW",$J,ITEM)) Q:ITEM'>0 D
184 . S RH=$P(^TMP("PRSRW",$J,ITEM),U,2)
185 . I RH>0 S PRSLIST=PRSLIST_ITEM_U_RH_U
186 Q PRSFILED'=PRSLIST
187 ;==================================================================
188 ;
189SETRECES ;SET HOURS FOR A WEEK AT A TIME
190 ;
191 S VALMBCK="R"
192 I $G(PRSVIEW) D VWMSG^PRSARC03(1) Q
193 ;
194 N LSTITEM,CTRH1
195 N ITEM,Y,RH1,RH2,OUT,HRSLEFT,HRDEFALT,CRH,TOURHRS,D1,PPI,PPE
196 ;
197 S VALMBCK="R"
198 D SELRWK^PRSARC01("X",.OUT)
199 Q:OUT
200 ;get remaining hours to schedule for FY
201 ;
202 S (CRH,ITEM)=0
203 F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0!OUT D
204 . S D1=$G(WKSFM(ITEM)) D PP^PRSAPPU
205 . N TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
206 . S CTRH1=+TH("W1"),CTRH2=+TH("W2")
207 . S TOURHRS=$S(ITEM#2:CTRH1,1:CTRH2)
208 . S HRSLEFT=$$HRSLEFT()
209 . S CRH=+$P($G(^TMP("PRSRW",$J,ITEM)),U,2)
210 . I HRSLEFT+CRH<TOURHRS D
211 .. S HRDEFALT=HRSLEFT+CRH
212 . E D
213 .. S HRDEFALT=TOURHRS
214 . I HRDEFALT<0 S HRDEFALT=0
215 . N DIRUT,DIR,Y,VALID
216 . S DIR(0)="N^0:72:2"
217 . S DIR("B")=HRDEFALT
218 . W !,"Recess hours remaining to schedule: ",HRSLEFT,!
219 . S DIR("A")="Enter recess hours for week "_ITEM
220 . S VALID=0
221 . F D Q:VALID!OUT
222 .. D ^DIR
223 .. I (+Y#.25)=0 S VALID=1
224 .. I +Y=0 S Y=""
225 .. S RH=Y
226 .. I $D(DIRUT) S OUT=1,RH=CRH
227 . ; Get item from selectable index
228 . S LSTITEM=$G(^TMP("PRSSW",$J,ITEM))
229 . D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$J(RH,15,2))
230 .;
231 .; set hrs for selected weeks, remove from array if zero
232 .;
233 . I RH'>0 D
234 .. K ^TMP("PRSRW",$J,ITEM)
235 . E D
236 .. S $P(^TMP("PRSRW",$J,ITEM),U,2)=RH
237 .. S $P(^TMP("PRSRW",$J,ITEM),U,3)=$G(WKSFM(ITEM))
238 .. S $P(^TMP("PRSRW",$J,ITEM),U,4)=0
239 ;
240 D DSELALL^PRSARC01
241 S VALMBCK="R"
242 Q
243 ;====================
244HRSLEFT() ; Get remaining hours available for recess for the FY
245 ;
246 N TRHA,WK,HRSWK,HRSUSED,PRSRWHRS
247 S (WK,HRSUSED)=0
248 F S WK=$O(^TMP("PRSRW",$J,WK)) Q:WK'>0 D
249 . ; Get item out of recess weeks items index
250 . S HRSWK=$P(^TMP("PRSRW",$J,WK),U,2)
251 . S HRSUSED=HRSUSED+HRSWK
252 S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
253 S TRHA=$P($G(PRSRWHRS),U,2)
254 Q TRHA-HRSUSED
255 ;
256HRSFILED(IEN) ; funtion returns number of recess hours on file
257 ;
258 N RW,RWDATA,RH,HRSFILED
259 S HRSFILED=0
260 Q:$G(IEN)'>0 HRSFILED
261 S RW=0,PRSFILED="",PRSLIST=""
262 F S RW=$O(^PRST(458.8,IEN,1,RW)) Q:RW'>0 D
263 . S RWDATA=^PRST(458.8,IEN,1,RW,0)
264 . S RH=$P(RWDATA,U,2)
265 . S HRSFILED=HRSFILED+RH
266 Q HRSFILED
267 ;==================================================================
268 ;
Note: See TracBrowser for help on using the repository browser.