source: WorldVistAEHR/trunk/r/PAID-PRS/PRSACED4.m@ 824

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PRSACED4 ;HISC/REL/FPT-Edits of Miscellaneous Fields ;10/22/01
2 ;;4.0;PAID;**6,30,45,69,71**;Sep 21, 1995
3 S E(1)=0
4 F K=30:1:41,43,44,46 S X=$P(C1,"^",K) I X'="" S LAB=$P(T1," ",K) D @LAB
5 I E(1),E(1)>$P(C1,"^",34) S ERR=111 D ERR^PRSACED
6 I NOR'>80 G ^PRSACED5
7 S X="" F K=1:1:3 S X=X+$P(C0,"^",K+37),X=X+$P(C1,"^",K+19)
8 I X S ERR=168 D ERR^PRSACED
9 G ^PRSACED5
10NL Q:X'>14 S ERR=101 D ERR^PRSACED Q
11DW I X>14 S ERR=102 D ERR^PRSACED
12 I DUT'=3 S ERR=103 D ERR^PRSACED
13 I $P(C0,"^",21)="",$P(C1,"^",3)="" S ERR=18 D ERR^PRSACED
14 Q
15IN I X=2,"BGU0123456789"'[PAY S ERR=104 D ERR^PRSACED
16 I X=3,"0123456789AGKMU"'[PAY S ERR=105 D ERR^PRSACED
17 Q
18LU I "12345"'[LVG S ERR=106 D ERR^PRSACED
19 I '$P(C1,"^",55) S ERR=137 D ERR^PRSACED
20 I NOR>80 S ERR=174 D ERR^PRSACED
21 Q
22LN I "BGU0123456789"'[PAY S ERR=107 D ERR^PRSACED
23 I '$P(C1,"^",34) S ERR=108 D ERR^PRSACED
24 S E(1)=E(1)+X Q
25LD I "0123456789AGKMU"'[PAY S ERR=109 D ERR^PRSACED
26 I '$P(C1,"^",34) S ERR=110 D ERR^PRSACED
27 S E(1)=E(1)+X Q
28TO I '$P(C1,"^",34) S ERR=112 D ERR^PRSACED
29 Q
30LA I "355 358 359 363 672 871 899 910"'[$P(C0,"^",4) S ERR=113 D ERR^PRSACED
31 I "ABCJKUY"'[PAY S ERR=114 D ERR^PRSACED
32 Q
33ML I DUT=3 S ERR=169 D ERR^PRSACED
34 S X=+$E(X,1,3)_"."_$E(X,4)
35 Q:X'>14
36 N C0,NH,FLX,PMP,AC,PP,PB,TA,OCC,LVG,ASS,ENT
37 Q:$$MLINHRS^PRSAENT(DFN)=1 ;Quit if entitled to ML in hours.
38 ;Check if Daily employee and more than 14 days of ML
39 I $$MLINHRS^PRSAENT(DFN)=0,X>14 S ERR=115 D ERR^PRSACED
40 Q
41CA I "45"[LVG,$E(X,4) S ERR=116 D ERR^PRSACED
42 I X>$S(NOR="00":130,1:NOR*10) S ERR=117 D ERR^PRSACED
43 I $E($G(^PRST(458,PPI,0)),4,5)<26 S ERR=118 D ERR^PRSACED
44 Q
45PC I X>14 S ERR=125 D ERR^PRSACED
46 I '$P(C0,"^",43),'$P(C1,"^",25) S ERR=126 D ERR^PRSACED
47 I X>7,'$P(C0,"^",43)!('$P(C1,"^",25)) S ERR=127 D ERR^PRSACED
48 Q
49RR Q
50TL Q:$D(^PRST(455.5,"B",X)) S ERR=131 D ERR^PRSACED
51 I X'?3N,X'?1"VC"1U,X'?1"F"2N S ERR=133 D ERR^PRSACED
52 Q
53CP Q:X'="F"
54 I "0123456789GU"'[PAY S ERR=171 D ERR^PRSACED
55 I PAY="G",PB'="2" S ERR=171 D ERR^PRSACED
56 I PAY="U","27EXT"'[PB S ERR=171 D ERR^PRSACED
57 Q
58CY I NOR="00",PAY="L",DUT=3,$E(X,3) S ERR=119 D ERR^PRSACED
59 I NOR="01","LMNQ"[PAY,DUT=2,$E(X,3) S ERR=119 D ERR^PRSACED
60 I NOR="01",X>130 S ERR=120 D ERR^PRSACED
61 I NOR'="01",X>(NOR*10+$P(C0,"^",21)+$P(C1,"^",3)-$P(C0,"^",16)-$P(C0,"^",51)) S ERR=120 D ERR^PRSACED
62 I $E($G(^PRST(458,PPI,0)),4,5)<26 S ERR=121 D ERR^PRSACED
63 Q
64FF I NOR'>80!(DUT'=1)!(X<900)!(X>1440) S ERR=129 D ERR^PRSACED
65 I '$P(C0,"^",42)!('$P(C1,"^",24)) S ERR=130 D ERR^PRSACED
66 I $E(X,1,3)+($E(X,4)*.25)'=E(9) S ERR=130 D ERR^PRSACED
67 Q
Note: See TracBrowser for help on using the repository browser.