- 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 Feb 18, 2025@23:50:37 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 ;