PRSARC03 ;WOIFO/JAH - Recess Tracking Functions ;10/25/06
;;4.0;PAID;**112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
NEWSTART(OUT,PRSDT) ; change alternate work schedule start date.
;
N FD,LD,ALLFY,GOOD,LINE,LISTI
S OUT=0
S FD=$P(PRSFYRNG,U,1)
S LD=$P(PRSFYRNG,U,2)
S ALLFY=$$ALLFYAWS^PRSARC04()
I ALLFY<0 S OUT=1 Q
I ALLFY=1 D
. S PRSDT=$P(PRSFY,U,5)
E D
. S PRSDT=$$AWSTART(FD,LD,"Enter Date 9 mo. AWS begins")
. I PRSDT'>0 S OUT=1
Q:OUT
; convert start to 1st day of pp and
; update the PRSFY var with new start date info
N D1,DAY S D1=PRSDT D PP^PRSAPPU
I DAY'=1 N X1,X2,X,%H S X1=D1,X2=-(DAY-1) D C^%DTC S PRSDT=X
S $P(PRSFY,U,12)=PPE
S $P(PRSFY,U,10)=$E(PRSDT,4,5)_"/"_$E(PRSDT,6,7)_"/"_$E(PRSDT,2,3)
S $P(PRSFY,U,11)=PRSDT
;
;
S PRSFSCYR=$$GETFSCYR^PRSARC04(PRSDT)
I PRSDT<2006 S OUT=1
;
;GET total available hours based on fiscal year and start date.
;
S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
;
; clean out old list data and rebuild everything
;
D CLEAN^VALM10
S (LISTI,LINE)=0
K ^TMP("PRSARC",$J) ; array-all items in list, incl. non selectable
; items such as month headings.
K ^TMP("PRSLI",$J) ; index of all selectable items in the list.
K ^TMP("PRSSW",$J) ; index of items selected as recess weeks.
K ^TMP("PRSRW",$J) ; index of recess weeks with hours.
D MAIN^PRSARC06(.PRSLSTRT,.LISTI,.LINE,PRSDT,PRSFYRNG)
D HDR^PRSARC
S PRSWKLST=LISTI-1
S VALMCNT=LINE
;
Q
;
AWSTART(FD,LD,PROMPT) ;function returns date within range FD-LD using PROMPT.
;
; since %DT will not restrict the valid date to a range we can use
; %DT to create the lower bound and then check the upper bound
; after exit from %DT. range is first and last day of FY.
N PRSDT,Y,DIRUT,DIR,X
S DIR("A")=PROMPT
S DIR(0)="D^"_FD_":"_LD_":EX"
D ^DIR
S PRSDT=Y
I $D(DIRUT) S PRSDT=0
Q PRSDT
;
FYRDATA(RWIEN) ; build a record of data for the Fiscal Year Recess for the viewer
; INPUT: Recess record IEN
;
; OUTPUT: SELFY-selected fiscal year data (11 ^ piece string)
; 1) 4 digit yr 2) ex.FY06-07 3) external 1st day
; 4) external last day 5) FM 1st day 6) FM last day
; 7) first pp 8) last pp 9) 458.8 IEN if exists
; 10) ext AWS start date 11) FM date AWS start
; 12) AWS start pay period
;
N NODE3,FY,RANGE,ST,EN,EXTRANGE,FYE,X,Y,EXTSTDT,SELFY,STDT
S NODE3=$G(^PRST(458.8,RWIEN,3))
S FY=$P(NODE3,U,1)
S RANGE=$$FYDAYS^PRSARC04(FY)
S ST=$P(RANGE,U)
S EN=$P(RANGE,U,2)
S ST=$E(ST,4,5)_"/"_$E(ST,6,7)_"/"_$E(ST,2,3)
S EN=$E(EN,4,5)_"/"_$E(EN,6,7)_"/"_$E(EN,2,3)
S EXTRANGE=ST_U_EN
S FYE=$$GETFSCYR^PRSARC04(FY-1700_"0101")
S SELFY=FY_U_$P(FYE,U,3)_U_EXTRANGE_U_RANGE
S X=$P(NODE3,U,2)
D ^%DT
S STDT=Y
N D1,DAY S D1=STDT D PP^PRSAPPU
S EXTSTDT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
S SELFY=SELFY_U_RWIEN_U_EXTSTDT_U_STDT_U_PPE
Q SELFY
VWMSG(MSG) ; roll and scroll message from listmanager call.
D FULL^VALM1
I MSG=1 D
. W !!,"This is a view only option. You may not make any changes to the"
. W !,"recess schedule. The Recess Hours Summary action is available.",!
. S OUT=$$ASK^PRSLIB00(1)
E D
. I 'PRSVIEW W !!,"Recess Schedule not saved." S OUT=$$ASK^PRSLIB00(1)
Q
OTHERHRS(CTHW1,CTHW2,PRSNURSE) ; are any tour hours selected different than
; current tour hours.
N ITEM,D1,TH,MISMATCH,K,PP4Y,PPE,PPI,Y,DAY,W1TMP,W2TMP
S (MISMATCH,ITEM)=0
F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0!MISMATCH D
. ; Get item out of selectable items index
. S D1=$G(WKSFM(ITEM)) D PP^PRSAPPU
. I $G(PPI)>0 D
.. K TH D TOURHRS^PRSARC07(.TH,PPI,PRSNURSE,"")
.. S W1TMP=$G(TH("W1"))
.. S W2TMP=$G(TH("W2"))
.. I W1TMP>0,W1TMP'=CTHW1 S MISMATCH=1 Q
.. I W2TMP>0,W2TMP'=CTHW2 S MISMATCH=1 Q
Q MISMATCH
;
GETFLWKS(IEN,PRSDT) ; Get weeks/recess hours from 458.8 and any posted recess
; by way of the TT8b string. Update the list columns.
;
; INPUT: IEN from file 458.8
;
N RW,RWDATA,REW,RWD1,D1,TMPDT,LSTITEM,RH,PPI,STR8B,PAD,RCPOSTED
N X1,X2,X,%H S X1=PRSDT,X2=-1 D C^%DTC S TMPDT=X
;
F S TMPDT=$O(^PRST(458.8,IEN,1,"AC",TMPDT)) Q:TMPDT'>0 D
. S RW=$O(^PRST(458.8,IEN,1,"AC",TMPDT,0))
. S RWDATA=^PRST(458.8,IEN,1,RW,0)
. S RH=$P(RWDATA,U,2)
. S RWD1=$P(RWDATA,U,3)
. S REW=$P(RWDATA,U,4)
. ; Get item number for week out of selectable items index
. S LSTITEM=$G(^TMP("PRSLI",$J,+RWDATA))
. D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$J($P(RWDATA,U,2),15,2))
. D FLDCTRL^VALM10(LSTITEM,"RECESS HOURS",,,1)
. S ^TMP("PRSRW",$J,+RWDATA)=LSTITEM_U_RH_U_RWD1_U_REW
;D RPOSTED
Q
RPOSTED ; Get weeks posted
; get 8b from 5 node unless corrected timecard--then re decomp
;
N WKDT,RW,STARTDT,STR8B,PAD,RCPOSTED,LSTITEM,RW
S STARTDT=PRSDT
N X1,X2,X,%H S X1=PRSDT,X2=-1 D C^%DTC S WKDT=X
F S WKDT=$O(FMWKS(WKDT)) Q:WKDT'>0 D
. S RW=$G(FMWKS(WKDT))
. S PPI=+$G(^PRST(458,"AD",WKDT))
. Q:PPI'>0
. S STR8B=$$GET8B^PRSPUT3(PPI,+PRSNURSE)
.; pad 8B for function
. S PAD="12345678901234567890123456789012"
. S RCPOSTED=$$CD8B^PRSU1B2(PAD_STR8B,"RS^3^RN^3",1)
. S RCPOSTED=$P(RCPOSTED,U,$S(RW#2:1,1:2))
. Q:RCPOSTED'>0
. S LSTITEM=$G(^TMP("PRSLI",$J,RW))
. D FLDTEXT^VALM10(LSTITEM,"RECESS POSTED",$J(RCPOSTED,7,2))
. I +$G(^TMP("PRSRW",$J,+RW)) D
.. S $P(^TMP("PRSRW",$J,+RW),U,5)=RCPOSTED
. E D
.. S ^TMP("PRSRW",$J,RW)=LSTITEM_U_U_U_U_RCPOSTED
Q
EVEODDWK(ODD,EVEN) ; CHECK SELECTION INDEX FOR ODD AND EVEN PP WEEKS
N ITEM
S (ODD,EVEN)=0
S ITEM=0
F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0!(ODD&EVEN) D
. I ITEM#2 S ODD=1
. E S EVEN=1
Q
CHANGE(IEN) ; funtion true if file record is different than current data
;
S VALMBCK="R"
Q:$G(IEN)'>0 0
N RW,RWDATA,REW,RH,RWD1,PRSFILED,ITEM,PRSLIST,WK
S RW=0,PRSFILED="",PRSLIST=""
F S RW=$O(^PRST(458.8,IEN,1,RW)) Q:RW'>0 D
. S RWDATA=^PRST(458.8,IEN,1,RW,0)
. S WK=+RWDATA
. S RH=$P(RWDATA,U,2)
. S RWD1=$P(RWDATA,U,3)
. S REW=$P(RWDATA,U,4)
. S PRSFILED=PRSFILED_WK_U_RH_U
;
S ITEM=0
F S ITEM=$O(^TMP("PRSRW",$J,ITEM)) Q:ITEM'>0 D
. S RH=$P(^TMP("PRSRW",$J,ITEM),U,2)
. I RH>0 S PRSLIST=PRSLIST_ITEM_U_RH_U
Q PRSFILED'=PRSLIST
;==================================================================
;
SETRECES ;SET HOURS FOR A WEEK AT A TIME
;
S VALMBCK="R"
I $G(PRSVIEW) D VWMSG^PRSARC03(1) Q
;
N LSTITEM,CTRH1
N ITEM,Y,RH1,RH2,OUT,HRSLEFT,HRDEFALT,CRH,TOURHRS,D1,PPI,PPE
;
S VALMBCK="R"
D SELRWK^PRSARC01("X",.OUT)
Q:OUT
;get remaining hours to schedule for FY
;
S (CRH,ITEM)=0
F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0!OUT D
. S D1=$G(WKSFM(ITEM)) D PP^PRSAPPU
. N TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
. S CTRH1=+TH("W1"),CTRH2=+TH("W2")
. S TOURHRS=$S(ITEM#2:CTRH1,1:CTRH2)
. S HRSLEFT=$$HRSLEFT()
. S CRH=+$P($G(^TMP("PRSRW",$J,ITEM)),U,2)
. I HRSLEFT+CRH<TOURHRS D
.. S HRDEFALT=HRSLEFT+CRH
. E D
.. S HRDEFALT=TOURHRS
. I HRDEFALT<0 S HRDEFALT=0
. N DIRUT,DIR,Y,VALID
. S DIR(0)="N^0:72:2"
. S DIR("B")=HRDEFALT
. W !,"Recess hours remaining to schedule: ",HRSLEFT,!
. S DIR("A")="Enter recess hours for week "_ITEM
. S VALID=0
. F D Q:VALID!OUT
.. D ^DIR
.. I (+Y#.25)=0 S VALID=1
.. I +Y=0 S Y=""
.. S RH=Y
.. I $D(DIRUT) S OUT=1,RH=CRH
. ; Get item from selectable index
. S LSTITEM=$G(^TMP("PRSSW",$J,ITEM))
. D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$J(RH,15,2))
.;
.; set hrs for selected weeks, remove from array if zero
.;
. I RH'>0 D
.. K ^TMP("PRSRW",$J,ITEM)
. E D
.. S $P(^TMP("PRSRW",$J,ITEM),U,2)=RH
.. S $P(^TMP("PRSRW",$J,ITEM),U,3)=$G(WKSFM(ITEM))
.. S $P(^TMP("PRSRW",$J,ITEM),U,4)=0
;
D DSELALL^PRSARC01
S VALMBCK="R"
Q
;====================
HRSLEFT() ; Get remaining hours available for recess for the FY
;
N TRHA,WK,HRSWK,HRSUSED,PRSRWHRS
S (WK,HRSUSED)=0
F S WK=$O(^TMP("PRSRW",$J,WK)) Q:WK'>0 D
. ; Get item out of recess weeks items index
. S HRSWK=$P(^TMP("PRSRW",$J,WK),U,2)
. S HRSUSED=HRSUSED+HRSWK
S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
S TRHA=$P($G(PRSRWHRS),U,2)
Q TRHA-HRSUSED
;
HRSFILED(IEN) ; funtion returns number of recess hours on file
;
N RW,RWDATA,RH,HRSFILED
S HRSFILED=0
Q:$G(IEN)'>0 HRSFILED
S RW=0,PRSFILED="",PRSLIST=""
F S RW=$O(^PRST(458.8,IEN,1,RW)) Q:RW'>0 D
. S RWDATA=^PRST(458.8,IEN,1,RW,0)
. S RH=$P(RWDATA,U,2)
. S HRSFILED=HRSFILED+RH
Q HRSFILED
;==================================================================
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSARC03 8744 printed Apr 09, 2024@21:29:55 Page 2
PRSARC03 ;WOIFO/JAH - Recess Tracking Functions ;10/25/06
+1 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
NEWSTART(OUT,PRSDT) ; change alternate work schedule start date.
+1 ;
+2 NEW FD,LD,ALLFY,GOOD,LINE,LISTI
+3 SET OUT=0
+4 SET FD=$PIECE(PRSFYRNG,U,1)
+5 SET LD=$PIECE(PRSFYRNG,U,2)
+6 SET ALLFY=$$ALLFYAWS^PRSARC04()
+7 IF ALLFY<0
SET OUT=1
QUIT
+8 IF ALLFY=1
Begin DoDot:1
+9 SET PRSDT=$PIECE(PRSFY,U,5)
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET PRSDT=$$AWSTART(FD,LD,"Enter Date 9 mo. AWS begins")
+12 IF PRSDT'>0
SET OUT=1
End DoDot:1
+13 if OUT
QUIT
+14 ; convert start to 1st day of pp and
+15 ; update the PRSFY var with new start date info
+16 NEW D1,DAY
SET D1=PRSDT
DO PP^PRSAPPU
+17 IF DAY'=1
NEW X1,X2,X,%H
SET X1=D1
SET X2=-(DAY-1)
DO C^%DTC
SET PRSDT=X
+18 SET $PIECE(PRSFY,U,12)=PPE
+19 SET $PIECE(PRSFY,U,10)=$EXTRACT(PRSDT,4,5)_"/"_$EXTRACT(PRSDT,6,7)_"/"_$EXTRACT(PRSDT,2,3)
+20 SET $PIECE(PRSFY,U,11)=PRSDT
+21 ;
+22 ;
+23 SET PRSFSCYR=$$GETFSCYR^PRSARC04(PRSDT)
+24 IF PRSDT<2006
SET OUT=1
+25 ;
+26 ;GET total available hours based on fiscal year and start date.
+27 ;
+28 SET PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
+29 ;
+30 ; clean out old list data and rebuild everything
+31 ;
+32 DO CLEAN^VALM10
+33 SET (LISTI,LINE)=0
+34 ; array-all items in list, incl. non selectable
KILL ^TMP("PRSARC",$JOB)
+35 ; items such as month headings.
+36 ; index of all selectable items in the list.
KILL ^TMP("PRSLI",$JOB)
+37 ; index of items selected as recess weeks.
KILL ^TMP("PRSSW",$JOB)
+38 ; index of recess weeks with hours.
KILL ^TMP("PRSRW",$JOB)
+39 DO MAIN^PRSARC06(.PRSLSTRT,.LISTI,.LINE,PRSDT,PRSFYRNG)
+40 DO HDR^PRSARC
+41 SET PRSWKLST=LISTI-1
+42 SET VALMCNT=LINE
+43 ;
+44 QUIT
+45 ;
AWSTART(FD,LD,PROMPT) ;function returns date within range FD-LD using PROMPT.
+1 ;
+2 ; since %DT will not restrict the valid date to a range we can use
+3 ; %DT to create the lower bound and then check the upper bound
+4 ; after exit from %DT. range is first and last day of FY.
+5 NEW PRSDT,Y,DIRUT,DIR,X
+6 SET DIR("A")=PROMPT
+7 SET DIR(0)="D^"_FD_":"_LD_":EX"
+8 DO ^DIR
+9 SET PRSDT=Y
+10 IF $DATA(DIRUT)
SET PRSDT=0
+11 QUIT PRSDT
+12 ;
FYRDATA(RWIEN) ; build a record of data for the Fiscal Year Recess for the viewer
+1 ; INPUT: Recess record IEN
+2 ;
+3 ; OUTPUT: SELFY-selected fiscal year data (11 ^ piece string)
+4 ; 1) 4 digit yr 2) ex.FY06-07 3) external 1st day
+5 ; 4) external last day 5) FM 1st day 6) FM last day
+6 ; 7) first pp 8) last pp 9) 458.8 IEN if exists
+7 ; 10) ext AWS start date 11) FM date AWS start
+8 ; 12) AWS start pay period
+9 ;
+10 NEW NODE3,FY,RANGE,ST,EN,EXTRANGE,FYE,X,Y,EXTSTDT,SELFY,STDT
+11 SET NODE3=$GET(^PRST(458.8,RWIEN,3))
+12 SET FY=$PIECE(NODE3,U,1)
+13 SET RANGE=$$FYDAYS^PRSARC04(FY)
+14 SET ST=$PIECE(RANGE,U)
+15 SET EN=$PIECE(RANGE,U,2)
+16 SET ST=$EXTRACT(ST,4,5)_"/"_$EXTRACT(ST,6,7)_"/"_$EXTRACT(ST,2,3)
+17 SET EN=$EXTRACT(EN,4,5)_"/"_$EXTRACT(EN,6,7)_"/"_$EXTRACT(EN,2,3)
+18 SET EXTRANGE=ST_U_EN
+19 SET FYE=$$GETFSCYR^PRSARC04(FY-1700_"0101")
+20 SET SELFY=FY_U_$PIECE(FYE,U,3)_U_EXTRANGE_U_RANGE
+21 SET X=$PIECE(NODE3,U,2)
+22 DO ^%DT
+23 SET STDT=Y
+24 NEW D1,DAY
SET D1=STDT
DO PP^PRSAPPU
+25 SET EXTSTDT=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+26 SET SELFY=SELFY_U_RWIEN_U_EXTSTDT_U_STDT_U_PPE
+27 QUIT SELFY
VWMSG(MSG) ; roll and scroll message from listmanager call.
+1 DO FULL^VALM1
+2 IF MSG=1
Begin DoDot:1
+3 WRITE !!,"This is a view only option. You may not make any changes to the"
+4 WRITE !,"recess schedule. The Recess Hours Summary action is available.",!
+5 SET OUT=$$ASK^PRSLIB00(1)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 IF 'PRSVIEW
WRITE !!,"Recess Schedule not saved."
SET OUT=$$ASK^PRSLIB00(1)
End DoDot:1
+8 QUIT
OTHERHRS(CTHW1,CTHW2,PRSNURSE) ; are any tour hours selected different than
+1 ; current tour hours.
+2 NEW ITEM,D1,TH,MISMATCH,K,PP4Y,PPE,PPI,Y,DAY,W1TMP,W2TMP
+3 SET (MISMATCH,ITEM)=0
+4 FOR
SET ITEM=$ORDER(^TMP("PRSSW",$JOB,ITEM))
if ITEM'>0!MISMATCH
QUIT
Begin DoDot:1
+5 ; Get item out of selectable items index
+6 SET D1=$GET(WKSFM(ITEM))
DO PP^PRSAPPU
+7 IF $GET(PPI)>0
Begin DoDot:2
+8 KILL TH
DO TOURHRS^PRSARC07(.TH,PPI,PRSNURSE,"")
+9 SET W1TMP=$GET(TH("W1"))
+10 SET W2TMP=$GET(TH("W2"))
+11 IF W1TMP>0
IF W1TMP'=CTHW1
SET MISMATCH=1
QUIT
+12 IF W2TMP>0
IF W2TMP'=CTHW2
SET MISMATCH=1
QUIT
End DoDot:2
End DoDot:1
+13 QUIT MISMATCH
+14 ;
GETFLWKS(IEN,PRSDT) ; Get weeks/recess hours from 458.8 and any posted recess
+1 ; by way of the TT8b string. Update the list columns.
+2 ;
+3 ; INPUT: IEN from file 458.8
+4 ;
+5 NEW RW,RWDATA,REW,RWD1,D1,TMPDT,LSTITEM,RH,PPI,STR8B,PAD,RCPOSTED
+6 NEW X1,X2,X,%H
SET X1=PRSDT
SET X2=-1
DO C^%DTC
SET TMPDT=X
+7 ;
+8 FOR
SET TMPDT=$ORDER(^PRST(458.8,IEN,1,"AC",TMPDT))
if TMPDT'>0
QUIT
Begin DoDot:1
+9 SET RW=$ORDER(^PRST(458.8,IEN,1,"AC",TMPDT,0))
+10 SET RWDATA=^PRST(458.8,IEN,1,RW,0)
+11 SET RH=$PIECE(RWDATA,U,2)
+12 SET RWD1=$PIECE(RWDATA,U,3)
+13 SET REW=$PIECE(RWDATA,U,4)
+14 ; Get item number for week out of selectable items index
+15 SET LSTITEM=$GET(^TMP("PRSLI",$JOB,+RWDATA))
+16 DO FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$JUSTIFY($PIECE(RWDATA,U,2),15,2))
+17 DO FLDCTRL^VALM10(LSTITEM,"RECESS HOURS",,,1)
+18 SET ^TMP("PRSRW",$JOB,+RWDATA)=LSTITEM_U_RH_U_RWD1_U_REW
End DoDot:1
+19 ;D RPOSTED
+20 QUIT
RPOSTED ; Get weeks posted
+1 ; get 8b from 5 node unless corrected timecard--then re decomp
+2 ;
+3 NEW WKDT,RW,STARTDT,STR8B,PAD,RCPOSTED,LSTITEM,RW
+4 SET STARTDT=PRSDT
+5 NEW X1,X2,X,%H
SET X1=PRSDT
SET X2=-1
DO C^%DTC
SET WKDT=X
+6 FOR
SET WKDT=$ORDER(FMWKS(WKDT))
if WKDT'>0
QUIT
Begin DoDot:1
+7 SET RW=$GET(FMWKS(WKDT))
+8 SET PPI=+$GET(^PRST(458,"AD",WKDT))
+9 if PPI'>0
QUIT
+10 SET STR8B=$$GET8B^PRSPUT3(PPI,+PRSNURSE)
+11 ; pad 8B for function
+12 SET PAD="12345678901234567890123456789012"
+13 SET RCPOSTED=$$CD8B^PRSU1B2(PAD_STR8B,"RS^3^RN^3",1)
+14 SET RCPOSTED=$PIECE(RCPOSTED,U,$SELECT(RW#2:1,1:2))
+15 if RCPOSTED'>0
QUIT
+16 SET LSTITEM=$GET(^TMP("PRSLI",$JOB,RW))
+17 DO FLDTEXT^VALM10(LSTITEM,"RECESS POSTED",$JUSTIFY(RCPOSTED,7,2))
+18 IF +$GET(^TMP("PRSRW",$JOB,+RW))
Begin DoDot:2
+19 SET $PIECE(^TMP("PRSRW",$JOB,+RW),U,5)=RCPOSTED
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 SET ^TMP("PRSRW",$JOB,RW)=LSTITEM_U_U_U_U_RCPOSTED
End DoDot:2
End DoDot:1
+22 QUIT
EVEODDWK(ODD,EVEN) ; CHECK SELECTION INDEX FOR ODD AND EVEN PP WEEKS
+1 NEW ITEM
+2 SET (ODD,EVEN)=0
+3 SET ITEM=0
+4 FOR
SET ITEM=$ORDER(^TMP("PRSSW",$JOB,ITEM))
if ITEM'>0!(ODD&EVEN)
QUIT
Begin DoDot:1
+5 IF ITEM#2
SET ODD=1
+6 IF '$TEST
SET EVEN=1
End DoDot:1
+7 QUIT
CHANGE(IEN) ; funtion true if file record is different than current data
+1 ;
+2 SET VALMBCK="R"
+3 if $GET(IEN)'>0
QUIT 0
+4 NEW RW,RWDATA,REW,RH,RWD1,PRSFILED,ITEM,PRSLIST,WK
+5 SET RW=0
SET PRSFILED=""
SET PRSLIST=""
+6 FOR
SET RW=$ORDER(^PRST(458.8,IEN,1,RW))
if RW'>0
QUIT
Begin DoDot:1
+7 SET RWDATA=^PRST(458.8,IEN,1,RW,0)
+8 SET WK=+RWDATA
+9 SET RH=$PIECE(RWDATA,U,2)
+10 SET RWD1=$PIECE(RWDATA,U,3)
+11 SET REW=$PIECE(RWDATA,U,4)
+12 SET PRSFILED=PRSFILED_WK_U_RH_U
End DoDot:1
+13 ;
+14 SET ITEM=0
+15 FOR
SET ITEM=$ORDER(^TMP("PRSRW",$JOB,ITEM))
if ITEM'>0
QUIT
Begin DoDot:1
+16 SET RH=$PIECE(^TMP("PRSRW",$JOB,ITEM),U,2)
+17 IF RH>0
SET PRSLIST=PRSLIST_ITEM_U_RH_U
End DoDot:1
+18 QUIT PRSFILED'=PRSLIST
+19 ;==================================================================
+20 ;
SETRECES ;SET HOURS FOR A WEEK AT A TIME
+1 ;
+2 SET VALMBCK="R"
+3 IF $GET(PRSVIEW)
DO VWMSG^PRSARC03(1)
QUIT
+4 ;
+5 NEW LSTITEM,CTRH1
+6 NEW ITEM,Y,RH1,RH2,OUT,HRSLEFT,HRDEFALT,CRH,TOURHRS,D1,PPI,PPE
+7 ;
+8 SET VALMBCK="R"
+9 DO SELRWK^PRSARC01("X",.OUT)
+10 if OUT
QUIT
+11 ;get remaining hours to schedule for FY
+12 ;
+13 SET (CRH,ITEM)=0
+14 FOR
SET ITEM=$ORDER(^TMP("PRSSW",$JOB,ITEM))
if ITEM'>0!OUT
QUIT
Begin DoDot:1
+15 SET D1=$GET(WKSFM(ITEM))
DO PP^PRSAPPU
+16 NEW TH
DO TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
+17 SET CTRH1=+TH("W1")
SET CTRH2=+TH("W2")
+18 SET TOURHRS=$SELECT(ITEM#2:CTRH1,1:CTRH2)
+19 SET HRSLEFT=$$HRSLEFT()
+20 SET CRH=+$PIECE($GET(^TMP("PRSRW",$JOB,ITEM)),U,2)
+21 IF HRSLEFT+CRH<TOURHRS
Begin DoDot:2
+22 SET HRDEFALT=HRSLEFT+CRH
End DoDot:2
+23 IF '$TEST
Begin DoDot:2
+24 SET HRDEFALT=TOURHRS
End DoDot:2
+25 IF HRDEFALT<0
SET HRDEFALT=0
+26 NEW DIRUT,DIR,Y,VALID
+27 SET DIR(0)="N^0:72:2"
+28 SET DIR("B")=HRDEFALT
+29 WRITE !,"Recess hours remaining to schedule: ",HRSLEFT,!
+30 SET DIR("A")="Enter recess hours for week "_ITEM
+31 SET VALID=0
+32 FOR
Begin DoDot:2
+33 DO ^DIR
+34 IF (+Y#.25)=0
SET VALID=1
+35 IF +Y=0
SET Y=""
+36 SET RH=Y
+37 IF $DATA(DIRUT)
SET OUT=1
SET RH=CRH
End DoDot:2
if VALID!OUT
QUIT
+38 ; Get item from selectable index
+39 SET LSTITEM=$GET(^TMP("PRSSW",$JOB,ITEM))
+40 DO FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$JUSTIFY(RH,15,2))
+41 ;
+42 ; set hrs for selected weeks, remove from array if zero
+43 ;
+44 IF RH'>0
Begin DoDot:2
+45 KILL ^TMP("PRSRW",$JOB,ITEM)
End DoDot:2
+46 IF '$TEST
Begin DoDot:2
+47 SET $PIECE(^TMP("PRSRW",$JOB,ITEM),U,2)=RH
+48 SET $PIECE(^TMP("PRSRW",$JOB,ITEM),U,3)=$GET(WKSFM(ITEM))
+49 SET $PIECE(^TMP("PRSRW",$JOB,ITEM),U,4)=0
End DoDot:2
End DoDot:1
+50 ;
+51 DO DSELALL^PRSARC01
+52 SET VALMBCK="R"
+53 QUIT
+54 ;====================
HRSLEFT() ; Get remaining hours available for recess for the FY
+1 ;
+2 NEW TRHA,WK,HRSWK,HRSUSED,PRSRWHRS
+3 SET (WK,HRSUSED)=0
+4 FOR
SET WK=$ORDER(^TMP("PRSRW",$JOB,WK))
if WK'>0
QUIT
Begin DoDot:1
+5 ; Get item out of recess weeks items index
+6 SET HRSWK=$PIECE(^TMP("PRSRW",$JOB,WK),U,2)
+7 SET HRSUSED=HRSUSED+HRSWK
End DoDot:1
+8 SET PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
+9 SET TRHA=$PIECE($GET(PRSRWHRS),U,2)
+10 QUIT TRHA-HRSUSED
+11 ;
HRSFILED(IEN) ; funtion returns number of recess hours on file
+1 ;
+2 NEW RW,RWDATA,RH,HRSFILED
+3 SET HRSFILED=0
+4 if $GET(IEN)'>0
QUIT HRSFILED
+5 SET RW=0
SET PRSFILED=""
SET PRSLIST=""
+6 FOR
SET RW=$ORDER(^PRST(458.8,IEN,1,RW))
if RW'>0
QUIT
Begin DoDot:1
+7 SET RWDATA=^PRST(458.8,IEN,1,RW,0)
+8 SET RH=$PIECE(RWDATA,U,2)
+9 SET HRSFILED=HRSFILED+RH
End DoDot:1
+10 QUIT HRSFILED
+11 ;==================================================================
+12 ;
