source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPEAA.m@ 1800

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

initial load of WorldVistAEHR
File size: 9.1 KB
RevLine 
[613]1PRSPEAA ;WOIFO/SAB - Ext. Absence Autopost for PT Physician ;4/6/2005
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6PEAPP(PRSIEN,PPI,DAYN) ; Post Extended Absences for a Pay Period (or day)
7 ; This API auto posts all extended absences for a specific employee
8 ; and pay period. It is called during the creation of an employee time
9 ; card when a new pay period is opened or when an employee timecard is
10 ; added to an existing pay period.
11 ;
12 ; Input
13 ; PRSIEN - Employee IEN (file 450), should be PTP with active memo
14 ; PPI - Pay Period IEN (file 458)
15 ; DAYN - (optional) Day # within PPI to only post that day
16 ;
17 ; Note: Timecard is assumed to be locked prior to calling this API.
18 ;
19 N EAIEN,EAY0,PEREND,PERSTR,PPD1,PPD14,PRSX,TDT,Y
20 S DAYN=$G(DAYN)
21 ;
22 ; Determine pay period dates
23 S Y=$G(^PRST(458,PPI,1))
24 S PRSX=$S(DAYN:DAYN,1:1) ; if passed use day# instead of 1st day in PP
25 S PPD1=$P(Y,U,PRSX) ; 1st day of PP
26 S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day# instead of last day in PP
27 S PPD14=$P(Y,U,PRSX) ; Last day of PP
28 K PRSX
29 Q:PPD1=""
30 ;Q:PPD14<DT ; EA only autoposted from curent date and forward
31 ;
32 ; loop thru extended absences for employee by reverse end date until
33 ; end date is before the pay period or no more end dates
34 S TDT=9999999 ; initial to date for loop
35 F S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT),-1) Q:'TDT!(TDT<PPD1) D
36 . ; loop thru extended absences
37 . S EAIEN=0
38 . S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN D
39 . . S EAY0=$G(^PRST(458.4,EAIEN,0)) ; extended absense 0 node
40 . . Q:$P(EAY0,U)>PPD14 ; skip if start date after pay period
41 . . Q:$P(EAY0,U,6)'="A" ; skip if status not active
42 . . ;
43 . . ; extended absence overlaps the pay period
44 . . ; determine start and end dates to post as absence
45 . . ; period end is lesser of absence to date and PP end
46 . . S PEREND=$S($P(EAY0,U,2)<PPD14:$P(EAY0,U,2),1:PPD14)
47 . . ;Q:PEREND<DT ; period ended before current day so can't auto post
48 . . ; period start is greater of absence from date and PP start
49 . . S PERSTR=$S($P(EAY0,U)>PPD1:$P(EAY0,U),1:PPD1)
50 . . ;I PERSTR<DT S PERSTR=DT ; don't auto post EA to days before current
51 . . ;
52 . . ; call API to post absence to appropriate ESR days
53 . . D PEA(PRSIEN,PERSTR,PEREND)
54 Q
55 ;
56CEA(PRSIEN,S1,E1,S2,E2) ; Update ESR when Extended Absence is changed
57 ; This API updates the ESRs when the date range of an extended
58 ; absence is changed.
59 ;
60 ; input
61 ; PRSIEN - Employee IEN (file 450)
62 ; S1 - old Start Date (FileMan internal)
63 ; E1 - old End Date (FileMan internal)
64 ; S2 - new Start Date (FileMan internal)
65 ; E2 - new End Date (FileMan internal)
66 ;
67 Q:'$G(PRSIEN)
68 Q:'$G(S1)
69 Q:'$G(E1)
70 Q:'$G(S2)
71 Q:'$G(E2)
72 ;
73 N X1,X2
74 ;
75 ; post/unpost impacted ranges
76 ;
77 ; if new start is less than old start then days from new start to
78 ; lesser of new end and old start-1 were changed from not covered to
79 ; covered.
80 I S2<S1 D
81 . S X1=S2
82 . S X2=$S(E2<(S1-1):E2,1:S1-1)
83 . D PEA(PRSIEN,X1,X2)
84 ;
85 ; if new start is greater than old start then days from old start to
86 ; lesser of old end and new start-1 were changed from covered to not
87 ; covered.
88 I S2>S1 D
89 . S X1=S1
90 . S X2=$S(E1<(S2-1):E1,1:S2-1)
91 . D UEA(PRSIEN,X1,X2)
92 ;
93 ; if new end is greater than old end then days from greater of old
94 ; end+1 and new start to new end were changed from not covered to
95 ; covered.
96 I E2>E1 D
97 . S X1=$S(E1+1>S2:E1+1,1:S2)
98 . S X2=E2
99 . D PEA(PRSIEN,X1,X2)
100 ;
101 ; if new end is less than old end then days from greater of new end+1
102 ; and old start to old end were changed from covered to not covered.
103 I E2<E1 D
104 . S X1=$S(E2+1>S1:E2+1,1:S1)
105 . S X2=E1
106 . D UEA(PRSIEN,X1,X2)
107 ;
108 Q
109 ;
110PEA(PRSIEN,PERSTR,PEREND) ; Post Extended Absence
111 ; Called during open next pay period process (by PEAPP above) to post
112 ; one extended absence to a single pay period.
113 ; Called by Enter option to post one new extended absence to all
114 ; opened pay periods.
115 ; Called by Edit option (by CEA above) to post one extended
116 ; absence to all opened pay periods when an extended absence is
117 ; edited such that some days originally not covered by the absence
118 ; are now covered.
119 ; Input
120 ; PRSIEN - Employee IEN (file 450)
121 ; PERSTR - Start of absence period to post (FileMan date)
122 ; PEREND - End of absence period to post (FileMan date)
123 ; Output
124 ; None
125 ;
126 ; Note: All applicable timecards are assumed to be locked prior to
127 ; calling this API.
128 ;
129 Q:('$G(PRSIEN))!($G(PERSTR)'?7N)!($G(PEREND)'?7N) ; required inputs
130 N D1,DAY,EPP4Y,PP4Y,PPDN,PPDNB,PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,SPP4Y,Y
131 ;
132 ; determine starting and ending pay periods
133 S D1=PERSTR D PP^PRSAPPU S SPP4Y=PP4Y
134 S D1=PEREND D PP^PRSAPPU S EPP4Y=PP4Y
135 Q:SPP4Y=""
136 Q:EPP4Y=""
137 ;
138 ; loop thru pay periods
139 S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
140 F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
141 . S PPI=$O(^PRST(458,"AB",PP4Y,0))
142 . ; quit if pay period not covered by memo
143 . S D1=$P($G(^PRST(458,PPI,1)),U)
144 . Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0
145 . ;
146 . ; determine begin and end day numbers within pay period
147 . S Y=$G(^PRST(458,PPI,1))
148 . ; begin day is greater of period start date and 1st PP day
149 . S PPDTB=$S($P(Y,U,1)>PERSTR:$P(Y,U,1),1:PERSTR)
150 . S PPDNB=$P($G(^PRST(458,"AD",PPDTB)),U,2) ; begin day number in PP
151 . ; end day is lesser of period end date and last PP day
152 . S PPDTE=$S(PEREND>$P(Y,U,14):$P(Y,U,14),1:PEREND)
153 . S PPDNE=$P($G(^PRST(458,"AD",PPDTE)),U,2) ; end day number in PP
154 . ;
155 . ; loop thru applicable days in PP
156 . S PPDN=PPDNB-1 ; initial PP day number for loop
157 . F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>PPDNE) D
158 . . ; skip day if not a scheduled tour
159 . . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
160 . . ; skip day if regular time already posted to ESR
161 . . Q:$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG"
162 . . ; skip day if ESR already signed or approved
163 . . Q:"^4^5^"[(U_$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)_U)
164 . . ;
165 . . ; mark ESR day as signed
166 . . K PRSFDA
167 . . S IENS=PPDN_","_PRSIEN_","_PPI_","
168 . . S PRSFDA(458.02,IENS,146)="4" ; status = signed
169 . . S PRSFDA(458.02,IENS,147)=$$NOW^XLFDT() ; signed d/t
170 . . S PRSFDA(458.02,IENS,149)="2" ; signed method = extended absence
171 . . D FILE^DIE("","PRSFDA") D MSG^DIALOG()
172 ;
173 Q
174 ;
175UEA(PRSIEN,PERSTR,PEREND) ; Unpost Extended Absence
176 ; Called by Cancel option to unpost one new extended absence from
177 ; opened pay periods.
178 ; Called by Edit option (by CEA above) to unpost one extended
179 ; absence to all opened pay periods when an extended absence is
180 ; edited such that some days originally covered by the absence
181 ; are now not covered.
182 ; Input
183 ; PRSIEN - Employee IEN (file 450)
184 ; PERSTR - Start of absence period (FileMan date)
185 ; PEREND - End of absence period (FileMan date)
186 ; Output
187 ;
188 ; Note: All applicable timecards are assumed to be locked prior to
189 ; calling this API.
190 ;
191 Q:('$G(PRSIEN))!($G(PERSTR)'?7N)!($G(PEREND)'?7N) ; required inputs
192 N D1,DAY,EPP4Y,PP4Y,PPDN,PPDNB,PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,SPP4Y,Y
193 ;
194 ; determine starting and ending pay periods
195 S D1=PERSTR D PP^PRSAPPU S SPP4Y=PP4Y
196 S D1=PEREND D PP^PRSAPPU S EPP4Y=PP4Y
197 Q:SPP4Y=""
198 Q:EPP4Y=""
199 ;
200 ; loop thru pay periods
201 S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
202 F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
203 . S PPI=$O(^PRST(458,"AB",PP4Y,0))
204 . ; quit if pay period not covered by memo
205 . S D1=$P($G(^PRST(458,PPI,1)),U)
206 . Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0
207 . ;
208 . ; determine begin and end day numbers within pay period
209 . S Y=$G(^PRST(458,PPI,1))
210 . ; begin day is greater of period start date and 1st PP day
211 . S PPDTB=$S($P(Y,U,1)>PERSTR:$P(Y,U,1),1:PERSTR)
212 . S PPDNB=$P($G(^PRST(458,"AD",PPDTB)),U,2) ; begin day number in PP
213 . ; end day is lesser of period end date and last PP day
214 . S PPDTE=$S(PEREND>$P(Y,U,14):$P(Y,U,14),1:PEREND)
215 . S PPDNE=$P($G(^PRST(458,"AD",PPDTE)),U,2) ; end day number in PP
216 . ;
217 . ; loop thru applicable days in PP
218 . S PPDN=PPDNB-1 ; initial PP day number for loop
219 . F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>PPDNE) D
220 . . ; skip day if not a scheduled tour
221 . . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
222 . . ; skip day if regular time already posted to ESR
223 . . Q:$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG"
224 . . ; skip day if ESR not signed or approved
225 . . Q:"^4^5^"'[(U_$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)_U)
226 . . ; skip day if ESR was not auto signed by extended absence
227 . . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U,3)'=2
228 . . ;
229 . . ; if ESR status was approved then remove the time card day posting
230 . . I $P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)=5 S X=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PPDN) K X
231 . . ;
232 . . ; update ESR day
233 . . K PRSFDA
234 . . S IENS=PPDN_","_PRSIEN_","_PPI_","
235 . . S PRSFDA(458.02,IENS,146)=$S($TR($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5)),"^")'="":2,1:1) ; status = pending (if time posted) or not started
236 . . S PRSFDA(458.02,IENS,147)="@" ; remove signed d/t stamp
237 . . S PRSFDA(458.02,IENS,149)="@" ; remove last signed method
238 . . D FILE^DIE("","PRSFDA") D MSG^DIALOG()
239 ;
240 Q
241 ;
242 ;PRSPEAA
Note: See TracBrowser for help on using the repository browser.