PRS8TL ;HISC/MRL-DECOMPOSITION, SELECTIVE T&L ;2/19/93 13:12
;;4.0;PAID;;Sep 21, 1995
;
;This routine is used to decompose, or re-decompose, all entries
;for a specific T&L for a selective Pay Period. Entries which
;have already been transmitted will not be affected by this process.
;
;Called by Routines: PRS8
;
S QUIT=0
PP ; --- get Pay Period
S SEE=1 D PY^PRS8 ;get pay period
Q:QUIT G END:'OK S PY(0)=$P(^PRST(458,+PY,0),"^",1)
;
SHOW ; --- show only
W !!,"Want to just SEE what's stored already and not decompose"
S %=2 D YN^DICN I %<0 G END
I %,%>0 S SHOW=$S(%=2:0,1:1),SHOW(1)=$S(SHOW:"SEE",1:"DECOMPOSE") G DECOM:'SHOW S DECOM=0 G ASK
W !?4,"Answer YES if you wish to display what's been previously decomposed."
W !?4,"Respond NO if you actually want to decompose records."
D OUT G SHOW
;
DECOM ; --- decompose even if done
W !!,"Should I decompose only those records which have not been decomposed" S %=2 D YN^DICN
S DECOM=0 I % G END:%<0 S DECOM=%-1 G ASK
W !?4,"Answer YES if you wish to decompose only records not previously decomposed."
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
ASK ; --- loop thru all T&L's
W !!,"Want to ",SHOW(1)," all T&L's for Pay Period ",PY(0) S %=2 D YN^DICN
I %,QUIT Q
I %=1 S PRS8("DES")="Decomposition of all T&L's for PP ",PRS8("PGM")="TLA^PRS8TL" G DEV
I % G END:%=-1,TL
W !?4,"Answer YES if you wish to ",SHOW(1)," all records for PP ",PY(0),"."
W !?4,"Respond NO if you wish to ",SHOW(1)," records for specific T&L's."
D OUT G ASK
;
TL ; --- Specific T&L Selection
W ! S CT=0 K TLU
F PRS8=1:1 D Q:+Y'>0
.S DIC="^PRST(455.5,",DIC(0)="AEQMZ",DIC("A")="Select T&L Unit: "
.I CT S DIC("A")="Select ANOTHER: "
.D ^DIC
.I Y>0,$D(TLU(Y(0,0))) W !?4,"T&L has already been selected!!",*7 Q
.I $D(^PRST(455.5,+Y,0)) S CT=CT+1,TLU(Y(0,0))=""
I $O(TLU(0))="" W !?4,"No T&L's have been selected!",*7 Q:QUIT G END
W !! S (CT,CT1)=0,J="" F I=0:0 S J=$O(TLU(J)) Q:J="" D
.S CT=CT+1,CT1=CT1+1 I CT1=7 S CT1=1 W !
.S X=(CT1*10-CT1) W ?X,J
;
OK ; --- are the selections ok
W !!,$S(CT=1:"Is this the T&L",1:"Are these the T&L's")
W " to be processed" S %=2 D YN^DICN
I %,QUIT Q
I % G TL1:%=1,TL:%=2,END
W !?4,"Answer YES if these are the T&L's you want to ",SHOW(1),"."
W !?4,"Answer NO if you wish to select another T&L (or set of T&L's)."
D OUT G OK
;
TL1 ; --- T&L's are ok, let's go on
S PRS8("DES")="Decomposition of Specific T&L's",PRS8("PGM")="TL2^PRS8TL" G DEV
;
TL2 ; --- entry point from QUEUE for running specific T&L's
D COVER^PRS8TL1
S TLU="" F TLU1=0:0 S TLU=$O(TLU(TLU)),NAME="" Q:TLU=""!(PRS8("QUIT")) D ^PRS8TL1
I 'PRS8("QUIT") S PRS8("QUIT")=1 D TOP^PRS8TL1
G END
;
TLA ; --- entry point from QUEUE for running all T&L's
D COVER^PRS8TL1
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
I 'PRS8("QUIT") S PRS8("QUIT")=1 D TOP^PRS8TL1
G END
;
OUT ; --- write exit comment
W !?4,"You may enter an up-arrow [""^""] if you wish to QUIT now!",*7 Q
;
DEV ; --- select output device
W !!,"WARNING: This report is designed to run with a 132-column Right Margin!"
S PRS8("DES")=PRS8("DES")_" "_PY(0),PRS8("VAR")="PY^PY(^SHOW^DECOM^TLU(" D ^PRS8UT
;
END ; --- all done here
G ALL^PRS8CV
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8TL 3440 printed Dec 13, 2024@02:23:02 Page 2
PRS8TL ;HISC/MRL-DECOMPOSITION, SELECTIVE T&L ;2/19/93 13:12
+1 ;;4.0;PAID;;Sep 21, 1995
+2 ;
+3 ;This routine is used to decompose, or re-decompose, all entries
+4 ;for a specific T&L for a selective Pay Period. Entries which
+5 ;have already been transmitted will not be affected by this process.
+6 ;
+7 ;Called by Routines: PRS8
+8 ;
+9 SET QUIT=0
PP ; --- get Pay Period
+1 ;get pay period
SET SEE=1
DO PY^PRS8
+2 if QUIT
QUIT
if 'OK
GOTO END
SET PY(0)=$PIECE(^PRST(458,+PY,0),"^",1)
+3 ;
SHOW ; --- show only
+1 WRITE !!,"Want to just SEE what's stored already and not decompose"
+2 SET %=2
DO YN^DICN
IF %<0
GOTO END
+3 IF %
IF %>0
SET SHOW=$SELECT(%=2:0,1:1)
SET SHOW(1)=$SELECT(SHOW:"SEE",1:"DECOMPOSE")
if 'SHOW
GOTO DECOM
SET DECOM=0
GOTO ASK
+4 WRITE !?4,"Answer YES if you wish to display what's been previously decomposed."
+5 WRITE !?4,"Respond NO if you actually want to decompose records."
+6 DO OUT
GOTO SHOW
+7 ;
DECOM ; --- decompose even if done
+1 WRITE !!,"Should I decompose only those records which have not been decomposed"
SET %=2
DO YN^DICN
+2 SET DECOM=0
IF %
if %<0
GOTO END
SET DECOM=%-1
GOTO ASK
+3 WRITE !?4,"Answer YES if you wish to decompose only records not previously decomposed."
+4 WRITE !?4,"Respond NO to decompose all records which have been released to payroll but",!?4,"have not yet been transmitted."
DO OUT
GOTO DECOM
ASK ; --- loop thru all T&L's
+1 WRITE !!,"Want to ",SHOW(1)," all T&L's for Pay Period ",PY(0)
SET %=2
DO YN^DICN
+2 IF %
IF QUIT
QUIT
+3 IF %=1
SET PRS8("DES")="Decomposition of all T&L's for PP "
SET PRS8("PGM")="TLA^PRS8TL"
GOTO DEV
+4 IF %
if %=-1
GOTO END
GOTO TL
+5 WRITE !?4,"Answer YES if you wish to ",SHOW(1)," all records for PP ",PY(0),"."
+6 WRITE !?4,"Respond NO if you wish to ",SHOW(1)," records for specific T&L's."
+7 DO OUT
GOTO ASK
+8 ;
TL ; --- Specific T&L Selection
+1 WRITE !
SET CT=0
KILL TLU
+2 FOR PRS8=1:1
Begin DoDot:1
+3 SET DIC="^PRST(455.5,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select T&L Unit: "
+4 IF CT
SET DIC("A")="Select ANOTHER: "
+5 DO ^DIC
+6 IF Y>0
IF $DATA(TLU(Y(0,0)))
WRITE !?4,"T&L has already been selected!!",*7
QUIT
+7 IF $DATA(^PRST(455.5,+Y,0))
SET CT=CT+1
SET TLU(Y(0,0))=""
End DoDot:1
if +Y'>0
QUIT
+8 IF $ORDER(TLU(0))=""
WRITE !?4,"No T&L's have been selected!",*7
if QUIT
QUIT
GOTO END
+9 WRITE !!
SET (CT,CT1)=0
SET J=""
FOR I=0:0
SET J=$ORDER(TLU(J))
if J=""
QUIT
Begin DoDot:1
+10 SET CT=CT+1
SET CT1=CT1+1
IF CT1=7
SET CT1=1
WRITE !
+11 SET X=(CT1*10-CT1)
WRITE ?X,J
End DoDot:1
+12 ;
OK ; --- are the selections ok
+1 WRITE !!,$SELECT(CT=1:"Is this the T&L",1:"Are these the T&L's")
+2 WRITE " to be processed"
SET %=2
DO YN^DICN
+3 IF %
IF QUIT
QUIT
+4 IF %
if %=1
GOTO TL1
if %=2
GOTO TL
GOTO END
+5 WRITE !?4,"Answer YES if these are the T&L's you want to ",SHOW(1),"."
+6 WRITE !?4,"Answer NO if you wish to select another T&L (or set of T&L's)."
+7 DO OUT
GOTO OK
+8 ;
TL1 ; --- T&L's are ok, let's go on
+1 SET PRS8("DES")="Decomposition of Specific T&L's"
SET PRS8("PGM")="TL2^PRS8TL"
GOTO DEV
+2 ;
TL2 ; --- entry point from QUEUE for running specific T&L's
+1 DO COVER^PRS8TL1
+2 SET TLU=""
FOR TLU1=0:0
SET TLU=$ORDER(TLU(TLU))
SET NAME=""
if TLU=""!(PRS8("QUIT"))
QUIT
DO ^PRS8TL1
+3 IF 'PRS8("QUIT")
SET PRS8("QUIT")=1
DO TOP^PRS8TL1
+4 GOTO END
+5 ;
TLA ; --- entry point from QUEUE for running all T&L's
+1 DO COVER^PRS8TL1
+2 SET TLU1="ATL00"
FOR
SET TLU1=$ORDER(^PRSPC(TLU1))
SET NAME=""
if TLU1'?1"ATL".E!(PRS8("QUIT"))
QUIT
SET TLU=$EXTRACT(TLU1,4,6)
DO ^PRS8TL1
+3 IF 'PRS8("QUIT")
SET PRS8("QUIT")=1
DO TOP^PRS8TL1
+4 GOTO END
+5 ;
OUT ; --- write exit comment
+1 WRITE !?4,"You may enter an up-arrow [""^""] if you wish to QUIT now!",*7
QUIT
+2 ;
DEV ; --- select output device
+1 WRITE !!,"WARNING: This report is designed to run with a 132-column Right Margin!"
+2 SET PRS8("DES")=PRS8("DES")_" "_PY(0)
SET PRS8("VAR")="PY^PY(^SHOW^DECOM^TLU("
DO ^PRS8UT
+3 ;
END ; --- all done here
+1 GOTO ALL^PRS8CV
