source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARCS.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1PRSARCS ;;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
5EN ;
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
11HDR ; -- header code
12 S VALMHDR(1)=PRSHDR
13 S VALMHDR(2)=PRSHDR2
14 Q
15 ;
16INIT ; -- 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
66VALIDRS ; 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 ;
95HELP ; -- help code
96 N X
97 S X="?" D DISP^XQORM1 W !!
98 Q
99 ;
100EXIT ; -- exit code
101 D CLEAN^VALM10
102 K PRSHDR,PRSHDR2
103 Q
104 ;
105EXPND ; -- expand code
106 Q
107 ;
Note: See TracBrowser for help on using the repository browser.