Released PRS*4*133 SEQ #119 Extracted from mail message **KIDS**:PRS*4.0*133^ **INSTALL NAME** PRS*4.0*133 "BLD",8898,0) PRS*4.0*133^PAID^0^3111103^y "BLD",8898,4,0) ^9.64PA^^ "BLD",8898,6.3) 2 "BLD",8898,"ABPKG") n "BLD",8898,"KRN",0) ^9.67PA^779.2^20 "BLD",8898,"KRN",.4,0) .4 "BLD",8898,"KRN",.401,0) .401 "BLD",8898,"KRN",.402,0) .402 "BLD",8898,"KRN",.403,0) .403 "BLD",8898,"KRN",.5,0) .5 "BLD",8898,"KRN",.84,0) .84 "BLD",8898,"KRN",3.6,0) 3.6 "BLD",8898,"KRN",3.8,0) 3.8 "BLD",8898,"KRN",9.2,0) 9.2 "BLD",8898,"KRN",9.8,0) 9.8 "BLD",8898,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",8898,"KRN",9.8,"NM",1,0) PRSALVB^^0^B25561687 "BLD",8898,"KRN",9.8,"NM",2,0) PRSALVS^^0^B19901127 "BLD",8898,"KRN",9.8,"NM","B","PRSALVB",1) "BLD",8898,"KRN",9.8,"NM","B","PRSALVS",2) "BLD",8898,"KRN",19,0) 19 "BLD",8898,"KRN",19.1,0) 19.1 "BLD",8898,"KRN",101,0) 101 "BLD",8898,"KRN",409.61,0) 409.61 "BLD",8898,"KRN",771,0) 771 "BLD",8898,"KRN",779.2,0) 779.2 "BLD",8898,"KRN",870,0) 870 "BLD",8898,"KRN",8989.51,0) 8989.51 "BLD",8898,"KRN",8989.52,0) 8989.52 "BLD",8898,"KRN",8994,0) 8994 "BLD",8898,"KRN","B",.4,.4) "BLD",8898,"KRN","B",.401,.401) "BLD",8898,"KRN","B",.402,.402) "BLD",8898,"KRN","B",.403,.403) "BLD",8898,"KRN","B",.5,.5) "BLD",8898,"KRN","B",.84,.84) "BLD",8898,"KRN","B",3.6,3.6) "BLD",8898,"KRN","B",3.8,3.8) "BLD",8898,"KRN","B",9.2,9.2) "BLD",8898,"KRN","B",9.8,9.8) "BLD",8898,"KRN","B",19,19) "BLD",8898,"KRN","B",19.1,19.1) "BLD",8898,"KRN","B",101,101) "BLD",8898,"KRN","B",409.61,409.61) "BLD",8898,"KRN","B",771,771) "BLD",8898,"KRN","B",779.2,779.2) "BLD",8898,"KRN","B",870,870) "BLD",8898,"KRN","B",8989.51,8989.51) "BLD",8898,"KRN","B",8989.52,8989.52) "BLD",8898,"KRN","B",8994,8994) "BLD",8898,"QUES",0) ^9.62^^ "BLD",8898,"REQB",0) ^9.611^^ "MBREQ") 0 "PKG",408,-1) 1^1 "PKG",408,0) PAID^PRS^PAID "PKG",408,20,0) ^9.402P^^ "PKG",408,22,0) ^9.49I^1^1 "PKG",408,22,1,0) 4.0^2950912^2960130 "PKG",408,22,1,"PAH",1,0) 133^3111103 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","PRSALVB") 0^1^B25561687^B15774190 "RTN","PRSALVB",1,0) PRSALVB ;WOIFO/JAH/PLT - Leave Balances ;02/01/08 "RTN","PRSALVB",2,0) ;;4.0;PAID;**22,35,34,69,114,133**;Sep 21, 1995;Build 2 "RTN","PRSALVB",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRSALVB",4,0) EMP ; Employee Entry Point "RTN","PRSALVB",5,0) S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)) "RTN","PRSALVB",6,0) I 'DFN W !!,$C(7),"Your SSN was not found in both the New Person & Employee File!" G EX "RTN","PRSALVB",7,0) G D "RTN","PRSALVB",8,0) TK ; Timekeeper Entry Point "RTN","PRSALVB",9,0) S PRSTLV=2 G S0 "RTN","PRSALVB",10,0) SUP ; Supervisor Entry Point "RTN","PRSALVB",11,0) S PRSTLV=3 G S0 "RTN","PRSALVB",12,0) S0 D ^PRSAUTL G:TLI<1 EX "RTN","PRSALVB",13,0) S1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC G:DFN<1 EX "RTN","PRSALVB",14,0) D N HOLD "RTN","PRSALVB",15,0) W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX "RTN","PRSALVB",16,0) I $D(IO("Q")) S PRSAPGM="Q1^PRSALVB",PRSALST="DFN" D QUE^PRSAUTL G EX "RTN","PRSALVB",17,0) U IO D Q1 D ^%ZISC K %ZIS,IOP G EX "RTN","PRSALVB",18,0) Q1 ; Show Balances "RTN","PRSALVB",19,0) N PGQUIT,LST,D1,YR,PPE,PYR,PPP,PPI,CTN,PPVN,PPVO,PPG,PPF "RTN","PRSALVB",20,0) S PGQUIT="" "RTN","PRSALVB",21,0) W:$E(IOST,1,2)="C-" @IOF W !?29,"EMPLOYEE LEAVE BALANCES" "RTN","PRSALVB",22,0) S C0=^PRSPC(DFN,0),DB=$P(C0,"^",10),LVG=$P(C0,"^",15),NH=+$P(C0,"^",16) "RTN","PRSALVB",23,0) D PGHD G Q2 "RTN","PRSALVB",24,0) ; "RTN","PRSALVB",25,0) ; Display employee name and ssn "RTN","PRSALVB",26,0) ; SSN defaults to display of last four digits "RTN","PRSALVB",27,0) ; employee displays last four "RTN","PRSALVB",28,0) ; timekeeper and supervisor display first digit+last four "RTN","PRSALVB",29,0) ; "RTN","PRSALVB",30,0) PGHD S X=$G(^PRSPC(DFN,0)) "RTN","PRSALVB",31,0) W !!,$P(X,"^",1),?48,"Leave Group: ",LVG "RTN","PRSALVB",32,0) S X=$P(X,"^",9) "RTN","PRSALVB",33,0) I X,'$G(PRSTLV)!($G(PRSTLV)=1) W ?67,"XXX-XX-",$E(X,6,9) "RTN","PRSALVB",34,0) I X,$G(PRSTLV)=2!($G(PRSTLV)=3) W ?67,$E(X),"XX-XX-",$E(X,6,9) "RTN","PRSALVB",35,0) QUIT "RTN","PRSALVB",36,0) ; "RTN","PRSALVB",37,0) ; compare last pp processed to current pp "RTN","PRSALVB",38,0) ; "RTN","PRSALVB",39,0) Q2 S LST=+$P($G(^PRSPC(DFN,"MISC4")),"^",16) "RTN","PRSALVB",40,0) ;get most recent year-pp in file "RTN","PRSALVB",41,0) S PPE=$P($G(^PRST(458,$O(^PRST(458,":"),-1),0)),U) "RTN","PRSALVB",42,0) S YR=$P(PPE,"-",1) "RTN","PRSALVB",43,0) S D1=+$P(PPE,"-",2) "RTN","PRSALVB",44,0) S YR=$S(D1'9:LST,1:"0"_LST),PYR=YR,PPP=$P(PPE,"-",2) "RTN","PRSALVB",46,0) S PPI=$O(^PRST(458,"B",PPE,0)) "RTN","PRSALVB",47,0) I PPI S D1=$P($G(^PRST(458,PPI,2)),"^",14) "RTN","PRSALVB",48,0) W !!,"Balances are as of Pay Period ",PPE," (",D1,")" "RTN","PRSALVB",49,0) ; "RTN","PRSALVB",50,0) S ALN=$G(^PRSPC(DFN,"ANNUAL")),SLN=$G(^("SICK")),CTN=$G(^("COMP")),MLN=$G(^("MILITARY")) "RTN","PRSALVB",51,0) ; "RTN","PRSALVB",52,0) I NH=48,DB=1 D "RTN","PRSALVB",53,0) . S BAY=$G(^PRSPC(DFN,"BAYLOR")) "RTN","PRSALVB",54,0) . S $P(ALN,"^",3)=$P(BAY,"^",1) "RTN","PRSALVB",55,0) . S $P(SLN,"^",3)=$P(BAY,"^",13) "RTN","PRSALVB",56,0) . F KK=9:1:12 S $P(ALN,"^",KK+1)=$P(BAY,"^",KK) "RTN","PRSALVB",57,0) ; "RTN","PRSALVB",58,0) S Y=$P(ALN,"^",3) "RTN","PRSALVB",59,0) W !,"Annual Leave Balance:",?30,$S(Y="":"",1:$J(Y,8,3)) "RTN","PRSALVB",60,0) S Y=$P(SLN,"^",3) "RTN","PRSALVB",61,0) W !,"Sick Leave Balance:",?30,$S(Y="":"",1:$J(Y,8,3)) "RTN","PRSALVB",62,0) ; "RTN","PRSALVB",63,0) ;print comptime downloaded with pp without year but padding with year based on the balance as of date's year "RTN","PRSALVB",64,0) I CTN]"",$P(CTN,U,1,8)'?1."^" D G:PGQUIT EX "RTN","PRSALVB",65,0) . N PA,PB,PC,PD,PE,PDAYS "RTN","PRSALVB",66,0) . S PC="",PDAYS=377 ;from 26*14+13 "RTN","PRSALVB",67,0) . W !!?10,"Comp Time/Credit Hours (CT/CH) Pay Period Balances",!?10,"Pay Period Earned",?30,"# of Hours",?45,"Must be used by" "RTN","PRSALVB",68,0) . F PA=1:1:8 I $P(CTN,U,PA),$P(CTN,U,PA+9) S PC=PC+$P(CTN,U,PA),PB=$$C1($P(CTN,U,PA+9),PDAYS) W !?10,$P(PB,U),?30,$J($P(CTN,U,PA),8,3),?45,$$FMTE^XLFDT($P(PB,U,2)) I IOSL-2<$Y S PGQUIT=$$PGBRK QUIT:PGQUIT W ! "RTN","PRSALVB",69,0) . S PD=$P($G(PB),U) "RTN","PRSALVB",70,0) . I $P(CTN,U,9)-PC,PD'=PPE S:PD]"" PD=$$PPDT^PRSU1B2(PD,14),PD=$$DTPP^PRSU1B2($P(PD,U,4)+15,"H") D "RTN","PRSALVB",71,0) .. S PE=$S($P(PD,U,2)=PPE:" "_PPE,1:"*"_$P(PD,U,2)_" thru "_PPE) W !?9,PE,?30,$J($P(CTN,U,9)-PC,8,3) "RTN","PRSALVB",72,0) .. W ?45,$S($P(PD,U,2)=PPE:$$FMTE^XLFDT($P($$C1(PPE,PDAYS),U,2)),1:$$FMTE^XLFDT($P($$C1($P(PD,U,2),PDAYS),U,2))_" thru "_$$FMTE^XLFDT($P($$C1(PPE,PDAYS),U,2))) "RTN","PRSALVB",73,0) .. QUIT "RTN","PRSALVB",74,0) . I IOSL-3<$Y S PGQUIT=$$PGBRK QUIT:PGQUIT W ! "RTN","PRSALVB",75,0) . W !?10,"-----------------------------------------------------------------" "RTN","PRSALVB",76,0) . W !,"Total CT/CH Hours Balance: ",?30,$J($P(CTN,U,9),8,3),! "RTN","PRSALVB",77,0) . I IOSL-3<$Y S PGQUIT=$$PGBRK QUIT:PGQUIT W ! "RTN","PRSALVB",78,0) . I $G(PE)["*" W !,"*The CT/CH balance of ",$J($P(CTN,U,9)-PC,1,3)," hours earned between ",$P($P(PE,"*",2)," ")," and ",$P(PE," ",3)," will be",!,"itemized in the report at least 8 pay periods in advance." "RTN","PRSALVB",79,0) . QUIT "RTN","PRSALVB",80,0) ; "RTN","PRSALVB",81,0) ;If employee has restored leave then interpret 1 digit year "RTN","PRSALVB",82,0) ;on file from AAC and display. "RTN","PRSALVB",83,0) ; "RTN","PRSALVB",84,0) S Y=$P(ALN,"^",10) I Y D "RTN","PRSALVB",85,0) .N YRDIGIT "RTN","PRSALVB",86,0) .W !!," Restored Leave:",?30,$J(Y,8,3) "RTN","PRSALVB",87,0) .S YRDIGIT=$P(ALN,"^",12) "RTN","PRSALVB",88,0) .I YRDIGIT>-1 W !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit." "RTN","PRSALVB",89,0) S Y=$P(ALN,"^",11) I Y D "RTN","PRSALVB",90,0) .N YRDIGIT "RTN","PRSALVB",91,0) .W !!," Restored Leave:",?30,$J(Y,8,3) "RTN","PRSALVB",92,0) .S YRDIGIT=$P(ALN,"^",13) "RTN","PRSALVB",93,0) .I YRDIGIT>-1 W !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit." "RTN","PRSALVB",94,0) ; "RTN","PRSALVB",95,0) ;Display other types of leave, if any. "RTN","PRSALVB",96,0) ; "RTN","PRSALVB",97,0) S Y=$P(MLN,"^",1) I Y D "RTN","PRSALVB",98,0) . W !!,"Military Leave in " "RTN","PRSALVB",99,0) . W $S($$MLINHRS^PRSAENT(DFN):"hours:",1:"days:") "RTN","PRSALVB",100,0) . W ?30,$J(Y,8,2) "RTN","PRSALVB",101,0) S Y=$P(ALN,"^",9) I Y W !!,"Non-Pay Leave Taken:",?30,$J(Y,8,3) "RTN","PRSALVB",102,0) W !,"END OF REPORT" "RTN","PRSALVB",103,0) I $E(IOST,1,2)="C-" S HOLD=$$ASK^PRSLIB00(1) "RTN","PRSALVB",104,0) QUIT "RTN","PRSALVB",105,0) ; "RTN","PRSALVB",106,0) ;a=yy-pp or pp and pp is 1 to 26, b=# of days for used by "RTN","PRSALVB",107,0) C1(A,B) ;ef - ^1=pp in format yy-pp or pp, ^2=expiration date "RTN","PRSALVB",108,0) N C,D,E "RTN","PRSALVB",109,0) ;get pp year based on the last pp download in the employee file "RTN","PRSALVB",110,0) QUIT:A="" "" "RTN","PRSALVB",111,0) S D=A S:A?1.2N D=$S(A'>PPP:PYR,1:$E(199+PYR,2,3))_"-"_$E(100+A,2,3) "RTN","PRSALVB",112,0) S C=$P($$PPDT^PRSU1B2(D,1),U,2),E=$$FMADD^XLFDT(C,B) "RTN","PRSALVB",113,0) QUIT D_"^"_E "RTN","PRSALVB",114,0) ; "RTN","PRSALVB",115,0) PGBRK() ;ev - 1 if quit, "" if continue "RTN","PRSALVB",116,0) N DIR,DIRUT "RTN","PRSALVB",117,0) I IOST?1"C-".E S DIR(0)="E" D ^DIR "RTN","PRSALVB",118,0) I '$G(DIRUT) W @IOF D PGHD "RTN","PRSALVB",119,0) QUIT $G(DIRUT) "RTN","PRSALVB",120,0) ; "RTN","PRSALVB",121,0) EX G KILL^XUSCLEAN "RTN","PRSALVS") 0^2^B19901127^B19299804 "RTN","PRSALVS",1,0) PRSALVS ;WOIFO/PLT - Display Leave Request ;02/12/08 "RTN","PRSALVS",2,0) ;;4.0;PAID;**9,69,112,133**;Sep 21, 1995;Build 2 "RTN","PRSALVS",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRSALVS",4,0) S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)) "RTN","PRSALVS",5,0) I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX "RTN","PRSALVS",6,0) D HDR "RTN","PRSALVS",7,0) 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 "RTN","PRSALVS",8,0) W ! S NUM=0 D DISP,H1 G EX "RTN","PRSALVS",9,0) DISP ; Display Leave Requests "RTN","PRSALVS",10,0) S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3),CNT=0,QT=0 K:NUM R "RTN","PRSALVS",11,0) 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 "RTN","PRSALVS",12,0) W:'CNT !,"No Requests on File." "RTN","PRSALVS",13,0) D0 Q "RTN","PRSALVS",14,0) LST ; Display Request "RTN","PRSALVS",15,0) 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="" "RTN","PRSALVS",16,0) .S X=$P(Z,"^",3),X=$G(^PRST(458,"AD",+X)) "RTN","PRSALVS",17,0) .S Y=$G(^PRST(458,+$P(X,"^",1),"E",DFN,"D",+$P(X,"^",2),2)) "RTN","PRSALVS",18,0) .Q:Y'[$P(Z,"^",7) S Z="" Q "RTN","PRSALVS",19,0) I CNT D:$Y>(IOSL-4) H1 Q:QT "RTN","PRSALVS",20,0) S CNT=CNT+1 W ! I NUM W $J(CNT,2)," " S R(CNT)=DA "RTN","PRSALVS",21,0) W $P(Z,"^",4)," " S X=$P(Z,"^",3) D DTP^PRSAPPU W Y," to ",$P(Z,"^",6)," " "RTN","PRSALVS",22,0) S X=$P(Z,"^",5) D DTP^PRSAPPU W Y," " "RTN","PRSALVS",23,0) S X=$P(Z,"^",15) I X W X," ",$S($P(Z,"^",16)="D":"days",1:"hrs")," " "RTN","PRSALVS",24,0) S X=$P(Z,"^",7),%=$F(LVT,";"_X_":") I %>0 W $P($E(LVT,%,999),";",1)," " "RTN","PRSALVS",25,0) S X=$P(Z,"^",9) "RTN","PRSALVS",26,0) S %=$F(LVS,";"_X_":") I %>0 W $P($E(LVS,%,999),";",1) "RTN","PRSALVS",27,0) S X=$P(Z,"^",8) W:X'="" !?5,X S Y=$P(Z,"^",11) D DTP^PRSAUDP W !?5,"Requested: ",Y "RTN","PRSALVS",28,0) W:SCOM'="" !?5,"Supr: ",SCOM Q "RTN","PRSALVS",29,0) BAL ; Leave Balance "RTN","PRSALVS",30,0) N CNT,PPE S Z=$P($G(^PRST(458.1,DA,0)),"^",7),(BAL,INC,CNT)="" Q:Z="" "RTN","PRSALVS",31,0) I "CB AD"[Z N Z S Z="SL" "RTN","PRSALVS",32,0) Q:"AL SL CU ML RL"'[Z D ^PRSALVT I NH'=48!(DB'=1) G B0 "RTN","PRSALVS",33,0) I Z="AL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",1) G B2 "RTN","PRSALVS",34,0) I Z="SL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",13) G B2 "RTN","PRSALVS",35,0) I Z="RL" S BAL=$G(^PRSPC(DFN,"BAYLOR")),BAL=$P(BAL,"^",9)+$P(BAL,"^",10) G B2 "RTN","PRSALVS",36,0) G B1 "RTN","PRSALVS",37,0) B0 I Z="AL" S BAL=$P($G(^PRSPC(DFN,"ANNUAL")),"^",3) G B2 "RTN","PRSALVS",38,0) I Z="SL" S BAL=$P($G(^PRSPC(DFN,"SICK")),"^",3) G B2 "RTN","PRSALVS",39,0) I Z="RL" S BAL=$G(^PRSPC(DFN,"ANNUAL")),BAL=$P(BAL,"^",10)+$P(BAL,"^",11) G B2 "RTN","PRSALVS",40,0) B1 I Z="ML" S BAL=$P($G(^PRSPC(DFN,"MILITARY")),"^",1) G B2 "RTN","PRSALVS",41,0) QUIT:Z'="CU" "RTN","PRSALVS",42,0) ;balance includes all comptime/credit hours "RTN","PRSALVS",43,0) S Z="CT",Y=$G(^PRSPC(DFN,"COMP")),BAL=BAL+$P(Y,U,9) "RTN","PRSALVS",44,0) B2 S LST=+$P($G(^PRSPC(DFN,"MISC4")),"^",16),D1=DT D PP^PRSAPPU S YR=$P(PPE,"-",1) "RTN","PRSALVS",45,0) S D1=+$P(PPE,"-",2),YR=$S(D1'9:LST,1:"0"_LST) "RTN","PRSALVS",46,0) 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) "RTN","PRSALVS",47,0) I PRT,Z="CT" W !,Z,?6," Leave Balance: ",$J(BAL,9,3)," as of ",D1 "RTN","PRSALVS",48,0) I PRT,Z'="CT" W !,Z," Leave Balance: ",$S(Z="ML":$J(BAL,13,2),1:$J(BAL,13,3))," as of ",D1 "RTN","PRSALVS",49,0) I "AL SL"'[Z Q "RTN","PRSALVS",50,0) S EDT=$P($G(^PRST(458.1,DA,0)),"^",5) I EDT'>SDT G B3 "RTN","PRSALVS",51,0) S X1=EDT,X2=SDT D ^%DTC S INC=X+13\14*$S(Z="AL":AINC,1:SINC) "RTN","PRSALVS",52,0) 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 "RTN","PRSALVS",53,0) I PRT W !,Z," Estimated Earnings: ",$J(INC,8,3) "RTN","PRSALVS",54,0) S LST=9999999-SDT,CNT=0 "RTN","PRSALVS",55,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 "RTN","PRSALVS",56,0) .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) "RTN","PRSALVS",57,0) .I NH=72,DB=1 S $P(Z1,U,15)=$$LC($P(Z1,U,15)) "RTN","PRSALVS",58,0) .S CNT=CNT+$P(Z1,"^",15) "RTN","PRSALVS",59,0) .I $P(Z1,"^",3)'EDT Q "RTN","PRSALVS",60,0) .S X1=$P(Z1,"^",5),X2=$P(Z1,"^",3) D ^%DTC S Z3=$P(Z1,"^",15)/$S($G(X):X,1:1) "RTN","PRSALVS",61,0) .I $P(Z1,"^",3)0 S CNT=CNT-(X*Z3) "RTN","PRSALVS",62,0) .I $P(Z1,"^",5)>EDT S X1=$P(Z1,"^",5),X2=EDT D ^%DTC I X>0 S CNT=CNT-(X*Z3) "RTN","PRSALVS",63,0) .Q "RTN","PRSALVS",64,0) I PRT W !,Z," Estimated Usage: ",$J(CNT,11,3) "RTN","PRSALVS",65,0) B3 S BAL=BAL+INC-CNT I PRT W !,Z," Projected Balance: ",$J(BAL,9,3) "RTN","PRSALVS",66,0) I PRT,BAL<0 W !,"Warning: Approval MAY result in a negative leave balance." "RTN","PRSALVS",67,0) Q "RTN","PRSALVS",68,0) HDR ; Display Header "RTN","PRSALVS",69,0) W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?32,"LEAVE REQUESTS" "RTN","PRSALVS",70,0) 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 "RTN","PRSALVS",71,0) H1 I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1 I 'QT W @IOF,! "RTN","PRSALVS",72,0) Q "RTN","PRSALVS",73,0) EX G KILL^XUSCLEAN "RTN","PRSALVS",74,0) ;Multiply leave request by 1.111 and round down to the quarter hour "RTN","PRSALVS",75,0) ;for 36/40 nurses "RTN","PRSALVS",76,0) LC(X) S X=X*1.111\.25*.25 Q X "RTN","PRSALVS",77,0) ;Calculate number of Recess hours scheduled for a 9-month AWS Nurse "RTN","PRSALVS",78,0) ;before the date leave has been requested for "RTN","PRSALVS",79,0) RT(EDT,SDT) N SFY,EFY,T,WK "RTN","PRSALVS",80,0) S SFY=$E($P($$GETFSCYR^PRSARC04(SDT),U,2),3,6),EFY=$E($P($$GETFSCYR^PRSARC04(EDT),U,2),3,6) "RTN","PRSALVS",81,0) 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) "RTN","PRSALVS",82,0) ;Calculate the number of hours of leave that would have been "RTN","PRSALVS",83,0) ;accumulated for the time the nurse was on recess. "RTN","PRSALVS",84,0) Q T/80*$S(Z="AL":AINC,1:SINC)\.25*.25 "VER") 8.0^22.0 "BLD",8898,6) ^119 **END** **END**