PRSDCOMP ;HISC/FPT,GWB-COMPUTED FIELDS FOR 450 & 459 ;12/09/2002
;;4.0;PAID;**78**;Sep 21, 1995
EN1 ;calculate computed fields
S ZERO=$G(^PRST(459,PPIEN,"P",IEN,0))
S ONE=$G(^PRST(459,PPIEN,"P",IEN,1))
S TWO=$G(^PRST(459,PPIEN,"P",IEN,2))
S THREE=$G(^PRST(459,PPIEN,"P",IEN,3))
S FOUR=$G(^PRST(459,PPIEN,"P",IEN,4))
S FIVE=$G(^PRST(459,PPIEN,"P",IEN,5))
S SIX=$G(^PRST(459,PPIEN,"P",IEN,6))
S SUBACCT=$P(ZERO,U,9),PAYPLAN=$P(ZERO,U,3)
S MEDICARE=$P(ONE,U,6),VAFICA=$P(ONE,U,10),VALICOST=$P(ONE,U,15),VAHBCOST=$P(ONE,U,18),VARETIRE=$P(ONE,U,21)
S TSP=$P(TWO,U,13)+$P(TWO,U,14)+$P(TWO,U,15)+$P(TWO,U,16)+$P(TWO,U,17)+$P(TWO,U,18)
S SEVPAY=$P(THREE,U,2)
S ALUSED=$P(FOUR,U,1),SLUSED=$P(FOUR,U,2)
S GROSSPAY=$P(FIVE,U,1),ANNUITY=$P(FIVE,U,4),BASEPAY=$P(FIVE,U,5),HOLPAY=$P(FIVE,U,8),ONCALL=$P(FIVE,U,13),OTPAY=$P(FIVE,U,14),SATPAY=$P(FIVE,U,17),STANDPAY=$P(FIVE,U,18),SUNPAY=$P(FIVE,U,19)
S LIVING=$P(FIVE,U,22),AWARDS=$P(FIVE,U,24),SESAWARD=$P(FIVE,U,25),LUMPSUM=$P(FIVE,U,26),MOVING=$P(FIVE,U,28),UNIFORM=$P(FIVE,U,29)
S MDDDPAY=$P(SIX,U,3)
;gross pay plus benefits
S COMPUTED=GROSSPAY+UNIFORM+MEDICARE+VALICOST+VAHBCOST+VAFICA+VARETIRE+TSP+ANNUITY D DECIMAL
S $P(^PRST(459,PPIEN,"P",IEN,8),U,1)=COMPUTED,$P(^PRSPC(IEN,"PAY"),U,10)=COMPUTED
;annual leave used
S COMPUTED=$S(SUBACCT=81!(SUBACCT=71)!(PAYPLAN="Y"):ALUSED*8,1:ALUSED) D DECIMAL
S $P(^PRST(459,PPIEN,"P",IEN,4),U,7)=COMPUTED,$P(^PRSPC(IEN,"ANNUAL"),U,14)=COMPUTED
;sick leave used
S COMPUTED=$S(SUBACCT=81!(SUBACCT=71)!(PAYPLAN="Y"):SLUSED*8,1:SLUSED) D DECIMAL
S $P(^PRST(459,PPIEN,"P",IEN,4),U,8)=COMPUTED,$P(^PRSPC(IEN,"SICK"),U,8)=COMPUTED
I $D(^PRSPC(IEN,"BOND1")),$P(^PRSPC(IEN,"BOND1"),U,11)="Y" K ^PRSPC(IEN,"BOND1")
I $D(^PRSPC(IEN,"BOND2")),$P(^PRSPC(IEN,"BOND2"),U,10)="Y" K ^PRSPC(IEN,"BOND2")
I $D(^PRSPC(IEN,"BOND3")),$P(^PRSPC(IEN,"BOND3"),U,10)="Y" K ^PRSPC(IEN,"BOND3")
I $D(^PRSPC(IEN,"BOND4")),$P(^PRSPC(IEN,"BOND4"),U,10)="Y" K ^PRSPC(IEN,"BOND4")
KILL1 K ALUSED,ANNUITY,AWARDS,BASEPAY,COMPUTED,FOUR,FIVE,GROSSPAY,HOLPAY,LIVING,LUMPSUM,MDDDPAY,MEDICARE,MOVING,ONCALL,ONE,OTPAY
K PAYPLAN,SATPAY,SESAWARD,SEVPAY,SIX,SLUSED,STANDPAY,SUBACCT,SUNPAY,THREE,TSP,TWO,UNIFORM,VAFICA,VAHBCOST,VALICOST,VARETIRE,ZERO
Q
DECIMAL ;check decimal digits
S:COMPUTED'["." COMPUTED=COMPUTED_"."
S:$L($P(COMPUTED,".",1))=0 COMPUTED="0"_COMPUTED
S:$L($P(COMPUTED,".",2))=0 COMPUTED=COMPUTED_"00"
S:$L($P(COMPUTED,".",2))=1 COMPUTED=COMPUTED_"0"
Q
FTE ;FTE computation
S FTEE=DATA,DB=$P(^PRSPC(IEN,0),U,10),NH8B=$P(^PRSPC(IEN,0),U,16) D
.I DB=1,FTEE=0 S $P(^PRSPC(IEN,"MISC4"),U,11)=1 Q
.I DB=1,FTEE>0 S $P(^PRSPC(IEN,"MISC4"),U,11)="."_FTEE Q
.I DB=2,NH8B=1 S $P(^PRSPC(IEN,"MISC4"),U,11)=0 Q
.I DB=2 S FTEE=$FN(NH8B/80,"",2),$P(^PRSPC(IEN,"MISC4"),U,11)=+FTEE Q
.I DB=3,FTEE=0 S $P(^PRSPC(IEN,"MISC4"),U,11)=0 Q
.I DB=3,FTEE>0 S $P(^PRSPC(IEN,"MISC4"),U,11)="."_FTEE
S NODE=""
K DB,FTEE,NH8B Q
BONDS ;Savings Bond Balance computation
I $D(^PRSPC(IEN,"BOND1")) S $P(^PRSPC(IEN,"BOND1"),U,9)="" I $P(RCD,":",8)="" D
.S SBBAL=$P(^PRSPC(IEN,"BOND1"),U,5)
.S SBEPP=$P(^PRSPC(IEN,"BOND1"),U,10)
.S SBDEM=$P(^PRSPC(IEN,"BOND1"),U,11)
.S SBDEM=$S(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
.I SBEPP+SBBAL=SBDEM S $P(^PRSPC(IEN,"BOND1"),U,5)=""
I $D(^PRSPC(IEN,"BOND2")) S $P(^PRSPC(IEN,"BOND2"),U,8)="" I $P(RCD,":",9)="" D
.S SBBAL=$P(^PRSPC(IEN,"BOND2"),U,4)
.S SBEPP=$P(^PRSPC(IEN,"BOND2"),U,9)
.S SBDEM=$P(^PRSPC(IEN,"BOND2"),U,10)
.S SBDEM=$S(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
.I SBEPP+SBBAL=SBDEM S $P(^PRSPC(IEN,"BOND2"),U,4)=""
I $D(^PRSPC(IEN,"BOND3")) S $P(^PRSPC(IEN,"BOND3"),U,8)="" I $P(RCD,":",9)="" D
.S SBBAL=$P(^PRSPC(IEN,"BOND3"),U,4)
.S SBEPP=$P(^PRSPC(IEN,"BOND3"),U,9)
.S SBDEM=$P(^PRSPC(IEN,"BOND3"),U,10)
.S SBDEM=$S(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
.I SBEPP+SBBAL=SBDEM S $P(^PRSPC(IEN,"BOND3"),U,4)=""
I $D(^PRSPC(IEN,"BOND4")) S $P(^PRSPC(IEN,"BOND4"),U,8)="" I $P(RCD,":",9)="" D
.S SBBAL=$P(^PRSPC(IEN,"BOND4"),U,4)
.S SBEPP=$P(^PRSPC(IEN,"BOND4"),U,9)
.S SBDEM=$P(^PRSPC(IEN,"BOND4"),U,10)
.S SBDEM=$S(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
.I SBEPP+SBBAL=SBDEM S $P(^PRSPC(IEN,"BOND4"),U,4)=""
K SBBAL,SBEPP,SBDEM Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDCOMP 4379 printed Oct 16, 2024@18:25:53 Page 2
PRSDCOMP ;HISC/FPT,GWB-COMPUTED FIELDS FOR 450 & 459 ;12/09/2002
+1 ;;4.0;PAID;**78**;Sep 21, 1995
EN1 ;calculate computed fields
+1 SET ZERO=$GET(^PRST(459,PPIEN,"P",IEN,0))
+2 SET ONE=$GET(^PRST(459,PPIEN,"P",IEN,1))
+3 SET TWO=$GET(^PRST(459,PPIEN,"P",IEN,2))
+4 SET THREE=$GET(^PRST(459,PPIEN,"P",IEN,3))
+5 SET FOUR=$GET(^PRST(459,PPIEN,"P",IEN,4))
+6 SET FIVE=$GET(^PRST(459,PPIEN,"P",IEN,5))
+7 SET SIX=$GET(^PRST(459,PPIEN,"P",IEN,6))
+8 SET SUBACCT=$PIECE(ZERO,U,9)
SET PAYPLAN=$PIECE(ZERO,U,3)
+9 SET MEDICARE=$PIECE(ONE,U,6)
SET VAFICA=$PIECE(ONE,U,10)
SET VALICOST=$PIECE(ONE,U,15)
SET VAHBCOST=$PIECE(ONE,U,18)
SET VARETIRE=$PIECE(ONE,U,21)
+10 SET TSP=$PIECE(TWO,U,13)+$PIECE(TWO,U,14)+$PIECE(TWO,U,15)+$PIECE(TWO,U,16)+$PIECE(TWO,U,17)+$PIECE(TWO,U,18)
+11 SET SEVPAY=$PIECE(THREE,U,2)
+12 SET ALUSED=$PIECE(FOUR,U,1)
SET SLUSED=$PIECE(FOUR,U,2)
+13 SET GROSSPAY=$PIECE(FIVE,U,1)
SET ANNUITY=$PIECE(FIVE,U,4)
SET BASEPAY=$PIECE(FIVE,U,5)
SET HOLPAY=$PIECE(FIVE,U,8)
SET ONCALL=$PIECE(FIVE,U,13)
SET OTPAY=$PIECE(FIVE,U,14)
SET SATPAY=$PIECE(FIVE,U,17)
SET STANDPAY=$PIECE(FIVE,U,18)
SET SUNPAY=$PIECE(FIVE,U,19)
+14 SET LIVING=$PIECE(FIVE,U,22)
SET AWARDS=$PIECE(FIVE,U,24)
SET SESAWARD=$PIECE(FIVE,U,25)
SET LUMPSUM=$PIECE(FIVE,U,26)
SET MOVING=$PIECE(FIVE,U,28)
SET UNIFORM=$PIECE(FIVE,U,29)
+15 SET MDDDPAY=$PIECE(SIX,U,3)
+16 ;gross pay plus benefits
+17 SET COMPUTED=GROSSPAY+UNIFORM+MEDICARE+VALICOST+VAHBCOST+VAFICA+VARETIRE+TSP+ANNUITY
DO DECIMAL
+18 SET $PIECE(^PRST(459,PPIEN,"P",IEN,8),U,1)=COMPUTED
SET $PIECE(^PRSPC(IEN,"PAY"),U,10)=COMPUTED
+19 ;annual leave used
+20 SET COMPUTED=$SELECT(SUBACCT=81!(SUBACCT=71)!(PAYPLAN="Y"):ALUSED*8,1:ALUSED)
DO DECIMAL
+21 SET $PIECE(^PRST(459,PPIEN,"P",IEN,4),U,7)=COMPUTED
SET $PIECE(^PRSPC(IEN,"ANNUAL"),U,14)=COMPUTED
+22 ;sick leave used
+23 SET COMPUTED=$SELECT(SUBACCT=81!(SUBACCT=71)!(PAYPLAN="Y"):SLUSED*8,1:SLUSED)
DO DECIMAL
+24 SET $PIECE(^PRST(459,PPIEN,"P",IEN,4),U,8)=COMPUTED
SET $PIECE(^PRSPC(IEN,"SICK"),U,8)=COMPUTED
+25 IF $DATA(^PRSPC(IEN,"BOND1"))
IF $PIECE(^PRSPC(IEN,"BOND1"),U,11)="Y"
KILL ^PRSPC(IEN,"BOND1")
+26 IF $DATA(^PRSPC(IEN,"BOND2"))
IF $PIECE(^PRSPC(IEN,"BOND2"),U,10)="Y"
KILL ^PRSPC(IEN,"BOND2")
+27 IF $DATA(^PRSPC(IEN,"BOND3"))
IF $PIECE(^PRSPC(IEN,"BOND3"),U,10)="Y"
KILL ^PRSPC(IEN,"BOND3")
+28 IF $DATA(^PRSPC(IEN,"BOND4"))
IF $PIECE(^PRSPC(IEN,"BOND4"),U,10)="Y"
KILL ^PRSPC(IEN,"BOND4")
KILL1 KILL ALUSED,ANNUITY,AWARDS,BASEPAY,COMPUTED,FOUR,FIVE,GROSSPAY,HOLPAY,LIVING,LUMPSUM,MDDDPAY,MEDICARE,MOVING,ONCALL,ONE,OTPAY
+1 KILL PAYPLAN,SATPAY,SESAWARD,SEVPAY,SIX,SLUSED,STANDPAY,SUBACCT,SUNPAY,THREE,TSP,TWO,UNIFORM,VAFICA,VAHBCOST,VALICOST,VARETIRE,ZERO
+2 QUIT
DECIMAL ;check decimal digits
+1 if COMPUTED'["."
SET COMPUTED=COMPUTED_"."
+2 if $LENGTH($PIECE(COMPUTED,".",1))=0
SET COMPUTED="0"_COMPUTED
+3 if $LENGTH($PIECE(COMPUTED,".",2))=0
SET COMPUTED=COMPUTED_"00"
+4 if $LENGTH($PIECE(COMPUTED,".",2))=1
SET COMPUTED=COMPUTED_"0"
+5 QUIT
FTE ;FTE computation
+1 SET FTEE=DATA
SET DB=$PIECE(^PRSPC(IEN,0),U,10)
SET NH8B=$PIECE(^PRSPC(IEN,0),U,16)
Begin DoDot:1
+2 IF DB=1
IF FTEE=0
SET $PIECE(^PRSPC(IEN,"MISC4"),U,11)=1
QUIT
+3 IF DB=1
IF FTEE>0
SET $PIECE(^PRSPC(IEN,"MISC4"),U,11)="."_FTEE
QUIT
+4 IF DB=2
IF NH8B=1
SET $PIECE(^PRSPC(IEN,"MISC4"),U,11)=0
QUIT
+5 IF DB=2
SET FTEE=$FNUMBER(NH8B/80,"",2)
SET $PIECE(^PRSPC(IEN,"MISC4"),U,11)=+FTEE
QUIT
+6 IF DB=3
IF FTEE=0
SET $PIECE(^PRSPC(IEN,"MISC4"),U,11)=0
QUIT
+7 IF DB=3
IF FTEE>0
SET $PIECE(^PRSPC(IEN,"MISC4"),U,11)="."_FTEE
End DoDot:1
+8 SET NODE=""
+9 KILL DB,FTEE,NH8B
QUIT
BONDS ;Savings Bond Balance computation
+1 IF $DATA(^PRSPC(IEN,"BOND1"))
SET $PIECE(^PRSPC(IEN,"BOND1"),U,9)=""
IF $PIECE(RCD,":",8)=""
Begin DoDot:1
+2 SET SBBAL=$PIECE(^PRSPC(IEN,"BOND1"),U,5)
+3 SET SBEPP=$PIECE(^PRSPC(IEN,"BOND1"),U,10)
+4 SET SBDEM=$PIECE(^PRSPC(IEN,"BOND1"),U,11)
+5 SET SBDEM=$SELECT(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
+6 IF SBEPP+SBBAL=SBDEM
SET $PIECE(^PRSPC(IEN,"BOND1"),U,5)=""
End DoDot:1
+7 IF $DATA(^PRSPC(IEN,"BOND2"))
SET $PIECE(^PRSPC(IEN,"BOND2"),U,8)=""
IF $PIECE(RCD,":",9)=""
Begin DoDot:1
+8 SET SBBAL=$PIECE(^PRSPC(IEN,"BOND2"),U,4)
+9 SET SBEPP=$PIECE(^PRSPC(IEN,"BOND2"),U,9)
+10 SET SBDEM=$PIECE(^PRSPC(IEN,"BOND2"),U,10)
+11 SET SBDEM=$SELECT(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
+12 IF SBEPP+SBBAL=SBDEM
SET $PIECE(^PRSPC(IEN,"BOND2"),U,4)=""
End DoDot:1
+13 IF $DATA(^PRSPC(IEN,"BOND3"))
SET $PIECE(^PRSPC(IEN,"BOND3"),U,8)=""
IF $PIECE(RCD,":",9)=""
Begin DoDot:1
+14 SET SBBAL=$PIECE(^PRSPC(IEN,"BOND3"),U,4)
+15 SET SBEPP=$PIECE(^PRSPC(IEN,"BOND3"),U,9)
+16 SET SBDEM=$PIECE(^PRSPC(IEN,"BOND3"),U,10)
+17 SET SBDEM=$SELECT(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
+18 IF SBEPP+SBBAL=SBDEM
SET $PIECE(^PRSPC(IEN,"BOND3"),U,4)=""
End DoDot:1
+19 IF $DATA(^PRSPC(IEN,"BOND4"))
SET $PIECE(^PRSPC(IEN,"BOND4"),U,8)=""
IF $PIECE(RCD,":",9)=""
Begin DoDot:1
+20 SET SBBAL=$PIECE(^PRSPC(IEN,"BOND4"),U,4)
+21 SET SBEPP=$PIECE(^PRSPC(IEN,"BOND4"),U,9)
+22 SET SBDEM=$PIECE(^PRSPC(IEN,"BOND4"),U,10)
+23 SET SBDEM=$SELECT(SBDEM=4:50,SBDEM=8:100,SBDEM="B":250,SBDEM="D":500,SBDEM="F":2500,1:0)
+24 IF SBEPP+SBBAL=SBDEM
SET $PIECE(^PRSPC(IEN,"BOND4"),U,4)=""
End DoDot:1
+25 KILL SBBAL,SBEPP,SBDEM
QUIT
