source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARC07.m@ 1789

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

initial load of WorldVistAEHR
File size: 7.6 KB
Line 
1PRSARC07 ;WOIFO/JAH - Tour Hours Procedure ;01/07/08
2 ;;4.0;PAID;**112,116**;Sep 21, 1995;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6TOURHRS(THRARY,PPI,PRSIEN,TOURSTR) ; Return data for TOUR OF DUTY
7 ;Input:
8 ; PPI (optional) IEN of #458 otherwise curr PPI assumed.
9 ; *If PPI and TOURSTR (or only PPI) defined then last pay period
10 ; spill over from 2nd sat. is added to day 1.
11 ; *If TOURSTR is defined but not PPI then tour hours
12 ; from 2nd saturday of tour in TOURSTR are placed on 1st Sunday.
13 ;
14 ; PRSIEN (required) IEN-File (#450).
15 ; TOURSTR (optional) if defined should contain 14 piece string
16 ; delimited by "^" pieces 1-14 contain pointers
17 ; to ToD file. Will be used instead of pp to determine
18 ; tour hrs.
19 ; Output
20 ; THRARY (TOUR HRS ARRAY)-2 piece array subsc by day #.
21 ; W1 & W2 node w/ wkly tour hrs.
22 ; Piece one = Shift code:
23 ; -Null when no tour hrs fall on that day.
24 ; -Always 0 for Wage Grades
25 ; -1, 2, or 3 corresponds to earliest shift on day being reported.
26 ; Piece two = total hrs for tours that fall on each day.
27 ; Tours crossing midnight--hrs placed in node on day the occur
28 ; SPECIAL CASE: COMPRESSED TOURS: "CT" node is defined
29 ; Piece one set to shift (earliest for pp or 0 for wage)
30 ; Piece 2 = total pp hrs
31 ;
32 ; Error Codes = ARRAY VARIABLE contains a 1 for success or 0 for
33 ; failure. If failed then error codes returned in Array 0 node
34 ; 1 = pp undef
35 ; 2 = emp undef
36 ; 3 = no timecard for emp in pp
37 ; Example
38 ; >D TOURHRS^PRSARC04(.THRS,257,12711)
39 ; >ZW THRS
40 ; THRS=1
41 ; THRS(1)=^0
42 ; THRS(2)=1^3
43 ; THRS(3)=1^6
44 ; ...
45 ; THRS(14)=^0
46 N SHIFTCD,ISWAGE,ZNODE,PRSD,SAT,LASTPPI
47 K THRARY
48 I '$D(^PRSPC(+$G(PRSIEN),0)) S THRARY=0,THRARY(0)="2^undefined employee"
49 I $G(TOURSTR)="" D
50 . I $G(PPI)'>0 S PPI=$P(^PRST(458,0),"^",3)
51 . I '$D(^PRST(458,+$G(PPI),0)) S THRARY=0,THRARY(0)="1^undefined pay period"
52 . S LASTPPI=PPI-1
53 . S ISWAGE=$$ISWAGE^PRSARC08(PRSIEN)
54 . ;
55 . ; Get ToD and Second ToD from last saturday of
56 . ; prior PP to check for spill over hrs onto day 1 of this PP.
57 . S SAT=$G(^PRST(458,LASTPPI,"E",PRSIEN,"D",14,0))
58 . S PRSD=0,T1=$P(SAT,U,2),T2=$P(SAT,U,13)
59 . D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,LASTPPI)
60 . F PRSD=1:1:14 D
61 .. S ZNODE=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
62 .. S T1=$P(ZNODE,U,2),T2=$P(ZNODE,U,13)
63 .. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
64 .. D PLACESHF(.THRARY,PRSD,T1,T2,ISWAGE)
65 .;
66 .; add compressed tour node if necessary
67 .I $$ISCMPTR^PRSARC08(PPI,PRSIEN) S THRARY("CT")=$$EARLYSH^PRSARC08(.THRARY,ISWAGE)_"^"_$$TOTAL^PRSARC08(.THRARY)
68 E D
69 .; use tourstring for tours
70 .; add prior tour spillover from 2nd Sat to first Sun
71 . I $G(PPI)>0 D
72 .. S SAT=$G(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0))
73 .. S PRSD=0,T1=$P(SAT,U,2),T2=$P(SAT,U,13)
74 .. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
75 . F PRSD=1:1:14 D
76 .. S T1=$P(TOURSTR,U,PRSD),T2=""
77 .. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
78 . ; wrap second saturday to first sunday (IF PPI NOT PASSED)
79 . I $G(PPI)="" S $P(THRARY(1),U,2)=$P(THRARY(1),U,2)+$P($G(THRARY(15)),U,2)
80 ; Prior Sat THRARY(0) only needed temp to get any part of a two day
81 ; tour that spilled onto THRARY(1)-1st Sun. Next Sun THRARY(15) is
82 ; only an artifact.
83 S THRARY("W1")=$$TOTAL^PRSARC08(.THRARY,1)
84 S THRARY("W2")=$$TOTAL^PRSARC08(.THRARY,2)
85 K THRARY(0),THRARY(15)
86 Q
87 ;
88PLACEHRS(PRSTH,PRSIEN,PRSD,T1,T2,PPI) ; procedure puts hrs from tours on current
89 ; day and next. called once for each day so a call for curr day
90 ; may have hrs from prior two day tour
91 ;
92 N CURHRS,CURSHFT,TODAYND,TOMORND,TODHRS,TOMHRS,TOURHRS
93 S TODAYND=$G(PRSTH(PRSD))
94 S TOMORND=$G(PRSTH(PRSD+1))
95 S TODHRS=$P(TODAYND,U,2)
96 S TOMHRS=$P(TOMORND,U,2)
97 ;
98 ; get tour 1 hrs-add to today, tomorrow
99 I T1>0 D
100 . S TOURHRS=$$TRHRS(1,PRSD,PRSIEN,T1,PPI)
101 . S TODHRS=TODHRS+$P(TOURHRS,U)
102 . S TOMHRS=TOMHRS+$P(TOURHRS,U,2)
103 ;
104 ; get tour 2 hrs-add to today, tomorrow
105 I T2>0 D
106 . S TOURHRS=$$TRHRS(2,PRSD,PRSIEN,T2,PPI)
107 . S TODHRS=TODHRS+$P(TOURHRS,U)
108 . S TOMHRS=TOMHRS+$P(TOURHRS,U,2)
109 ;
110 ; add tour hrs to array
111 S $P(PRSTH(PRSD),U,2)=TODHRS
112 ;
113 ; add hrs to day node of array
114 ; (2 day tour hrs past midnight on last Sat. go in node 15)
115 ;
116 S $P(PRSTH(PRSD+1),U,2)=TOMHRS
117 Q
118TRHRS(TNUM,PRSD,PRSIEN,TOURIEN,PPI) ; return string w/ todays hrs p1 ^ tomorrows hrs p2
119 ;
120 N TODHR,TOMHR,TOUR,TSEGS,TWODAYTR,REGHRS,DONE,CROSS,BEG,END,MEALTIME
121 N BEG24,END24,SEGTIME,SEGTOD,SEGTOM,I,SPECIND
122 ;
123 S TODHR=0,TOMHR=0
124 I $G(TOURIEN)'>0 Q TODHR_"^"_TOMHR
125 S TOUR=$G(^PRST(457.1,TOURIEN,0))
126 I TNUM=1 S TSEGS=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1))
127 I TNUM=2 S TSEGS=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4))
128 I TSEGS="" S TSEGS=$G(^PRST(457.1,TOURIEN,1))
129 S TWODAYTR=$P(TOUR,U,5)="Y"
130 S MEALTIME=$P(TOUR,U,3)
131 I TNUM=1 S REGHRS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,8)
132 I TNUM=2 S REGHRS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,14)
133 I REGHRS'>0 S REGHRS=$P(TOUR,U,6)
134 I TWODAYTR D
135 . S (DONE,CROSS)=0
136 . F I=1:3:19 D Q:DONE
137 .. S BEG=$P(TSEGS,U,I)
138 .. I BEG="" S DONE=1 Q
139 .. S END=$P(TSEGS,U,I+1)
140 .. S SPECIND=$P(TSEGS,U,I+2)
141 ..; only count regular hours
142 .. I SPECIND,"RG"'[$P($G(^PRST(457.2,+SPECIND,0)),"^",2) Q
143 ..; convert beg & end to 24 hr to check if one < other (Xes midnight)
144 ..; also crossed midnight if not first seg starts at midnight.
145 ..; CROSS is true so remaining segments recorded to tomorrow.
146 .. S BEG24=$$TWENTY4^PRSPESR2(BEG)
147 .. S END24=$$TWENTY4^PRSPESR2(END)
148 .. I 'CROSS&(((BEG24'<END24)&(BEG24'=2400))!((I>1)&(BEG24=2400))) D
149 ... S CROSS=1
150 ... S SEGTOD=$S(BEG24=2400:0,1:$$AMT^PRSPSAPU(BEG,"MID",0))
151 ... S SEGTOM=$$AMT^PRSPSAPU("MID",END,0)
152 ... S TODHR=TODHR+SEGTOD
153 ... S TOMHR=TOMHR+SEGTOM
154 .. E D
155 ... S SEGTIME=$$AMT^PRSPSAPU(BEG,END,0)
156 ... I CROSS D
157 .... S TOMHR=TOMHR+SEGTIME
158 ... E D
159 .... S TODHR=TODHR+SEGTIME
160 . ;Pull meal off hrs for today, tomorrow or both.
161 . N HOURS S HOURS=$$PLACEML^PRSARC08(TODHR,TOMHR,MEALTIME)
162 . S TODHR=$P(HOURS,U)
163 . S TOMHR=$P(HOURS,U,2)
164 E D
165 . S TODHR=REGHRS
166 Q TODHR_"^"_TOMHR
167 ;
168PLACESHF(PRSTH,PRSD,T1,T2,WAGER) ;Place earliest shift from
169 ; tour 1 and tour 2 in SDA Tour array (PRSTH)
170 ;INPUT:
171 ; PRSTH - array to store SDA tour info p1=shift, p2=tour hrs.
172 ; PRSD - day number in pp 1-14
173 ; T1, T2 - tour 1 and 2 (ien in ToD file)
174 ; WAGER - 0 or 1 for whether this is a wage grade employee.
175 ;OUTPUT:
176 ; PRSTH by reference. Update "^" piece 1 with shift indicator
177 ;
178 N SHIFT,T1SHFTS,T2SHFTS,SHIFTINI,EARLIEST,SHIFT2
179 ;
180 ; Wage grade always have a 0 for shift
181 I WAGER D
182 . S $P(PRSTH(PRSD),U)=0
183 E D
184 . S T1SHFTS=$$TRSHFTS^PRSARC08(T1) ; get tour 1 shift for today and tomorrow
185 . S T2SHFTS=$$TRSHFTS^PRSARC08(T2) ; and tour 2
186 .; Get any shift placed by a two day tour from yesterday.
187 .; Then find earliest shift from t1, t2 and two day carryover
188 . S SHIFTINI=$P($G(PRSTH(PRSD)),U) I SHIFTINI="" S SHIFTINI=4
189 . S SHIFT=$P(T1SHFTS,U) I SHIFT="" S SHIFT=4
190 . S SHIFT2=$P(T2SHFTS,U) I SHIFT2="" S SHIFT2=4
191 . S EARLIEST=SHIFTINI
192 . I SHIFT<SHIFTINI S EARLIEST=SHIFT
193 . I SHIFT2<EARLIEST S EARLIEST=SHIFT2
194 . I EARLIEST=4 S EARLIEST=""
195 . S $P(PRSTH(PRSD),U)=EARLIEST
196 . ;
197 . ; Now do anything for tomorrow
198 . S SHIFTINI=$P($G(PRSTH(PRSD+1)),U,1) I SHIFTINI="" S SHIFTINI=4
199 . S SHIFT=$P(T1SHFTS,U,2) I SHIFT="" S SHIFT=4
200 . S SHIFT2=$P(T2SHFTS,U,2) I SHIFT2="" S SHIFT2=4
201 . S EARLIEST=SHIFTINI
202 . I SHIFT<SHIFTINI S EARLIEST=SHIFT
203 . I SHIFT2<EARLIEST S EARLIEST=SHIFT2
204 . I EARLIEST=4 S EARLIEST=""
205 . S $P(PRSTH(PRSD+1),U)=EARLIEST
206 Q
207 ;
Note: See TracBrowser for help on using the repository browser.