source: FOIAVistA/trunk/r/PAID-PRS/PRSASR.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1PRSASR ;HISC/MGD,WOIFO/JAH/PLT - Supervisor Certification ;02/05/2005
2 ;;4.0;PAID;**2,7,8,22,37,43,82,93,112**;Sep 21, 1995;Build 54
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;Called by Pay Per Cert Option on T&A Superv menu. Timecard 4 each
6 ;employee in this supervs T&L is displayed. Superv prompted at each
7 ;display as to whether card is ready 4 certification. Cards that r
8 ;ready r saved in ^TMP. After this review--elect sign code is
9 ;required to release approved cards to payroll. Upon ES
10 ; 8b, exceptions, & ot warnings r stored & timecard status
11 ;changed to 'P'--'released to payroll'
12 ;
13 ;=====================================================================
14 ;
15 ;Set up reverse video ON & OFF for tour error highlighting
16 N IORVOFF,IORVON,IOINHI,IOINORM,IOBOFF,IOBON,RESP
17 S X="IORVOFF;IORVON;IOBOFF;IOBON;IOINHI;IOINORM" D ENDR^%ZISS
18 ;
19 N MIDPP,DUMMY
20 S MIDPP="In middle of Pay Period; Cannot Certify & Release."
21 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
22 W !?27,"SUPERVISORY CERTIFICATION"
23 S PRSTLV=3 D ^PRSAUTL G:TLI<1 EX
24 D NOW^%DTC
25 S DT=%\1,APDT=%,Y=$G(^PRST(458,"AD",DT)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
26 I DAY>5,DAY<11 W $C(7),!!,MIDPP G EX
27 I DAY<6 S X1=DT,X2=-7 D C^%DTC S PPI=$P($G(^PRST(458,"AD",X)),"^",1) G:'PPI EX
28 ; -----------------------------------------
29P0 ;PDT = string of pay period dates with format - Sun 29-Sep-96^
30 ;PDTI = string of pay period dates in fileman format.
31 ;PPI = pay period internal entry number in file 458.
32 ;GLOB = global reference for employees pay period record
33 ; returned from $$AVAILREC & passed to UNLOCK.
34 ; -----------------------------------------
35 ;
36 S PDT=$G(^PRST(458,PPI,2)),PDTI=$G(^(1)),QT=0 K ^TMP($J)
37 ;
38 ; -----------------------------------------
39 ;Loop thru this supervisor's T&L unit on x-ref in 450.
40 ;$$availrec() ensures there's data & node with employee's
41 ;pay period record is NOT locked, then locks node.
42 ;Call to CHK checks for needed approvals for current employee
43 ;If supervisor decides record is not ready, during this call,
44 ;then node is unlocked. Records that super accepts for release
45 ;are not unlocked until they are processed thru temp global
46 ;& their status' are updated.
47 ; ---------------------------------------------------
48 ;
49 S NN="",CKS=1
50 F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 I $$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G T0
51 ;
52 ; ---------------------------------------------------
53 ;Loop through T&L unit file x-ref 2 c if this supervisor certifies
54 ;payperiod data for other supervisors of other T&L units. If so
55 ;process after ensuring node to be certified is available.
56 ; ---------------------------------------------------
57 ;
58 S CKS=0
59 F VA2=0:0 S VA2=$$TLSUP Q:VA2<1 S SSN=$$SSN I SSN'="" S DFN=$$DFN S Z=$P($G(^PRSPC(+DFN,0)),"^",8) I Z'="",Z'=TLE,$$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G EX:'$T,T0
60 ;
61 ; ---------------------------------------------------
62T0 I $D(^TMP($J,"E")) G T1
63 W !!,"No records have been selected for certification."
64 S DUMMY=$$ASK^PRSLIB00(1) G EX
65 ;
66 ; ---------------------------------------------------
67 ;
68T1 ;if supervisor signs off then update all records in tmp
69 ;otherwise remove any auto posting.
70 D ^PRSAES I ESOK D
71 .D NOW^%DTC S APDT=%
72 .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 S VAL=$G(^(DFN)) D PROC
73 I 'ESOK D
74 .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 D
75 ..D AUTOPINI^PRS8(PPI,DFN)
76 D EX
77 Q
78 ;
79 ; ---------------------------------------------------
80CHK ; Check for needed approvals
81 N PRSENT,PRSWOC
82 S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I "PX"[STAT Q
83 I USR=DFN Q:'$D(^XUSEC("PRSA SIGN",DUZ))
84 E I CKS S SSN=$P($G(^PRSPC(DFN,0)),"^",9) I SSN S EDUZ=+$O(^VA(200,"SSN",SSN,0)) I $D(^PRST(455.5,"AS",EDUZ,TLI)) Q:$P($G(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)'=TLE
85 S HDR=0 D HDR,^PRSAENT S PRSENT=ENT
86 ;
87 ;Loop to display tour, exceptions(leave, etc..) & errors.
88 ;
89 S (XF,X9)=0
90 F DAY=1:1:14 D TOURERR($P(PDT,"^",DAY),.X9,.XF) D:$Y>(IOSL-6)&(DAY<14) HDR G:QT O1
91 ;
92 ;Display VCS commission sales, if applicable
93 S Z=$G(^PRST(458,PPI,"E",DFN,2))
94 I Z'="" D:$Y>(IOSL-11) HDR Q:QT D VCS^PRSASR1
95 ;
96 ;
97 S Z=$G(^PRST(458,PPI,"E",DFN,4))
98 I Z'="" D:$Y>(IOSL-9) HDR Q:QT D ED^PRSASR1
99 I XF W !,IORVON,"Serious error; cannot release.",IORVOFF S QT=$$ASK^PRSLIB00() Q
100 S QT=$$ASK^PRSLIB00() Q:QT
101 ;
102 ;PRS8 call creates & stores 8B string in employees attendance
103 ;record. Later, under a payroll option, string will be
104 ;transmitted to Austin.
105 ;
106 N NN D ONE^PRS8 S C0=$G(^PRSPC(DFN,0)),PY=PPI D CERT^PRS8VW S QT=0
107 ;
108 ;Show OT (approve-vs-8B) warning & save in TMP.
109 N WK,OTERR,O8,OA
110 F WK=1:1:2 D
111 . D WARNSUP^PRSAOTT(PPE,DFN,VAL,WK,.OTERR,.O8,.OA)
112 . I OTERR S ^TMP($J,"OT",DFN,WK)=O8_"^"_OA
113 ;
114 ;warning message for rs/rn and on type of time
115 I $E(PRSENT,5) D
116 . I @($TR($$CD8B^PRSU1B2(VAL,"RS^3^RN^3",1),U,"+")_"-("_$TR($$RSHR^PRSU1B2(DFN,PPI),U,"+")_")") W !,?3,"WARNING: The total scheduled recess hours for this pay period does not match the total RS/RN posted."
117 . I $G(PRSWOC)]"" W !,?3,"Warning: The entire tour for day# ",PRSWOC," is posted RECESS. The On-Call will be paid unless posted UNAVAILABLE."
118 . QUIT
119 ;
120LD ; Check for changes to the Labor Distribution Codes made during the pay
121 ; period.
122 I $D(^PRST(458,PPI,"E",DFN,"LDAUD")) D LD^PRSASR1
123 ; ---------------------------------------------------
124OK ;Prompt Supervisor to release timecard. If yes, store in ^TMP(.
125 ;If supervisor answers no then bypass & unlock record.
126 ; ---------------------------------------------------
127 W !!,IORVON,"Release to Payroll?",IORVOFF," "
128 R X:DTIME S:'$T!(X["^") QT=1 Q:QT S:X="" X="*" S X=$TR(X,"yesno","YESNO")
129 I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G OK
130 I X?1"Y".E S ^TMP($J,"E",DFN)=VAL
131 E D
132 . D AUTOPINI^PRS8(PPI,DFN) ; remove any auto posting
133 . D UNLOCK^PRSLIB00(GLOB) ; unlock record
134 . K ^TMP($J,"LOCK",DFN) ;clean out of local lock list.
135O1 Q
136 ;
137PROC ; Set Approval, file any exceptions & update 8B string
138 ;
139 ; get employees entitlement string in variable A1
140 D ^PRSAENT
141 ;
142 ; set approvals
143 S $P(^PRST(458,PPI,"E",DFN,0),"^",3,5)=DUZ_"^"_APDT_"^"_A1
144 ; VCS approval
145 I $D(^PRST(458,PPI,"E",DFN,2)) S $P(^(2),"^",17,18)=DUZ_"^"_APDT
146 ;
147 ; loop thru any exceptions & file in 458.5
148 I $D(^TMP($J,"X",DFN)) S K="" F S K=$O(^TMP($J,"X",DFN,K)) Q:K="" S DAY=$P(K," ",1),X1=$P(PDTI,"^",DAY),X2=$G(^(K)) D ^PRSATPF
149 ;
150 ; file overtime warnings
151 F WK=1:1:2 I $G(^TMP($J,"OT",DFN,WK))'="" D
152 . S O8=$P(^TMP($J,"OT",DFN,WK),"^")
153 . S OA=$P(^TMP($J,"OT",DFN,WK),"^",2)
154 . D FILEOTW^PRSAOTTF(PPI,DFN,WK,O8,OA)
155 ;
156 ;set 8b string & change status of timecard to payroll
157 S ^PRST(458,PPI,"E",DFN,5)=VAL S $P(^PRST(458,PPI,"E",DFN,0),"^",2)="P"
158 ;
159 ; If employee is a PT Phys w/ memo update hours credited
160 D PTP^PRSASR1(DFN,PPI)
161 ;
162 ;unlock employees time card record
163 S GLOB="^PRST(458,"_PPI_","_"""E"""_","_DFN_",0)"
164 D UNLOCK^PRSLIB00(GLOB)
165 K ^TMP($J,"LOCK",DFN) ;clean out of local lock list.
166 Q
167 ;
168 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
169 ;
170HDR ; Display Header
171 I HDR S QT=$$ASK^PRSLIB00() Q:QT
172 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X),"XX-XX-",$E(X,6,9) S HDR=1
173 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF
174 W !?3 F I=1:1:72 W "-"
175 Q
176 ;====================================================================
177HDR2 ; Display Header don't quit
178 N HOLD
179 S HOLD=$$ASK^PRSLIB00(1)
180 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X),"XX-XX-",$E(X,6,9)
181 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF
182 W !?3 F I=1:1:72 W "-"
183 Q
184 ;====================================================================
185 ;
186EX ; clean up variables & unlock any leftover time card nodes
187 N EMPREC
188 S EMPREC=""
189 F S EMPREC=$O(^TMP($J,"LOCK",EMPREC)) Q:EMPREC="" D
190 . S GLOB="^PRST(458,"_PPI_","_"""E"""_","_EMPREC_",0)"
191 . D UNLOCK^PRSLIB00(GLOB)
192 K ^TMP($J) G KILL^XUSCLEAN
193 Q
194 ;
195 ;
196 ;These extrinsic functions simply remove lengthy code from long,
197 ;single line, nested loop.
198 ; ---------------------------------------------------
199TLSUP() ;get next supervisor who certifies other supervisors
200 Q $O(^PRST(455.5,"ASX",TLE,VA2))
201 ; ---------------------------------------------------
202SSN() ;get ssn of supervisor to be certified by this supervisor.
203 Q $P($G(^VA(200,VA2,1)),"^",9)
204 ; ---------------------------------------------------
205DFN() ;get internal entry number of supvisor of other T&L 2b approved
206 ;by current supervisor.
207 Q $O(^PRSPC("SSN",SSN,0))
208 ;====================================================================
209TOURERR(DTE,X9,XF) ;DISPLAY TOUR & ERRORS
210 ;
211 N IORVOFF,IORVON,RESP,ERRLEN
212 S X="IORVOFF;IORVON" D ENDR^%ZISS
213 D F1^PRSADP1,^PRSATPE
214 F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) D
215 . I $Y>(IOSL-4) D HDR2
216 . W:K>1 !
217 . W:$D(Y1(K)) ?21,Y1(K)
218 . W:$P($G(Y2(K)),"^")'="" ?45,$P(Y2(K),"^",1)
219 . I $P($G(Y2(K)),"^",2)'="" W:$X>44 ! W ?45,$P(Y2(K),"^",2)
220 W:Y3'="" !?10,Y3
221 I $D(ER) S:FATAL XF=1 F K=0:0 S K=$O(ER(K)) Q:K<1 D
222 . I $Y>(IOSL-4) D HDR2
223 .W:X9!($X>55) ! S ERRLEN=23
224 .I $P(ER(K),"^",2)'="" S ERRLEN=$L(ER(K))
225 .W ?(IOM-(ERRLEN+1)),IORVON
226 .W:$P(ER(K),"^",2)'="" $P(ER(K),"^",2)
227 .W " ",$P(ER(K),"^",1),IORVOFF
228 .S X9=0 S:'XF ^TMP($J,"X",DFN,DAY_" "_K)=ER(K)
229 .Q
230 Q
Note: See TracBrowser for help on using the repository browser.