source: WorldVistAEHR/trunk/r/PAID-PRS/PRSA8BNH.m@ 1610

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

initial load of WorldVistAEHR
File size: 7.1 KB
Line 
1PRSA8BNH ;WOIFO/JAH - Tour Hours vs 8B Norm Hrs Report ;12/28/07
2 ;;4.0;PAID;**116**;Sep 21, 1995;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ; Search for 8b normal hours that don't match tours
6 ; look in timecard 8B node for normal hours otherwise use 450
7 ;
8PAYROLL ;prompt for T&L's--set's up payroll all T&L's
9 N PRSTLV,FORWHO
10 S PRSTLV=7
11 S FORWHO="for Payroll"
12 ;
13TIMEKEEP ; entry point sets up timekeeper T&L variable for PRSAUTL call
14 I $G(PRSTLV)'>0 N PRSTLV,FORWHO S PRSTLV=2,FORWHO="for Timekeeper"
15 ;
16SUPERV ; sets up supervisor for T&L lookup
17 I $G(PRSTLV)'>0 N PRSTLV,FORWHO S PRSTLV=3,FORWHO="for T&A Supervisor"
18 ;
19 N DIR,DIRUT,TLS,Y,PPI,PPE,NOTOUR,NOTCARD,PPRANGE,DAILYHRS,EP,SP,SDT,EDT
20 S TLS=1
21 S DIR(0)="Y"
22 S DIR("B")="Y"
23 S DIR("A")="All T&L's"
24 D ^DIR
25 Q:$D(DIRUT)
26 I +Y=1 S TLS="ALL"
27 I TLS=1 D
28 . D ^PRSAUTL
29 Q:TLS=1&($G(TLI)="")
30 ;
31 S PPI=$$GETPP^PRSA8BNI()
32 Q:PPI'>0
33 S PPE=$P($G(^PRST(458,PPI,0)),U)
34 S SDT=$P($G(^PRST(458,PPI,2)),U)
35 S EDT=$P($G(^PRST(458,PPI,2)),U,14)
36 S SP=$L(SDT," ")
37 S EP=$L(EDT," ")
38 S PPRANGE=$P(SDT," ",SP)_" thru "_$P(EDT," ",EP)
39 ;
40 ; ask user to include employees with no timecard at all.
41 S NOTCARD=$$NOTCARD^PRSA8BNI()
42 Q:NOTCARD<0
43 ;
44 ; ask user to include employees with no tour of duty entered
45 S NOTOUR=$$NOTOURS^PRSA8BNI()
46 Q:NOTOUR<0
47 ;
48 ; ask user to include employees daily tour hours
49 S DAILYHRS=$$DAILYHRS^PRSA8BNI()
50 Q:DAILYHRS<0
51 ;
52 ;
53 N %ZIS,POP,IOP
54 S %ZIS="MQ"
55 D ^%ZIS
56 Q:POP
57 I $D(IO("Q")) D
58 . K IO("Q")
59 . N ZTDESC,ZTRTN,ZTSAVE
60 . S ZTDESC="PAID REPORT: TOUR HOURS DON'T MATCH 8B NORMAL"
61 . S ZTRTN="TOUR8B^PRSA8BNH"
62 . S ZTSAVE("PRSTLV")=""
63 . S ZTSAVE("TLE")=""
64 . S ZTSAVE("PPI")=""
65 . S ZTSAVE("PPE")=""
66 . S ZTSAVE("TLS")=""
67 . S ZTSAVE("NOTOUR")=""
68 . S ZTSAVE("NOTCARD")=""
69 . S ZTSAVE("DAILYHRS")=""
70 . S ZTSAVE("PPRANGE")=""
71 . S ZTSAVE("FORWHO")=""
72 . D ^%ZTLOAD
73 . I $D(ZTSK) S ZTREQ="@"
74 E D
75 . D TOUR8B
76 K PRSTLV
77 D ^%ZISC K %ZIS,IOP
78 Q
79 ;
80TOUR8B ;
81 U IO
82 N OUT,TLECNT,TSTAMP,Y,%,%I,GRANDTOT,PG,ATL
83 D NOW^%DTC S Y=% D DD^%DT S TSTAMP=$P(Y,":",1,2)
84 S (TLECNT,OUT,GRANDTOT,PG)=0
85 I TLS="ALL" D
86 . N TLI,TLE
87 . S ATL="ATL"
88 . F S ATL=$O(^PRSPC(ATL)) Q:ATL>"ATLVCS"!OUT D
89 .. S TLE=$E(ATL,4,6)
90 .. Q:TLE=""
91 .. S TLI=$O(^PRST(455.5,"B",TLE,0))
92 .. Q:TLI'>0
93 ..; skip T&L's supervisors and timekeepers don't have access too
94 .. Q:(PRSTLV=2)&('$D(^PRST(455.5,"AT",DUZ,TLI)))
95 .. Q:(PRSTLV=3)&('$D(^PRST(455.5,"AS",DUZ,TLI)))
96 .. I TLECNT=0 D HDR^PRSA8BNI(.PG,TSTAMP,0,FORWHO,PPE,PPRANGE)
97 .. D LOOPTL(.OUT,.GRANDTOT,TLE,PPI,TSTAMP)
98 .. S TLECNT=TLECNT+1
99 E D
100 . D HDR^PRSA8BNI(.PG,TSTAMP,0,FORWHO,PPE,PPRANGE)
101 . D LOOPTL(.OUT,.GRANDTOT,TLE,PPI,TSTAMP)
102 . S TLECNT=TLECNT+1
103 D REPDONE^PRSA8BNI(OUT,TLECNT,TSTAMP,DAILYHRS,GRANDTOT)
104 Q
105 ;
106LOOPTL(OUT,TOT,TLE,PPI,TSTAMP) ; LOOP THROUGH T&L
107 N COUNT,NN,PRSIEN,EMPNODE,PRSENAME,HRS,EMPND1,SEPIND,WEEKHRS,PRSD,PRSSN
108 K ERRORS
109 S (COUNT,OUT)=0
110 S NN=""
111 F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" D
112 . F PRSIEN=0:0 S PRSIEN=$O(^PRSPC("ATL"_TLE,NN,PRSIEN)) Q:PRSIEN<1!(OUT) D
113 ..; skip Extended LWOP or anyone without a timecard
114 .. Q:'NOTCARD&($G(^PRST(458,PPI,"E",PRSIEN,0))="")
115 .. Q:'NOTOUR&($P($G(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,2)="")
116 .. S EMPNODE=$G(^PRSPC(PRSIEN,0))
117 .. S EMPND1=$G(^PRSPC(PRSIEN,1))
118 .. S SEPIND=$P(EMPND1,U,33)
119 .. Q:EMPNODE=""!(SEPIND="Y")
120 .. I '$$HRSMATCH^PRSATPE(PPI,PRSIEN) D
121 ... S COUNT=COUNT+1
122 ... S GRANDTOT=GRANDTOT+1
123 ... S ERRORS(PRSIEN)=""
124 I COUNT>0 D
125 . I DAILYHRS,$Y>(IOSL-12) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
126 . I 'DAILYHRS,$Y>(IOSL-7) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
127 . W !!,?12,"T & L UNIT: "_TLE," ",COUNT," mismatches found."
128 . S PRSIEN=""
129 . F S PRSIEN=$O(ERRORS(PRSIEN)) Q:PRSIEN'>0!OUT D
130 .. S WEEKHRS=$$GETHOURS^PRSA8BNI(PPI,PRSIEN)
131 .. S PRSENAME=$P($G(^PRSPC(PRSIEN,0)),U)
132 .. S PRSSN=$P($G(^PRSPC(PRSIEN,0)),U,9)
133 .. S PRSSN=$S(PRSTLV=7:$E(PRSSN,1,3)_"-"_$E(PRSSN,4,5),PRSTLV'<2:$E(PRSSN,1)_"XX-XX",1:"XXX-XX")_"-"_$E(PRSSN,6,9)
134 .. I DAILYHRS,$Y>(IOSL-10) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
135 .. I 'DAILYHRS,$Y>(IOSL-5) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
136 .. D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
137 ..; show the actual tour hours for each day
138 .. I DAILYHRS D
139 ... N HRS,I
140 ... D TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
141 ... I $Y>(IOSL-8) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
142 ... D TRHDR^PRSA8BNI
143 ... F PRSD=1:1:7 D Q:OUT
144 .... I $Y>(IOSL-4) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS),TRHDR^PRSA8BNI
145 .... Q:OUT
146 .... D TOURDISP(PPI,PRSIEN,PRSD,.HRS)
147 .. Q:OUT
148 .. I $Y>(IOSL-5) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT
149 Q
150TOURDISP(PPI,PRSIEN,PRSD,HRS) ;
151 N Y1,Y2,Y4,Y5,DTE,TD1C1,TD1C2,L2,L3,TD2C1,TD2C2
152 S TD1C1=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2),Y1=$G(^(1)),Y4=$G(^(4))
153 S TD2C1=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",13)
154 I Y1="" S Y1=$S(TD1C1=1:"Day Off",TD1C1=2:"Day Tour",TD1C1=3!(TD1C1=4):"Intermittent",1:"")
155 S TD1C2=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD+7,0)),"^",2),Y2=$G(^(1)),Y5=$G(^(4))
156 S TD2C2=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD+7,0)),"^",13)
157 I Y2="" S Y2=$S(TD1C2=1:"Day Off",TD1C2=2:"Day Tour",TD1C2=3!(TD1C2=4):"Intermittent",1:"")
158 S DTE=$P("Sun Mon Tue Wed Thu Fri Sat"," ",PRSD)
159 W !?7,DTE S (L2,L3)=0
160 I Y1="",Y2="" Q
161 ;
162S0 ; Set Schedule Array
163 N A1,L1,B
164 F L1=1:3:19 D
165 . S A1=$P(Y1,"^",L1) Q:A1=""
166 . S L2=L2+1,Y1(L2)=A1
167 . S:$P(Y1,"^",L1+1)'="" Y1(L2)=Y1(L2)_"-"_$P(Y1,"^",L1+1)
168 . I L1=1 D
169 .. N DAYHRS S DAYHRS=$J($P(HRS(PRSD),U,2),5,2)
170 .. S B=$E(" ",1,20-$L(DAYHRS)-$L(Y1(L2)))
171 .. S Y1(L2)=$J(TD1C1,5,0)_" "_Y1(L2)_B_DAYHRS
172 . E D
173 .. S Y1(L2)=" "_Y1(L2)
174 . I $P(Y1,"^",L1+2)'="" D
175 .. S L2=L2+1
176 .. S Y1(L2)=" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",1)
177 G:Y4="" S1
178 F L1=1:3:19 D
179 . S A1=$P(Y4,"^",L1) Q:A1=""
180 . S L2=L2+1
181 . S Y1(L2)=A1
182 . S:$P(Y4,"^",L1+1)'="" Y1(L2)=Y1(L2)_"-"_$P(Y4,"^",L1+1)
183 . I L1=1 D
184 .. S Y1(L2)=$J(TD2C1,5,0)_" "_Y1(L2)
185 . E D
186 .. S Y1(L2)=" "_Y1(L2)
187 . I $P(Y4,"^",L1+2)'="" D
188 .. S L2=L2+1
189 .. S Y1(L2)=" "_$P($G(^PRST(457.2,+$P(Y4,"^",L1+2),0)),"^",1)
190 ;
191S1 ; Set Schedule Array
192 F L1=1:3:19 D
193 . S A1=$P(Y2,"^",L1) Q:A1=""
194 . S L3=L3+1
195 . S Y2(L3)=A1
196 . S:$P(Y2,"^",L1+1)'="" Y2(L3)=Y2(L3)_"-"_$P(Y2,"^",L1+1)
197 . I L1=1 D
198 .. N DAYHRS S DAYHRS=$J($P(HRS(PRSD+7),U,2),5,2)
199 .. S B=$E(" ",1,20-$L(DAYHRS)-$L(Y2(L3)))
200 .. S Y2(L3)=$J(TD1C2,5,0)_" "_Y2(L3)_B_DAYHRS
201 . E D
202 .. S Y2(L3)=" "_Y2(L3)
203 . I $P(Y2,"^",L1+2)'="" D
204 .. S L3=L3+1
205 .. S Y2(L3)=" "_$P($G(^PRST(457.2,+$P(Y2,"^",L1+2),0)),"^",1)
206 ;
207 G:Y5="" S2
208 ;
209 F L1=1:3:19 D
210 . S A1=$P(Y5,"^",L1) Q:A1=""
211 . S L3=L3+1,Y2(L3)=A1
212 . S:$P(Y5,"^",L1+1)'="" Y2(L3)=Y2(L3)_"-"_$P(Y5,"^",L1+1)
213 . I L1=1 D
214 .. S Y2(L3)=$J(TD2C2,5,0)_" "_Y2(L3)
215 . E D
216 .. S Y2(L3)=" "_Y2(L3)
217 . I $P(Y5,"^",L1+2)'="" D
218 .. S L3=L3+1
219 .. S Y2(L3)=" "_$P($G(^PRST(457.2,+$P(Y5,"^",L1+2),0)),"^",1)
220 ;
221S2 ;
222 N K
223 F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) D
224 . W:K>1 ! W:$D(Y1(K)) ?12,Y1(K) W:$D(Y2(K)) ?47,Y2(K)
225 Q
Note: See TracBrowser for help on using the repository browser.