- 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 Feb 18, 2025@23:49:10 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