PRSARCS ;;WOIFO/JAH - Recess Tracking Functions ;02-MAR-2007
;;4.0;PAID;**112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
EN ;
S PRSHDR="9 Mo. AWS Recess Summary for "_$P(PRSFSCYR,U,2)_" AWS Start Date: "_$P(PRSFY,U,10)_" (pp "_$P(PRSFY,U,12)_")"
S PRSHDR2=$G(VALMHDR(2))
D EN^VALM("PRSA RECESS SUMMARY")
S VALMBCK="R"
Q
HDR ; -- header code
S VALMHDR(1)=PRSHDR
S VALMHDR(2)=PRSHDR2
Q
;
INIT ; -- init variables and list array
; hours based on 25% of AWS schedule--total assigned and available hrs
; and hours available to be assigned to weeks.
;
N TRWA,TRHA,RRHA,OUT,RCNT,ED1,TEXT,WD1,WK,HRSWK,HRSUSED,TOTWKS,HRSPOST
N HRSPSTOT,DEC
S (WK,HRSUSED,RCNT,HRSPSTOT)=0
S VALMCNT=0
F S WK=$O(^TMP("PRSRW",$J,WK)) Q:WK'>0 D
. ; Get item out of recess weeks items index
. S VALMCNT=VALMCNT+1
. S WD1=$G(WKSFM(WK)),ED1=$E(WD1,4,5)_"/"_$E(WD1,6,7)_"/"_$E(WD1,2,3)
. S HRSWK=$P(^TMP("PRSRW",$J,WK),U,2)
. I HRSWK>0 S RCNT=RCNT+1
. S HRSPOST=$P(^TMP("PRSRW",$J,WK),U,5)
. S HRSPSTOT=HRSPSTOT+HRSPOST
. S HRSUSED=HRSUSED+HRSWK
. S DEC=$S($P(HRSWK,".",2)>0:1,1:0)
. S TEXT=$J(WK,5,0)_" "_ED1_$J(HRSWK,18,2)_$J(HRSPOST,19,2)
. D SET^VALM10(VALMCNT,TEXT)
I RCNT=0 D
. S VALMCNT=VALMCNT+1
. D SET^VALM10(VALMCNT," There are no weeks scheduled with recess hours.")
S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
S TOTWKS=$P($G(PRSRWHRS),U)
S TRHA=$P($G(PRSRWHRS),U,2)
S TRWA=$P($G(PRSRWHRS),U,3)
S RRHA=TRHA-HRSUSED
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT," ====== ======")
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT," Total Recess. Scheduled:"_$J(HRSUSED,7,2)_" Posted:"_$J(HRSPSTOT,7,2))
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT,"")
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT," Total Weeks in AWS FY Schedule: "_$J(TOTWKS,5,2))
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT," Total available FY recess hrs: "_$J(TRHA,6,2)_" ("_TRWA_" weeks)")
S VALMCNT=VALMCNT+1
I RRHA<0 D
. D SET^VALM10(VALMCNT," WARNING--Recess hours over scheduled: "_$J(RRHA,6,2))
. S VALMSG="WARNING--Recess hours are over scheduled: "_$J(RRHA,6,2)
E D
. I RRHA>0 D
.. D SET^VALM10(VALMCNT," WARNING--Recess hours under scheduled: "_$J(RRHA,6,2))
.. S VALMSG="WARNING--Recess hours are under scheduled: "_$J(RRHA,6,2)
. E D
.. D SET^VALM10(VALMCNT," Scheduled recess hours match hours available for recess.")
S VALMBCK="Q"
Q
VALIDRS ; valid recess schedule?
; hours based on 25% of AWS schedule--total assigned and available hrs
; and hours available to be assigned to weeks.
;
; if quitting (PRSOUT=1) check the file, otherwise check what is
; being saved from the PRSRW array.
;
N TRHA,RRHA,OUT,CNT,ED1,WD1,WK,HRSWK,HRSUSED,OUT
I '$G(PRSOUT) D
. 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
E D
. S HRSUSED=$$HRSFILED^PRSARC03($P($G(PRSFY),U,9))
S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
S TRHA=$P($G(PRSRWHRS),U,2)
S RRHA=TRHA-HRSUSED
I RRHA<0 D
. W !,"WARNING--Recess hours are over scheduled: "_$J(-RRHA,6,2)
E D
. I RRHA>0 D
.. W !,"WARNING--Recess hours are under scheduled: "_$J(-RRHA,6,2)
. E D
.. W !,"Scheduled recess hours match hours available for recess."
S OUT=$$ASK^PRSLIB00(1)
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAN^VALM10
K PRSHDR,PRSHDR2
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSARCS 3673 printed Nov 22, 2024@17:34:17 Page 2
PRSARCS ;;WOIFO/JAH - Recess Tracking Functions ;02-MAR-2007
+1 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
EN ;
+1 SET PRSHDR="9 Mo. AWS Recess Summary for "_$PIECE(PRSFSCYR,U,2)_" AWS Start Date: "_$PIECE(PRSFY,U,10)_" (pp "_$PIECE(PRSFY,U,12)_")"
+2 SET PRSHDR2=$GET(VALMHDR(2))
+3 DO EN^VALM("PRSA RECESS SUMMARY")
+4 SET VALMBCK="R"
+5 QUIT
HDR ; -- header code
+1 SET VALMHDR(1)=PRSHDR
+2 SET VALMHDR(2)=PRSHDR2
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 ; hours based on 25% of AWS schedule--total assigned and available hrs
+2 ; and hours available to be assigned to weeks.
+3 ;
+4 NEW TRWA,TRHA,RRHA,OUT,RCNT,ED1,TEXT,WD1,WK,HRSWK,HRSUSED,TOTWKS,HRSPOST
+5 NEW HRSPSTOT,DEC
+6 SET (WK,HRSUSED,RCNT,HRSPSTOT)=0
+7 SET VALMCNT=0
+8 FOR
SET WK=$ORDER(^TMP("PRSRW",$JOB,WK))
if WK'>0
QUIT
Begin DoDot:1
+9 ; Get item out of recess weeks items index
+10 SET VALMCNT=VALMCNT+1
+11 SET WD1=$GET(WKSFM(WK))
SET ED1=$EXTRACT(WD1,4,5)_"/"_$EXTRACT(WD1,6,7)_"/"_$EXTRACT(WD1,2,3)
+12 SET HRSWK=$PIECE(^TMP("PRSRW",$JOB,WK),U,2)
+13 IF HRSWK>0
SET RCNT=RCNT+1
+14 SET HRSPOST=$PIECE(^TMP("PRSRW",$JOB,WK),U,5)
+15 SET HRSPSTOT=HRSPSTOT+HRSPOST
+16 SET HRSUSED=HRSUSED+HRSWK
+17 SET DEC=$SELECT($PIECE(HRSWK,".",2)>0:1,1:0)
+18 SET TEXT=$JUSTIFY(WK,5,0)_" "_ED1_$JUSTIFY(HRSWK,18,2)_$JUSTIFY(HRSPOST,19,2)
+19 DO SET^VALM10(VALMCNT,TEXT)
End DoDot:1
+20 IF RCNT=0
Begin DoDot:1
+21 SET VALMCNT=VALMCNT+1
+22 DO SET^VALM10(VALMCNT," There are no weeks scheduled with recess hours.")
End DoDot:1
+23 SET PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
+24 SET TOTWKS=$PIECE($GET(PRSRWHRS),U)
+25 SET TRHA=$PIECE($GET(PRSRWHRS),U,2)
+26 SET TRWA=$PIECE($GET(PRSRWHRS),U,3)
+27 SET RRHA=TRHA-HRSUSED
+28 SET VALMCNT=VALMCNT+1
+29 DO SET^VALM10(VALMCNT," ====== ======")
+30 SET VALMCNT=VALMCNT+1
+31 DO SET^VALM10(VALMCNT," Total Recess. Scheduled:"_$JUSTIFY(HRSUSED,7,2)_" Posted:"_$JUSTIFY(HRSPSTOT,7,2))
+32 SET VALMCNT=VALMCNT+1
+33 DO SET^VALM10(VALMCNT,"")
+34 SET VALMCNT=VALMCNT+1
+35 DO SET^VALM10(VALMCNT," Total Weeks in AWS FY Schedule: "_$JUSTIFY(TOTWKS,5,2))
+36 SET VALMCNT=VALMCNT+1
+37 DO SET^VALM10(VALMCNT," Total available FY recess hrs: "_$JUSTIFY(TRHA,6,2)_" ("_TRWA_" weeks)")
+38 SET VALMCNT=VALMCNT+1
+39 IF RRHA<0
Begin DoDot:1
+40 DO SET^VALM10(VALMCNT," WARNING--Recess hours over scheduled: "_$JUSTIFY(RRHA,6,2))
+41 SET VALMSG="WARNING--Recess hours are over scheduled: "_$JUSTIFY(RRHA,6,2)
End DoDot:1
+42 IF '$TEST
Begin DoDot:1
+43 IF RRHA>0
Begin DoDot:2
+44 DO SET^VALM10(VALMCNT," WARNING--Recess hours under scheduled: "_$JUSTIFY(RRHA,6,2))
+45 SET VALMSG="WARNING--Recess hours are under scheduled: "_$JUSTIFY(RRHA,6,2)
End DoDot:2
+46 IF '$TEST
Begin DoDot:2
+47 DO SET^VALM10(VALMCNT," Scheduled recess hours match hours available for recess.")
End DoDot:2
End DoDot:1
+48 SET VALMBCK="Q"
+49 QUIT
VALIDRS ; valid recess schedule?
+1 ; hours based on 25% of AWS schedule--total assigned and available hrs
+2 ; and hours available to be assigned to weeks.
+3 ;
+4 ; if quitting (PRSOUT=1) check the file, otherwise check what is
+5 ; being saved from the PRSRW array.
+6 ;
+7 NEW TRHA,RRHA,OUT,CNT,ED1,WD1,WK,HRSWK,HRSUSED,OUT
+8 IF '$GET(PRSOUT)
Begin DoDot:1
+9 SET (WK,HRSUSED)=0
+10 FOR
SET WK=$ORDER(^TMP("PRSRW",$JOB,WK))
if WK'>0
QUIT
Begin DoDot:2
+11 ; Get item out of recess weeks items index
+12 SET HRSWK=$PIECE(^TMP("PRSRW",$JOB,WK),U,2)
+13 SET HRSUSED=HRSUSED+HRSWK
End DoDot:2
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET HRSUSED=$$HRSFILED^PRSARC03($PIECE($GET(PRSFY),U,9))
End DoDot:1
+16 SET PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
+17 SET TRHA=$PIECE($GET(PRSRWHRS),U,2)
+18 SET RRHA=TRHA-HRSUSED
+19 IF RRHA<0
Begin DoDot:1
+20 WRITE !,"WARNING--Recess hours are over scheduled: "_$JUSTIFY(-RRHA,6,2)
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 IF RRHA>0
Begin DoDot:2
+23 WRITE !,"WARNING--Recess hours are under scheduled: "_$JUSTIFY(-RRHA,6,2)
End DoDot:2
+24 IF '$TEST
Begin DoDot:2
+25 WRITE !,"Scheduled recess hours match hours available for recess."
End DoDot:2
End DoDot:1
+26 SET OUT=$$ASK^PRSLIB00(1)
+27 QUIT
+28 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 DO CLEAN^VALM10
+2 KILL PRSHDR,PRSHDR2
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
