Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRS8UP

PRS8UP.m

Go to the documentation of this file.
  1. PRS8UP ;HISC/MRL,JAH/WIRMFO-DECOMPOSITION, UPDATE TOTALS ;7/10/08
  1. ;;4.0;PAID;**6,21,30,45,117,132**;Sep 21, 1995;Build 13
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;This routine is used to collect information related to
  1. ;weekly activity which is unrelated to actual time, including
  1. ;VCS Sales, Environmental Differential, Hazard Pay,
  1. ;Lump Sum Data, etc.
  1. ;
  1. ;Called by Routines: PRS8ST
  1. ;
  1. ; -- VCS Sales (VC, VS)/Fee Basis (FE)
  1. ;
  1. ; If there is data (X) on the VCS sales node. (Both VCS sales and
  1. ; Fee Basis data is stored on this node). Then we need to check to
  1. ; see if the employee's pay plan is F=Fee Basis or U=VCS Sales.
  1. ;
  1. ;
  1. ; If we're dealing w/ previous pay period where an employee
  1. ; has changed pay plans, we need to check their pay plan for the
  1. ; pay period we are dealing with.
  1. N PAYPDTMP,PPLOLD
  1. S PAYPDTMP=$G(^PRST(458,+PY,0)) ;pay period we're working with.
  1. S PPLOLD=$$OLDPP^PRS8UT(PAYPDTMP,+DFN) ;pay plan from PAYPDTMP.
  1. S PPL=$P($G(^PRSPC(+DFN,0)),"^",21) ;pay plan in master record.
  1. ;
  1. ;if we find an old pay plan and it's different than the master record
  1. ;use the old pay plan to determine VCS or FEE.
  1. I PPLOLD'=0,(PPL'=PPLOLD) S PPL=PPLOLD
  1. ;
  1. S X=$G(^PRST(458,+PY,"E",+DFN,2)),(T,T(1),T(2))=0
  1. I PPL'="F",X'="" F I=1:1:14 S V=+$P(X,"^",I),W=$S(I<8:1,1:2),T(W)=T(W)+V
  1. I PPL'="F" F I=1,2 I $D(T(I)) D
  1. .S X1=$P(T(I),".",2)
  1. .S X1=X1_$E("00",0,2-$L(X1)) ;2 numbers for cents (X1)
  1. .S X=+$P(T(I),".",1)
  1. .S X=X_X1 I '+X Q ;no value/don't report
  1. .S $P(WK(I),"^",37)=X
  1. S X=$G(^PRST(458,+PY,"E",+DFN,2))
  1. I PPL="F",X'="" F I=1:1:14 S V=+$P(X,"^",I),T=T+V
  1. I PPL="F",$D(T) D
  1. .S X1=$P(T,".",2)
  1. .S X1=X1_$E("00",0,2-$L(X1))
  1. .S X=+$P(T,".",1)
  1. .S X=X_X1 I '+X Q ;if no value, don't save
  1. .S $P(WK(3),"^",17)=X
  1. K I,PPL,T,V,W,X,X1
  1. ;
  1. ; -- Environmental Differential (EA, EC)
  1. ; -- Hazardous Duty Pay (EB, ED)
  1. ;
  1. S X=$G(^PRST(458,+PY,"E",+DFN,4))
  1. F I=1,3,5,7,9,11 S Y=+$P(X,"^",I) D
  1. .I I=1!(I=7) S T=0,W=1+(I=7)
  1. .S Y=$G(^PRST(457.6,+Y,0)) Q:Y=""
  1. .S Y=+$P(Y,"^",3) Q:'Y
  1. .S Y=$E("00",0,2-$L(Y))_Y ;percentage
  1. .S Y(1)=+$P(X,"^",I+1) Q:'Y(1)
  1. .S Y(1)=$E("000",0,3-$L(Y(1)))_Y(1) ;hours
  1. .S T=T+1
  1. .I T<3 S $P(WK(W),"^",36+(T*2))=Y,$P(WK(W),"^",37+(T*2))=Y(1)
  1. .K Y
  1. K I,T,W,X,Y
  1. ;
  1. ;PRS4*117 CT Trav Earnd Wk 1&2. Convert file decimal to 1/4 hr integer
  1. ;
  1. N CTTNODE,CTTW1,CTTW2 S CTTNODE=$G(^PRST(458,+PY,"E",+DFN,6))
  1. S CTTW1=+$P(CTTNODE,U)*100/.25\100
  1. S CTTW2=+$P(CTTNODE,U,2)*100/.25\100
  1. I CTTW1>0 S $P(WK(1),"^",52)=CTTW1
  1. I CTTW2>0 S $P(WK(2),"^",52)=CTTW2
  1. ;
  1. ;PRS4*117 Move Credit Hours back to the comptime buckets.
  1. ; Credit hours still reported under comptime 8B codes but are
  1. ; split out during decomp so appropriate rules are applied
  1. ; for credit hours. When credit hours 8B code reporting is
  1. ; implemented this code should be removed.[credit hours future use]
  1. ;
  1. ; { begin credit hours move to ct buckets
  1. ;
  1. ; For week 1 & 2, add credit hours to comptime buckets and zero
  1. ; out credit hours buckets.
  1. ;
  1. F I=1,2 D
  1. .; add
  1. . S $P(WK(I),U,7)=$P(WK(I),U,7)+$P(WK(I),U,54)
  1. . S $P(WK(I),U,8)=$P(WK(I),U,8)+$P(WK(I),U,55)
  1. .;
  1. .; zero out
  1. . S $P(WK(I),U,54)=""
  1. . S $P(WK(I),U,55)=""
  1. ;
  1. ; end credit hours move to ct buckets }
  1. ;
  1. ; PRS*4*132
  1. ; Telework hours are stored as actual hours for each day of the
  1. ; pay period. Loop through timecard and add up any telework hours
  1. ; recorded. Disregard two day tours as telework hours will be
  1. ; reported on the week in which the telework started.
  1. ;
  1. ; Store telework in wk array
  1. ;
  1. F I=1,2 D
  1. . N NODE,STW,ATW,MTW
  1. . S (STW(I),ATW(I),MTW(I))=0
  1. . N PRSD
  1. . F PRSD=I*7-6:1:I*7 D
  1. .. S NODE=$G(^PRST(458,+PY,"E",+DFN,"D",PRSD,8))
  1. .. S STW(I)=STW(I)+$P(NODE,U,2)
  1. .. S ATW(I)=ATW(I)+$P(NODE,U,4)
  1. .. S MTW(I)=MTW(I)+$P(NODE,U,3)
  1. . I TYP'["D" D
  1. .. S STW(I)=STW(I)*100/.25\100
  1. .. S ATW(I)=ATW(I)*100/.25\100
  1. .. S MTW(I)=MTW(I)*100/.25\100
  1. . S $P(WK(I),U,56)=STW(I)
  1. . S $P(WK(I),U,57)=ATW(I)
  1. . S $P(WK(I),U,58)=MTW(I)
  1. ;
  1. ; -- Lump Sum Data (LY, LH, LD, DT)
  1. ;
  1. S (X,Y)=$G(^PRST(458,+PY,"E",+DFN,3)),(C,T(1),T(2),T(3))=""
  1. I X'="" F I=2,3,4 S T(I-1)=+$P(X,"^",I) I +T(I-1) S C=1
  1. I C F I=1,2,3 I +T(I) D
  1. .S X1="."_$P(T(I),".",2)\.25 ;turn % into quarter hours
  1. .S X=+$P(T(I),".",1)
  1. .S X=X_+X1 I '+X Q
  1. .S $P(WK(3),"^",4+I)=X
  1. S X=$P(Y,"^",5)
  1. I X?7N S X=$E(X,4,7)_$E(X,2,3),$P(WK(3),"^",8)=X
  1. K I,C,T,X ;clean up/save new T&L as Y (if there)
  1. ;
  1. ; -- T&L Change (TL)
  1. ;
  1. S X=$P(Y,"^") I $L(X)=3 S $P(WK(3),"^",4)=X
  1. K X
  1. ;
  1. ; -- Optional Withholding Tax (TO)
  1. ;
  1. I $P(Y,"^",7)="Y" S $P(WK(3),"^",9)=1
  1. ;
  1. ; -- Foreign Cola (LA)
  1. ;
  1. I $P(Y,"^",8)="Y" S $P(WK(3),"^",10)=2
  1. ;
  1. ; -- Payment Records (RR)
  1. ;
  1. I $P(Y,"^",6)="Y" S $P(WK(3),"^",15)=1
  1. ;
  1. ; -- Days Worked (DW)
  1. ;
  1. I DWK,TYP["I" S $P(WK(3),"^",2)=+DWK
  1. ;
  1. ; -- Calendar Year Adjustment (CA)
  1. ;
  1. ; I $D(WPCY) S X=WPCYA S X=(X\4)_"0",$P(WK(3),"^",12)=X K WPCY,WPCYA
  1. I $D(WPCY) D
  1. . S X=WPCYA S:$E(ENT,1,2)["H" X=(X\4) I +X S X=X_"0",$P(WK(3),"^",12)=X
  1. . K WPCY,WPCYA
  1. E S X=+CAMISC I TYP["I",+X S X=X_"0",$P(WK(3),"^",12)=X
  1. ;
  1. ; -- Days Worked [SF 2806] (CY)
  1. ;
  1. I CYA2806'=0 S X=+CYA2806 I (TYP["I"!(TYP["P")),TYP'["B",+X S:"56U"'[$P(C0,"^",21) X=(X\4)_(X#4),$P(WK(3),"^",14)=X
  1. E S X=+CAMISC I TYP["I",+X S:"56U"'[$P(C0,"^",21) X=X_"0",$P(WK(3),"^",14)=X
  1. ;
  1. ; -- Fire Fighter Normal Hours (FF)
  1. ; Sum PT from week 1 with PH from week 2 and copy into FF
  1. ;
  1. S $P(WK(3),"^",16)=""
  1. I "Ff"[TYP,(("RC"[PMP)!(NH=448)!(NH>320&(NH(1)'=NH(2)))) D
  1. . F I=1,2 D
  1. .. S X=+$P(WK(I),"^",32)
  1. .. I +X S $P(WK(3),"^",16)=$P(WK(3),"^",16)+X
  1. ;
  1. S X=$P(WK(3),"^",16)
  1. I X S $P(WK(3),"^",16)=(X\4)_(X#4) ;quarter hours
  1. K I,X,Y
  1. ;
  1. ; -- reduce OC by OT where applicable
  1. F I=1,2 I $P(WK(I),"^",35),+$G(CBCK(I)) D
  1. .S $P(WK(I),"^",35)=$P(WK(I),"^",35)-CBCK(I)
  1. ;
  1. ; -- Military Leave (ML)
  1. ;I $G(MILV) S P=11 D DAYS
  1. ;
  1. ; -- Work Comp [Count COP days] (PC)
  1. I $G(WCMP) S P=13 D DAYS
  1. ;
  1. END ; --- all done here
  1. Q
  1. ;
  1. DAYS ; --- count total number of days for ML and PC
  1. K NODE S NODE=$P("ML^^CP","^",P-10),(NODE(1),NODE(2))=""
  1. F D=1:1:14 D
  1. .S NODE(1)=NODE(1)_+$G(^TMP($J,"PRS8",D,NODE))
  1. .S NODE(2)=NODE(2)_+$G(^TMP($J,"PRS8",D,"OFF"))
  1. .I $E(NODE(1),D) D SET ;save day in WK(3)
  1. S NODE(1)=$E("0*",1+$G(^TMP($J,"PRS8",0,NODE)))_NODE(1)_$E("0*",1+$G(^TMP($J,"PRS8",15,NODE))) ; assume ML/CP has been counted for past/future ppd
  1. S NODE(2)=+$G(^TMP($J,"PRS8",0,"OFF"))_NODE(2)_+$G(^TMP($J,"PRS8",15,"OFF")) ; set off days for past/future ppd
  1. S F=1 ;F=Forward check needed
  1. F I=2:1:15 S X=$E(NODE(1),I),X1=$E(NODE(2),I) D
  1. .I 'X1 S F=$S(X="*":I,1:-1) ;go forward into next week
  1. .S (C,Q)=0 I X1,X'="*",$E(NODE(1),I-1)="*" F J=F+1:1:15 Q:Q D ; X'="*"" ==> X=1 for NODE="ML" if there is a problem with the counting of ML when the orders specify days off are not to be counted.
  1. ..S X=$E(NODE(1),J),X1=$E(NODE(2),J)
  1. ..I 'X1,X=0 S Q=1 Q ;worked
  1. ..I X="*" S Q=1,C=J-2 Q ;military leave
  1. ..I J=15,$E(NODE(1),J+1)="*" S Q=1,C=14 Q ; if last day in ppd, and there is ML/CP on the first day of next ppd, then count this ML/CP
  1. .I C F J=I-1:1:C S D=J D SET ;save off days in pp
  1. Q
  1. ;
  1. SET ; --- set WK(3) Node for ML
  1. S $P(WK(3),"^",+P)=$P(WK(3),"^",+P)+1
  1. S NODE(1)=$E(NODE(1),0,D-1)_"*"_$E(NODE(1),D+1,99)
  1. Q