| 1 | PRSARCS ;;WOIFO/JAH - Recess Tracking Functions ;02-MAR-2007 | 
|---|
| 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 | EN ; | 
|---|
| 6 | S PRSHDR="9 Mo. AWS Recess Summary for "_$P(PRSFSCYR,U,2)_"  AWS Start Date: "_$P(PRSFY,U,10)_" (pp "_$P(PRSFY,U,12)_")" | 
|---|
| 7 | S PRSHDR2=$G(VALMHDR(2)) | 
|---|
| 8 | D EN^VALM("PRSA RECESS SUMMARY") | 
|---|
| 9 | S VALMBCK="R" | 
|---|
| 10 | Q | 
|---|
| 11 | HDR ; -- header code | 
|---|
| 12 | S VALMHDR(1)=PRSHDR | 
|---|
| 13 | S VALMHDR(2)=PRSHDR2 | 
|---|
| 14 | Q | 
|---|
| 15 | ; | 
|---|
| 16 | INIT ; -- init variables and list array | 
|---|
| 17 | ; hours based on 25% of AWS schedule--total assigned and available hrs | 
|---|
| 18 | ; and hours available to be assigned to weeks. | 
|---|
| 19 | ; | 
|---|
| 20 | N TRWA,TRHA,RRHA,OUT,RCNT,ED1,TEXT,WD1,WK,HRSWK,HRSUSED,TOTWKS,HRSPOST | 
|---|
| 21 | N HRSPSTOT,DEC | 
|---|
| 22 | S (WK,HRSUSED,RCNT,HRSPSTOT)=0 | 
|---|
| 23 | S VALMCNT=0 | 
|---|
| 24 | F  S WK=$O(^TMP("PRSRW",$J,WK)) Q:WK'>0  D | 
|---|
| 25 | . ; Get item out of recess weeks items index | 
|---|
| 26 | .   S VALMCNT=VALMCNT+1 | 
|---|
| 27 | .   S WD1=$G(WKSFM(WK)),ED1=$E(WD1,4,5)_"/"_$E(WD1,6,7)_"/"_$E(WD1,2,3) | 
|---|
| 28 | .   S HRSWK=$P(^TMP("PRSRW",$J,WK),U,2) | 
|---|
| 29 | .   I HRSWK>0 S RCNT=RCNT+1 | 
|---|
| 30 | .   S HRSPOST=$P(^TMP("PRSRW",$J,WK),U,5) | 
|---|
| 31 | .   S HRSPSTOT=HRSPSTOT+HRSPOST | 
|---|
| 32 | .   S HRSUSED=HRSUSED+HRSWK | 
|---|
| 33 | .   S DEC=$S($P(HRSWK,".",2)>0:1,1:0) | 
|---|
| 34 | .   S TEXT=$J(WK,5,0)_"   "_ED1_$J(HRSWK,18,2)_$J(HRSPOST,19,2) | 
|---|
| 35 | .   D SET^VALM10(VALMCNT,TEXT) | 
|---|
| 36 | I RCNT=0 D | 
|---|
| 37 | .  S VALMCNT=VALMCNT+1 | 
|---|
| 38 | .  D SET^VALM10(VALMCNT,"  There are no weeks scheduled with recess hours.") | 
|---|
| 39 | S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT) | 
|---|
| 40 | S TOTWKS=$P($G(PRSRWHRS),U) | 
|---|
| 41 | S TRHA=$P($G(PRSRWHRS),U,2) | 
|---|
| 42 | S TRWA=$P($G(PRSRWHRS),U,3) | 
|---|
| 43 | S RRHA=TRHA-HRSUSED | 
|---|
| 44 | S VALMCNT=VALMCNT+1 | 
|---|
| 45 | D SET^VALM10(VALMCNT,"                            ======             ======") | 
|---|
| 46 | S VALMCNT=VALMCNT+1 | 
|---|
| 47 | D SET^VALM10(VALMCNT," Total Recess.   Scheduled:"_$J(HRSUSED,7,2)_"     Posted:"_$J(HRSPSTOT,7,2)) | 
|---|
| 48 | S VALMCNT=VALMCNT+1 | 
|---|
| 49 | D SET^VALM10(VALMCNT,"") | 
|---|
| 50 | S VALMCNT=VALMCNT+1 | 
|---|
| 51 | D SET^VALM10(VALMCNT," Total Weeks in AWS FY Schedule: "_$J(TOTWKS,5,2)) | 
|---|
| 52 | S VALMCNT=VALMCNT+1 | 
|---|
| 53 | D SET^VALM10(VALMCNT," Total available FY recess hrs: "_$J(TRHA,6,2)_" ("_TRWA_" weeks)") | 
|---|
| 54 | S VALMCNT=VALMCNT+1 | 
|---|
| 55 | I RRHA<0 D | 
|---|
| 56 | .  D SET^VALM10(VALMCNT," WARNING--Recess hours over scheduled: "_$J(RRHA,6,2)) | 
|---|
| 57 | .  S VALMSG="WARNING--Recess hours are over scheduled: "_$J(RRHA,6,2) | 
|---|
| 58 | E  D | 
|---|
| 59 | .  I RRHA>0 D | 
|---|
| 60 | ..    D SET^VALM10(VALMCNT," WARNING--Recess hours under scheduled: "_$J(RRHA,6,2)) | 
|---|
| 61 | ..  S VALMSG="WARNING--Recess hours are under scheduled: "_$J(RRHA,6,2) | 
|---|
| 62 | .  E  D | 
|---|
| 63 | ..    D SET^VALM10(VALMCNT," Scheduled recess hours match hours available for recess.") | 
|---|
| 64 | S VALMBCK="Q" | 
|---|
| 65 | Q | 
|---|
| 66 | VALIDRS ; valid recess schedule? | 
|---|
| 67 | ; hours based on 25% of AWS schedule--total assigned and available hrs | 
|---|
| 68 | ; and hours available to be assigned to weeks. | 
|---|
| 69 | ; | 
|---|
| 70 | ; if quitting (PRSOUT=1) check the file, otherwise check what is | 
|---|
| 71 | ; being saved from the PRSRW array. | 
|---|
| 72 | ; | 
|---|
| 73 | N TRHA,RRHA,OUT,CNT,ED1,WD1,WK,HRSWK,HRSUSED,OUT | 
|---|
| 74 | I '$G(PRSOUT) D | 
|---|
| 75 | . S (WK,HRSUSED)=0 | 
|---|
| 76 | . F  S WK=$O(^TMP("PRSRW",$J,WK)) Q:WK'>0  D | 
|---|
| 77 | .. ; Get item out of recess weeks items index | 
|---|
| 78 | ..   S HRSWK=$P(^TMP("PRSRW",$J,WK),U,2) | 
|---|
| 79 | ..   S HRSUSED=HRSUSED+HRSWK | 
|---|
| 80 | E  D | 
|---|
| 81 | .  S HRSUSED=$$HRSFILED^PRSARC03($P($G(PRSFY),U,9)) | 
|---|
| 82 | S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT) | 
|---|
| 83 | S TRHA=$P($G(PRSRWHRS),U,2) | 
|---|
| 84 | S RRHA=TRHA-HRSUSED | 
|---|
| 85 | I RRHA<0 D | 
|---|
| 86 | .  W !,"WARNING--Recess hours are over scheduled: "_$J(-RRHA,6,2) | 
|---|
| 87 | E  D | 
|---|
| 88 | .  I RRHA>0 D | 
|---|
| 89 | ..   W !,"WARNING--Recess hours are under scheduled: "_$J(-RRHA,6,2) | 
|---|
| 90 | .  E  D | 
|---|
| 91 | ..   W !,"Scheduled recess hours match hours available for recess." | 
|---|
| 92 | S OUT=$$ASK^PRSLIB00(1) | 
|---|
| 93 | Q | 
|---|
| 94 | ; | 
|---|
| 95 | HELP ; -- help code | 
|---|
| 96 | N X | 
|---|
| 97 | S X="?" D DISP^XQORM1 W !! | 
|---|
| 98 | Q | 
|---|
| 99 | ; | 
|---|
| 100 | EXIT ; -- exit code | 
|---|
| 101 | D CLEAN^VALM10 | 
|---|
| 102 | K PRSHDR,PRSHDR2 | 
|---|
| 103 | Q | 
|---|
| 104 | ; | 
|---|
| 105 | EXPND ; -- expand code | 
|---|
| 106 | Q | 
|---|
| 107 | ; | 
|---|