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