source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPLVU.m@ 623

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

initial load of WorldVistAEHR
File size: 7.2 KB
Line 
1PRSPLVU ;WOIFO/SAB - LEAVE UTILITIES ;3/31/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 ;
6LOADTOD(PPI,PRSIEN,DAY,TOD,TODD) ; Load Tour of Duty into TOD() Array
7 ; input
8 ; PPI - pay period IEN, file 458
9 ; PRSIEN - employee IEN, file 450
10 ; DAY - day number in PP
11 ; TOD - array, passed by reference, will be initialized
12 ; TODD - array, passed by reference, will be initialized
13 ; output
14 ; TOD - array updated with tour segments in following format
15 ; TOD(tour#-segment#)=
16 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
17 ; ^special code
18 ; TODD - array updated with tour data in the following format
19 ; TODD(tour#)=
20 ; earliest regular start d/t (FM)^latest regular end d/t (FM)^
21 ; tour meal length (minutes)^segment # of longest regular tour segment
22 ;
23 N FLD,NODE,PRSDT,PRSX,TN,TODI,TODY,TSC,TSE,TSI,TSLS,TSS,TST
24 ;
25 K TOD,TODD ; initialize array
26 ;
27 S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
28 Q:'PRSDT
29 ;
30 ; loop thru both tours (#1 and #2) for the day
31 F TN=1,2 D
32 . S NODE=$S(TN=1:1,TN=2:4,1:"")
33 . Q:NODE=""
34 . S TODY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,NODE))
35 . S TSLS(0)=0 ; init longest regular segment length (seconds)
36 . ;
37 . ; obtain the tour meal time
38 . S FLD=$S(TN=1:2,1:10.3) ; field number corresponding to tour #1 or #2
39 . S TODI=$$GET1^DIQ(458.02,DAY_","_PRSIEN_","_PPI_",",FLD,"I") ; tour of duty IEN
40 . S:TODI $P(TODD(TN),U,3)=$$GET1^DIQ(457.1,TODI,2) ; tour meal (minutes)
41 . ;
42 . ; loop thru seven time segments of tour
43 . F TSI=1:1:7 D
44 . . S TSS=$P(TODY,U,(TSI-1)*3+1) ; time segment start
45 . . Q:TSS=""
46 . . S TSE=$P(TODY,U,(TSI-1)*3+2) ; time segment end
47 . . Q:TSE=""
48 . . S TSC=$P(TODY,U,(TSI-1)*3+3) ; time segment special code
49 . . ; derive type of time
50 . . S TST=$S(TSC:$P($G(^PRST(457.2,TSC,0)),U,2),1:"RG")
51 . . ; convert times to FileMan date/time format
52 . . S PRSX=$$CNVTS(PRSDT,TSS,TSE)
53 . . Q:$P(PRSX,U)=""
54 . . S TOD(TN_"-"_TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSC
55 . . ;
56 . . ; skip remaining steps if segment is not regular time
57 . . Q:TST'="RG"
58 . . ;
59 . . ; if earliest start time of tour is null, set it from current seg.
60 . . S:$P($G(TODD(TN)),U)="" $P(TODD(TN),U)=$P(PRSX,U)
61 . . ;
62 . . ; if latest end time of tour is null, set it from current seg.
63 . . S:$P($G(TODD(TN)),U,2)="" $P(TODD(TN),U,2)=$P(PRSX,U,2)
64 . . ;
65 . . ; if this segments start time is earlier, update the tour start
66 . . I $P(PRSX,U)<$P(TODD(TN),U) S $P(TODD(TN),U)=$P(PRSX,U)
67 . . ;
68 . . ; if this segments end time is later, update the tour end
69 . . I $P(PRSX,U,2)>$P(TODD(TN),U,2) S $P(TODD(TN),U,2)=$P(PRSX,U,2)
70 . . ;
71 . . ; compute length of the tour segment (seconds)
72 . . S TSLS=$$FMDIFF^XLFDT($P(PRSX,U,2),$P(PRSX,U,1),2)
73 . . ; if segment length more than longest found use it as longest found
74 . . I TSLS>TSLS(0) S TSLS(0)=TSLS,$P(TODD(TN),U,4)=TSI
75 Q
76 ;
77LOADESR(PPI,PRSIEN,DAY,ESR) ; Load ESR into ESR() Array
78 ; input
79 ; PPI - pay period IEN, file 458
80 ; PRSIEN - employee IEN, file 450
81 ; DAY - day number in PP
82 ; ESR - array, passed by reference, will be initialized
83 ; output
84 ; ESR - array updated with tour segments in following format
85 ; ESR(segment #)=
86 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
87 ; ^meal (min)
88 ;
89 N ESRY,PRSDT,PRSX,TSE,TSI,TSM,TSS,TST
90 ;
91 K ESR ; initialize array
92 ;
93 S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
94 Q:'PRSDT
95 ;
96 S ESRY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
97 ;
98 ; loop thru seven time segments
99 F TSI=1:1:7 D
100 . S TSS=$P(ESRY,U,(TSI-1)*5+1) ; time segment start
101 . Q:TSS=""
102 . S TSE=$P(ESRY,U,(TSI-1)*5+2) ; time segment end
103 . Q:TSE=""
104 . S TST=$P(ESRY,U,(TSI-1)*5+3) ; time segment type of time
105 . Q:TST=""
106 . ; convert times to FileMan date/time format
107 . S PRSX=$$CNVTS(PRSDT,TSS,TSE)
108 . Q:$P(PRSX,U)=""
109 . S TSM=$P(ESRY,U,(TSI-1)*5+5) ; time segment meal (min)
110 . S ESR(TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSM
111 Q
112 ;
113LOADTC(PPI,PRSIEN,DAY,TC) ; Load Time Card into TC() Array
114 ; input
115 ; PPI - pay period IEN, file 458
116 ; PRSIEN - employee IEN, file 450
117 ; DAY - day number in PP
118 ; TC - array, passed by reference, may contain data
119 ; output
120 ; TC - array updated with tour segments in following format
121 ; TC(segment #)=
122 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
123 ;
124 N PRSDT,PRSX,TCY,TSE,TSI,TSS
125 ;
126 K TC ; initialize array
127 ;
128 S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
129 Q:'PRSDT
130 ;
131 S TCY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,2))
132 ;
133 ; loop thru seven tour segments
134 F TSI=1:1:7 D
135 . S TSS=$P(TCY,U,(TSI-1)*3+1) ; time segment start
136 . Q:TSS=""
137 . S TSE=$P(TCY,U,(TSI-1)*3+2) ; time segment end
138 . Q:TSE=""
139 . S TST=$P(TCY,U,(TSI-1)*3+3) ; time segment type of time
140 . Q:TST=""
141 . ; convert times to FileMan date/time format
142 . S PRSX=$$CNVTS(PRSDT,TSS,TSE)
143 . Q:$P(PRSX,U)=""
144 . S TC(TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE
145 Q
146 ;
147OKALVR(LVIEN) ; OK Approve Leave Request
148 ; Called by Supervisory Approvals to see if it is OK to approve a
149 ; leave request
150 ; Input
151 ; LVIEN - Leave Request IEN (file 458.1)
152 ; Result
153 ; string value
154 ; = 1 if OK to approve leave request
155 ; = 0 or 0^PPI if not OK to approve leave request
156 ; where PPI is the Pay Period ien (file 458)
157 ;
158 N D1,DAY,EPP4Y,LVY0,PP4Y,PPE,PPI,PRSIEN,PRSRET,SPP4Y,Y
159 ;
160 S PRSRET=1 ; initialize as OK
161 ;
162 I '$G(LVIEN) S PRSRET=0 Q PRSRET ; required input
163 ;
164 S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
165 S PRSIEN=$P(LVY0,U,2) ; employee IEN
166 ;
167 ; if employee has any memos
168 I $$PTP^PRSPUT3(PRSIEN) D
169 . ; determine starting and ending pay periods
170 . 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)
171 . S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
172 . ;
173 . ; loop thru pay periods
174 . S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
175 . F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D Q:'PRSRET
176 . . S PPI=$O(^PRST(458,"AB",PP4Y,0))
177 . . ;
178 . . ; skip PP if not covered by memo
179 . . S D1=$P($G(^PRST(458,PPI,1)),U)
180 . . Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0 ; PP not covered by memo
181 . . ;
182 . . ; skip PP if time card status not = payroll
183 . . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)'="P"
184 . . ;
185 . . ; can't approve this leave request until time card status changes
186 . . S PRSRET=0_U_PPI
187 ;
188 Q PRSRET
189 ;
190CNVTS(DATE,START,END) ; Convert Time Segment
191 ; input
192 ; returns string with value =
193 ; Start Date/Time (FileMan internal)^End Date/Time (FileMan internal)
194 ;
195 N CNX,FMEND,FMSTR,PRSM,PRSRET,X,XMID,Y
196 S X=START_U_END
197 D CNV^PRSATIM
198 S PRSM=Y
199 S XMID=$S($P(PRSM,U,2)'>$P(PRSM,U):1,1:0)
200 S FMSTR=$$FMADD^XLFDT(DATE,,,$P(PRSM,U))
201 S FMEND=$$FMADD^XLFDT(DATE,XMID,,$P(PRSM,U,2))
202 S PRSRET=FMSTR_"^"_FMEND
203 ;
204 Q PRSRET
205 ;
206FMETA(TIME) ; FileMan to ETA time
207 N HRS,MIN,PM,PRSRET
208 S PRSRET=""
209 S TIME=$$LJ^XLFSTR(TIME,4,"0") ; add trailing 0s to fileman time
210 I TIME=1200 S PRSRET="NOON"
211 I TIME=2400 S PRSRET="MID"
212 I PRSRET="" D
213 . S PM=0
214 . S HRS=$E(TIME,1,2)
215 . S MIN=$E(TIME,3,4)
216 . I HRS>12 S HRS=HRS-12,PM=1
217 . S PRSRET=$$RJ^XLFSTR(HRS,2,"0")_":"_$$RJ^XLFSTR(MIN,2,"0")_$S(PM:"P",1:"A")
218 Q PRSRET
219 ;PRSPLVU
Note: See TracBrowser for help on using the repository browser.