Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/PAID-PRS/PRSACED2.m

    r613 r623  
    1 PRSACED2        ; HISC/FPT-T&A Edits ;11/24/1999
    2         ;;4.0;PAID;**45,54,112**;Sep 21, 1995;Build 54
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5         ; initialize array that stores 8b values.  This array is used
    6         ; for edit checks that involve more than one type of time.
    7         ;   nodes 14-17 were initialized and set in PRSACED1.
    8         F Z=1:1:13 S E(Z)=0
    9         ;
    10         F K=29:1:32,34:1:42,46,47 S X=$P(C0,"^",K) I X'="" S LAB=$P(T0," ",K-12) D @LAB
    11         F K=11:1:14,16:1:24,28,29,58,59 S X=$P(C1,"^",K) I X'="" S LAB=$P(T1," ",K) D @LAB
    12         I E(1)+E(2)=0 G E1
    13         I "0123456789GHU"[PAY,E(1)>60!(E(2)>60) S ERR=41 D ERR^PRSACED
    14 E1      I "^R^C^"'[(U_PMP_U),E(3)>20!(E(4)>20) S ERR=55 D ERR^PRSACED
    15         I E(5)>24!(E(6)>24) S ERR=61 D ERR^PRSACED
    16         I NOR>80,(E(5)+E(6)) S ERR=168 D ERR^PRSACED
    17         ;  RA or RE hours may not exceed PT or PH hours minus 53.
    18         ;  RA is stored in E(3), RE in E(4), PT in E(10) and PH in E(11).
    19         ;  only check firefighters with premium pay indicator R or C (patch *54)
    20         I "^R^C^"[(U_PMP_U) D
    21         . I E(3),(E(3)>(E(10)-53)) S ERR=175 D ERR^PRSACED
    22         . I E(4),(E(4)>(E(11)-53)) S ERR=176 D ERR^PRSACED
    23         ;
    24         ; NT, NH, NO, NP, WD, WP in E(12), E(13), E(14), E(15), E(16), E(17)
    25         ; NT hrs can't exceed WD + NO.  NH hrs can't exceed WP + NP.
    26         ;
    27         I E(12)>(E(14)+E(16)) S ERR=178 D ERR^PRSACED
    28         I E(13)>(E(15)+E(17)) S ERR=179 D ERR^PRSACED
    29         ;
    30         I E(7)+E(8)=0 G E2
    31         I DUT=1,CWK'="C" S MX=NOR/2 I E(7)>MX!(E(8)>MX) S ERR=80 D ERR^PRSACED
    32         G:DUT=1 E2 S X1=$P(C0,"^",42)+$P(C0,"^",21),X1=X1\10+(X1#10*.25)
    33         I E(7)>X1 S ERR=81 D ERR^PRSACED
    34         S X1=$P(C1,"^",24)+$P(C1,"^",3),X1=X1\10+(X1#10*.25)
    35         I E(8)>X1 S ERR=81 D ERR^PRSACED
    36 E2      I NOR=112,DUT=1,'$P(C0,"^",42)!('$P(C1,"^",24)) S ERR=67 D ERR^PRSACED
    37         I E(9),'$P(C1,"^",46),E(9)'=+NOR S ERR=65 D ERR^PRSACED
    38         ;exclude 9/3 month employee
    39         I DUT=2,'(NOR="01"&("LMN"[PAY)),'(NOR="80"&(PAY="M")),$P(C0,"^",42)=""!($P(C1,"^",24)="") S ERR=66 D ERR^PRSACED
    40         G ^PRSACED3
    41 OA      ;
    42 OE      I "ABCKMN"[PAY,X>600 S ERR=35 D ERR^PRSACED
    43         I "ABCGKMNU0123456789"'[PAY S ERR=36 D ERR^PRSACED
    44         S X1=LAB="OE"+1,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    45         Q
    46 OB      ;
    47 OF      I "ABCGU0123456789"'[PAY S ERR=37 D ERR^PRSACED
    48         I "ABC"[PAY,X>60 S ERR=38 D ERR^PRSACED
    49         S X1=LAB="OF"+1,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    50         Q
    51 OC      ;
    52 OG      I "0123456789GU"'[PAY S ERR=39 D ERR^PRSACED
    53         S X1=LAB="OG"+1,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    54         Q
    55 OK      ;
    56 OS      I "ABCKM"'[PAY S ERR=44 D ERR^PRSACED
    57         I "ABC"[PAY,PMP="" S ERR=45 D ERR^PRSACED
    58         I FLSA'="E" S ERR=46 D ERR^PRSACED
    59         Q
    60 OM      I X>560 S ERR=48 D ERR^PRSACED
    61         I ($P(C0,"^",44)'>0),NOR'>80 S ERR=50 D ERR^PRSACED
    62         I X>$P(C0,"^",44) S ERR=62 D ERR^PRSACED
    63         Q
    64 OU      I X>560 S ERR=49 D ERR^PRSACED
    65         I ($P(C1,"^",26)'>0),NOR'>80 S ERR=51 D ERR^PRSACED
    66         I X>$P(C1,"^",26) S ERR=63 D ERR^PRSACED
    67         Q
    68 RA      ;RA is stored in E(3), RE in E(4)
    69 RE      I "ABCGKMNU0123456789"'[PAY S ERR=52 D ERR^PRSACED
    70         S X1=LAB="RE"+3,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    71         Q
    72 RB      ;
    73 RF      I "BGU0123456789"'[PAY S ERR=53 D ERR^PRSACED
    74         S X1=LAB="RF"+3,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    75         Q
    76 RC      ;
    77 RG      I "0123456789AGKMNU"'[PAY S ERR=54 D ERR^PRSACED
    78         I PAY="A",X>200 S ERR=56 D ERR^PRSACED
    79         S X1=LAB="RG"+3,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    80         Q
    81 HA      ;
    82 HL      I "ABCGKMNU0123456789"'[PAY S ERR=57 D ERR^PRSACED
    83         S X1=LAB="HL"+5,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    84         Q
    85 HB      ;
    86 HM      I "BGU0123456789"'[PAY S ERR=58 D ERR^PRSACED
    87         S X1=LAB="HM"+5,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    88         Q
    89 HC      ;
    90 HN      I "0123456789GKMU"'[PAY S ERR=59 D ERR^PRSACED
    91         S X1=LAB="HN"+5,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    92         Q
    93 HD      ;
    94 HO      I X>240 S ERR=60 D ERR^PRSACED
    95         I PAY'="U" S ERR=76 D ERR^PRSACED
    96         I PB'="P" S ERR=76 D ERR^PRSACED
    97         Q
    98 PT      ;
    99 PH      I 'X,'LVG,'(DUT=2&("BLM"[PAY)) S ERR=64 D ERR^PRSACED
    100         I DUT=1,NOR'>80 S ERR=67 D ERR^PRSACED
    101         I DUT=3 S ERR=68 D ERR^PRSACED
    102         ; total part time hours stored in E(9)
    103         S E(9)=E(9)+$E(X,1,2)+($E(X,3)*.25)
    104         ; Save PT in E(10) and PH in E(11)
    105         S X1=LAB="PH"+10,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    106         Q
    107 EA      S E(7)=E(7)+$E(X,3,4)+($E(X,5)*.25)
    108 EB      I LAB="EB" S E(7)=E(7)+$E(X,3,4)+($E(X,5)*.25)
    109 EC      I LAB="EC" S E(8)=E(8)+$E(X,3,4)+($E(X,5)*.25)
    110 ED      I LAB="ED" S E(8)=E(8)+$E(X,3,4)+($E(X,5)*.25)
    111         I "GU1234567"'[PAY S ERR=78 D ERR^PRSACED
    112         I $E(X,1,2)>50 S ERR=79 D ERR^PRSACED
    113         Q
    114 NT      ; Special firefighter codes
    115 NH      ; NT is stored in E(12), NH in E(13)
    116         I NOR'>80 S ERR=177 D ERR^PRSACED
    117         S X1=LAB="NH"+12,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
    118         Q
     1PRSACED2 ; HISC/FPT-T&A Edits ;11/24/1999
     2 ;;4.0;PAID;**45,54**;Sep 21, 1995
     3 ;
     4 ; initialize array that stores 8b values.  This array is used
     5 ; for edit checks that involve more than one type of time.
     6 ;   nodes 14-17 were initialized and set in PRSACED1.
     7 F Z=1:1:13 S E(Z)=0
     8 ;
     9 F K=29:1:32,34:1:42,46,47 S X=$P(C0,"^",K) I X'="" S LAB=$P(T0," ",K-12) D @LAB
     10 F K=11:1:14,16:1:24,28,29,58,59 S X=$P(C1,"^",K) I X'="" S LAB=$P(T1," ",K) D @LAB
     11 I E(1)+E(2)=0 G E1
     12 I "0123456789GHU"[PAY,E(1)>60!(E(2)>60) S ERR=41 D ERR^PRSACED
     13E1 I "^R^C^"'[(U_PMP_U),E(3)>20!(E(4)>20) S ERR=55 D ERR^PRSACED
     14 I E(5)>24!(E(6)>24) S ERR=61 D ERR^PRSACED
     15 I NOR>80,(E(5)+E(6)) S ERR=168 D ERR^PRSACED
     16 ;  RA or RE hours may not exceed PT or PH hours minus 53.
     17 ;  RA is stored in E(3), RE in E(4), PT in E(10) and PH in E(11).
     18 ;  only check firefighters with premium pay indicator R or C (patch *54)
     19 I "^R^C^"[(U_PMP_U) D
     20 . I E(3),(E(3)>(E(10)-53)) S ERR=175 D ERR^PRSACED
     21 . I E(4),(E(4)>(E(11)-53)) S ERR=176 D ERR^PRSACED
     22 ;
     23 ; NT, NH, NO, NP, WD, WP in E(12), E(13), E(14), E(15), E(16), E(17)
     24 ; NT hrs can't exceed WD + NO.  NH hrs can't exceed WP + NP.
     25 ;
     26 I E(12)>(E(14)+E(16)) S ERR=178 D ERR^PRSACED
     27 I E(13)>(E(15)+E(17)) S ERR=179 D ERR^PRSACED
     28 ;
     29 I E(7)+E(8)=0 G E2
     30 I DUT=1,CWK'="C" S MX=NOR/2 I E(7)>MX!(E(8)>MX) S ERR=80 D ERR^PRSACED
     31 G:DUT=1 E2 S X1=$P(C0,"^",42)+$P(C0,"^",21),X1=X1\10+(X1#10*.25)
     32 I E(7)>X1 S ERR=81 D ERR^PRSACED
     33 S X1=$P(C1,"^",24)+$P(C1,"^",3),X1=X1\10+(X1#10*.25)
     34 I E(8)>X1 S ERR=81 D ERR^PRSACED
     35E2 I NOR=112,DUT=1,'$P(C0,"^",42)!('$P(C1,"^",24)) S ERR=67 D ERR^PRSACED
     36 I E(9),'$P(C1,"^",46),E(9)'=+NOR S ERR=65 D ERR^PRSACED
     37 I DUT=2,'(NOR="01"&("LMN"[PAY)),$P(C0,"^",42)=""!($P(C1,"^",24)="") S ERR=66 D ERR^PRSACED
     38 G ^PRSACED3
     39OA ;
     40OE I "ABCKMN"[PAY,X>600 S ERR=35 D ERR^PRSACED
     41 I "ABCGKMNU0123456789"'[PAY S ERR=36 D ERR^PRSACED
     42 S X1=LAB="OE"+1,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     43 Q
     44OB ;
     45OF I "ABCGU0123456789"'[PAY S ERR=37 D ERR^PRSACED
     46 I "ABC"[PAY,X>60 S ERR=38 D ERR^PRSACED
     47 S X1=LAB="OF"+1,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     48 Q
     49OC ;
     50OG I "0123456789GU"'[PAY S ERR=39 D ERR^PRSACED
     51 S X1=LAB="OG"+1,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     52 Q
     53OK ;
     54OS I "ABCKM"'[PAY S ERR=44 D ERR^PRSACED
     55 I "ABC"[PAY,PMP="" S ERR=45 D ERR^PRSACED
     56 I FLSA'="E" S ERR=46 D ERR^PRSACED
     57 Q
     58OM I X>560 S ERR=48 D ERR^PRSACED
     59 I ($P(C0,"^",44)'>0),NOR'>80 S ERR=50 D ERR^PRSACED
     60 I X>$P(C0,"^",44) S ERR=62 D ERR^PRSACED
     61 Q
     62OU I X>560 S ERR=49 D ERR^PRSACED
     63 I ($P(C1,"^",26)'>0),NOR'>80 S ERR=51 D ERR^PRSACED
     64 I X>$P(C1,"^",26) S ERR=63 D ERR^PRSACED
     65 Q
     66RA ;RA is stored in E(3), RE in E(4)
     67RE I "ABCGKMNU0123456789"'[PAY S ERR=52 D ERR^PRSACED
     68 S X1=LAB="RE"+3,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     69 Q
     70RB ;
     71RF I "BGU0123456789"'[PAY S ERR=53 D ERR^PRSACED
     72 S X1=LAB="RF"+3,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     73 Q
     74RC ;
     75RG I "0123456789AGKMNU"'[PAY S ERR=54 D ERR^PRSACED
     76 I PAY="A",X>200 S ERR=56 D ERR^PRSACED
     77 S X1=LAB="RG"+3,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     78 Q
     79HA ;
     80HL I "ABCGKMNU0123456789"'[PAY S ERR=57 D ERR^PRSACED
     81 S X1=LAB="HL"+5,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     82 Q
     83HB ;
     84HM I "BGU0123456789"'[PAY S ERR=58 D ERR^PRSACED
     85 S X1=LAB="HM"+5,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     86 Q
     87HC ;
     88HN I "0123456789GKMU"'[PAY S ERR=59 D ERR^PRSACED
     89 S X1=LAB="HN"+5,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     90 Q
     91HD ;
     92HO I X>240 S ERR=60 D ERR^PRSACED
     93 I PAY'="U" S ERR=76 D ERR^PRSACED
     94 I PB'="P" S ERR=76 D ERR^PRSACED
     95 Q
     96PT ;
     97PH I 'X,'LVG,'(DUT=2&("BLM"[PAY)) S ERR=64 D ERR^PRSACED
     98 I DUT=1,NOR'>80 S ERR=67 D ERR^PRSACED
     99 I DUT=3 S ERR=68 D ERR^PRSACED
     100 ; total part time hours stored in E(9)
     101 S E(9)=E(9)+$E(X,1,2)+($E(X,3)*.25)
     102 ; Save PT in E(10) and PH in E(11)
     103 S X1=LAB="PH"+10,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     104 Q
     105EA S E(7)=E(7)+$E(X,3,4)+($E(X,5)*.25)
     106EB I LAB="EB" S E(7)=E(7)+$E(X,3,4)+($E(X,5)*.25)
     107EC I LAB="EC" S E(8)=E(8)+$E(X,3,4)+($E(X,5)*.25)
     108ED I LAB="ED" S E(8)=E(8)+$E(X,3,4)+($E(X,5)*.25)
     109 I "GU1234567"'[PAY S ERR=78 D ERR^PRSACED
     110 I $E(X,1,2)>50 S ERR=79 D ERR^PRSACED
     111 Q
     112NT ; Special firefighter codes
     113NH ; NT is stored in E(12), NH in E(13)
     114 I NOR'>80 S ERR=177 D ERR^PRSACED
     115 S X1=LAB="NH"+12,E(X1)=E(X1)+$E(X,1,2)+($E(X,3)*.25)
     116 Q
Note: See TracChangeset for help on using the changeset viewer.