VistA-WorldVistAEHR/r/PAID-PRS/PRSACED4.m

68 lines
2.5 KiB
Mathematica

PRSACED4 ;HISC/REL/FPT-Edits of Miscellaneous Fields ;10/22/01
;;4.0;PAID;**6,30,45,69,71**;Sep 21, 1995
S E(1)=0
F K=30:1:41,43,44,46 S X=$P(C1,"^",K) I X'="" S LAB=$P(T1," ",K) D @LAB
I E(1),E(1)>$P(C1,"^",34) S ERR=111 D ERR^PRSACED
I NOR'>80 G ^PRSACED5
S X="" F K=1:1:3 S X=X+$P(C0,"^",K+37),X=X+$P(C1,"^",K+19)
I X S ERR=168 D ERR^PRSACED
G ^PRSACED5
NL Q:X'>14 S ERR=101 D ERR^PRSACED Q
DW I X>14 S ERR=102 D ERR^PRSACED
I DUT'=3 S ERR=103 D ERR^PRSACED
I $P(C0,"^",21)="",$P(C1,"^",3)="" S ERR=18 D ERR^PRSACED
Q
IN I X=2,"BGU0123456789"'[PAY S ERR=104 D ERR^PRSACED
I X=3,"0123456789AGKMU"'[PAY S ERR=105 D ERR^PRSACED
Q
LU I "12345"'[LVG S ERR=106 D ERR^PRSACED
I '$P(C1,"^",55) S ERR=137 D ERR^PRSACED
I NOR>80 S ERR=174 D ERR^PRSACED
Q
LN I "BGU0123456789"'[PAY S ERR=107 D ERR^PRSACED
I '$P(C1,"^",34) S ERR=108 D ERR^PRSACED
S E(1)=E(1)+X Q
LD I "0123456789AGKMU"'[PAY S ERR=109 D ERR^PRSACED
I '$P(C1,"^",34) S ERR=110 D ERR^PRSACED
S E(1)=E(1)+X Q
TO I '$P(C1,"^",34) S ERR=112 D ERR^PRSACED
Q
LA I "355 358 359 363 672 871 899 910"'[$P(C0,"^",4) S ERR=113 D ERR^PRSACED
I "ABCJKUY"'[PAY S ERR=114 D ERR^PRSACED
Q
ML I DUT=3 S ERR=169 D ERR^PRSACED
S X=+$E(X,1,3)_"."_$E(X,4)
Q:X'>14
N C0,NH,FLX,PMP,AC,PP,PB,TA,OCC,LVG,ASS,ENT
Q:$$MLINHRS^PRSAENT(DFN)=1 ;Quit if entitled to ML in hours.
;Check if Daily employee and more than 14 days of ML
I $$MLINHRS^PRSAENT(DFN)=0,X>14 S ERR=115 D ERR^PRSACED
Q
CA I "45"[LVG,$E(X,4) S ERR=116 D ERR^PRSACED
I X>$S(NOR="00":130,1:NOR*10) S ERR=117 D ERR^PRSACED
I $E($G(^PRST(458,PPI,0)),4,5)<26 S ERR=118 D ERR^PRSACED
Q
PC I X>14 S ERR=125 D ERR^PRSACED
I '$P(C0,"^",43),'$P(C1,"^",25) S ERR=126 D ERR^PRSACED
I X>7,'$P(C0,"^",43)!('$P(C1,"^",25)) S ERR=127 D ERR^PRSACED
Q
RR Q
TL Q:$D(^PRST(455.5,"B",X)) S ERR=131 D ERR^PRSACED
I X'?3N,X'?1"VC"1U,X'?1"F"2N S ERR=133 D ERR^PRSACED
Q
CP Q:X'="F"
I "0123456789GU"'[PAY S ERR=171 D ERR^PRSACED
I PAY="G",PB'="2" S ERR=171 D ERR^PRSACED
I PAY="U","27EXT"'[PB S ERR=171 D ERR^PRSACED
Q
CY I NOR="00",PAY="L",DUT=3,$E(X,3) S ERR=119 D ERR^PRSACED
I NOR="01","LMNQ"[PAY,DUT=2,$E(X,3) S ERR=119 D ERR^PRSACED
I NOR="01",X>130 S ERR=120 D ERR^PRSACED
I NOR'="01",X>(NOR*10+$P(C0,"^",21)+$P(C1,"^",3)-$P(C0,"^",16)-$P(C0,"^",51)) S ERR=120 D ERR^PRSACED
I $E($G(^PRST(458,PPI,0)),4,5)<26 S ERR=121 D ERR^PRSACED
Q
FF I NOR'>80!(DUT'=1)!(X<900)!(X>1440) S ERR=129 D ERR^PRSACED
I '$P(C0,"^",42)!('$P(C1,"^",24)) S ERR=130 D ERR^PRSACED
I $E(X,1,3)+($E(X,4)*.25)'=E(9) S ERR=130 D ERR^PRSACED
Q