source: FOIAVistA/trunk/r/PAID-PRS/PRSDV459.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1PRSDV459 ;HISC/MGD-VIEW PAID PAYRUN DATA ;09/09/04
2 ;;4.0;PAID;**78,83,82,86,73,97**;Sep 21, 1995
3 K CHOICE F LOOP=1:1:5 S CHOICE(LOOP)=$T(TABLE+LOOP)
4PP ;select pay period
5 K DIC S DIC="^PRST(459,",DIC(0)="AEMQZ" D ^DIC I Y'>0 D KILL1,KILL2 Q
6 S PP=+Y,PPNAME=$P(^PRST(459,PP,0),U,1)
7EMP K DASHES S $P(DASHES,"-",80)="-"
8 K DIC,^UTILITY("DIQ1",$J) S DIC="^PRST(459,"_PP_",""P"",",DIC(0)="AEMQZ" D ^DIC K DIC G:Y'>0 PP
9 S EMP=+Y,ZERO=^PRST(459,PP,"P",EMP,0),NAME=$P(^PRSPC(EMP,0),U,1)
10 S SSN=$P(ZERO,U,2),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
11 S TLU=$P(ZERO,U,13),STATION=$P(^PRSPC(EMP,0),U,7)
12 S Y=$P(^PRSPC(EMP,0),U,49) X ^DD(450,458,2.1) S CCORG=Y
13 S DS=$P($G(^PRSPC(EMP,1)),U,42)
14CAT S CLNGTH=$L(CCORG),TAB=(80-CLNGTH)\2,TAB=TAB-1
15 W @IOF,!,NAME,?TAB,CCORG,?62,"DUTY STATION: ",STATION_DS
16 W !,SSN,?71,"T&L: ",TLU,!,DASHES,!,"PAY PERIOD: ",PPNAME
17 W !! F LOOP=1:1:5 W !,?20,$P(CHOICE(LOOP),";",3),?23,$P(CHOICE(LOOP),";",4)
18SAN W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT
19 S DIR(0)="NAO^1:5:0",DIR("A")="Select a number: "
20 S DIR("?")="Type a number between 1 and 5"
21 D ^DIR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D KILL1 G EMP
22 I X="@" W !!,*7,DIR("?")_"." G SAN
23 G:X="" EMP
24 N L,LAB,NOL
25 S CATEGORY=$P(CHOICE(+Y),";",4),LAB=$P(CHOICE(+Y),";",5)
26 S NOL=$P(CHOICE(+Y),";",6),PAGE=0
27 F L=1:1:NOL S (DRSUB(L),PRNTORDR(L))=$P($T(@LAB+L^PRSDV459),";",3) D
28 . F Q:DRSUB(L)'["," D
29 . . S DRSUB(L)=$P(DRSUB(L),",")_";"_$P(DRSUB(L),",",2,999)
30 . F Q:DRSUB(L)'[":1:" D
31 . . S DRSUB(L)=$P(DRSUB(L),":1:")_":"_$P(DRSUB(L),":1:",2,999)
32 . F Q:DRSUB(L)'[":.01:" D
33 . . S DRSUB(L)=$P(DRSUB(L),":.01:")_":"_$P(DRSUB(L),":.01:",2,999)
34 S IOFSAV=IOF
35 K %ZIS,IOP S %ZIS="MQ",%ZIS("B")="" D ^%ZIS I POP D KILL1,KILL2 Q
36 S IOF=IOFSAV
37 F LOOP="CATEGORY","CCORG","CLNGTH","DASHES","DS","EMP","DRSUB(","NAME","PAGE","PP","PPNAME","PRNTORDR(","SSN","STATION","TAB","TLU" S ZTSAVE(LOOP)=""
38 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
39 D:$E(IOST,1)="C" WAIT^DICD
40 U IO D DISPLAY G:PRTC=0 CAT
41 I $E(IOST,1)="C" D:PRTC="" PRTC G:PRTC=0 CAT
42 D:$E(IOST,1)'="C" ^%ZISC
43 W @IOF G CAT
44DISPLAY ;display payrun data
45 N DRIEN
46 S DRIEN=0
47 F S DRIEN=$O(DRSUB(DRIEN)) Q:DRIEN="" D
48 . S DIQ(0)="EIN",DIC=459,DR=1,DR(459.01)=DRSUB(DRIEN),DA(459.01)=EMP,DA=PP
49 . D EN^DIQ1
50 W:$E(IOST,1)="C" @IOF D HEADER S FIELDN=0
51 I CATEGORY="LABOR DISTRIBUTION" D
52 . S PRTC=0
53 . D LD
54 . I $E(IOST,1)="C" D CHECK
55 . I $E(IOST,1)'="C" D ^%ZISC
56 I CATEGORY'="LABOR DISTRIBUTION" D
57 . S PRTC="",DRIEN=0
58 . F S DRIEN=$O(PRNTORDR(DRIEN)) Q:DRIEN="" D
59 . . S PRNTVALS="F FIELDN="_PRNTORDR(DRIEN)_" D WRITE^PRSDV459 Q:PRTC=0"
60 . . X PRNTVALS
61KILL1 ;kill most variables and close the device
62 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)
63 Q
64KILL2 ;kill the remaining variables
65 K CATEGORY,CCORG,CHOICE,CLNGTH,DA,DS,DASHES,EMP,NAME,PAGE,PP,PPNAME,PRTC,SSN,STATION,TAB,TLU,ZTREQ Q
66WRITE ;write the data
67 S NODEDD=^DD(459.01,FIELDN,0),DESC=$G(^UTILITY("DIQ1",$J,459.01,EMP,FIELDN,"E"))
68 I (DESC="")!(DESC="NA") K NODEDD,DESC Q
69 S INTERNAL=^UTILITY("DIQ1",$J,459.01,EMP,FIELDN,"I")
70 I $P(NODEDD,U,2)["NJ",+INTERNAL=0 K NODEDD,DESC Q
71 I PRTC=1 D HEADER S PRTC=""
72 W !,$P(NODEDD,U,1)
73 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))
74 I $P(NODEDD,U,2)'["D",INTERNAL'=DESC D DESC
75 K DESC,INTERNAL,NODEDD
76 D CHECK
77 Q
78CHECK I $E(IOST,1)="C",$Y>(IOSL-4) D PRTC
79 Q
80PRTC ;press return to continue
81 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
82 Q
83HEADER ;print header
84 W:$Y>0 @IOF S PAGE=PAGE+1
85 S CLNGTH=$L(CCORG),TAB=(80-CLNGTH)\2,TAB=TAB-1
86 W !,NAME,?TAB,CCORG,?62,"DUTY STATION: ",STATION_DS
87 W !,SSN,?71,"T&L: ",TLU,!,DASHES
88 S CLNGTH=$L(CATEGORY),TAB=(80-CLNGTH)\2,TAB=TAB-1
89 W !,"PAY PERIOD: ",PPNAME,?TAB,CATEGORY,?73,"PAGE ",PAGE
90 W !,DASHES
91 K CLNGTH,TAB
92 Q
93LD ; Display Labor Distribution codes
94 Q:'$G(DA)
95 N PRSLD,LDCNT,LDDATA,Y
96 F PRSLD=1:1:4 D
97 . S DIC=459,DR=1,DA=PP ; Specify Pay Period
98 . S DR(459.01)=173,DA(459.01)=EMP ; Specify Employee
99 . S DR(459.1173)="1;2;3;4",DA(459.1173)=PRSLD ; Specify LD multiple
100 . S DIQ(0)="IE",DIQ="LDDATA"
101 . D EN^DIQ1
102 . F LDCNT=1:1:4 D
103 . . S NODEDD=^DD(459.1173,LDCNT,0)
104 . . S INTERNAL=$G(LDDATA(459.1173,PRSLD,LDCNT,"I"))
105 . . I LDCNT'=3 S DESC=$G(LDDATA(459.1173,PRSLD,LDCNT,"E"))
106 . . I LDCNT=3 D
107 . . . S Y=INTERNAL,SUB454="CC"
108 . . . D OT^PRSDUTIL K SUB454
109 . . . S DESC=Y
110 . . W !,"LABOR DIST CODE-",PRSLD," ",$P(NODEDD,U,1)
111 . . 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))
112 . . I $P(NODEDD,U,2)'["D",INTERNAL'=DESC D DESC^PRSDW450
113 Q
114 ;
115DESC ;write description
116 I $L(DESC)<33 W ?47,DESC Q
117 S COLUMN=47,LGTH=0
118 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
119 K COLUMN,LGTH,LOOP1 Q
120TABLE ;set subfile dr variable
121 ;;1;GENERAL INFORMATION;P1;1
122 ;;2;EARNINGS;P2;2
123 ;;3;DEDUCTIONS;P3;4
124 ;;4;LEAVE;P4;1
125 ;;5;LABOR DISTRIBUTION;
126 ;
127P1 ;;1;GENERAL INFORMATION;P1;1
128 ;;2,3,4,5,6,11,13,110,122,123,112,118,111,7,8,9,10,115,116,117,171,160
129P2 ;;2;EARNINGS;P2;2
130 ;;81,82,83,73,85,124,149,86,87,94,95,101,90,91,97,99,100,88,89,92
131 ;;93,98,96,102,103,104,104.1,172,105,109,113,114,108,106,107,74
132P3 ;;3;DEDUCTIONS;P3;4
133 ;;20,21,22,23,24,27,28,29,25,26,39,40,56,57,60,63,66,59,62,65,58,61
134 ;;64,33,34,35,30,31,32,36,37,41:1:48,55,53,54,67.1,67,68.1,68,68.3
135 ;;68.2,68.5,68.4,69,70,71,72,38,84,49,50,51,52,150,151,178,179
136 ;;152,153,180,181,167,168,175,174,177,176,159
137P4 ;;4;LEAVE;P4;1
138 ;;75,76,77,78,79,80,80.1,80.2,106,107,154,155,156,157,158
139P5 ;;5;LABOR DISTRIBUTION;
Note: See TracBrowser for help on using the repository browser.