PRSALVS ;WOIFO/PLT - Display Leave Request ;02/12/08
;;4.0;PAID;**9,69,112,133**;Sep 21, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0))
I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX
D HDR
K %DT S %DT="AEX",%DT("A")="Begin with Date: ",%DT("B")="T" W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S EDT=9999999-Y
W ! S NUM=0 D DISP,H1 G EX
DISP ; Display Leave Requests
S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3),CNT=0,QT=0 K:NUM R
F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>EDT) F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,DTI,DA)) Q:DA="" D LST G:QT D0
W:'CNT !,"No Requests on File."
D0 Q
LST ; Display Request
S Z=$G(^PRST(458.1,DA,0)) Q:Z="" Q:$P(Z,"^",9)="X" S SCOM=$P($G(^(1)),"^",1) I NUM,$P(Z,"^",9)'="R" Q:"D"[$P(Z,"^",9) D Q:Z=""
.S X=$P(Z,"^",3),X=$G(^PRST(458,"AD",+X))
.S Y=$G(^PRST(458,+$P(X,"^",1),"E",DFN,"D",+$P(X,"^",2),2))
.Q:Y'[$P(Z,"^",7) S Z="" Q
I CNT D:$Y>(IOSL-4) H1 Q:QT
S CNT=CNT+1 W ! I NUM W $J(CNT,2)," " S R(CNT)=DA
W $P(Z,"^",4)," " S X=$P(Z,"^",3) D DTP^PRSAPPU W Y," to ",$P(Z,"^",6)," "
S X=$P(Z,"^",5) D DTP^PRSAPPU W Y," "
S X=$P(Z,"^",15) I X W X," ",$S($P(Z,"^",16)="D":"days",1:"hrs")," "
S X=$P(Z,"^",7),%=$F(LVT,";"_X_":") I %>0 W $P($E(LVT,%,999),";",1)," "
S X=$P(Z,"^",9)
S %=$F(LVS,";"_X_":") I %>0 W $P($E(LVS,%,999),";",1)
S X=$P(Z,"^",8) W:X'="" !?5,X S Y=$P(Z,"^",11) D DTP^PRSAUDP W !?5,"Requested: ",Y
W:SCOM'="" !?5,"Supr: ",SCOM Q
BAL ; Leave Balance
N CNT,PPE S Z=$P($G(^PRST(458.1,DA,0)),"^",7),(BAL,INC,CNT)="" Q:Z=""
I "CB AD"[Z N Z S Z="SL"
Q:"AL SL CU ML RL"'[Z D ^PRSALVT I NH'=48!(DB'=1) G B0
I Z="AL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",1) G B2
I Z="SL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",13) G B2
I Z="RL" S BAL=$G(^PRSPC(DFN,"BAYLOR")),BAL=$P(BAL,"^",9)+$P(BAL,"^",10) G B2
G B1
B0 I Z="AL" S BAL=$P($G(^PRSPC(DFN,"ANNUAL")),"^",3) G B2
I Z="SL" S BAL=$P($G(^PRSPC(DFN,"SICK")),"^",3) G B2
I Z="RL" S BAL=$G(^PRSPC(DFN,"ANNUAL")),BAL=$P(BAL,"^",10)+$P(BAL,"^",11) G B2
B1 I Z="ML" S BAL=$P($G(^PRSPC(DFN,"MILITARY")),"^",1) G B2
QUIT:Z'="CU"
;balance includes all comptime/credit hours
S Z="CT",Y=$G(^PRSPC(DFN,"COMP")),BAL=BAL+$P(Y,U,9)
B2 S LST=+$P($G(^PRSPC(DFN,"MISC4")),"^",16),D1=DT D PP^PRSAPPU S YR=$P(PPE,"-",1)
S D1=+$P(PPE,"-",2),YR=$S(D1'<LST:YR,1:$E(199+YR,2,3)),PPE=YR_"-"_$S(LST>9:LST,1:"0"_LST)
S PPI=$O(^PRST(458,"B",PPE,0)),SDT=DT I PPI S D1=$P($G(^PRST(458,PPI,2)),"^",14),SDT=$P($G(^(1)),"^",14)
I PRT,Z="CT" W !,Z,?6," Leave Balance: ",$J(BAL,9,3)," as of ",D1
I PRT,Z'="CT" W !,Z," Leave Balance: ",$S(Z="ML":$J(BAL,13,2),1:$J(BAL,13,3))," as of ",D1
I "AL SL"'[Z Q
S EDT=$P($G(^PRST(458.1,DA,0)),"^",5) I EDT'>SDT G B3
S X1=EDT,X2=SDT D ^%DTC S INC=X+13\14*$S(Z="AL":AINC,1:SINC)
I NH=80,DB=2 S X1=EDT,X2=X+13\14*14-X D C^%DTC S INC=INC-$$RT(X,SDT) S:INC<0 INC=0
I PRT W !,Z," Estimated Earnings: ",$J(INC,8,3)
S LST=9999999-SDT,CNT=0
F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>LST) F RDA=0:0 S RDA=$O(^PRST(458.1,"AD",DFN,DTI,RDA)) Q:RDA="" I $G(^(RDA))'>EDT D
.S Z1=$G(^PRST(458.1,RDA,0)) S X1=$P(Z1,"^",7) S:"CB AD"[X1 X1="SL" Q:X1'=Z Q:"AR"'[$P(Z1,"^",9)
.I NH=72,DB=1 S $P(Z1,U,15)=$$LC($P(Z1,U,15))
.S CNT=CNT+$P(Z1,"^",15)
.I $P(Z1,"^",3)'<SDT,$P(Z1,"^",5)'>EDT Q
.S X1=$P(Z1,"^",5),X2=$P(Z1,"^",3) D ^%DTC S Z3=$P(Z1,"^",15)/$S($G(X):X,1:1)
.I $P(Z1,"^",3)<SDT S X1=SDT,X2=$P(Z1,"^",3) D ^%DTC I X>0 S CNT=CNT-(X*Z3)
.I $P(Z1,"^",5)>EDT S X1=$P(Z1,"^",5),X2=EDT D ^%DTC I X>0 S CNT=CNT-(X*Z3)
.Q
I PRT W !,Z," Estimated Usage: ",$J(CNT,11,3)
B3 S BAL=BAL+INC-CNT I PRT W !,Z," Projected Balance: ",$J(BAL,9,3)
I PRT,BAL<0 W !,"Warning: Approval MAY result in a negative leave balance."
Q
HDR ; Display Header
W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?32,"LEAVE REQUESTS"
S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?50,"XXX-XX-",$E(X,6,9) Q
H1 I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1 I 'QT W @IOF,!
Q
EX G KILL^XUSCLEAN
;Multiply leave request by 1.111 and round down to the quarter hour
;for 36/40 nurses
LC(X) S X=X*1.111\.25*.25 Q X
;Calculate number of Recess hours scheduled for a 9-month AWS Nurse
;before the date leave has been requested for
RT(EDT,SDT) N SFY,EFY,T,WK
S SFY=$E($P($$GETFSCYR^PRSARC04(SDT),U,2),3,6),EFY=$E($P($$GETFSCYR^PRSARC04(EDT),U,2),3,6)
D RES^PRSARC05(.WK,DFN,SFY,EFY,SDT,EDT) S (I,T)=0 F S I=$O(WK(I)) Q:I="" S T=T+WK(I)
;Calculate the number of hours of leave that would have been
;accumulated for the time the nurse was on recess.
Q T/80*$S(Z="AL":AINC,1:SINC)\.25*.25
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSALVS 4854 printed Dec 13, 2024@02:23:39 Page 2
PRSALVS ;WOIFO/PLT - Display Leave Request ;02/12/08
+1 ;;4.0;PAID;**9,69,112,133**;Sep 21, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET DFN=""
SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
IF SSN'=""
SET DFN=$ORDER(^PRSPC("SSN",SSN,0))
+4 IF 'DFN
WRITE !!,*7,"Your SSN was not found in both the New Person & Employee File!"
GOTO EX
+5 DO HDR
+6 KILL %DT
SET %DT="AEX"
SET %DT("A")="Begin with Date: "
SET %DT("B")="T"
WRITE !
DO ^%DT
KILL %DT
if $DATA(DTOUT)
SET Y=0
if Y<1
GOTO EX
SET EDT=9999999-Y
+7 WRITE !
SET NUM=0
DO DISP
DO H1
GOTO EX
DISP ; Display Leave Requests
+1 SET LVT=";"_$PIECE(^DD(458.1,6,0),"^",3)
SET LVS=";"_$PIECE(^DD(458.1,8,0),"^",3)
SET CNT=0
SET QT=0
if NUM
KILL R
+2 FOR DTI=0:0
SET DTI=$ORDER(^PRST(458.1,"AD",DFN,DTI))
if DTI=""!(DTI>EDT)
QUIT
FOR DA=0:0
SET DA=$ORDER(^PRST(458.1,"AD",DFN,DTI,DA))
if DA=""
QUIT
DO LST
if QT
GOTO D0
+3 if 'CNT
WRITE !,"No Requests on File."
D0 QUIT
LST ; Display Request
+1 SET Z=$GET(^PRST(458.1,DA,0))
if Z=""
QUIT
if $PIECE(Z,"^",9)="X"
QUIT
SET SCOM=$PIECE($GET(^(1)),"^",1)
IF NUM
IF $PIECE(Z,"^",9)'="R"
if "D"[$PIECE(Z,"^",9)
QUIT
Begin DoDot:1
+2 SET X=$PIECE(Z,"^",3)
SET X=$GET(^PRST(458,"AD",+X))
+3 SET Y=$GET(^PRST(458,+$PIECE(X,"^",1),"E",DFN,"D",+$PIECE(X,"^",2),2))
+4 if Y'[$PIECE(Z,"^",7)
QUIT
SET Z=""
QUIT
End DoDot:1
if Z=""
QUIT
+5 IF CNT
if $Y>(IOSL-4)
DO H1
if QT
QUIT
+6 SET CNT=CNT+1
WRITE !
IF NUM
WRITE $JUSTIFY(CNT,2)," "
SET R(CNT)=DA
+7 WRITE $PIECE(Z,"^",4)," "
SET X=$PIECE(Z,"^",3)
DO DTP^PRSAPPU
WRITE Y," to ",$PIECE(Z,"^",6)," "
+8 SET X=$PIECE(Z,"^",5)
DO DTP^PRSAPPU
WRITE Y," "
+9 SET X=$PIECE(Z,"^",15)
IF X
WRITE X," ",$SELECT($PIECE(Z,"^",16)="D":"days",1:"hrs")," "
+10 SET X=$PIECE(Z,"^",7)
SET %=$FIND(LVT,";"_X_":")
IF %>0
WRITE $PIECE($EXTRACT(LVT,%,999),";",1)," "
+11 SET X=$PIECE(Z,"^",9)
+12 SET %=$FIND(LVS,";"_X_":")
IF %>0
WRITE $PIECE($EXTRACT(LVS,%,999),";",1)
+13 SET X=$PIECE(Z,"^",8)
if X'=""
WRITE !?5,X
SET Y=$PIECE(Z,"^",11)
DO DTP^PRSAUDP
WRITE !?5,"Requested: ",Y
+14 if SCOM'=""
WRITE !?5,"Supr: ",SCOM
QUIT
BAL ; Leave Balance
+1 NEW CNT,PPE
SET Z=$PIECE($GET(^PRST(458.1,DA,0)),"^",7)
SET (BAL,INC,CNT)=""
if Z=""
QUIT
+2 IF "CB AD"[Z
NEW Z
SET Z="SL"
+3 if "AL SL CU ML RL"'[Z
QUIT
DO ^PRSALVT
IF NH'=48!(DB'=1)
GOTO B0
+4 IF Z="AL"
SET BAL=$PIECE($GET(^PRSPC(DFN,"BAYLOR")),"^",1)
GOTO B2
+5 IF Z="SL"
SET BAL=$PIECE($GET(^PRSPC(DFN,"BAYLOR")),"^",13)
GOTO B2
+6 IF Z="RL"
SET BAL=$GET(^PRSPC(DFN,"BAYLOR"))
SET BAL=$PIECE(BAL,"^",9)+$PIECE(BAL,"^",10)
GOTO B2
+7 GOTO B1
B0 IF Z="AL"
SET BAL=$PIECE($GET(^PRSPC(DFN,"ANNUAL")),"^",3)
GOTO B2
+1 IF Z="SL"
SET BAL=$PIECE($GET(^PRSPC(DFN,"SICK")),"^",3)
GOTO B2
+2 IF Z="RL"
SET BAL=$GET(^PRSPC(DFN,"ANNUAL"))
SET BAL=$PIECE(BAL,"^",10)+$PIECE(BAL,"^",11)
GOTO B2
B1 IF Z="ML"
SET BAL=$PIECE($GET(^PRSPC(DFN,"MILITARY")),"^",1)
GOTO B2
+1 if Z'="CU"
QUIT
+2 ;balance includes all comptime/credit hours
+3 SET Z="CT"
SET Y=$GET(^PRSPC(DFN,"COMP"))
SET BAL=BAL+$PIECE(Y,U,9)
B2 SET LST=+$PIECE($GET(^PRSPC(DFN,"MISC4")),"^",16)
SET D1=DT
DO PP^PRSAPPU
SET YR=$PIECE(PPE,"-",1)
+1 SET D1=+$PIECE(PPE,"-",2)
SET YR=$SELECT(D1'<LST:YR,1:$EXTRACT(199+YR,2,3))
SET PPE=YR_"-"_$SELECT(LST>9:LST,1:"0"_LST)
+2 SET PPI=$ORDER(^PRST(458,"B",PPE,0))
SET SDT=DT
IF PPI
SET D1=$PIECE($GET(^PRST(458,PPI,2)),"^",14)
SET SDT=$PIECE($GET(^(1)),"^",14)
+3 IF PRT
IF Z="CT"
WRITE !,Z,?6," Leave Balance: ",$JUSTIFY(BAL,9,3)," as of ",D1
+4 IF PRT
IF Z'="CT"
WRITE !,Z," Leave Balance: ",$SELECT(Z="ML":$JUSTIFY(BAL,13,2),1:$JUSTIFY(BAL,13,3))," as of ",D1
+5 IF "AL SL"'[Z
QUIT
+6 SET EDT=$PIECE($GET(^PRST(458.1,DA,0)),"^",5)
IF EDT'>SDT
GOTO B3
+7 SET X1=EDT
SET X2=SDT
DO ^%DTC
SET INC=X+13\14*$SELECT(Z="AL":AINC,1:SINC)
+8 IF NH=80
IF DB=2
SET X1=EDT
SET X2=X+13\14*14-X
DO C^%DTC
SET INC=INC-$$RT(X,SDT)
if INC<0
SET INC=0
+9 IF PRT
WRITE !,Z," Estimated Earnings: ",$JUSTIFY(INC,8,3)
+10 SET LST=9999999-SDT
SET CNT=0
+11 FOR DTI=0:0
SET DTI=$ORDER(^PRST(458.1,"AD",DFN,DTI))
if DTI=""!(DTI>LST)
QUIT
FOR RDA=0:0
SET RDA=$ORDER(^PRST(458.1,"AD",DFN,DTI,RDA))
if RDA=""
QUIT
IF $GET(^(RDA))'>EDT
Begin DoDot:1
+12 SET Z1=$GET(^PRST(458.1,RDA,0))
SET X1=$PIECE(Z1,"^",7)
if "CB AD"[X1
SET X1="SL"
if X1'=Z
QUIT
if "AR"'[$PIECE(Z1,"^",9)
QUIT
+13 IF NH=72
IF DB=1
SET $PIECE(Z1,U,15)=$$LC($PIECE(Z1,U,15))
+14 SET CNT=CNT+$PIECE(Z1,"^",15)
+15 IF $PIECE(Z1,"^",3)'<SDT
IF $PIECE(Z1,"^",5)'>EDT
QUIT
+16 SET X1=$PIECE(Z1,"^",5)
SET X2=$PIECE(Z1,"^",3)
DO ^%DTC
SET Z3=$PIECE(Z1,"^",15)/$SELECT($GET(X):X,1:1)
+17 IF $PIECE(Z1,"^",3)<SDT
SET X1=SDT
SET X2=$PIECE(Z1,"^",3)
DO ^%DTC
IF X>0
SET CNT=CNT-(X*Z3)
+18 IF $PIECE(Z1,"^",5)>EDT
SET X1=$PIECE(Z1,"^",5)
SET X2=EDT
DO ^%DTC
IF X>0
SET CNT=CNT-(X*Z3)
+19 QUIT
End DoDot:1
+20 IF PRT
WRITE !,Z," Estimated Usage: ",$JUSTIFY(CNT,11,3)
B3 SET BAL=BAL+INC-CNT
IF PRT
WRITE !,Z," Projected Balance: ",$JUSTIFY(BAL,9,3)
+1 IF PRT
IF BAL<0
WRITE !,"Warning: Approval MAY result in a negative leave balance."
+2 QUIT
HDR ; Display Header
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",!?32,"LEAVE REQUESTS"
+2 SET X=$GET(^PRSPC(DFN,0))
WRITE !!,$PIECE(X,"^",1)
SET X=$PIECE(X,"^",9)
IF X
WRITE ?50,"XXX-XX-",$EXTRACT(X,6,9)
QUIT
H1 IF $EXTRACT(IOST,1,2)="C-"
READ !!,"Press RETURN to Continue.",X:DTIME
if '$TEST!(X["^")
SET QT=1
IF 'QT
WRITE @IOF,!
+1 QUIT
EX GOTO KILL^XUSCLEAN
+1 ;Multiply leave request by 1.111 and round down to the quarter hour
+2 ;for 36/40 nurses
LC(X) SET X=X*1.111\.25*.25
QUIT X
+1 ;Calculate number of Recess hours scheduled for a 9-month AWS Nurse
+2 ;before the date leave has been requested for
RT(EDT,SDT) NEW SFY,EFY,T,WK
+1 SET SFY=$EXTRACT($PIECE($$GETFSCYR^PRSARC04(SDT),U,2),3,6)
SET EFY=$EXTRACT($PIECE($$GETFSCYR^PRSARC04(EDT),U,2),3,6)
+2 DO RES^PRSARC05(.WK,DFN,SFY,EFY,SDT,EDT)
SET (I,T)=0
FOR
SET I=$ORDER(WK(I))
if I=""
QUIT
SET T=T+WK(I)
+3 ;Calculate the number of hours of leave that would have been
+4 ;accumulated for the time the nurse was on recess.
+5 QUIT T/80*$SELECT(Z="AL":AINC,1:SINC)\.25*.25
