source: FOIAVistA/trunk/r/PAID-PRS/PRSPLVA2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1PRSPLVA2 ;WOIFO/SAB - AUTOPOST LEAVE FOR PTP (CONT) ;3/30/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 ;
6PDAY ; Process Day (within Pay Period loop of Unpost feature)
7 ; called from PRSPLVA
8 ; input variables LVDTE,LVDTS,LVY0,PPDN,PPI,PRSIEN,PRSFDA(),
9 ; output variable
10 ; PRSFDA() may be updated with additional data to post to ESR
11 ;
12 N ESR,ESRHX,ESRRG,ESRLVM,ESRST,FOUND,OVERLAP,PPDIENS,PRSDT,PRSX
13 N PSTDTE,PSTDTS,PSTMEAL,PSTSEG,PSTTYP,SEGI,TOD,TODD,TODL,TOURLV
14 N TSE,TSID,TSS,TSY
15 ;
16 ; skip day if not a scheduled tour
17 Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
18 ;
19 S PPDIENS=PPDN_","_PRSIEN_","_PPI_","
20 ;
21 S PRSDT=$P($G(^PRST(458,PPI,1)),U,PPDN) ; FileMan date of day number
22 ;
23 ; load tour segments from both tours into arrays TOD() and TODD()
24 D LOADTOD^PRSPLVU(PPI,PRSIEN,PPDN,.TOD,.TODD)
25 ;
26 ; load ESR segments into array ESR()
27 D LOADESR^PRSPLVU(PPI,PRSIEN,PPDN,.ESR)
28 ;
29 ; determine leave postings
30 ; loop thru tour segments
31 S TSID="" F S TSID=$O(TOD(TSID)) Q:TSID="" D
32 . S TSY=TOD(TSID)
33 . S TSS=$P(TSY,U)
34 . S TSE=$P(TSY,U,2)
35 . ; skip if tour seg. end < leave start
36 . Q:TSE<LVDTS
37 . ; skip if tour seg. start > leave end
38 . Q:TSS>LVDTE
39 . ;
40 . ; leave overlaps tour segment
41 . ;
42 . ; determine posting times
43 . ; posting start is greater of leave start and tour seg. start
44 . S PSTDTS=$S(LVDTS>TSS:LVDTS,1:TSS)
45 . ; posting end is lesser of leave end and tour seg. end
46 . S PSTDTE=$S(LVDTE<TSE:LVDTE,1:TSE)
47 . ;
48 . ; determine type of time to post
49 . S PSTTYP=$P(LVY0,U,7)
50 . I $P(TSY,U,3)'="RG","TR TV"'[PSTTYP S PSTTYP="UN"
51 . ;
52 . S PSTMEAL=0 ; init
53 . ;
54 . ; if leave is within or equal to the tour segment then calculate
55 . ; a meal based on the leave request hours
56 . I LVDTS'<TSS,LVDTE'>TSE D
57 . . N CLM,FLD,TODI,TODN
58 . . Q:$P(TSY,U,3)'="RG"
59 . . S CLM=($$FMDIFF^XLFDT(LVDTE,LVDTS,2))/60 ; calc lv length min
60 . . S PSTMEAL=CLM-($P(LVY0,U,15)*60)
61 . . I PSTMEAL<0 S PSTMEAL=0 Q ; must be positive or zero
62 . . I PSTMEAL#15 S PSTMEAL=0 Q ; must be multiple of 15
63 . . ; must not exceed meal time for TOD
64 . . S TODN=$P(TSID,"-",1) ; determine tour # (1 or 2) for segment
65 . . I PSTMEAL>$P($G(TODD(TODN)),U,3) S PSTMEAL=$P($G(TODD(TODN)),U,3)
66 . ;
67 . ; if meal was not set based on leave request hours then check if it
68 . ; can be set based on tour info
69 . I PSTMEAL=0 D
70 . . N TODN
71 . . S TODN=$P(TSID,"-",1) ; tour # (1 or 2)
72 . . ; quit if tour does not have a meal
73 . . Q:$P($G(TODD(TODN)),U,3)'>0
74 . . ; quit if segment # currently being processed is not the longest
75 . . ; (better to place meal in the longest segment when more than one)
76 . . Q:$P($G(TODD(TODN)),U,4)'=$P(TSID,"-",2)
77 . . ; quit if leave started after tour began
78 . . Q:LVDTS>$P($G(TODD(TODN)),U,1)
79 . . ; quit if leave ended before tour ended
80 . . Q:LVDTE<$P($G(TODD(TODN)),U,2)
81 . . ; since leave covers the entire tour - set meal time based on tour
82 . . S PSTMEAL=$P($G(TODD(TODN)),U,3)
83 . ;
84 . ; find current leave posting on the ESR
85 . S FOUND=0
86 . ; loop thru ESR segments
87 . S SEGI="" F S SEGI=$O(ESR(SEGI)) Q:SEGI="" D Q:FOUND
88 . . N ESRY
89 . . S ESRY=ESR(SEGI)
90 . . Q:$P(ESRY,U,3)'=PSTTYP ; quit if not same type
91 . . I PSTDTS=$P(ESRY,U),PSTDTE=$P(ESRY,U,2) S FOUND=1
92 . Q:'FOUND ; skip because posting is not on the ESR
93 . S PSTSEG=SEGI
94 . ;
95 . ; OK to add unposting to FDA array
96 . ;
97 . ; add unposting to FDA() array and ESR() array
98 . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+110)="@" ; start time
99 . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+111)="@" ; stop time
100 . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+112)="@" ; type time
101 . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+114)="@" ; meal
102 . K ESR(PSTSEG)
103 ;
104 ; quit if nothing will be unposted from the ESR day
105 Q:'$D(PRSFDA(458.02,PPDIENS))
106 ;
107 ; obtain current ESR daily status
108 S ESRST=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)
109 ;
110 ; determine proposed new status of ESR day
111 ;
112 ; determine if any ESR time segments overlap
113 ; (some types of time are excluded from check)
114 S OVERLAP=0
115 S SEGI=0 F S SEGI=$O(ESR(SEGI)) Q:'SEGI D
116 . N SEGJ,SEGX,SEGY
117 . S SEGX=ESR(SEGI)
118 . Q:"ON SB UN"[$P(SEGX,U,3)
119 . S SEGJ=SEGI F S SEGJ=$O(ESR(SEGJ)) Q:'SEGJ D
120 . . S SEGY=ESR(SEGJ)
121 . . Q:"ON SB UN"[$P(SEGY,U,3)
122 . . Q:$P(SEGX,U,2)'>$P(SEGY,U,1)
123 . . Q:$P(SEGX,U,1)'<$P(SEGY,U,2)
124 . . S OVERLAP=1
125 ;
126 ; determine if entire tour covered by leave
127 S PRSX=$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,0))
128 S TODL=$P(PRSX,U,8)+$P(PRSX,U,14) ; tour of duty length in hours
129 ; loop thru ESR segments to add up leave
130 S ESRLVM=0 ; leave in minutes
131 S SEGI="" F S SEGI=$O(ESR(SEGI)) Q:SEGI="" D
132 . N ESRY,SEGLVM
133 . S ESRY=ESR(SEGI)
134 . Q:"AL SL WP CU AA ML RL NL CB AD DL"'[$P(ESRY,U,3)
135 . S SEGLVM=($$FMDIFF^XLFDT($P(ESRY,U,2),$P(ESRY,U,1),2)/60)-$P(ESRY,U,6)
136 . S ESRLVM=ESRLVM+SEGLVM
137 S TOURLV=$S((ESRLVM/60)'<TODL:1,1:0) ; true if tour covered by leave
138 ;
139 ; determine if any RG time on ESR
140 S ESRRG=$S($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG":1,1:0)
141 ;
142 ; determine if any HX time on ESR
143 S ESRHX=$S($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["HX":1,1:0)
144 ;
145 ; determine appropriate status for day
146 D
147 . ; if current status = signed and current method = manual then re-sign
148 . ; by manual and quit block
149 . I ESRST=4,$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U,3)=1 D Q
150 . . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
151 . . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
152 . . S PRSFDA(458.02,PPDIENS,149)="1" ; signed method = manual
153 . ;
154 . ; if day covered by holiday, no RG, no overlap then re-sign by holiday
155 . ; and quit block
156 . I ESRHX,'ESRRG,'OVERLAP D Q
157 . . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
158 . . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
159 . . S PRSFDA(458.02,PPDIENS,149)="4" ; signed method = holiday
160 . ;
161 . ; if tour covered by leave, no RG, no overlap, then re-sign by leave
162 . ; and quit block
163 . I TOURLV,'ESRRG,'OVERLAP D Q
164 . . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
165 . . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
166 . . S PRSFDA(458.02,PPDIENS,149)="3" ; signed method = leave
167 . ;
168 . ; if day covered by extended absence, no RG, no overlap, then re-sign
169 . ; by EA and quit block
170 . I $$CONFLICT^PRSPEAU(PRSIEN,PRSDT),'ESRRG,'OVERLAP D Q
171 . . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
172 . . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
173 . . S PRSFDA(458.02,PPDIENS,149)="2" ; signed method = EA
174 . ;
175 . ; day will not be signed
176 . ;
177 . ; if day previously signed then clear out signed fields
178 . I ESRST="4" D
179 . . S PRSFDA(458.02,PPDIENS,147)="@" ; delete signed d/t
180 . . S PRSFDA(458.02,PPDIENS,149)="@" ; delete signed method
181 . ;
182 . ; set status = resubmit (if that was current) or pending (if segment)
183 . ; or not started
184 . S PRSFDA(458.02,PPDIENS,146)=$S(ESRST="3":"3",$O(ESR(0)):"2",1:"1")
185 Q
186 ;
187 ;PRSPLVA2
Note: See TracBrowser for help on using the repository browser.