PRS8DR ;HISC/MRL,JAH/WCIOFO-DECOMPOSITION, DRIVER ;4/09/2007
;;4.0;PAID;**22,29,56,90,111,112,107**;Sep 21, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine determines whether or not the parameters necessary
;to decompose time are in existence. The majority of variables
;involving processing an individual employee are defined in this
;routine.
;
;The following lines establish variables necessary to process a
;specific employees time for the specified pay period.
;
;Called by Routines: PRS8, PRS8DR (tag 1)
;
N PRVAL,RESTORE
;
D ONE^PRS8CV ;clean up variables
S SAVE=+$G(SAVE),SEE=+$G(SEE)
S TMTD=$G(^PRST(458,+PY,"E",DFN,0)),TMTD=$S($P(TMTD,"^",2)="X":1,1:0)
K WK F I=1,2,3 S WK(I)="" ;weekly totals (wk3=misc data)
D ^PRSAENT S VAL="" ;get entitlement (ENT)
I PP="S" G END ;Manila citizen/don't decompose/no stub
I $G(PB)["$" G STUB^PRS8CR ;don't decompose stipend/create stub
; Set NAWS to type of AWS
N NAWS
S NAWS=0
I "KM"[$E(AC,1),$E(AC,2)=1,NH=72 S NAWS="36/40 AWS"
I $E(AC,1)="M",$E(AC,2)=2,NH=80 S NAWS="9Mo AWS"
;
I "^P^X^"[(U_$P($G(^PRST(458,+PY,"E",DFN,0)),"^",2)_U) S RESTORE=1
D AUTOPINI^PRS8(+PY,+DFN,$G(RESTORE),.PRVAL) ; remove auto-posted data
S DOUB=0 I $E(ENT,26),$E(ENT,29) S DOUB=1 ;count standby & oncall same
S FLX="" S FLX=$P($G(^PRST(458,+PY,"E",DFN,0)),"^",6)
I +NAWS=36 S FLX="C"
S (SST,TAL)="",X=$P(C0,"^",8) I X'="" D ;T&L Unit
.S X=$O(^PRST(455.5,"B",X,0)) ;get ien
.S TAL=$G(^PRST(455.5,+X,0)),X=$P(TAL,"^",8) ;get sleep start time
.I $L(X) S (NDAY,LAST,Y,Y1)=0 D 15^PRS8SU
.S SST=$S(+X:X,1:93) K X,Y1,LAST,X ;sleep start time
.K SL,SB,ST ;make sure standby variable don't exist
S (CAMISC,CYA,CYA2806,WPCYA,LU)=0 ; << ADDED >> calendar year adjust./leave used in pp
S (NH(1),NH(2))=0 ;normal hrs/pp total/week(1)/week(2)
S (TH,TH(1),TH(2))=0 ;total hours
N CT S (CT(1),CT(2))=0 ; counter for compensatory time
K DWK S DWK=0 ;count of days worked - for intermittents
S NH=NH/.25 ;turn Norm hrs into 15min increments
K TOUR S (TOUR(1),TOUR(2))="" ;tour code for wg/week(1)/week(2)
K TYP S TYP="" I $E(ENT)="D"!($E(ENT,1,2)="0D") S TYP=TYP_"D" ;daily pay basis
I PP?1N.E!(PP="U") S TYP=TYP_"W" ;wagegrade
I PP'="","KM"[PP S TYP=TYP_"N" ;nurse
I +$E(AC,2)=1,NH=192 S TYP=TYP_"B" ;baylor plan
I $G(PMP)'="","EF"[PMP S TYP=TYP_"H" ;Nurse Hybrid
I $E($G(AC),2)=3 S TYP=TYP_"I" ;intermittent
I NH>320 S TYP=TYP_"F" I NH'>448 S TYP=TYP_"f" ;firefighter
; Nurses on the 9month AWS will be treated as FT employees during the 9 months
; that they are working. Prevent a "P" from being added to TYP.
I NH,NH'>319,$E(AC,2)'=1 S TYP=TYP_"P" ;part-time
I PP="L",$E(AC,2)=2 S TYP=TYP_"d" ;doctor
I PP="L",$E(AC,2)=1 S TYP=TYP_"dR" ;doctor/resident or intern
I PP="Q",$E(AC,2)=2 S TYP=TYP_"d" ;doctor
I PP="Q",$E(AC,2)=1 S TYP=TYP_"dR" ;doctor/resident or intern
S (PTH,PTH(1),PTH(2))=0 ;part-time hours
K WKL S (WKL(1),WKL(2))=0 ;count leave used in week during ND hours
K MEAL S $P(MEAL,"1^",14)="",MEAL=MEAL_1 ;mealtime
S (MILV,WCMP)=0 ;ML and PC indicators
S (CBCK(1),CBCK(2))=0 ;call back hrs by week counter
I TYP="" S TYP="*"
K I,PB,PP,X,X1,X2
D ^PRS8SU ;set up employee variables and commence decomposing
D ^PRS8CR
D:$D(PRVAL) AUTOPRES^PRS8(+PY,+DFN,.PRVAL) ; restore auto-posted data
I SEE D ^PRS8VW
;
END ; --- This is where we end this process
G ONE^PRS8CV ;clean up
Q
;
1 ; --- enter here to print single entry and close device
D ^PRS8DR,^%ZISC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8DR 3583 printed Dec 13, 2024@02:22:45 Page 2
PRS8DR ;HISC/MRL,JAH/WCIOFO-DECOMPOSITION, DRIVER ;4/09/2007
+1 ;;4.0;PAID;**22,29,56,90,111,112,107**;Sep 21, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This routine determines whether or not the parameters necessary
+5 ;to decompose time are in existence. The majority of variables
+6 ;involving processing an individual employee are defined in this
+7 ;routine.
+8 ;
+9 ;The following lines establish variables necessary to process a
+10 ;specific employees time for the specified pay period.
+11 ;
+12 ;Called by Routines: PRS8, PRS8DR (tag 1)
+13 ;
+14 NEW PRVAL,RESTORE
+15 ;
+16 ;clean up variables
DO ONE^PRS8CV
+17 SET SAVE=+$GET(SAVE)
SET SEE=+$GET(SEE)
+18 SET TMTD=$GET(^PRST(458,+PY,"E",DFN,0))
SET TMTD=$SELECT($PIECE(TMTD,"^",2)="X":1,1:0)
+19 ;weekly totals (wk3=misc data)
KILL WK
FOR I=1,2,3
SET WK(I)=""
+20 ;get entitlement (ENT)
DO ^PRSAENT
SET VAL=""
+21 ;Manila citizen/don't decompose/no stub
IF PP="S"
GOTO END
+22 ;don't decompose stipend/create stub
IF $GET(PB)["$"
GOTO STUB^PRS8CR
+23 ; Set NAWS to type of AWS
+24 NEW NAWS
+25 SET NAWS=0
+26 IF "KM"[$EXTRACT(AC,1)
IF $EXTRACT(AC,2)=1
IF NH=72
SET NAWS="36/40 AWS"
+27 IF $EXTRACT(AC,1)="M"
IF $EXTRACT(AC,2)=2
IF NH=80
SET NAWS="9Mo AWS"
+28 ;
+29 IF "^P^X^"[(U_$PIECE($GET(^PRST(458,+PY,"E",DFN,0)),"^",2)_U)
SET RESTORE=1
+30 ; remove auto-posted data
DO AUTOPINI^PRS8(+PY,+DFN,$GET(RESTORE),.PRVAL)
+31 ;count standby & oncall same
SET DOUB=0
IF $EXTRACT(ENT,26)
IF $EXTRACT(ENT,29)
SET DOUB=1
+32 SET FLX=""
SET FLX=$PIECE($GET(^PRST(458,+PY,"E",DFN,0)),"^",6)
+33 IF +NAWS=36
SET FLX="C"
+34 ;T&L Unit
SET (SST,TAL)=""
SET X=$PIECE(C0,"^",8)
IF X'=""
Begin DoDot:1
+35 ;get ien
SET X=$ORDER(^PRST(455.5,"B",X,0))
+36 ;get sleep start time
SET TAL=$GET(^PRST(455.5,+X,0))
SET X=$PIECE(TAL,"^",8)
+37 IF $LENGTH(X)
SET (NDAY,LAST,Y,Y1)=0
DO 15^PRS8SU
+38 ;sleep start time
SET SST=$SELECT(+X:X,1:93)
KILL X,Y1,LAST,X
+39 ;make sure standby variable don't exist
KILL SL,SB,ST
End DoDot:1
+40 ; << ADDED >> calendar year adjust./leave used in pp
SET (CAMISC,CYA,CYA2806,WPCYA,LU)=0
+41 ;normal hrs/pp total/week(1)/week(2)
SET (NH(1),NH(2))=0
+42 ;total hours
SET (TH,TH(1),TH(2))=0
+43 ; counter for compensatory time
NEW CT
SET (CT(1),CT(2))=0
+44 ;count of days worked - for intermittents
KILL DWK
SET DWK=0
+45 ;turn Norm hrs into 15min increments
SET NH=NH/.25
+46 ;tour code for wg/week(1)/week(2)
KILL TOUR
SET (TOUR(1),TOUR(2))=""
+47 ;daily pay basis
KILL TYP
SET TYP=""
IF $EXTRACT(ENT)="D"!($EXTRACT(ENT,1,2)="0D")
SET TYP=TYP_"D"
+48 ;wagegrade
IF PP?1N.E!(PP="U")
SET TYP=TYP_"W"
+49 ;nurse
IF PP'=""
IF "KM"[PP
SET TYP=TYP_"N"
+50 ;baylor plan
IF +$EXTRACT(AC,2)=1
IF NH=192
SET TYP=TYP_"B"
+51 ;Nurse Hybrid
IF $GET(PMP)'=""
IF "EF"[PMP
SET TYP=TYP_"H"
+52 ;intermittent
IF $EXTRACT($GET(AC),2)=3
SET TYP=TYP_"I"
+53 ;firefighter
IF NH>320
SET TYP=TYP_"F"
IF NH'>448
SET TYP=TYP_"f"
+54 ; Nurses on the 9month AWS will be treated as FT employees during the 9 months
+55 ; that they are working. Prevent a "P" from being added to TYP.
+56 ;part-time
IF NH
IF NH'>319
IF $EXTRACT(AC,2)'=1
SET TYP=TYP_"P"
+57 ;doctor
IF PP="L"
IF $EXTRACT(AC,2)=2
SET TYP=TYP_"d"
+58 ;doctor/resident or intern
IF PP="L"
IF $EXTRACT(AC,2)=1
SET TYP=TYP_"dR"
+59 ;doctor
IF PP="Q"
IF $EXTRACT(AC,2)=2
SET TYP=TYP_"d"
+60 ;doctor/resident or intern
IF PP="Q"
IF $EXTRACT(AC,2)=1
SET TYP=TYP_"dR"
+61 ;part-time hours
SET (PTH,PTH(1),PTH(2))=0
+62 ;count leave used in week during ND hours
KILL WKL
SET (WKL(1),WKL(2))=0
+63 ;mealtime
KILL MEAL
SET $PIECE(MEAL,"1^",14)=""
SET MEAL=MEAL_1
+64 ;ML and PC indicators
SET (MILV,WCMP)=0
+65 ;call back hrs by week counter
SET (CBCK(1),CBCK(2))=0
+66 IF TYP=""
SET TYP="*"
+67 KILL I,PB,PP,X,X1,X2
+68 ;set up employee variables and commence decomposing
DO ^PRS8SU
+69 DO ^PRS8CR
+70 ; restore auto-posted data
if $DATA(PRVAL)
DO AUTOPRES^PRS8(+PY,+DFN,.PRVAL)
+71 IF SEE
DO ^PRS8VW
+72 ;
END ; --- This is where we end this process
+1 ;clean up
GOTO ONE^PRS8CV
+2 QUIT
+3 ;
1 ; --- enter here to print single entry and close device
+1 DO ^PRS8DR
DO ^%ZISC
QUIT
