| 1 | PRSDSRS ;HISC/GWB-SERVICE RECORD SCREEN ;2/8/95 14:14
|
|---|
| 2 | ;;4.0;PAID;**114**;Sep 21, 1995;Build 6
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EMP S DA="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
|
|---|
| 6 | I SSN'="" S DA=$O(^PRSPC("SSN",SSN,0))
|
|---|
| 7 | I 'DA W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX
|
|---|
| 8 | START D WAIT^DICD
|
|---|
| 9 | K DASHES S $P(DASHES,"-",80)="-"
|
|---|
| 10 | S ZERO=^PRSPC(DA,0)
|
|---|
| 11 | S NAME=$P(ZERO,U,1),STATION=$P(ZERO,U,7),TLU=$P(ZERO,U,8)
|
|---|
| 12 | S SSN=$P(ZERO,U,9),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
|
|---|
| 13 | S Y=$P(ZERO,U,49) X ^DD(450,458,2.1) S CCORG=Y
|
|---|
| 14 | S DS=$P($G(^PRSPC(DA,1)),U,42),LPP=$P($G(^PRSPC(DA,"MISC4")),U,16)
|
|---|
| 15 | D ^PRSDYTD
|
|---|
| 16 | SRS S CATEGORY="SERVICE RECORD SCREEN",PAGE=0
|
|---|
| 17 | K ^UTILITY("DIQ1",$J) S DIC="^PRSPC("
|
|---|
| 18 | S DR="2:5;9:11;13;15;15.5;16;19:23;26;28;30:32;37:39;42;43;47;52;53;64;82;83;89:116.2;139;120;132;142;143;144;226;231;395:427;458;538;600"
|
|---|
| 19 | S DIQ(0)="IE" D EN^DIQ1
|
|---|
| 20 | W @IOF D HDR S PRTC=1
|
|---|
| 21 | F F=16,20,15.5,13,38,28,82,83,142:1:144,23,3,37,9,15,19,21,11,458,42,39,53,52,32,31,4,43,10,5,47,139,120,132,226,231,26,64,538,22,30,2,600 D WR G:'PRTC EX
|
|---|
| 22 | S END="" D PRTC G:'PRTC EX
|
|---|
| 23 | FU S FUFLD=89 K FUYES
|
|---|
| 24 | F S FUFLD=$O(^UTILITY("DIQ1",$J,450,DA,FUFLD)) Q:(FUFLD>116.2)!(FUFLD="") I ^UTILITY("DIQ1",$J,450,DA,FUFLD,"I")'="" S FUYES=""
|
|---|
| 25 | G:'$D(FUYES) TSP K END S CATEGORY="FOLLOWUPS"
|
|---|
| 26 | W @IOF D HDR S PRTC=1
|
|---|
| 27 | F F=115.17,89:1:97,97.1,98,98.1,98.2,98.3,98.4,99,99.1,100:1:114,114.1,114.2,115.01:.01:115.14,115.18,115.19,115.2,115.21,115.15,115.16,115.17,116.01:.01:116.2 D WR G:'PRTC EX
|
|---|
| 28 | S END="" D PRTC G:'PRTC EX
|
|---|
| 29 | TSP K END S CATEGORY="THRIFT SAVINGS PLAN"
|
|---|
| 30 | W @IOF D HDR S PRTC=1
|
|---|
| 31 | F F=409,410,406,399,396,404,412,403,395,397,398,414,413,415,417,419,418,420,422,424,423,425,427,400,401,402,405,407,408 D WR G:'PRTC EX
|
|---|
| 32 | W:TSPYTD'=0 !!,"TSP EMP DED YTD.................",$FN(TSPYTD,",",2)
|
|---|
| 33 | S END="" D PRTC G:'PRTC EX
|
|---|
| 34 | EX K ^UTILITY("DIQ1",$J)
|
|---|
| 35 | N PRSTLV D KILL^XUSCLEAN W @IOF
|
|---|
| 36 | Q
|
|---|
| 37 | WR S NODEDD=^DD(450,F,0),NODEUTIL=$G(^UTILITY("DIQ1",$J,450,DA,F,"E"))
|
|---|
| 38 | I F=26 W:HBDYTD'=0 !,"HEALTH BENEFITS DEDUCTION YTD...",$FN(HBDYTD,",",2)
|
|---|
| 39 | I (NODEUTIL="")!(NODEUTIL="NA") K NODEDD,NODEUTIL Q
|
|---|
| 40 | S FLDNAM=$P(NODEDD,U,1)
|
|---|
| 41 | I F=15.5 S INT=^UTILITY("DIQ1",$J,450,DA,F,"E") G EXT
|
|---|
| 42 | S INT=^UTILITY("DIQ1",$J,450,DA,F,"I")
|
|---|
| 43 | EXT S EXT=^UTILITY("DIQ1",$J,450,DA,F,"E")
|
|---|
| 44 | S IL=$L(INT)
|
|---|
| 45 | I $P(NODEDD,U,2)["NJ",+INT=0 K NODEDD,NODEUTIL Q
|
|---|
| 46 | S:F=15 FLDNAM="NORMAL HOURS" S:F=458 INT=$E(INT,1,4)_":"_$E(INT,5,8)
|
|---|
| 47 | S:F=414 FLDNAM="TSP CSF DIST PCT" S:F=419 FLDNAM="TSP FIF DIST PCT"
|
|---|
| 48 | S:F=424 FLDNAM="TSP GSF DIST PCT"
|
|---|
| 49 | I $P(NODEDD,U,5)["""$""" S VAL=$FN(INT,",",2) G IOSL
|
|---|
| 50 | I F>88,F<116.3 S VAL=EXT I $D(^PRSP(454,1,"PUC","C",FLDNAM)) S FUIEN=$O(^PRSP(454,1,"PUC","C",FLDNAM,0)) I $P(^PRSP(454,1,"PUC",FUIEN,0),U,3)'="" S VAL=VAL_" "_$P(^PRSP(454,1,"PUC",FUIEN,0),U,3) G IOSL
|
|---|
| 51 | I (F=404)!(F=414)!(F=419)!(F=424) S VAL=EXT G IOSL
|
|---|
| 52 | I $P(NODEDD,U,2)["D" S VAL=EXT G IOSL
|
|---|
| 53 | I $P(NODEDD,U,2)["NJ" S VAL=$J(INT,IL,2) G IOSL
|
|---|
| 54 | S VAL=EXT
|
|---|
| 55 | S:F=458 VAL=INT
|
|---|
| 56 | IOSL K DOTS S NOD=32-$L(FLDNAM),$P(DOTS,".",NOD)="."
|
|---|
| 57 | I $Y>(IOSL-4) D PRTC Q:'PRTC
|
|---|
| 58 | I (F=400)!(F=407)!(F=414)!(F=419)!(F=424) W !
|
|---|
| 59 | W !,FLDNAM,DOTS
|
|---|
| 60 | D VAL Q
|
|---|
| 61 | VAL I $L(VAL)<48 W ?32,VAL Q
|
|---|
| 62 | S COLUMN=32,LGTH=0
|
|---|
| 63 | 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
|
|---|
| 64 | Q
|
|---|
| 65 | HDR W:$Y>0 @IOF S PAGE=PAGE+1
|
|---|
| 66 | S CLNGTH=$L(CCORG),TAB=(80-CLNGTH)\2,TAB=TAB-1
|
|---|
| 67 | W !,NAME,?TAB,CCORG,?62,"DUTY STATION: ",STATION_DS
|
|---|
| 68 | I '$G(PRSTLV) W !,"XXX-XX-",$E(SSN,8,11),?71,"T&L: ",TLU,!,DASHES
|
|---|
| 69 | I $G(PRSTLV)=7 W !,SSN,?71,"T&L: ",TLU,!,DASHES
|
|---|
| 70 | S CLNGTH=$L(CATEGORY),TAB=(80-CLNGTH)\2,TAB=TAB-1
|
|---|
| 71 | W !,"LAST PP: ",LPP,?TAB,CATEGORY,?73,"PAGE ",PAGE
|
|---|
| 72 | W !,DASHES
|
|---|
| 73 | K CLNGTH,TAB Q
|
|---|
| 74 | PRTC W:$Y<22 ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT
|
|---|
| 75 | S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
|
|---|
| 76 | I $D(DIRUT) S PRTC=0 Q
|
|---|
| 77 | D:'$D(END) HDR Q
|
|---|
| 78 | Q
|
|---|
| 79 | SVC S Y=$P(^PRSPC(DA,0),U,49),C=$P(^DD(450,458,0),U,2) D Y^DIQ S USRSVC=Y
|
|---|
| 80 | S DIC="^PRSPC(",DIC(0)="AEQ",DIC("A")="Select EMPLOYEE: "
|
|---|
| 81 | S DIC("S")="S YSAV=Y,Y=$P(^PRSPC(YSAV,0),U,49),C=$P(^DD(450,458,0),U,2) D Y^DIQ S EMPSVC=Y,Y=YSAV I USRSVC=EMPSVC"
|
|---|
| 82 | D ^DIC I Y=-1 G EX
|
|---|
| 83 | S DA=+Y D START G SVC
|
|---|
| 84 | ;S %ZIS="QM" D ^%ZIS G EX:POP
|
|---|
| 85 | ;I $D(IO("Q")) D G EX
|
|---|
| 86 | ;.S ZTRTN="START^PRSDSRS",ZTDESC="PRS SERVICE RECORD SCREEN"
|
|---|
| 87 | ;.S ZTSAVE("DA")=""
|
|---|
| 88 | ;.D ^%ZTLOAD W:$D(ZTSK) !,"Request Queued!" D HOME^%ZIS K IO("Q") Q
|
|---|
