source: FOIAVistA/trunk/r/PAID-PRS/PRSACED3.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1PRSACED3 ;HISC/MGD-T&A Edits ;02/03/06
2 ;;4.0;PAID;**35,45,75,92,96,102**;Sep 21, 1995
3 S E(1)=0
4 F K=24,25,33,43:1:45 S X=$P(C0,"^",K) I X'="" S LAB=$P(T0," ",K-12) D @LAB
5 F K=6,7,15,25:1:27,42,45,47:1:57 S X=$P(C1,"^",K) I X'="" S LAB=$P(T1," ",K) D @LAB
6 I E(1)>$S(NOR>1:NOR*10,1:140),DUT=1 S ERR=69 D ERR^PRSACED
7 G ^PRSACED4
8PA ;
9PB S E(1)=E(1)+X
10 I DUT=2,LAB="PA",X>$P(C0,"^",42) S ERR=70 D ERR^PRSACED
11 I DUT=2,LAB="PB",X>$P(C1,"^",24) S ERR=70 D ERR^PRSACED
12 I DUT=3,X>400 S ERR=71 D ERR^PRSACED
13 I '$P(C1,"^",41) S ERR=72 D ERR^PRSACED
14 Q
15ON ;
16CL I PAY'="A"!("^U^V^W^Y^"'[(U_PMP_U)) S ERR=73 D ERR^PRSACED
17 I X>1280 S ERR=74 D ERR^PRSACED
18 Q
19VC I $P(C1,"^",27)="" S ERR=75 D ERR^PRSACED
20VS I LAB="VS",$P(C0,"^",45)="" S ERR=75 D ERR^PRSACED
21 I PAY'="U" S ERR=77 D ERR^PRSACED
22 Q
23YA Q
24YD Q
25YE Q
26DT ;Validate lump sum expiration date and report format errors.
27 ; REQUIRED VARIABLES: X = date to be checked, format mmddyy.
28 ; PPI = current pay period IEN.
29 ;
30 ;1. Check month. 2. Check days aren't > than corresponding month.
31 ;3. To check that year is in range: current year to next year:
32 ; Get 1st day of pp for date being checked.
33 ; Get 4 digit year from PP^PRSAPPU.
34 ; Add 1 to the 4 digit year and check year range.
35 ;
36 ; Month
37 I $E(X,1,2)<1!($E(X,1,2)>12) D
38 . S ERR=138 D ERR^PRSACED
39 ;
40 ; Days
41 S X1=+$E(X,3,4)
42 I X1<1!(X1>$P("31 29 31 30 31 30 31 31 30 31 30 31"," ",+$E(X,1,2))) D
43 . S ERR=138 D ERR^PRSACED
44 ;
45 ; Year
46 N PPE,PP4Y,D1,NXTYR,DAY
47 S D1=$P($G(^PRST(458,PPI,1)),"^")
48 D PP^PRSAPPU
49 S YEAR=$E(+PP4Y,3,4),NXTYR=$E(+PP4Y+1,3,4),X1=$E(X,5,6)
50 I '((X1=YEAR)!(X1=NXTYR)) D
51 . S ERR=138 D ERR^PRSACED
52 ;
53 ; Firefighters can't use lump sum date
54 I NOR>80 S ERR=173 D ERR^PRSACED
55 Q
56YH Q
57SP ; saturday premium pay
58SQ N HYBRID
59 S HYBRID=$S(+$G(DFN)'="":$$HYBRID^PRSAENT1(DFN),1:0)
60 S MX=$S("ABCKMN"[PAY:400,HYBRID:400,1:320) I X>MX S ERR=140 D ERR^PRSACED
61 I "ABCKMN"'[PAY S ERR=141 D ERR^PRSACED
62 I "ABCN"[PAY,PMP="",'HYBRID S ERR=149 D ERR^PRSACED
63 Q
64TF ; travel ot flsa
65TG I FLSA'="N" S ERR=142 D ERR^PRSACED
66 Q
67DA ; hrs excess 8 (day)
68DE I "0123456789AGKMNU"'[PAY S ERR=143 D ERR^PRSACED
69 Q
70DB ; hrs excess 8 (two)
71DF I "0123456789BGU"'[PAY S ERR=145 D ERR^PRSACED
72 Q
73DC ; hrs excess 8 (three)
74DG I "0123456789GU"'[PAY S ERR=147 D ERR^PRSACED
75 Q
76TA ; travel
77 I NOR>0,DUT=1,(X+($P(C1,"^",54)))>(NOR*10) S ERR=95 D ERR^PRSACED
78 I "23"[DUT,X>($P(C0,"^",42)+($P(C0,"^",21))) S ERR=94 D ERR^PRSACED
79 I DUT=1,"45"[LVG,+X>70 S ERR=91 D ERR^PRSACED
80 I NOR>80,$P(C0,"^",42),X>$P(C0,"^",42) S ERR=92 D ERR^PRSACED
81 Q
82TB ;
83 I NOR>0,DUT=1,($P(C1,"^",15)+X)>(NOR*10) S ERR=95 D ERR^PRSACED
84 I "23"[DUT,X>($P(C1,"^",24)+($P(C1,"^",3))) S ERR=94 D ERR^PRSACED
85 I DUT=1,"45"[LVG,+X>70 S ERR=91 D ERR^PRSACED
86 I NOR>80,$P(C1,"^",24),X>$P(C1,"^",24) S ERR=92 D ERR^PRSACED
87 Q
88TC ; training
89 I NOR>0,DUT=1,(X+($P(C1,"^",57)))>(NOR*10) S ERR=98 D ERR^PRSACED
90 I "23"[DUT,X>($P(C0,"^",42)+($P(C0,"^",21))) S ERR=97 D ERR^PRSACED
91 I DUT=1,"45"[LVG,+X>70 S ERR=91 D ERR^PRSACED
92 I NOR>80,$P(C0,"^",42),X>$P(C0,"^",42) S ERR=92 D ERR^PRSACED
93 Q
94TD ;
95 I NOR>0,DUT=1,($P(C1,"^",42)+X)>(NOR*10) S ERR=98 D ERR^PRSACED
96 I "23"[DUT,X>($P(C1,"^",24)+($P(C1,"^",3))) S ERR=97 D ERR^PRSACED
97 I DUT=1,"45"[LVG,+X>70 S ERR=91 D ERR^PRSACED
98 I NOR>80,$P(C1,"^",24),X>$P(C1,"^",24) S ERR=92 D ERR^PRSACED
99 Q
Note: See TracBrowser for help on using the repository browser.