source: FOIAVistA/trunk/r/PAID-PRS/PRSD1150.m@ 1394

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1PRSD1150 ;HISC/GWB-RECORD OF LEAVE DATA ;2/5/1998
2 ;;4.0;PAID;**35**;Sep 21, 1995
3EMP K DIC S DIC="^PRSPC(",DIC(0)="AEMQZ"
4 S DIC("A")="Select SEPARATED EMPLOYEE: " D ^DIC K DIC
5 I Y'>0 G EX
6 S DA=+Y
7 I $P($G(^PRSPC(DA,1)),U,33)'="Y" D G EMP
8 .W !!,*7,"This is not a separated employee. "
9 .W "The SEPARATION IND does not equal Y.",!
10START ;
11 K DASHES S $P(DASHES,"-",80)="-"
12 S ZERO=^PRSPC(DA,0)
13 S NAME=$P(ZERO,U,1),STATION=$P(ZERO,U,7),TLU=$P(ZERO,U,8)
14 S SSN=$P(ZERO,U,9),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
15 S SAL=$P(ZERO,U,29),HR=$S(SAL>99:SAL/2087,1:SAL),HR=$J(HR,0,2)
16 S Y=$P(ZERO,U,49) X ^DD(450,458,2.1) S CCORG=Y
17 S DS=$P($G(^PRSPC(DA,1)),U,42),LPP=$P($G(^PRSPC(DA,"MISC4")),U,16)
18 S SCD=$P(ZERO,U,31)
19 S SCDYR=$E(SCD,1,3),SCDMO=+$E(SCD,4,5),SCDDY=+$E(SCD,6,7)
20 S DOS=$P($G(^PRSPC(DA,1)),U,2)
21 S DOS1=$$FMADD^XLFDT(DOS,1) ; add 1 day so empl. credited for DOS
22 S DOS1YR=$E(DOS1,1,3),DOS1MO=+$E(DOS1,4,5),DOS1DY=+$E(DOS1,6,7)
23 ;
24 ; calculate difference between DOS1 and SCD
25 S TOTDY=DOS1DY-SCDDY
26 S TOTMO=DOS1MO-SCDMO
27 S TOTYR=DOS1YR-SCDYR
28 ; if negative days then recalc. Subtract 1 from month and get days by
29 ; adding the days from first and last month together.
30 I TOTDY<0 D
31 . S SCDDIM=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,SCDMO)
32 . I SCDDIM=28 S SCDDIM=SCDDIM+$$LEAPYR^PRSLIB00(SCDYR+1700)
33 . S TOTDY=SCDDIM-SCDDY+DOS1DY
34 . S TOTMO=TOTMO-1
35 I TOTMO<0 S TOTMO=TOTMO+12,TOTYR=TOTYR-1
36 ;
37ROLD S CATEGORY="RECORD OF LEAVE DATA",PAGE=0
38 K ^UTILITY("DIQ1",$J) S DIC="^PRSPC("
39 S DR="30;49;50",DIQ(0)="IE" D EN^DIQ1 W @IOF D HDR S PRTC=1
40 F F=30,49,50 D WR G:'PRTC EX
41 W !,"TOTAL SERVICE FOR LEAVE.........",TOTYR," YEARS"
42 W !," ",TOTMO," MONTHS"
43 W !," ",TOTDY," DAYS"
44 K ^UTILITY("DIQ1",$J) S DIC="^PRSPC("
45 S DR="462;510",DIQ(0)="IE" D EN^DIQ1
46 F F=462,510 D WR G:'PRTC EX
47 W !,"HOURLY RATE.....................",HR
48 S END="" D PRTC
49EX K ^UTILITY("DIQ1",$J)
50 N PRSTLV D KILL^XUSCLEAN W @IOF
51 Q
52WR S NODEDD=^DD(450,F,0),NODEUTIL=$G(^UTILITY("DIQ1",$J,450,DA,F,"E"))
53 I (NODEUTIL="")!(NODEUTIL="NA") K NODEDD,NODEUTIL Q
54 S FLDNAM=$P(NODEDD,U,1)
55 S INT=^UTILITY("DIQ1",$J,450,DA,F,"I")
56EXT S EXT=^UTILITY("DIQ1",$J,450,DA,F,"E")
57 S IL=$L(INT)
58 I $P(NODEDD,U,2)["NJ",+INT=0 K NODEDD,NODEUTIL Q
59 I $P(NODEDD,U,5)["""$""" S VAL=$FN(INT,",",2) G IOSL
60 I $P(NODEDD,U,2)["D" S VAL=EXT G IOSL
61 I $P(NODEDD,U,2)["NJ" S VAL=$J(INT,IL,2) G IOSL
62 S VAL=EXT
63IOSL K DOTS S NOD=32-$L(FLDNAM),$P(DOTS,".",NOD)="."
64 I $Y>(IOSL-4) D PRTC Q:'PRTC
65 W !,FLDNAM,DOTS
66 D VAL Q
67VAL I $L(VAL)<48 W ?32,VAL Q
68 S COLUMN=32,LGTH=0
69 F LOOP=1:1 Q:LGTH=$L(VAL)!(LGTH>($L(VAL))) W:$L($P(VAL," ",LOOP))>(80-COLUMN) ! S:$L($P(VAL," ",LOOP))>(80-COLUMN) COLUMN=32 W ?COLUMN,$P(VAL," ",LOOP) S COLUMN=COLUMN+$L($P(VAL," ",LOOP))+1,LGTH=LGTH+$L($P(VAL," ",LOOP))+1
70 Q
71HDR W:$Y>0 @IOF S PAGE=PAGE+1
72 S CLNGTH=$L(CCORG),TAB=(80-CLNGTH)\2,TAB=TAB-1
73 W !,NAME,?TAB,CCORG,?62,"DUTY STATION: ",STATION_DS
74 W !,SSN,?71,"T&L: ",TLU,!,DASHES
75 S CLNGTH=$L(CATEGORY),TAB=(80-CLNGTH)\2,TAB=TAB-1
76 W !,"LAST PP: ",LPP,?TAB,CATEGORY,?73,"PAGE ",PAGE
77 W !,DASHES
78 K CLNGTH,TAB Q
79PRTC W:$Y<22 ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT
80 S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
81 I $D(DIRUT) S PRTC=0 Q
82 D:'$D(END) HDR Q
83 Q
Note: See TracBrowser for help on using the repository browser.