Routine: PRSDV459

PRSDV459 ;HISC/MGD-VIEW PAID PAYRUN DATA ;09/09/04

 ;;4.0;PAID;**78,83,82,86,73,97,100**;Sep 21, 1995;Build 3

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 K CHOICE F LOOP=1:1:5 S CHOICE(LOOP)=$T(TABLE+LOOP)

PP ;select pay period

 K DIC S DIC="^PRST(459,",DIC(0)="AEMQZ" D ^DIC I Y'>0 D KILL1,KILL2 Q

 S PP=+Y,PPNAME=$P(^PRST(459,PP,0),U,1)

EMP K DASHES S $P(DASHES,"-",80)="-"

 K DIC,^UTILITY("DIQ1",$J) S DIC="^PRST(459,"_PP_",""P"",",DIC(0)="AEMQZ" D ^DIC K DIC G:Y'>0 PP

 S EMP=+Y,ZERO=^PRST(459,PP,"P",EMP,0),NAME=$P(^PRSPC(EMP,0),U,1)

 S SSN=$P(ZERO,U,2),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)

 S TLU=$P(ZERO,U,13),STATION=$P(^PRSPC(EMP,0),U,7)

 S Y=$P(^PRSPC(EMP,0),U,49) X ^DD(450,458,2.1) S CCORG=Y

 S DS=$P($G(^PRSPC(EMP,1)),U,42)

CAT S CLNGTH=$L(CCORG),TAB=(80-CLNGTH)\2,TAB=TAB-1

 W @IOF,!,NAME,?TAB,CCORG,?61,"DUTY STATION: ",STATION_DS

 W !,SSN,?71,"T&L: ",TLU,!,DASHES,!,"PAY PERIOD: ",PPNAME

 W !! F LOOP=1:1:5 W !,?20,$P(CHOICE(LOOP),";",3),?23,$P(CHOICE(LOOP),";",4)

SAN W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT

 S DIR(0)="NAO^1:5:0",DIR("A")="Select a number: "

 S DIR("?")="Type a number between 1 and 5"

 D ^DIR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D KILL1 G EMP

 I X="@" W !!,*7,DIR("?")_"." G SAN

 G:X="" EMP

 N L,LAB,NOL

 S CATEGORY=$P(CHOICE(+Y),";",4),LAB=$P(CHOICE(+Y),";",5)

 S NOL=$P(CHOICE(+Y),";",6),PAGE=0

 F L=1:1:NOL S (DRSUB(L),PRNTORDR(L))=$P($T(@LAB+L^PRSDV459),";",3) D

 . F  Q:DRSUB(L)'[","  D

 . . S DRSUB(L)=$P(DRSUB(L),",")_";"_$P(DRSUB(L),",",2,999)

 . F  Q:DRSUB(L)'[":1:"  D

 . . S DRSUB(L)=$P(DRSUB(L),":1:")_":"_$P(DRSUB(L),":1:",2,999)

 . F  Q:DRSUB(L)'[":.01:"  D

 . . S DRSUB(L)=$P(DRSUB(L),":.01:")_":"_$P(DRSUB(L),":.01:",2,999)

 S IOFSAV=IOF

 K %ZIS,IOP S %ZIS="MQ",%ZIS("B")="" D ^%ZIS I POP D KILL1,KILL2 Q

 S IOF=IOFSAV

 F LOOP="CATEGORY","CCORG","CLNGTH","DASHES","DS","EMP","DRSUB(","NAME","PAGE","PP","PPNAME","PRNTORDR(","SSN","STATION","TAB","TLU" S ZTSAVE(LOOP)=""

 I $D(IO("Q")) S ZTIO=ION,ZTDESC="DISPLAY PAYRUN DATA",ZTRTN="DISPLAY^PRSDV459",ZTREQ="@",ZTSAVE("ZTREQ")="" D ^%ZTLOAD W:$D(ZTSK) !,"Request Queued!" D KILL1 G CAT

 D:$E(IOST,1)="C" WAIT^DICD

 U IO D DISPLAY G:PRTC=0 CAT

 I $E(IOST,1)="C" D:PRTC="" PRTC G:PRTC=0 CAT

 D:$E(IOST,1)'="C" ^%ZISC

 W @IOF G CAT

