| [613] | 1 | PRSARC03 ;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
|
|---|
| 5 | NEWSTART(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 | ;
|
|---|
| 51 | AWSTART(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 | ;
|
|---|
| 64 | FYRDATA(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
|
|---|
| 92 | VWMSG(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
|
|---|
| 101 | OTHERHRS(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 | ;
|
|---|
| 116 | GETFLWKS(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
|
|---|
| 137 | RPOSTED ; 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
|
|---|
| 160 | EVEODDWK(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
|
|---|
| 168 | CHANGE(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 | ;
|
|---|
| 189 | SETRECES ;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 | ;====================
|
|---|
| 244 | HRSLEFT() ; 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 | ;
|
|---|
| 256 | HRSFILED(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 | ;
|
|---|
