source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPLVA.m@ 1261

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

initial load of WorldVistAEHR
File size: 8.0 KB
Line 
1PRSPLVA ;WOIFO/SAB - AUTOPOST LEAVE FOR PART-TIME PHY. WITH MEMO ;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 ;
6PLPP(PRSIEN,PPI,DAYN) ; Post Leave for a Pay Period (or day)
7 ; Called by the open next PP option to post leave to one new pay period
8 ; for one part-time physician.
9 ; Called by the enter/edit tour option to re-post leave to one
10 ; pay period when a tour is changed.
11 ; Input
12 ; PRSIEN - Employee IEN (file 450), should be PTP with active memo
13 ; PPI - Pay Period IEN (file 458)
14 ; DAYN - (optional) day # within pay period to only post that day
15 ;
16 N LVIEN,LVY0,PPD1,PPD15,PRSX,RPPD1,RTDT,Y
17 S DAYN=$G(DAYN)
18 ;
19 ; Determine pay period dates
20 S Y=$G(^PRST(458,PPI,1))
21 S PRSX=$S(DAYN:DAYN,1:1) ; if passed use day # instead of 1st PP day
22 S PPD1=$P(Y,U,PRSX) ; 1st day of PP
23 S RPPD1=9999999-PPD1 ; reverse 1st day of PP
24 S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day # instead of last PP day
25 S PPD15=$$FMADD^XLFDT($P(Y,U,PRSX),1) ; Last day of PP+1
26 ; (use day 15 to include leave that starts on 2nd day of 2-day tour and
27 ; would be posted on the prior day)
28 K PRSX
29 Q:PPD1=""
30 ;
31 ; loop thru leave requests for employee by reverse to date until
32 ; to date is before the pay period or no more to dates
33 S RTDT=""
34 F S RTDT=$O(^PRST(458.1,"AD",PRSIEN,RTDT)) Q:'RTDT!(RTDT>RPPD1) D
35 . ; loop thru requests
36 . S LVIEN=0
37 . S LVIEN=$O(^PRST(458.1,"AD",PRSIEN,RTDT,LVIEN)) Q:'LVIEN D
38 . . S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
39 . . Q:$P(LVY0,U,3)>PPD15 ; skip if from date after pay period+1
40 . . Q:$P(LVY0,U,9)'="A" ; skip if status not approved
41 . . ;
42 . . ; approved request may overlap PP so post the leave request
43 . . D PLR(LVIEN,PPI,DAYN)
44 Q
45 ;
46PLR(LVIEN,SPPI,DAYN,PRSEX) ; Post Leave Request
47 ; Called during open next pay period process (by PLPP above) to post
48 ; one leave request to a single pay period.
49 ; Called during Supervisory Approvals process to post one leave request
50 ; to all opened pay periods.
51 ; Input
52 ; LVIEN - Leave Request IEN (file 458.1)
53 ; SPPI - Pay Period IEN (file 458) or Null Value if for all.
54 ; DAYN - (optional) day # within SPPI or null value
55 ; PRSEX - Passed by reference, will be initialized (killed)
56 ; Output
57 ; PRSEX - passed by reference, only defined if the leave was not
58 ; posted to the ESR and should not be approved because the
59 ; leave is not currently on the time card and it has a status
60 ; of Payroll. This exception should only be applicable when
61 ; auto post is called by the supervisory approval of leave.
62 ;
63 ;
64 ; Note: All applicable time cards are assumed to be locked prior to
65 ; calling this API.
66 ;
67 Q:'$G(LVIEN) ; required input
68 S SPPI=$G(SPPI)
69 ;
70 N D1,DAY,EDN,EPP4Y,FATAL,LVDTE,LVDTS,LVY0,PP4Y,PPDN,PPDNB
71 N PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,PRSX,SDN,SPP4Y,TCST,TCUNPOST,Y
72 ;
73 K PRSEX
74 ;
75 S DAYN=$G(DAYN)
76 S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
77 S PRSIEN=$P(LVY0,U,2) ; employee IEN
78 D
79 . N CNX,PRSM,X,Y
80 . S X=$P(LVY0,U,4)_U_$P(LVY0,U,6)
81 . D CNV^PRSATIM
82 . S PRSM=Y
83 . S LVDTS=$$FMADD^XLFDT($P(LVY0,U,3),,,$P(PRSM,U,1)) ; leave d/t start
84 . S LVDTE=$$FMADD^XLFDT($P(LVY0,U,5),,,$P(PRSM,U,2)) ; leave d/t end
85 ;
86 ; determine starting and ending pay periods
87 ; if single pay period specified
88 I $G(SPPI) D
89 . S D1=$P(^PRST(458,SPPI,1),U) D PP^PRSAPPU S (SPP4Y,EPP4Y)=PP4Y
90 ; if no pay period specified
91 I '$G(SPPI) D
92 . S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
93 . S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
94 ;
95 ; loop thru pay periods
96 S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
97 F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
98 . S PPI=$O(^PRST(458,"AB",PP4Y,0))
99 . ;
100 . ; check status of memo
101 . S D1=$P($G(^PRST(458,PPI,1)),U)
102 . S PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
103 . Q:PRSX'>0 ; skip if pay period is not covered by memo
104 . Q:$P(PRSX,U,2)=4 ; skip if memo is reconciled
105 . K PRSX
106 . ;
107 . ; obtain time card status
108 . S TCST=$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
109 . ;
110 . ; determine begin and end day numbers within pay period
111 . S PPY1=$G(^PRST(458,PPI,1))
112 . ; begin day is greater of leave from date-1 and 1st PP day
113 . S PRSX=$S(DAYN:DAYN,1:1) ; if passed use day # instead of 1st PP day
114 . S SDT=$S($P(PPY1,U,PRSX)>$$FMADD^XLFDT($P(LVY0,U,3),-1):$P(PPY1,U,PRSX),1:$$FMADD^XLFDT($P(LVY0,U,3),-1))
115 . S SDN=$P($G(^PRST(458,"AD",SDT)),U,2) ; start day number
116 . ; end day is lesser of leave request to date and last PP day
117 . S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day # instead of last PP day
118 . S EDT=$S($P(LVY0,U,5)>$P(PPY1,U,PRSX):$P(PPY1,U,PRSX),1:$P(LVY0,U,5))
119 . S EDN=$P($G(^PRST(458,"AD",EDT)),U,2) ; end day number
120 . K PPY1,PRSX,SDT,EDT
121 . ;
122 . ; loop thru applicable days in PP
123 . S PPDN=SDN-1 ; initial PP day number for loop
124 . F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>EDN) D PDAY^PRSPLVA1
125 ;
126 ; handle fatal exception and quit without updating file 458
127 I $G(FATAL) S PRSEX=$P(FATAL,U,2) Q
128 ;
129 ; clear appropriate time card days
130 S PPI="" F S PPI=$O(TCUNPOST(PPI)) Q:'PPI D
131 . S PPDN="" F S PPDN=$O(TCUNPOST(PPI,PPDN)) Q:'PPDN D
132 . . N X
133 . . S X=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PPDN)
134 ;
135 ; update the ESR
136 I $D(PRSFDA) D FILE^DIE("","PRSFDA") D MSG^DIALOG()
137 ;
138 Q
139 ;
140ULR(LVY0) ; Unpost Leave Request
141 ; Called by the Edit Leave Request and Cancel Leave Request options
142 ; to unpost one leave request from all opened pay periods.
143 ; Input
144 ; LVIEN - Leave Request 0 Node (before edit) (see file 458.1)
145 ;
146 ; Note: All applicable time cards are assumed to be locked prior to
147 ; calling this API.
148 ;
149 Q:$G(LVY0)="" ; required input
150 ;
151 N D1,DAY,EDN,EPP4Y,LVDTE,LVDTS,PP4Y,PPDN,PPDNB
152 N PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,SDN,SPP4Y,Y
153 ;
154 S PRSIEN=$P(LVY0,U,2) ; employee IEN
155 D
156 . N CNX,PRSM,X,Y
157 . S X=$P(LVY0,U,4)_U_$P(LVY0,U,6)
158 . D CNV^PRSATIM
159 . S PRSM=Y
160 . S LVDTS=$$FMADD^XLFDT($P(LVY0,U,3),,,$P(PRSM,U,1)) ; leave d/t start
161 . S LVDTE=$$FMADD^XLFDT($P(LVY0,U,5),,,$P(PRSM,U,2)) ; leave d/t end
162 ;
163 ; determine starting and ending pay periods
164 S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
165 S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
166 ;
167 ; loop thru pay periods
168 S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
169 F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
170 . S PPI=$O(^PRST(458,"AB",PP4Y,0))
171 . ;
172 . ; check status of memo
173 . S D1=$P($G(^PRST(458,PPI,1)),U)
174 . S PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
175 . Q:PRSX'>0 ; skip if pay period is not covered by memo
176 . Q:$P(PRSX,U,2)=4 ; skip if memo is reconciled
177 . K PRSX
178 . ;
179 . ; determine begin and end day numbers within pay period
180 . S PPY1=$G(^PRST(458,PPI,1))
181 . ; begin day is greater of leave from date-1 and 1st PP day
182 . S SDT=$S($P(PPY1,U,1)>$$FMADD^XLFDT($P(LVY0,U,3),-1):$P(PPY1,U,1),1:$$FMADD^XLFDT($P(LVY0,U,3),-1))
183 . S SDN=$P($G(^PRST(458,"AD",SDT)),U,2) ; start day number
184 . ; end day is lesser of leave request to date and last PP day
185 . S EDT=$S($P(LVY0,U,5)>$P(PPY1,U,14):$P(PPY1,U,14),1:$P(LVY0,U,5))
186 . S EDN=$P($G(^PRST(458,"AD",EDT)),U,2) ; end day number
187 . K PPY1,SDT,EDT
188 . ;
189 . ; loop thru applicable days in PP
190 . S PPDN=SDN-1 ; initial PP day number for loop
191 . F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>EDN) D PDAY^PRSPLVA2
192 ;
193 ; update the ESR
194 I $D(PRSFDA) D FILE^DIE("S","PRSFDA") D MSG^DIALOG()
195 ;
196 ; Call API BURP^PRSPESR2 to 'burp' the ESR for any unposted days.
197 ; loop thru iens in PRSFDA(), get node 5, use burp, if result different
198 ; then save result back in node 5
199 I $D(PRSFDA) D
200 . N PPDIENS,PPDN,PPI,PRSIEN,PRSX,PRSY
201 . ; loop thru iens (days)
202 . S PPDIENS="" F S PPDIENS=$O(PRSFDA(458.02,PPDIENS)) Q:PPDIENS="" D
203 . . S PPDN=$P(PPDIENS,",",1)
204 . . S PRSIEN=$P(PPDIENS,",",2)
205 . . S PPI=$P(PPDIENS,",",3)
206 . . S PRSX=$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))
207 . . S PRSY=$$BURP^PRSPESR2(PRSX)
208 . . I PRSX'=PRSY S ^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5)=PRSY
209 ;
210 Q
211 ;
212 ;PRSPLVA
Note: See TracBrowser for help on using the repository browser.