PRSASR1 ;WCIOFO/JAH - Display VCS, Fee, ED ;02/20/08
;;4.0;PAID;**6,21,82,93,116**;Sep 21, 1995;Build 23
;;Per VHA Directive 2004-038, this routine should not be modified.
VCS ; Display VCS Sales/Fee Basis
;
N OLDPP
S PAYP=$P($G(^PRSPC(DFN,0)),"^",21)
; Check the pay plan for the pay period we are dealing with
; in case it's a previous pay period where an employee
; had a different pay plan.
; 1st put pay period in YY-PP format 4 call 2 lookup old pay plan.
;Only check if called from option Display employee pay period PPERIOD
;will be defined.
I $G(PPERIOD) D
.;S PPERIOD=$S(Y["-":$P(Y,"^",2),1:$P(^PRST(458,$P(Y,"^"),0),"^"))
.S OLDPP=$$OLDPP^PRS8UT(PPERIOD,DFN)
.I OLDPP'=0,(OLDPP'=PAYP) D
.. S PAYP=OLDPP
.. W !,"Employee is NOT currently under this pay plan."
;
W !!?30,$S(PAYP="F":"Fee Basis Appointee",1:"VCS Commission Sales")
W !!?13,"Sun Mon Tue Wed Thu Fri Sat",!
W !,"Week 1" S L1=1 F K=1:1:7 S L1=L1+10,Z1=$P(Z,"^",K) I Z1'="" W ?L1,$J(Z1,7,2)
W !,"Week 2" S L1=1 F K=8:1:14 S L1=L1+10,Z1=$P(Z,"^",K) I Z1'="" W ?L1,$J(Z1,7,2)
I PAYP="F" W !! F K=19:1:21 S Z1=$P(Z,"^",K) W "Total ",$P("Hours Days Procedures"," ",K-18),": ",Z1," "
Q
ED ; Display Envir. Diff.
W !!?26,"Environmental Differentials",!
S Y="" F K=1:2:5 S Z1=$P(Z,"^",K) Q:'Z1 S:Y'="" Y=Y_"; " S Y=Y_$P($G(^PRST(457.6,+Z1,0)),"^",1)_" "_$P(Z,"^",K+1)_" Hrs."
I Y'="" W !,"Week 1: ",Y
S Y="" F K=7:2:11 S Z1=$P(Z,"^",K) Q:'Z1 S:Y'="" Y=Y_"; " S Y=Y_$P($G(^PRST(457.6,+Z1,0)),"^",1)_" "_$P(Z,"^",K+1)_" Hrs."
I Y'="" W !,"Week 2: ",Y
Q
;
LD ; Display changes to the Labor Distribution Codes within the Pay
; Period.
;
N DASH,DESC,IENS,LDCC,LDCCB,LDCCEX,LDCODE,LDCNT,LDDOA,LDFCP
N LDHOLD,LDPCT,LDTOI,PRSLD,Y
S $P(DASH,"-",80)=""
W !
D LDHOLD
W !,"Current Labor Distribution Values:"
S LDDOA=$$GET1^DIQ(450,DFN,756,"E")
S LDCCB=$$GET1^DIQ(450,DFN,755,"E")
S LDTOI=$$GET1^DIQ(450,DFN,755.1,"E")
W !,LDDOA,?24,LDCCB,?61,LDTOI
F PRSLD=1:1:4 D
. S LDCODE=$$GET1^DIQ(450.0757,PRSLD_","_DFN,1)
. S LDPCT=$$GET1^DIQ(450.0757,PRSLD_","_DFN,2)
. S LDCC=$$GET1^DIQ(450.0757,PRSLD_","_DFN,3)
. S Y=LDCC,SUB454="CC"
. D OT^PRSDUTIL K SUB454
. S LDCCEX=$E(Y,1,30)
. S LDFCP=$$GET1^DIQ(450.0757,PRSLD_","_DFN,4)
. W !,"Code",PRSLD,": ",LDCODE,?12,LDPCT,?24,LDCC," - ",LDCCEX,?70,LDFCP
;
W !!,"The previous Labor Distribution Values:"
S LDCNT="A"
S LDCNT=$O(^PRST(458,PPI,"E",DFN,"LDAUD",LDCNT),-1)
Q:'LDCNT
S IENS=LDCNT_","_DFN_","_PPI_","
S LDDOA=$$GET1^DIQ(458.1105,IENS,1,"E")
S LDCCB=$$GET1^DIQ(458.1105,IENS,2,"E")
S LDTOI=$$GET1^DIQ(458.1105,IENS,3,"E")
W !,LDDOA,?24,LDCCB,?61,LDTOI
F PRSLD=1:1:4 D
. S IENS=PRSLD_","_LDCNT_","_DFN_","_PPI_","
. S LDCODE=$$GET1^DIQ(458.11054,IENS,1)
. S LDPCT=$$GET1^DIQ(458.11054,IENS,2)
. S LDCC=$$GET1^DIQ(458.11054,IENS,3)
. S Y=LDCC,SUB454="CC"
. D OT^PRSDUTIL K SUB454
. S LDCCEX=$E(Y,1,30)
. S LDFCP=$$GET1^DIQ(458.11054,IENS,4)
. W !,"Code",PRSLD,": ",LDCODE,?12,LDPCT,?24,LDCC," - ",LDCCEX,?70,LDFCP
Q
;
LDHDR ; Labor Distribution Header information
;
W !?15,"Labor Distribution Changes within the Pay Period:"
W !,"Date/Time",?24,"Changed by",?61,"Type of Interface"
W !,"Code",?12,"Percent",?24,"Cost Center - Description"
W ?65,"Fund Ctrl Pt"
W !,DASH
Q
;
LDHOLD ; Pause of more LD changes that will fit on 1 screen.
;
N X
S LDHOLD=$$ASK^PRSLIB00(1)
S X=$G(^PRSPC(DFN,0))
W !,@IOF,?3,$P(X,"^",1)
S X=$P(X,"^",9)
I X W ?68,$E(X),"XX-XX-",$E(X,6,9)
W !,DASH
D LDHDR
Q
;
PTP(PRSIEN,PPI) ; Updates hours credited for PT Phys w/ Memorandums
; This API can be used for initial and subsequent calculation
; of the PTP's ESR.
; algorithm for this API follows:
; 1. Grab copy of currently stored pay period hours
; 2. Look at ESR/timecard data to recalculate pay period hours
; 3. Calculate net difference between 1 and 2
; 4. update current pay period with new pp totals from (2) above
; 5. add net diff (3) to memo totals
;
N AHRS,AHTCM,AMT,COHRS,DIFFNP,DIFFRG,DIFFWP,INPH,ITHP,ITHW,IWPH
N MDAT,MDATA,MEAL,MIEN,MPPIEN,POHC,POT,PPC,PPE
N PPHRS,PPNP,PPWP,PRSX,START,STOP,THP,TOT,TOTAL,TOTNP,TOTWP
S MDAT=$P($G(^PRST(458,PPI,1)),U,1)
S MIEN=+$$MIEN^PRSPUT1(PRSIEN,MDAT)
Q:'MIEN ; Not a PTP w/ memo
S PPE=$P($G(^PRST(458,PPI,0)),U,1)
;
; Locate this PP in the PTP's memorandum
S MPPIEN=$O(^PRST(458.7,MIEN,9,"B",PPE,0))
Q:'MPPIEN ; PP not found within memo (###exception message)
;
;get the current values for this pay period under the memo.
S PRSX=$G(^PRST(458.7,MIEN,9,MPPIEN,0))
S PPHRS=+$P(PRSX,U,2) ; Actual hours of work credited
S PPNP=+$P(PRSX,U,3) ; Actual hours of Non Pay
S PPWP=+$P(PRSX,U,4) ; Actual hours of LWOP
K PRSX
;
; Load the memo totals
S MDATA=$G(^PRST(458.7,MIEN,0))
S AHRS=+$P(MDATA,U,4) ; Agreed Hours
S COHRS=+$P(MDATA,U,9) ; Carryover Hours
S ITHW=+$P(MDATA,U,10) ; Initial Total Hours Worked
S ITHP=+$P(MDATA,U,11) ; Initial Total Hours Paid
S INPH=+$P(MDATA,U,12) ; Initial Non-Pay Hours
S IWPH=+$P(MDATA,U,13) ; Initial Without Pay Hours
S (AHTCM,DIFFRG,DIFFNP,DIFFWP)=0
;
; Get Non pay and Leave without pay times from 8b string or recalc.
N TAMTS
S TAMTS("WP","Leave Without Pay")=""
S TAMTS("NP","Non-Pay Time")=""
D PP8BAMT^PRSPUT3(.TAMTS,PPI,PRSIEN)
S TOTAL("WP")=$G(TAMTS("WP","Leave Without Pay"))
S TOTAL("NP")=$G(TAMTS("NP","Non-Pay Time"))
S DIFFNP=TOTAL("NP")-PPNP
S DIFFWP=TOTAL("WP")-PPWP
;
; Loop thru day and ESR segments looking for leave and RG time
N DAY,ESR,RGCODES,SEG,TOT
S RGCODES="AA,AD,AL,CB,CP,DL,HX,ML,RG,RL,SL,TR,TV"
S TOTAL("RG")=0
F DAY=1:1:14 D
. ; only add totals for supervisor approved days
. Q:$$GETSTAT^PRSPESR1(PRSIEN,PPI,DAY)'=5
. S ESR=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
. Q:ESR=""
. F SEG=0:1:6 Q:$P(ESR,U,(5*SEG)+3)="" D
. . S TOT=$P(ESR,U,(5*SEG)+3)
. . ; Types Of Time that might have been worked in week 1
. . I RGCODES[TOT D Q
. . . S TOTAL("RG")=TOTAL("RG")+$$AMT(ESR)
;
; Checks for Regular Time
S DIFFRG=TOTAL("RG")-PPHRS
; determine number of memo pay periods that have been certified
S PRSX=$$MEMCPP^PRSPUT3(MIEN)
S PPC=$P(PRSX,U,2)+$S(PPE]$P(PRSX,U):1,1:0)
;
; Update pp totals with current calculated values
K IEN4587,PRSFDA
S IEN4587=MIEN_","
S PRSFDA(458.701,MPPIEN_","_IEN4587,1)=TOTAL("RG") ; PP new REG hrs
S PRSFDA(458.701,MPPIEN_","_IEN4587,2)=TOTAL("NP") ; PP new NP hrs
S PRSFDA(458.701,MPPIEN_","_IEN4587,3)=TOTAL("WP") ; PP new WP hrs
;
; update memo grand totals with differences found
S TOTNP=INPH+DIFFNP
S TOTWP=IWPH+DIFFWP
S PRSFDA(458.7,IEN4587,11)=TOTNP ; NP hrs
S PRSFDA(458.7,IEN4587,12)=TOTWP ; WP hrs
S PRSFDA(458.7,IEN4587,9)=ITHW+DIFFRG ; tot hrs worked (all creditable)
;
; If this is the first time the PP has been processed PPHRS will be null
; so add the average hrs/pp, otherwise this count has already been added
S THP=ITHP+$S(PPHRS="":AHRS/26,1:0)
S PRSFDA(458.7,IEN4587,10)=$FN(THP-DIFFNP-DIFFWP,"",2) ; tot hrs paid
S PRSFDA(458.7,IEN4587,13)=$FN(PPC/26,"",2) ; % of memo completed
; % OF HOURS COMPLETED
S POHC=$FN((ITHW+COHRS+DIFFRG)/(AHRS-TOTNP-TOTWP),"",2)
S PRSFDA(458.7,IEN4587,14)=POHC
;
; ave hrs/pp to complete mem (if certifying last pay period then then
; you're out of pay periods so use 0.00 to report how many more hours)
S AHTCM=$S(PPC>25:"0.00",1:$FN((AHRS-(ITHW+COHRS+DIFFRG)/(26-PPC)),"",2))
S PRSFDA(458.7,IEN4587,15)=AHTCM
; % off target
S POT=((AHRS/26)*PPC)-TOTNP-TOTWP
S POT=(ITHW+COHRS+DIFFRG)-POT/POT,POT=POT*100,POT=$FN(POT,"",2)
S PRSFDA(458.7,IEN4587,16)=POT
D FILE^DIE("","PRSFDA")
Q
;
AMT(ESR) ; Return hours elapsed for time segment in decimal format
; deduct meal
; e.g. AMT=2.5 (2 hours 30 min)
N START,STOP,MEAL,AMT,X
S START=$P(ESR,U,(5*SEG)+1),STOP=$P(ESR,U,(5*SEG)+2)
S MEAL=$P(ESR,U,(5*SEG)+5)
S AMT=$$ELAPSE^PRSPESR2(MEAL,START,STOP)
S X=$P(AMT,":",2) S X=$S(X=30:5,X=15:25,X=45:75,1:0)
S AMT=+$P(AMT,":",1)_"."_X
Q AMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSASR1 8177 printed Dec 13, 2024@02:24:21 Page 2
PRSASR1 ;WCIOFO/JAH - Display VCS, Fee, ED ;02/20/08
+1 ;;4.0;PAID;**6,21,82,93,116**;Sep 21, 1995;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
VCS ; Display VCS Sales/Fee Basis
+1 ;
+2 NEW OLDPP
+3 SET PAYP=$PIECE($GET(^PRSPC(DFN,0)),"^",21)
+4 ; Check the pay plan for the pay period we are dealing with
+5 ; in case it's a previous pay period where an employee
+6 ; had a different pay plan.
+7 ; 1st put pay period in YY-PP format 4 call 2 lookup old pay plan.
+8 ;Only check if called from option Display employee pay period PPERIOD
+9 ;will be defined.
+10 IF $GET(PPERIOD)
Begin DoDot:1
+11 ;S PPERIOD=$S(Y["-":$P(Y,"^",2),1:$P(^PRST(458,$P(Y,"^"),0),"^"))
+12 SET OLDPP=$$OLDPP^PRS8UT(PPERIOD,DFN)
+13 IF OLDPP'=0
IF (OLDPP'=PAYP)
Begin DoDot:2
+14 SET PAYP=OLDPP
+15 WRITE !,"Employee is NOT currently under this pay plan."
End DoDot:2
End DoDot:1
+16 ;
+17 WRITE !!?30,$SELECT(PAYP="F":"Fee Basis Appointee",1:"VCS Commission Sales")
+18 WRITE !!?13,"Sun Mon Tue Wed Thu Fri Sat",!
+19 WRITE !,"Week 1"
SET L1=1
FOR K=1:1:7
SET L1=L1+10
SET Z1=$PIECE(Z,"^",K)
IF Z1'=""
WRITE ?L1,$JUSTIFY(Z1,7,2)
+20 WRITE !,"Week 2"
SET L1=1
FOR K=8:1:14
SET L1=L1+10
SET Z1=$PIECE(Z,"^",K)
IF Z1'=""
WRITE ?L1,$JUSTIFY(Z1,7,2)
+21 IF PAYP="F"
WRITE !!
FOR K=19:1:21
SET Z1=$PIECE(Z,"^",K)
WRITE "Total ",$PIECE("Hours Days Procedures"," ",K-18),": ",Z1," "
+22 QUIT
ED ; Display Envir. Diff.
+1 WRITE !!?26,"Environmental Differentials",!
+2 SET Y=""
FOR K=1:2:5
SET Z1=$PIECE(Z,"^",K)
if 'Z1
QUIT
if Y'=""
SET Y=Y_"; "
SET Y=Y_$PIECE($GET(^PRST(457.6,+Z1,0)),"^",1)_" "_$PIECE(Z,"^",K+1)_" Hrs."
+3 IF Y'=""
WRITE !,"Week 1: ",Y
+4 SET Y=""
FOR K=7:2:11
SET Z1=$PIECE(Z,"^",K)
if 'Z1
QUIT
if Y'=""
SET Y=Y_"; "
SET Y=Y_$PIECE($GET(^PRST(457.6,+Z1,0)),"^",1)_" "_$PIECE(Z,"^",K+1)_" Hrs."
+5 IF Y'=""
WRITE !,"Week 2: ",Y
+6 QUIT
+7 ;
LD ; Display changes to the Labor Distribution Codes within the Pay
+1 ; Period.
+2 ;
+3 NEW DASH,DESC,IENS,LDCC,LDCCB,LDCCEX,LDCODE,LDCNT,LDDOA,LDFCP
+4 NEW LDHOLD,LDPCT,LDTOI,PRSLD,Y
+5 SET $PIECE(DASH,"-",80)=""
+6 WRITE !
+7 DO LDHOLD
+8 WRITE !,"Current Labor Distribution Values:"
+9 SET LDDOA=$$GET1^DIQ(450,DFN,756,"E")
+10 SET LDCCB=$$GET1^DIQ(450,DFN,755,"E")
+11 SET LDTOI=$$GET1^DIQ(450,DFN,755.1,"E")
+12 WRITE !,LDDOA,?24,LDCCB,?61,LDTOI
+13 FOR PRSLD=1:1:4
Begin DoDot:1
+14 SET LDCODE=$$GET1^DIQ(450.0757,PRSLD_","_DFN,1)
+15 SET LDPCT=$$GET1^DIQ(450.0757,PRSLD_","_DFN,2)
+16 SET LDCC=$$GET1^DIQ(450.0757,PRSLD_","_DFN,3)
+17 SET Y=LDCC
SET SUB454="CC"
+18 DO OT^PRSDUTIL
KILL SUB454
+19 SET LDCCEX=$EXTRACT(Y,1,30)
+20 SET LDFCP=$$GET1^DIQ(450.0757,PRSLD_","_DFN,4)
+21 WRITE !,"Code",PRSLD,": ",LDCODE,?12,LDPCT,?24,LDCC," - ",LDCCEX,?70,LDFCP
End DoDot:1
+22 ;
+23 WRITE !!,"The previous Labor Distribution Values:"
+24 SET LDCNT="A"
+25 SET LDCNT=$ORDER(^PRST(458,PPI,"E",DFN,"LDAUD",LDCNT),-1)
+26 if 'LDCNT
QUIT
+27 SET IENS=LDCNT_","_DFN_","_PPI_","
+28 SET LDDOA=$$GET1^DIQ(458.1105,IENS,1,"E")
+29 SET LDCCB=$$GET1^DIQ(458.1105,IENS,2,"E")
+30 SET LDTOI=$$GET1^DIQ(458.1105,IENS,3,"E")
+31 WRITE !,LDDOA,?24,LDCCB,?61,LDTOI
+32 FOR PRSLD=1:1:4
Begin DoDot:1
+33 SET IENS=PRSLD_","_LDCNT_","_DFN_","_PPI_","
+34 SET LDCODE=$$GET1^DIQ(458.11054,IENS,1)
+35 SET LDPCT=$$GET1^DIQ(458.11054,IENS,2)
+36 SET LDCC=$$GET1^DIQ(458.11054,IENS,3)
+37 SET Y=LDCC
SET SUB454="CC"
+38 DO OT^PRSDUTIL
KILL SUB454
+39 SET LDCCEX=$EXTRACT(Y,1,30)
+40 SET LDFCP=$$GET1^DIQ(458.11054,IENS,4)
+41 WRITE !,"Code",PRSLD,": ",LDCODE,?12,LDPCT,?24,LDCC," - ",LDCCEX,?70,LDFCP
End DoDot:1
+42 QUIT
+43 ;
LDHDR ; Labor Distribution Header information
+1 ;
+2 WRITE !?15,"Labor Distribution Changes within the Pay Period:"
+3 WRITE !,"Date/Time",?24,"Changed by",?61,"Type of Interface"
+4 WRITE !,"Code",?12,"Percent",?24,"Cost Center - Description"
+5 WRITE ?65,"Fund Ctrl Pt"
+6 WRITE !,DASH
+7 QUIT
+8 ;
LDHOLD ; Pause of more LD changes that will fit on 1 screen.
+1 ;
+2 NEW X
+3 SET LDHOLD=$$ASK^PRSLIB00(1)
+4 SET X=$GET(^PRSPC(DFN,0))
+5 WRITE !,@IOF,?3,$PIECE(X,"^",1)
+6 SET X=$PIECE(X,"^",9)
+7 IF X
WRITE ?68,$EXTRACT(X),"XX-XX-",$EXTRACT(X,6,9)
+8 WRITE !,DASH
+9 DO LDHDR
+10 QUIT
+11 ;
PTP(PRSIEN,PPI) ; Updates hours credited for PT Phys w/ Memorandums
+1 ; This API can be used for initial and subsequent calculation
+2 ; of the PTP's ESR.
+3 ; algorithm for this API follows:
+4 ; 1. Grab copy of currently stored pay period hours
+5 ; 2. Look at ESR/timecard data to recalculate pay period hours
+6 ; 3. Calculate net difference between 1 and 2
+7 ; 4. update current pay period with new pp totals from (2) above
+8 ; 5. add net diff (3) to memo totals
+9 ;
+10 NEW AHRS,AHTCM,AMT,COHRS,DIFFNP,DIFFRG,DIFFWP,INPH,ITHP,ITHW,IWPH
+11 NEW MDAT,MDATA,MEAL,MIEN,MPPIEN,POHC,POT,PPC,PPE
+12 NEW PPHRS,PPNP,PPWP,PRSX,START,STOP,THP,TOT,TOTAL,TOTNP,TOTWP
+13 SET MDAT=$PIECE($GET(^PRST(458,PPI,1)),U,1)
+14 SET MIEN=+$$MIEN^PRSPUT1(PRSIEN,MDAT)
+15 ; Not a PTP w/ memo
if 'MIEN
QUIT
+16 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U,1)
+17 ;
+18 ; Locate this PP in the PTP's memorandum
+19 SET MPPIEN=$ORDER(^PRST(458.7,MIEN,9,"B",PPE,0))
+20 ; PP not found within memo (###exception message)
if 'MPPIEN
QUIT
+21 ;
+22 ;get the current values for this pay period under the memo.
+23 SET PRSX=$GET(^PRST(458.7,MIEN,9,MPPIEN,0))
+24 ; Actual hours of work credited
SET PPHRS=+$PIECE(PRSX,U,2)
+25 ; Actual hours of Non Pay
SET PPNP=+$PIECE(PRSX,U,3)
+26 ; Actual hours of LWOP
SET PPWP=+$PIECE(PRSX,U,4)
+27 KILL PRSX
+28 ;
+29 ; Load the memo totals
+30 SET MDATA=$GET(^PRST(458.7,MIEN,0))
+31 ; Agreed Hours
SET AHRS=+$PIECE(MDATA,U,4)
+32 ; Carryover Hours
SET COHRS=+$PIECE(MDATA,U,9)
+33 ; Initial Total Hours Worked
SET ITHW=+$PIECE(MDATA,U,10)
+34 ; Initial Total Hours Paid
SET ITHP=+$PIECE(MDATA,U,11)
+35 ; Initial Non-Pay Hours
SET INPH=+$PIECE(MDATA,U,12)
+36 ; Initial Without Pay Hours
SET IWPH=+$PIECE(MDATA,U,13)
+37 SET (AHTCM,DIFFRG,DIFFNP,DIFFWP)=0
+38 ;
+39 ; Get Non pay and Leave without pay times from 8b string or recalc.
+40 NEW TAMTS
+41 SET TAMTS("WP","Leave Without Pay")=""
+42 SET TAMTS("NP","Non-Pay Time")=""
+43 DO PP8BAMT^PRSPUT3(.TAMTS,PPI,PRSIEN)
+44 SET TOTAL("WP")=$GET(TAMTS("WP","Leave Without Pay"))
+45 SET TOTAL("NP")=$GET(TAMTS("NP","Non-Pay Time"))
+46 SET DIFFNP=TOTAL("NP")-PPNP
+47 SET DIFFWP=TOTAL("WP")-PPWP
+48 ;
+49 ; Loop thru day and ESR segments looking for leave and RG time
+50 NEW DAY,ESR,RGCODES,SEG,TOT
+51 SET RGCODES="AA,AD,AL,CB,CP,DL,HX,ML,RG,RL,SL,TR,TV"
+52 SET TOTAL("RG")=0
+53 FOR DAY=1:1:14
Begin DoDot:1
+54 ; only add totals for supervisor approved days
+55 if $$GETSTAT^PRSPESR1(PRSIEN,PPI,DAY)'=5
QUIT
+56 SET ESR=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
+57 if ESR=""
QUIT
+58 FOR SEG=0:1:6
if $PIECE(ESR,U,(5*SEG)+3)=""
QUIT
Begin DoDot:2
+59 SET TOT=$PIECE(ESR,U,(5*SEG)+3)
+60 ; Types Of Time that might have been worked in week 1
+61 IF RGCODES[TOT
Begin DoDot:3
+62 SET TOTAL("RG")=TOTAL("RG")+$$AMT(ESR)
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+63 ;
+64 ; Checks for Regular Time
+65 SET DIFFRG=TOTAL("RG")-PPHRS
+66 ; determine number of memo pay periods that have been certified
+67 SET PRSX=$$MEMCPP^PRSPUT3(MIEN)
+68 SET PPC=$PIECE(PRSX,U,2)+$SELECT(PPE]$PIECE(PRSX,U):1,1:0)
+69 ;
+70 ; Update pp totals with current calculated values
+71 KILL IEN4587,PRSFDA
+72 SET IEN4587=MIEN_","
+73 ; PP new REG hrs
SET PRSFDA(458.701,MPPIEN_","_IEN4587,1)=TOTAL("RG")
+74 ; PP new NP hrs
SET PRSFDA(458.701,MPPIEN_","_IEN4587,2)=TOTAL("NP")
+75 ; PP new WP hrs
SET PRSFDA(458.701,MPPIEN_","_IEN4587,3)=TOTAL("WP")
+76 ;
+77 ; update memo grand totals with differences found
+78 SET TOTNP=INPH+DIFFNP
+79 SET TOTWP=IWPH+DIFFWP
+80 ; NP hrs
SET PRSFDA(458.7,IEN4587,11)=TOTNP
+81 ; WP hrs
SET PRSFDA(458.7,IEN4587,12)=TOTWP
+82 ; tot hrs worked (all creditable)
SET PRSFDA(458.7,IEN4587,9)=ITHW+DIFFRG
+83 ;
+84 ; If this is the first time the PP has been processed PPHRS will be null
+85 ; so add the average hrs/pp, otherwise this count has already been added
+86 SET THP=ITHP+$SELECT(PPHRS="":AHRS/26,1:0)
+87 ; tot hrs paid
SET PRSFDA(458.7,IEN4587,10)=$FNUMBER(THP-DIFFNP-DIFFWP,"",2)
+88 ; % of memo completed
SET PRSFDA(458.7,IEN4587,13)=$FNUMBER(PPC/26,"",2)
+89 ; % OF HOURS COMPLETED
+90 SET POHC=$FNUMBER((ITHW+COHRS+DIFFRG)/(AHRS-TOTNP-TOTWP),"",2)
+91 SET PRSFDA(458.7,IEN4587,14)=POHC
+92 ;
+93 ; ave hrs/pp to complete mem (if certifying last pay period then then
+94 ; you're out of pay periods so use 0.00 to report how many more hours)
+95 SET AHTCM=$SELECT(PPC>25:"0.00",1:$FNUMBER((AHRS-(ITHW+COHRS+DIFFRG)/(26-PPC)),"",2))
+96 SET PRSFDA(458.7,IEN4587,15)=AHTCM
+97 ; % off target
+98 SET POT=((AHRS/26)*PPC)-TOTNP-TOTWP
+99 SET POT=(ITHW+COHRS+DIFFRG)-POT/POT
SET POT=POT*100
SET POT=$FNUMBER(POT,"",2)
+100 SET PRSFDA(458.7,IEN4587,16)=POT
+101 DO FILE^DIE("","PRSFDA")
+102 QUIT
+103 ;
AMT(ESR) ; Return hours elapsed for time segment in decimal format
+1 ; deduct meal
+2 ; e.g. AMT=2.5 (2 hours 30 min)
+3 NEW START,STOP,MEAL,AMT,X
+4 SET START=$PIECE(ESR,U,(5*SEG)+1)
SET STOP=$PIECE(ESR,U,(5*SEG)+2)
+5 SET MEAL=$PIECE(ESR,U,(5*SEG)+5)
+6 SET AMT=$$ELAPSE^PRSPESR2(MEAL,START,STOP)
+7 SET X=$PIECE(AMT,":",2)
SET X=$SELECT(X=30:5,X=15:25,X=45:75,1:0)
+8 SET AMT=+$PIECE(AMT,":",1)_"."_X
+9 QUIT AMT
