source: WorldVistAEHR/trunk/r/PAID-PRS/PRSALVB.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PRSALVB ;HISC/REL,WIRMFO/JAH - Leave Balances ;09/21/01
2 ;;4.0;PAID;**22,35,34,69,114**;Sep 21, 1995;Build 6
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4EMP ; Employee Entry Point
5 S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0))
6 I 'DFN W !!,$C(7),"Your SSN was not found in both the New Person & Employee File!" G EX
7 G D
8TK ; Timekeeper Entry Point
9 S PRSTLV=2 G S0
10SUP ; Supervisor Entry Point
11 S PRSTLV=3 G S0
12S0 D ^PRSAUTL G:TLI<1 EX
13S1 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
14D N HOLD
15 W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
16 I $D(IO("Q")) S PRSAPGM="Q1^PRSALVB",PRSALST="DFN" D QUE^PRSAUTL G EX
17 U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
18Q1 ; Show Balances
19 W:$E(IOST,1,2)="C-" @IOF W !?29,"EMPLOYEE LEAVE BALANCES"
20 ;
21 ; Display employee name and ssn
22 ; SSN defaults to display of last four digits
23 ; employee displays last four
24 ; timekeeper and supervisor display first digit+last four
25 ;
26 S X=$G(^PRSPC(DFN,0))
27 W !!,$P(X,"^",1)
28 S X=$P(X,"^",9)
29 I X,'$G(PRSTLV)!($G(PRSTLV)=1) W ?67,"XXX-XX-",$E(X,6,9)
30 I X,$G(PRSTLV)=2!($G(PRSTLV)=3) W ?67,$E(X),"XX-XX-",$E(X,6,9)
31 ;
32 ; compare last pp processed to current pp
33 ;
34 S LST=+$P($G(^PRSPC(DFN,"MISC4")),"^",16)
35 S D1=DT D PP^PRSAPPU
36 S YR=$P(PPE,"-",1)
37 S D1=+$P(PPE,"-",2)
38 S YR=$S(D1'<LST:YR,1:$E(199+YR,2,3))
39 S PPE=YR_"-"_$S(LST>9:LST,1:"0"_LST)
40 S PPI=$O(^PRST(458,"B",PPE,0))
41 I PPI S D1=$P($G(^PRST(458,PPI,2)),"^",14)
42 W !!,"Balances are as of ",D1
43 ;
44 S C0=^PRSPC(DFN,0),DB=$P(C0,"^",10),LVG=$P(C0,"^",15),NH=+$P(C0,"^",16)
45 S ALN=$G(^PRSPC(DFN,"ANNUAL")),SLN=$G(^("SICK")),CTN=$G(^("COMP")),MLN=$G(^("MILITARY"))
46 ;
47 I NH=48,DB=1 D
48 . S BAY=$G(^PRSPC(DFN,"BAYLOR"))
49 . S $P(ALN,"^",3)=$P(BAY,"^",1)
50 . S $P(SLN,"^",3)=$P(BAY,"^",13)
51 . F KK=9:1:12 S $P(ALN,"^",KK+1)=$P(BAY,"^",KK)
52 ;
53 W !!,"Leave Group: ",LVG
54 S Y=$P(ALN,"^",3)
55 W !,"Annual Leave Balance:",?30,$S(Y="":"",1:$J(Y,8,3))
56 S Y=$P(SLN,"^",3)
57 W !!,"Sick Leave Balance:",?30,$S(Y="":"",1:$J(Y,8,3))
58 ;
59 ;If employee has something in comptime record
60 ; -Determine number & year of last pay period on file for use in
61 ; guessing the year when comp time earned.
62 ; -Loop thru comp time values & report.
63 ;
64 I CTN]"",$P(CTN,U,1,8)'="^^^^^^^" D
65 . N KK,LASTPP,LASTYR,Y
66 . S Y=+$P($G(^PRST(458,0)),U,3) Q:'Y
67 . S LASTPP=+$P($P($G(^PRST(458,Y,0)),U),"-",2) Q:'LASTPP
68 . S LASTYR=$P($G(^PRST(458,Y,1)),U) Q:'LASTYR
69 . S LASTYR=$E(LASTYR,1,3)+1700
70 . W ! F KK=1:1:8 I $P(CTN,"^",KK) D C1
71 ;
72 ;If employee has restored leave then interpret 1 digit year
73 ;on file from AAC and display.
74 ;
75 S Y=$P(ALN,"^",10) I Y D
76 .N YRDIGIT
77 .W !!," Restored Leave:",?30,$J(Y,8,3)
78 .S YRDIGIT=$P(ALN,"^",12)
79 .I YRDIGIT>-1 W !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit."
80 S Y=$P(ALN,"^",11) I Y D
81 .N YRDIGIT
82 .W !!," Restored Leave:",?30,$J(Y,8,3)
83 .S YRDIGIT=$P(ALN,"^",13)
84 .I YRDIGIT>-1 W !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit."
85 ;
86 ;Display other types of leave, if any.
87 ;
88 S Y=$P(MLN,"^",1) I Y D
89 . W !!,"Military Leave in "
90 . W $S($$MLINHRS^PRSAENT(DFN):"hours:",1:"days:")
91 . W ?30,$J(Y,8,2)
92 S Y=$P(ALN,"^",9) I Y W !!,"Non-Pay Leave Taken:",?30,$J(Y,8,3)
93 I $E(IOST,1,2)="C-" S HOLD=$$ASK^PRSLIB00(1)
94 Q
95 ;
96 ;====================================================================
97C1 ; Display comp time hours and add 8 pay periods (111 days)
98 ; to the "Comp Time Earned Pay Period" field to display when
99 ; the comp time must be used by.
100 ;
101 ; input
102 ; CTN = value of "COMP" node from File 450
103 ; KK = piece in CTN (1-8) of comp time being displayed
104 ; LASTPP = number of last pay period
105 ; LASTYR = 4-digit year associated with last pay period
106 ;
107 N D1,EARNPP,EARNYR,PPE,USEDT
108 W !,"Comp Time/Credit Hours: ",$J($P(CTN,U,KK),8,3)
109 S EARNPP=+$P(CTN,"^",KK+9) ; number of pay period CT earned
110 S EARNYR=$S(LASTPP<EARNPP:LASTYR-1,1:LASTYR) ; guess year CT earned
111 S PPE=$E(EARNYR,3,4)_"-"_$S(EARNPP<10:"0",1:"")_EARNPP
112 D NX^PRSAPPU S USEDT=$$FMADD^XLFDT(D1,111)
113 I USEDT W " must be used by ",$$FMTE^XLFDT(USEDT)
114 Q
115 ;
116EX G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.