source: WorldVistAEHR/trunk/r/PAID-PRS/PRS8TL.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: 3.3 KB
Line 
1PRS8TL ;HISC/MRL-DECOMPOSITION, SELECTIVE T&L ;2/19/93 13:12
2 ;;4.0;PAID;;Sep 21, 1995
3 ;
4 ;This routine is used to decompose, or re-decompose, all entries
5 ;for a specific T&L for a selective Pay Period. Entries which
6 ;have already been transmitted will not be affected by this process.
7 ;
8 ;Called by Routines: PRS8
9 ;
10 S QUIT=0
11PP ; --- get Pay Period
12 S SEE=1 D PY^PRS8 ;get pay period
13 Q:QUIT G END:'OK S PY(0)=$P(^PRST(458,+PY,0),"^",1)
14 ;
15SHOW ; --- show only
16 W !!,"Want to just SEE what's stored already and not decompose"
17 S %=2 D YN^DICN I %<0 G END
18 I %,%>0 S SHOW=$S(%=2:0,1:1),SHOW(1)=$S(SHOW:"SEE",1:"DECOMPOSE") G DECOM:'SHOW S DECOM=0 G ASK
19 W !?4,"Answer YES if you wish to display what's been previously decomposed."
20 W !?4,"Respond NO if you actually want to decompose records."
21 D OUT G SHOW
22 ;
23DECOM ; --- decompose even if done
24 W !!,"Should I decompose only those records which have not been decomposed" S %=2 D YN^DICN
25 S DECOM=0 I % G END:%<0 S DECOM=%-1 G ASK
26 W !?4,"Answer YES if you wish to decompose only records not previously decomposed."
27 W !?4,"Respond NO to decompose all records which have been released to payroll but",!?4,"have not yet been transmitted." D OUT G DECOM
28ASK ; --- loop thru all T&L's
29 W !!,"Want to ",SHOW(1)," all T&L's for Pay Period ",PY(0) S %=2 D YN^DICN
30 I %,QUIT Q
31 I %=1 S PRS8("DES")="Decomposition of all T&L's for PP ",PRS8("PGM")="TLA^PRS8TL" G DEV
32 I % G END:%=-1,TL
33 W !?4,"Answer YES if you wish to ",SHOW(1)," all records for PP ",PY(0),"."
34 W !?4,"Respond NO if you wish to ",SHOW(1)," records for specific T&L's."
35 D OUT G ASK
36 ;
37TL ; --- Specific T&L Selection
38 W ! S CT=0 K TLU
39 F PRS8=1:1 D Q:+Y'>0
40 .S DIC="^PRST(455.5,",DIC(0)="AEQMZ",DIC("A")="Select T&L Unit: "
41 .I CT S DIC("A")="Select ANOTHER: "
42 .D ^DIC
43 .I Y>0,$D(TLU(Y(0,0))) W !?4,"T&L has already been selected!!",*7 Q
44 .I $D(^PRST(455.5,+Y,0)) S CT=CT+1,TLU(Y(0,0))=""
45 I $O(TLU(0))="" W !?4,"No T&L's have been selected!",*7 Q:QUIT G END
46 W !! S (CT,CT1)=0,J="" F I=0:0 S J=$O(TLU(J)) Q:J="" D
47 .S CT=CT+1,CT1=CT1+1 I CT1=7 S CT1=1 W !
48 .S X=(CT1*10-CT1) W ?X,J
49 ;
50OK ; --- are the selections ok
51 W !!,$S(CT=1:"Is this the T&L",1:"Are these the T&L's")
52 W " to be processed" S %=2 D YN^DICN
53 I %,QUIT Q
54 I % G TL1:%=1,TL:%=2,END
55 W !?4,"Answer YES if these are the T&L's you want to ",SHOW(1),"."
56 W !?4,"Answer NO if you wish to select another T&L (or set of T&L's)."
57 D OUT G OK
58 ;
59TL1 ; --- T&L's are ok, let's go on
60 S PRS8("DES")="Decomposition of Specific T&L's",PRS8("PGM")="TL2^PRS8TL" G DEV
61 ;
62TL2 ; --- entry point from QUEUE for running specific T&L's
63 D COVER^PRS8TL1
64 S TLU="" F TLU1=0:0 S TLU=$O(TLU(TLU)),NAME="" Q:TLU=""!(PRS8("QUIT")) D ^PRS8TL1
65 I 'PRS8("QUIT") S PRS8("QUIT")=1 D TOP^PRS8TL1
66 G END
67 ;
68TLA ; --- entry point from QUEUE for running all T&L's
69 D COVER^PRS8TL1
70 S TLU1="ATL00" F S TLU1=$O(^PRSPC(TLU1)),NAME="" Q:TLU1'?1"ATL".E!(PRS8("QUIT")) S TLU=$E(TLU1,4,6) D ^PRS8TL1
71 I 'PRS8("QUIT") S PRS8("QUIT")=1 D TOP^PRS8TL1
72 G END
73 ;
74OUT ; --- write exit comment
75 W !?4,"You may enter an up-arrow [""^""] if you wish to QUIT now!",*7 Q
76 ;
77DEV ; --- select output device
78 W !!,"WARNING: This report is designed to run with a 132-column Right Margin!"
79 S PRS8("DES")=PRS8("DES")_" "_PY(0),PRS8("VAR")="PY^PY(^SHOW^DECOM^TLU(" D ^PRS8UT
80 ;
81END ; --- all done here
82 G ALL^PRS8CV
Note: See TracBrowser for help on using the repository browser.