DISPLAY ;display payrun data

 N DRIEN

 S DRIEN=0

 F  S DRIEN=$O(DRSUB(DRIEN)) Q:DRIEN=""  D

 . S DIQ(0)="EIN",DIC=459,DR=1,DR(459.01)=DRSUB(DRIEN),DA(459.01)=EMP,DA=PP

 . D EN^DIQ1

 W:$E(IOST,1)="C" @IOF D HEADER S FIELDN=0

 I CATEGORY="LABOR DISTRIBUTION" D

 . S PRTC=0

 . D LD

 . I $E(IOST,1)="C" D CHECK

 . I $E(IOST,1)'="C" D ^%ZISC

 I CATEGORY'="LABOR DISTRIBUTION" D

 . S PRTC="",DRIEN=0

 . F  S DRIEN=$O(PRNTORDR(DRIEN)) Q:DRIEN=""  D

 . . S PRNTVALS="F FIELDN="_PRNTORDR(DRIEN)_" D WRITE^PRSDV459 Q:PRTC=0"

 . . X PRNTVALS

KILL1 ;kill most variables and close the device

 K D0,DIC,DIQ,DIQ2,DIR,DIRUT,DIROUT,DR,DRSUB,DTOUT,DUOUT,FIELDN,IOFSAV,IOP,LOOP,POP,PRNTORDR,PRNTVALS,X,Y,ZERO,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,%ZIS,^UTILITY("DIQ1",$J)

KILL2 ;kill the remaining variables

 K CATEGORY,CCORG,CHOICE,CLNGTH,DA,DS,DASHES,EMP,NAME,PAGE,PP,PPNAME,PRTC,SSN,STATION,TAB,TLU,ZTREQ Q

