source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARC04.m@ 893

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1PRSARC04 ;WOIFO/JAH - Recess Tracking Functions ;11/1/06
2 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5GETFSCYR(PRSDT) ; Given a date get the 9-month AWS fiscal year.
6 ; This is the fiscal year during which the 9-month AWS is effective.
7 ; The fiscal year for 2006 (FY06, sometimes written FY05-06) is from
8 ; October 1, 2005 through September 30, 2006. However, the fiscal
9 ; year for purposes of the 9-month AWS will be governed also by
10 ; complete pay periods, since the nurses normal hours=80 and duty
11 ; basis = part-time, must be in effect for the entire pay period.
12 ; Thus some 9-month AWS fiscal years may have 50, 52 or 54 weeks.
13 ; The fiscal year is defined as the 12 months from the first full
14 ; pay period after October 1 through the pay period that contains
15 ; September 30. In the example below September 30, 2007 is the
16 ; first day of the pay period 20 and thus the entire pay period is
17 ; included in the weeks for the 9-month AWS schedule for FY07.
18 ;
19 ; Week PayPd Sun Mon Tue Wed Thu Fri Sat
20 ;
21 ; =============Oct 2006============
22 ; 1 06-20 1 2 3 4 5 6 7
23 ; 2 8 9 10 11 12 13 14
24 ; 3 06-21 15 16 17 18 19 20 21
25 ; ...
26 ;
27 ; 51 07-19 16 17 18 19 20 21 22
28 ; 52 23 24 25 26 27 28 29
29 ; 53 07-20 30 1 2 3 4 5 6
30 ; =============Oct 2007============
31 ; 54 7 8 9 10 11 12 13
32 ;
33 ; Get pay period with PRSDT and the 1st day of that pp
34 N X1,X2,%H,X,D1,PPE,YR,DAY,TMPYR,FFPPE,PPE,FISCALYR,PPDT1,FY1,FY2,FYLONG
35 S D1=PRSDT D PP^PRSAPPU
36 S FFPPE=PPE
37 S X2=(1-DAY),X1=PRSDT D C^%DTC S PPDT1=X
38 S TMPYR=$E(PPDT1,1,3)
39 S FISCALYR=$S(PPDT1'>(TMPYR_"0930"):TMPYR,1:TMPYR+1)_"0000"
40 S YR=$E(FISCALYR,1,3)
41 S FY1=$E($E(YR,1,3)-1,2,3)
42 S FYLONG=1700+YR
43 S FY2=$E(YR,2,3)
44 Q FISCALYR_"^"_"FY"_FYLONG_"^"_"FY"_FY1_"-"_FY2
45 ;
46FYDAYS(FSCYR) ; Given a fiscal year get the PAID ETA start and stop
47 ; dates (i.e. the first day of the first pay period of the fiscal
48 ; year and the last day of the last pay period in the fiscal year.
49 ; see GETFSCYR for fiscal year info
50 ;
51 Q:($G(FSCYR)'>1992)!($G(FSCYR)>2106) "input date out of range"
52 ;
53 N X1,X2,%H,X,D1,PPE,DAY,END,START,ENDPPE,FYENDT,FYSTDT,STRTPPE
54 ;
55 ; The start pay period can't contain the date Sept 30.
56 ;
57 S START=FSCYR-1701
58 S D1=START_"0930" D PP^PRSAPPU
59 S X2=(15-DAY),X1=D1 D C^%DTC S FYSTDT=X
60 S D1=FYSTDT D PP^PRSAPPU
61 S STRTPPE=PPE
62 ;
63 ; the end pay period must contain sept 30
64 ;
65 S END=FSCYR-1700
66 S D1=END_"0930" D PP^PRSAPPU
67 S ENDPPE=PPE
68 S X2=(14-DAY),X1=D1 D C^%DTC S FYENDT=X
69 ;
70 Q FYSTDT_"^"_FYENDT_"^"_STRTPPE_"^"_ENDPPE
71 ;
72GETPPDY(PRSDT) ; Given FM date--PRSDT--Get pay period + 1st day of that pp
73 N X1,X2,%H,X,D1,PPE,PPD1
74 S D1=PRSDT D PP^PRSAPPU
75 S FFPPE=PPE
76 S X2=(1-DAY),X1=PRSDT D C^%DTC S PPD1=X
77 Q PPD1_U_PPE
78 ;
79ALLFYAWS() ; Ask user if AWS will cover the entire Fiscal Year
80 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,FY
81 S DIR(0)="Y"
82 S DIR("B")="NO"
83 S DIR("A")="Does the AWS cover the entire fiscal year"
84 S DIR("?")="Enter Y for Yes or N for No."
85 S DIR("?",1)=" If the Nurse is starting the fiscal year on the"
86 S DIR("?",2)=" 9 Month AWS then answer YES. If they are starting"
87 S DIR("?",3)=" the AWS in a pay period after the 1st pay period"
88 S DIR("?",4)=" of the fiscal year then answer NO."
89 D ^DIR
90 Q:$D(DIRUT) -1
91 Q Y
92 ;
93 ;
94 ;
95FYWEEKS(WKARRAY,FY,SD) ; RETURN ARRAY WITH WEEKS
96 ; INPUT:
97 ; FY - fiscal year in 4 digit format
98 ; SD - (optional) set to 1 if you want week numbers in the subscript
99 ; otherwise subscript will be fmdates.
100 ;
101 N FD,LD,PRSFYRNG
102 ;
103 ; get range of dates for FY (PRS
104 ; cleaned up at exit from LM)
105 ;
106 S PRSFYRNG=$$FYDAYS(FY)
107 ;
108 S FD=$P(PRSFYRNG,U,1)
109 S LD=$P(PRSFYRNG,U,2)
110 ; Build an array with FMdate for first day of each week in the FY
111 ;
112 D WKSDAY1(.WKARRAY,FD,LD,$G(SD))
113 Q
114 ;
115GETAVHRS(FMWKS,PRSDT) ; calculate the number of weeks in the AWS fiscal year
116 ; from the input date and the hours available for recess from that
117 ; date
118 ; INPUT: PRSDT-must be a first day of a pay period in the input array
119 ; FMWKS-array produced from FYWEEKS call in this routine.
120 ; OUTPUT:
121 ; # of FY weeks from PRSDT ^ available recess hrs ^ avail recess weeks
122 ;
123 N FRSTWK,LASTWK,WKS,HRS,AVWKS
124 Q:'$D(FMWKS($G(PRSDT))) 0
125 S FRSTWK=$G(FMWKS(PRSDT))
126 S LASTWK=$O(FMWKS(9999999),-1),LASTWK=$G(FMWKS(LASTWK))
127 S WKS=LASTWK-FRSTWK+1
128 S HRS=WKS*40*.25
129 S AVWKS=WKS*.25
130 Q WKS_U_HRS_U_AVWKS
131 ;
132 ;
133WKSDAY1(WKARRAY,FD,LD,SF) ;Build FY week array
134 ;
135 ; INPUT FD = fm first day of ETA type fiscal year (i.e. Sunday of pp)
136 ; LD = last day ETA fiscal year
137 ; SF = optional subscript flag = 1 use week otherwise use FMDAY
138 ;
139 ; OUTPUT WKARRAY = ARRAY for weeks in a Fiscal Year with
140 ; (Subscript) = FMdate
141 ; Value = FY WEEK of 1st day of week.
142 ;
143 N SUBS,WKD1,WEEK,X1,X2,X,VALUE
144 I $G(SF)=1 S SUBS="WEEK",VALUE="WKD1"
145 E S SUBS="WKD1",VALUE="WEEK"
146 S WKD1=FD,WEEK=1
147 F D Q:WKD1>$G(LD)
148 . S WKARRAY(@SUBS)=@VALUE
149 . S WEEK=WEEK+1
150 . S X2=7,X1=WKD1 D C^%DTC S WKD1=X
151 Q
152ALLOKEY(PRSNURSE) ; Allocate security key to the NURSE if they don't hold it
153 ;
154 ; determine associated NEW PERSON entry
155 Q:+$G(PRSNURSE)'>0
156 Q:'$O(^PRST(458.8,"B",+PRSNURSE,0))
157 N SSN,IEN200
158 S SSN=$$GET1^DIQ(450,+PRSNURSE_",",8,"I")
159 S IEN200=$S(SSN="":"",1:$O(^VA(200,"SSN",SSN,0)))
160 I 'IEN200 D Q
161 . W $C(7),!!,"Can't find this nurse in the NEW PERSON file. This must"
162 . W !,"be corrected before they can view their schedule and the"
163 . W !,"PRSAWS9 security key may need to be allocated to this nurse."
164 . S SSN=$$ASK^PRSLIB00(1)
165 ;
166 I '$D(^XUSEC("PRSAWS9",IEN200)) D
167 . W !,"... allocating PRSAWS9 security key for this nurse." H 1 W !!
168 . N KEYIEN,PRSFDA,PRSIENS
169 . S KEYIEN=$$FIND1^DIC(19.1,,"X","PRSAWS9")
170 . I 'KEYIEN D Q
171 . . W !!,"The PRSAWS9 key is missing from file 19.1."
172 . S PRSFDA(200.051,"?+1,"_IEN200_",",.01)=KEYIEN
173 . S PRSIENS(1)=KEYIEN
174 . D UPDATE^DIE("","PRSFDA","PRSIENS"),MSG^DIALOG()
175 ;
176 Q
Note: See TracBrowser for help on using the repository browser.