- 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 Feb 18, 2025@23:49:27 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