WRITE ;write the data

 S NODEDD=^DD(459.01,FIELDN,0),DESC=$G(^UTILITY("DIQ1",$J,459.01,EMP,FIELDN,"E"))

 I (DESC="")!(DESC="NA") K NODEDD,DESC Q

 S INTERNAL=^UTILITY("DIQ1",$J,459.01,EMP,FIELDN,"I")

 I $P(NODEDD,U,2)["NJ",+INTERNAL=0 K NODEDD,DESC Q

 I PRTC=1 D HEADER S PRTC=""

 W !,$P(NODEDD,U,1)

 W ?30,$S($P(NODEDD,U,5)["""$""":$J($FN(INTERNAL,",",2),14),$P(NODEDD,U,2)["NJ":$J(INTERNAL,14,2),$P(NODEDD,U,2)["D":$J(DESC,14),1:$J(INTERNAL,14))

 I $P(NODEDD,U,2)'["D",INTERNAL'=DESC D DESC

 K DESC,INTERNAL,NODEDD

 D CHECK

CHECK I $E(IOST,1)="C",$Y>(IOSL-4) D PRTC

PRTC ;press return to continue

 W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR S PRTC=Y S:$D(DIRUT) PRTC=0

HEADER ;print header

 W:$Y>0 @IOF S PAGE=PAGE+1

 S CLNGTH=$L(CCORG),TAB=(80-CLNGTH)\2,TAB=TAB-1

 W !,NAME,?TAB,CCORG,?61,"DUTY STATION: ",STATION_DS

 W !,SSN,?71,"T&L: ",TLU,!,DASHES

 S CLNGTH=$L(CATEGORY),TAB=(80-CLNGTH)\2,TAB=TAB-1

 W !,"PAY PERIOD: ",PPNAME,?TAB,CATEGORY,?73,"PAGE ",PAGE

 W !,DASHES

 K CLNGTH,TAB

LD ; Display Labor Distribution codes

 Q:'$G(DA)

 N PRSLD,LDCNT,LDDATA,Y

 F PRSLD=1:1:4 D

 . S DIC=459,DR=1,DA=PP ; Specify Pay Period

 . S DR(459.01)=173,DA(459.01)=EMP ; Specify Employee

 . S DR(459.1173)="1;2;3;4",DA(459.1173)=PRSLD ; Specify LD multiple

 . S DIQ(0)="IE",DIQ="LDDATA"

 . D EN^DIQ1

 . F LDCNT=1:1:4 D

 . . S NODEDD=^DD(459.1173,LDCNT,0)

 . . S INTERNAL=$G(LDDATA(459.1173,PRSLD,LDCNT,"I"))

 . . I LDCNT'=3 S DESC=$G(LDDATA(459.1173,PRSLD,LDCNT,"E"))

 . . I LDCNT=3 D

 . . . S Y=INTERNAL,SUB454="CC"

 . . . D OT^PRSDUTIL K SUB454

 . . . S DESC=Y

 . . W !,"LABOR DIST CODE-",PRSLD," ",$P(NODEDD,U,1)

 . . W ?30,$S($P(NODEDD,U,5)["""$""":$J($FN(INTERNAL,",",2),14),$P(NODEDD,U,2)["NJ":$J(INTERNAL,14,2),$P(NODEDD,U,2)["D":$J(DESC,14),1:$J(INTERNAL,14))

 . . I $P(NODEDD,U,2)'["D",INTERNAL'=DESC D DESC^PRSDW450

DESC ;write description

 I $L(DESC)<33 W ?47,DESC Q

 S COLUMN=47,LGTH=0

 F LOOP1=1:1 Q:LGTH=$L(DESC)!(LGTH>($L(DESC)))  W:$L($P(DESC," ",LOOP1))>(80-COLUMN) ! S:$L($P(DESC," ",LOOP1))>(80-COLUMN) COLUMN=47 W ?COLUMN,$P(DESC," ",LOOP1) S COLUMN=COLUMN+$L($P(DESC," ",LOOP1))+1,LGTH=LGTH+$L($P(DESC," ",LOOP1))+1

 K COLUMN,LGTH,LOOP1 Q

TABLE ;set subfile dr variable

 ;;1;GENERAL INFORMATION;P1;1

 ;;2;EARNINGS;P2;2

 ;;3;DEDUCTIONS;P3;4

 ;;4;LEAVE;P4;1

 ;;5;LABOR DISTRIBUTION;

P1 ;;1;GENERAL INFORMATION;P1;1

 ;;2,3,4,5,6,11,13,110,122,123,112,118,111,7,8,9,10,115,116,117,171,160

P2 ;;2;EARNINGS;P2;2

 ;;81,82,83,73,85,124,149,86,87,94,95,101,90,91,97,99,100,88,89,92

 ;;93,98,96,102,103,104,104.1,172,105,109,113,114,108,106,107,74

P3 ;;3;DEDUCTIONS;P3;4

 ;;20,21,22,23,24,27,28,29,25,26,39,40,56,57,60,63,66,59,62,65,58,61

 ;;64,33,34,35,30,31,32,36,37,41:1:48,55,53,54,67.1,67,68.1,68,68.3

 ;;68.2,68.5,68.4,69,70,71,72,38,84,49,50,51,52,150,151,178,179

 ;;152,153,180,181,167,168,175,174,177,176,159

P4 ;;4;LEAVE;P4;1

 ;;75,76,77,78,79,80,80.1,80.2,106,107,154,155,156,157,158

P5 ;;5;LABOR DISTRIBUTION;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDV459   6280     printed  Mar 13, 2025@21:31:15                                                                                                                                                                                                    Page 2

PRSDV459  ;HISC/MGD-VIEW PAID PAYRUN DATA ;09/09/04

 +1       ;;4.0;PAID;**78,83,82,86,73,97,100**;Sep 21, 1995;Build 3

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3        KILL CHOICE

           FOR LOOP=1:1:5

               SET CHOICE(LOOP)=$TEXT(TABLE+LOOP)

PP        ;select pay period

 +1        KILL DIC

           SET DIC="^PRST(459,"

           SET DIC(0)="AEMQZ"

           DO ^DIC

           IF Y'>0

               DO KILL1

               DO KILL2

               QUIT

 +2        SET PP=+Y

           SET PPNAME=$PIECE(^PRST(459,PP,0),U,1)

EMP        KILL DASHES

           SET $PIECE(DASHES,"-",80)="-"

 +1        KILL DIC,^UTILITY("DIQ1",$JOB)

           SET DIC="^PRST(459,"_PP_",""P"","

           SET DIC(0)="AEMQZ"

           DO ^DIC

           KILL DIC

           if Y'>0

               GOTO PP

 +2        SET EMP=+Y

           SET ZERO=^PRST(459,PP,"P",EMP,0)

           SET NAME=$PIECE(^PRSPC(EMP,0),U,1)

 +3        SET SSN=$PIECE(ZERO,U,2)

           SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)

 +4        SET TLU=$PIECE(ZERO,U,13)

           SET STATION=$PIECE(^PRSPC(EMP,0),U,7)

 +5        SET Y=$PIECE(^PRSPC(EMP,0),U,49)

           XECUTE ^DD(450,458,2.1)

           SET CCORG=Y

 +6        SET DS=$PIECE($GET(^PRSPC(EMP,1)),U,42)

CAT        SET CLNGTH=$LENGTH(CCORG)

           SET TAB=(80-CLNGTH)\2

           SET TAB=TAB-1

 +1        WRITE @IOF,!,NAME,?TAB,CCORG,?61,"DUTY STATION: ",STATION_DS

 +2        WRITE !,SSN,?71,"T&L: ",TLU,!,DASHES,!,"PAY PERIOD: ",PPNAME

 +3        WRITE !!

           FOR LOOP=1:1:5

               WRITE !,?20,$PIECE(CHOICE(LOOP),";",3),?23,$PIECE(CHOICE(LOOP),";",4)

SAN        WRITE !

           KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT

 +1        SET DIR(0)="NAO^1:5:0"

           SET DIR("A")="Select a number: "

 +2        SET DIR("?")="Type a number between 1 and 5"

 +3        DO ^DIR

           IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))

               DO KILL1

               GOTO EMP

 +4        IF X="@"

               WRITE !!,*7,DIR("?")_"."

               GOTO SAN

 +5        if X=""

               GOTO EMP

 +6        NEW L,LAB,NOL

 +7        SET CATEGORY=$PIECE(CHOICE(+Y),";",4)

           SET LAB=$PIECE(CHOICE(+Y),";",5)

 +8        SET NOL=$PIECE(CHOICE(+Y),";",6)

           SET PAGE=0

 +9        FOR L=1:1:NOL

               SET (DRSUB(L),PRNTORDR(L))=$PIECE($TEXT(@LAB+L^PRSDV459),";",3)

               Begin DoDot:1

 +10               FOR

                       if DRSUB(L)'[","

                           QUIT

                       Begin DoDot:2

 +11                       SET DRSUB(L)=$PIECE(DRSUB(L),",")_";"_$PIECE(DRSUB(L),",",2,999)

                       End DoDot:2

 +12               FOR

                       if DRSUB(L)'["

                           QUIT

                       Begin DoDot:2

 +13                       SET DRSUB(L)=$PIECE(DRSUB(L),":1:")_":"_$PIECE(DRSUB(L),":1:",2,999)

                       End DoDot:2

 +14               FOR

                       if DRSUB(L)'["

                           QUIT

                       Begin DoDot:2

 +15                       SET DRSUB(L)=$PIECE(DRSUB(L),":.01:")_":"_$PIECE(DRSUB(L),":.01:",2,999)

                       End DoDot:2

               End DoDot:1

 +16       SET IOFSAV=IOF

 +17       KILL %ZIS,IOP

           SET %ZIS="MQ"

           SET %ZIS("B")=""

           DO ^%ZIS

           IF POP

               DO KILL1

               DO KILL2

               QUIT

 +18       SET IOF=IOFSAV

 +19       FOR LOOP="CATEGORY","CCORG","CLNGTH","DASHES","DS","EMP","DRSUB(","NAME","PAGE","PP","PPNAME","PRNTORDR(","SSN","STATION","TAB","TLU"

               SET ZTSAVE(LOOP)=""

 +20       IF $DATA(IO("Q"))

               SET ZTIO=ION

               SET ZTDESC="DISPLAY PAYRUN DATA"

               SET ZTRTN="DISPLAY^PRSDV459"

               SET ZTREQ="@"

               SET ZTSAVE("ZTREQ")=""

               DO ^%ZTLOAD

               if $DATA(ZTSK)

                   WRITE !,"Request Queued!"

               DO KILL1

               GOTO CAT

 +21       if $EXTRACT(IOST,1)="C"

               DO WAIT^DICD

 +22       USE IO

           DO DISPLAY

           if PRTC=0

               GOTO CAT

 +23       IF $EXTRACT(IOST,1)="C"

               if PRTC=""

                   DO PRTC

               if PRTC=0

                   GOTO CAT

 +24       if $EXTRACT(IOST,1)'="C"

               DO ^%ZISC

 +25       WRITE @IOF

           GOTO CAT

DISPLAY   ;display payrun data

 +1        NEW DRIEN

 +2        SET DRIEN=0

 +3        FOR

               SET DRIEN=$ORDER(DRSUB(DRIEN))

               if DRIEN=""

                   QUIT

               Begin DoDot:1

 +4                SET DIQ(0)="EIN"

                   SET DIC=459

                   SET DR=1

                   SET DR(459.01)=DRSUB(DRIEN)

                   SET DA(459.01)=EMP

                   SET DA=PP

 +5                DO EN^DIQ1

               End DoDot:1

 +6        if $EXTRACT(IOST,1)="C"

               WRITE @IOF

           DO HEADER

           SET FIELDN=0

 +7        IF CATEGORY="LABOR DISTRIBUTION"

               Begin DoDot:1

 +8                SET PRTC=0

 +9                DO LD

 +10               IF $EXTRACT(IOST,1)="C"

                       DO CHECK

 +11               IF $EXTRACT(IOST,1)'="C"

                       DO ^%ZISC

               End DoDot:1

 +12       IF CATEGORY'="LABOR DISTRIBUTION"

               Begin DoDot:1

 +13               SET PRTC=""

                   SET DRIEN=0

 +14               FOR

                       SET DRIEN=$ORDER(PRNTORDR(DRIEN))

                       if DRIEN=""

                           QUIT

                       Begin DoDot:2

 +15                       SET PRNTVALS="F FIELDN="_PRNTORDR(DRIEN)_" D WRITE^PRSDV459 Q:PRTC=0"

 +16                       XECUTE PRNTVALS

                       End DoDot:2

               End DoDot:1

KILL1     ;kill most variables and close the device

 +1        KILL D0,DIC,DIQ,DIQ2,DIR,DIRUT,DIROUT,DR,DRSUB,DTOUT,DUOUT,FIELDN,IOFSAV,IOP,LOOP,POP,PRNTORDR,PRNTVALS,X,Y,ZERO,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,%ZIS,^UTILITY("DIQ1",$JOB)

 +2        QUIT

KILL2     ;kill the remaining variables

 +1        KILL CATEGORY,CCORG,CHOICE,CLNGTH,DA,DS,DASHES,EMP,NAME,PAGE,PP,PPNAME,PRTC,SSN,STATION,TAB,TLU,ZTREQ

           QUIT

WRITE     ;write the data

 +1        SET NODEDD=^DD(459.01,FIELDN,0)

           SET DESC=$GET(^UTILITY("DIQ1",$JOB,459.01,EMP,FIELDN,"E"))

 +2        IF (DESC="")!(DESC="NA")

               KILL NODEDD,DESC

               QUIT

 +3        SET INTERNAL=^UTILITY("DIQ1",$JOB,459.01,EMP,FIELDN,"I")

 +4        IF $PIECE(NODEDD,U,2)["NJ"

               IF +INTERNAL=0

                   KILL NODEDD,DESC

                   QUIT

 +5        IF PRTC=1

               DO HEADER

               SET PRTC=""

 +6        WRITE !,$PIECE(NODEDD,U,1)

 +7        WRITE ?30,$SELECT($PIECE(NODEDD,U,5)["""$""":$JUSTIFY($FNUMBER(INTERNAL,",",2),14),$PIECE(NODEDD,U,2)["NJ":$JUSTIFY(INTERNAL,14,2),$PIECE(NODEDD,U,2)["D":$JUSTIFY(DESC,14),1:$JUSTIFY(INTERNAL,14))

 +8        IF $PIECE(NODEDD,U,2)'["D"

               IF INTERNAL'=DESC

                   DO DESC

 +9        KILL DESC,INTERNAL,NODEDD

 +10       DO CHECK

 +11       QUIT

CHECK      IF $EXTRACT(IOST,1)="C"

               IF $Y>(IOSL-4)

                   DO PRTC

 +1        QUIT

PRTC      ;press return to continue

 +1        WRITE !

           KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT

           SET DIR(0)="E"

           SET DIR("A")="Press RETURN to continue"

           DO ^DIR

           SET PRTC=Y

           if $DATA(DIRUT)

               SET PRTC=0

 +2        QUIT

HEADER    ;print header

 +1        if $Y>0

               WRITE @IOF

           SET PAGE=PAGE+1

 +2        SET CLNGTH=$LENGTH(CCORG)

           SET TAB=(80-CLNGTH)\2

           SET TAB=TAB-1

 +3        WRITE !,NAME,?TAB,CCORG,?61,"DUTY STATION: ",STATION_DS

 +4        WRITE !,SSN,?71,"T&L: ",TLU,!,DASHES

 +5        SET CLNGTH=$LENGTH(CATEGORY)

           SET TAB=(80-CLNGTH)\2

           SET TAB=TAB-1

 +6        WRITE !,"PAY PERIOD: ",PPNAME,?TAB,CATEGORY,?73,"PAGE ",PAGE

 +7        WRITE !,DASHES

 +8        KILL CLNGTH,TAB

 +9        QUIT

LD        ; Display Labor Distribution codes

 +1        if '$GET(DA)

               QUIT

 +2        NEW PRSLD,LDCNT,LDDATA,Y

 +3        FOR PRSLD=1:1:4

               Begin DoDot:1

 +4       ; Specify Pay Period

                   SET DIC=459

                   SET DR=1

                   SET DA=PP

 +5       ; Specify Employee

                   SET DR(459.01)=173

                   SET DA(459.01)=EMP

 +6       ; Specify LD multiple

                   SET DR(459.1173)="1;2;3;4"

                   SET DA(459.1173)=PRSLD

 +7                SET DIQ(0)="IE"

                   SET DIQ="LDDATA"

 +8                DO EN^DIQ1

 +9                FOR LDCNT=1:1:4

                       Begin DoDot:2

 +10                       SET NODEDD=^DD(459.1173,LDCNT,0)

 +11                       SET INTERNAL=$GET(LDDATA(459.1173,PRSLD,LDCNT,"I"))

 +12                       IF LDCNT'=3

                               SET DESC=$GET(LDDATA(459.1173,PRSLD,LDCNT,"E"))

 +13                       IF LDCNT=3

                               Begin DoDot:3

 +14                               SET Y=INTERNAL

                                   SET SUB454="CC"

 +15                               DO OT^PRSDUTIL

                                   KILL SUB454

 +16                               SET DESC=Y

                               End DoDot:3

 +17                       WRITE !,"LABOR DIST CODE-",PRSLD," ",$PIECE(NODEDD,U,1)

 +18                       WRITE ?30,$SELECT($PIECE(NODEDD,U,5)["""$""":$JUSTIFY($FNUMBER(INTERNAL,",",2),14),$PIECE(NODEDD,U,2)["NJ":$JUSTIFY(INTERNAL,14,2),$PIECE(NODEDD,U,2)["D":$JUSTIFY(DESC,14),1:$JUSTIFY(INTERNAL,14))

 +19                       IF $PIECE(NODEDD,U,2)'["D"

                               IF INTERNAL'=DESC

                                   DO DESC^PRSDW450

                       End DoDot:2

               End DoDot:1

 +20       QUIT

 +21      ;

DESC      ;write description

 +1        IF $LENGTH(DESC)<33

               WRITE ?47,DESC

               QUIT

 +2        SET COLUMN=47

           SET LGTH=0

 +3        FOR LOOP1=1:1

               if LGTH=$LENGTH(DESC)!(LGTH>($LENGTH(DESC)))

                   QUIT

               if $LENGTH($PIECE(DESC," ",LOOP1))>(80-COLUMN)

                   WRITE !

               if $LENGTH($PIECE(DESC," ",LOOP1))>(80-COLUMN)

                   SET COLUMN=47

               WRITE ?COLUMN,$PIECE(DESC," ",LOOP1)

               SET COLUMN=COLUMN+$LENGTH($PIECE(DESC," ",LOOP1))+1

               SET LGTH=LGTH+$LENGTH($PIECE(DESC," ",LOOP1))+1

 +4        KILL COLUMN,LGTH,LOOP1

           QUIT

TABLE     ;set subfile dr variable

 +1       ;;1;GENERAL INFORMATION;P1;1

 +2       ;;2;EARNINGS;P2;2

 +3       ;;3;DEDUCTIONS;P3;4

 +4       ;;4;LEAVE;P4;1

 +5       ;;5;LABOR DISTRIBUTION;

 +6       ;

P1        ;;1;GENERAL INFORMATION;P1;1

 +1       ;;2,3,4,5,6,11,13,110,122,123,112,118,111,7,8,9,10,115,116,117,171,160

P2        ;;2;EARNINGS;P2;2

 +1       ;;81,82,83,73,85,124,149,86,87,94,95,101,90,91,97,99,100,88,89,92

 +2       ;;93,98,96,102,103,104,104.1,172,105,109,113,114,108,106,107,74

P3        ;;3;DEDUCTIONS;P3;4

 +1       ;;20,21,22,23,24,27,28,29,25,26,39,40,56,57,60,63,66,59,62,65,58,61

 +2       ;;64,33,34,35,30,31,32,36,37,41:1:48,55,53,54,67.1,67,68.1,68,68.3

 +3       ;;68.2,68.5,68.4,69,70,71,72,38,84,49,50,51,52,150,151,178,179

 +4       ;;152,153,180,181,167,168,175,174,177,176,159

P4        ;;4;LEAVE;P4;1

 +1       ;;75,76,77,78,79,80,80.1,80.2,106,107,154,155,156,157,158

P5        ;;5;LABOR DISTRIBUTION;

PRSDV459.m