PRS8TL1 ;HISC/MRL-DECOMPOSITION, SELECTIVE T&L, CONT. ;2/26/93  14:35
 ;;4.0;PAID;;Sep 21, 1995
 ;
 ;This routine is a continuation of PRS8TL.  This portion of the
 ;routine actually loops through file 450 and locates the entries
 ;identified by the user.  If the user has decided to only show
 ;the information currently stored it is located in file 458 and
 ;displayed.  If decomposition has been selected and the record has
 ;not yet been transmitted the record will be decomposed and then
 ;the information (old and new) will be displayed.
 ;
 ;Called by Routines:  PRS8TL
 ;
 D TOP F TLU2=0:0 S NAME=$O(^PRSPC("ATL"_TLU,NAME)),DFN=0 Q:NAME=""!(PRS8("QUIT"))  D
 .F TLU3=0:0 S DFN=$O(^PRSPC("ATL"_TLU,NAME,DFN)) Q:'DFN!(PRS8("QUIT"))  D  W !
 ..S X=$G(IOSL) S:'X X=24 S X=X-8 I $Y>X,'PRS8("QUIT") D TOP
 ..Q:PRS8("QUIT")
 ..S X=$G(^PRST(458,+PY,"E",+DFN,0)) I X="" Q  ;no record for this pp
 ..W !,$E($P(NAME,",",1)_","_$E($P(NAME,",",2)),1,25)
 ..S X1=$P($G(^PRSPC(+DFN,0)),"^",9) I X1="" S X1="XXXXXXXXX"
 ..W ?30,$E(X1,1,3)_"-"_$E(X1,4,5)_"-"_$E(X1,6,9)
 ..S X1=$P(X,"^",2)
 ..W ?45,$S(X1="P":"Released to Payroll",X1="X":"Transmitted to Austin",1:"T&L still updating Record")
 ..I X1="" W !?6,"|OLD|  Record has not been released to Payroll...Cannot Decompose..." Q
 ..S VALUE=$G(^PRST(458,+PY,"E",+DFN,5))
 ..W !?6,"|OLD|  ",$S(VALUE'="":VALUE,1:"No Decomposition currently on File")
 ..Q:SHOW
 ..I X1="X"!(VALUE'=""&('DECOM)) W !?6,"|NEW|  " D  Q
 ...I X1="X" W "Record already Transmitted...Cannot update Decomposition..." Q
 ...W "Record already decomposed <see above>...Not updated per user..."
 ..D UP
 ..S VALUE(1)=$G(^PRST(458,+PY,"E",+DFN,5))
 ..W !?6,"|NEW| ",$S(VALUE(1)=VALUE:" ",1:"*"),VALUE(1)
 Q
 ;
UP ; --- decompose
 S PPI=PY
 N PRS8,SHOW,VALUE,PY
 S (SEE,SHOW)=0,SAVE=1
 D ONE^PRS8
 Q
 ;
TOP ; --- Top of Form
 S PRS8("PAGE")=PRS8("PAGE")+1
 I PRS8("PAGE")>1 D
 .F I=$Y:1:(IOSL)-6 W !
 .D BOT
 I PRS8("QUIT") Q
 W @IOF S X="Decomposition Report for T&L '"_TLU_"'" D CTR
 S X="Pay Period "_PY(0) D CTR
 W !!,"Employee Name",?30,"SSN",?45,"Current T&A Status",!
 S X="",$P(X,"-",(IOM-1))="" W X Q
 ;
BOT ; --- bottom of form
 I IOST["C-" D  Q
 .R !!,"Press <RETURN> to Continue, Enter '^' to QUIT:  ",X:DTIME
 .I X["^"!('$T) S PRS8("QUIT")=1
 S X="",$P(X,"=",(IOM-1))="" W !!,X
 W !,PRS8("WHO") S X="Page "_PRS8("PAGE") D CTR1
 W ?(IOM-($L(PRS8("DATE"))+2)),PRS8("DATE"),! Q
 ;
COVER ; --- cover page
 D NOW^%DTC S Y=% X ^DD("DD") S PRS8("DATE")=Y
 S X=$P($G(^VA(200,+$G(DUZ),0)),"^",1) ;user
 S PRS8("WHO")=$S(X'="":X,1:"REQUESTOR UNKNOWN")
 S (PRS8("PAGE"),PRS8("QUIT"))=0
 I IOST["C-" Q
 F I=1:1:10 W !
 S X="D E C O M P O S I T I O N    A C T I V I T Y   R E P O R T" D CTR
 F I=1:1:5 W !
 S X="Date/Time Started",X1=PRS8("DATE") D FORM
 S X="User Initiating Report",X1=PRS8("WHO") D FORM
 W !!! S X="S E A R C H   P A R A M E T E R S" D CTR
 W !! S X="Report is Run for Pay Period",X1=PY(0) D FORM
 S X="Decompose or Show Data",X1=$S(SHOW:"SHOW",1:"DECOMPOSE") D FORM
 I 'SHOW S X=$S(DECOM:"",1:"*")_"Decompose All Records",X1=$S(DECOM:"YES",1:"NO") D FORM
 S X="Process All Records",X1=$S($O(TLU(0))]"":"NO",1:"YES") D FORM
 I $O(TLU(0))]"" D
 .W ! S X="The following T&L's are processed in this Report:",X1="" D CTR
 .S X="",CT=0,J="" F I=0:0 S J=$O(TLU(J)) Q:J=""  D
 ..S CT=CT+1 I (CT*10)>(IOM-10)  S CT=1 D CTR S X=""
 ..S X=X_J_"       "
 .D CTR:X'=""
 W !! S X="",$P(X,80)="" D CTR
 S X="NOTE:  Records which have not been released to Payroll are never Decomposed." D CTR
 S X="Additionally, records which have been  Transmitted to Austin are not Decomposed." D CTR
 Q:DECOM!SHOW
 W ! S X="* You have chosen the  feature which will  not initiate a  decomposition run for" D CTR
 S X="any record already having been previously decomposed.                           " D CTR
 Q
 ;
FORM ; --- format X and X1 then fall into CTR (Center)
 S X=$E(X_"...............................",1,50)_" "
 S X1=$E(X1,1,20),X1=$J(X1,10),X=X_X1
 ;
CTR ; --- center
 W !
 ;
CTR1 ; --- center but don't write line feed
 W ?(IOM-$L(X)\2),X
 K X,X1 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8TL1   4164     printed  Sep 23, 2025@19:59:27                                                                                                                                                                                                     Page 2
PRS8TL1   ;HISC/MRL-DECOMPOSITION, SELECTIVE T&L, CONT. ;2/26/93  14:35
 +1       ;;4.0;PAID;;Sep 21, 1995
 +2       ;
 +3       ;This routine is a continuation of PRS8TL.  This portion of the
 +4       ;routine actually loops through file 450 and locates the entries
 +5       ;identified by the user.  If the user has decided to only show
 +6       ;the information currently stored it is located in file 458 and
 +7       ;displayed.  If decomposition has been selected and the record has
 +8       ;not yet been transmitted the record will be decomposed and then
 +9       ;the information (old and new) will be displayed.
 +10      ;
 +11      ;Called by Routines:  PRS8TL
 +12      ;
 +13       DO TOP
           FOR TLU2=0:0
               SET NAME=$ORDER(^PRSPC("ATL"_TLU,NAME))
               SET DFN=0
               if NAME=""!(PRS8("QUIT"))
                   QUIT 
               Begin DoDot:1
 +14               FOR TLU3=0:0
                       SET DFN=$ORDER(^PRSPC("ATL"_TLU,NAME,DFN))
                       if 'DFN!(PRS8("QUIT"))
                           QUIT 
                       Begin DoDot:2
 +15                       SET X=$GET(IOSL)
                           if 'X
                               SET X=24
                           SET X=X-8
                           IF $Y>X
                               IF 'PRS8("QUIT")
                                   DO TOP
 +16                       if PRS8("QUIT")
                               QUIT 
 +17      ;no record for this pp
                           SET X=$GET(^PRST(458,+PY,"E",+DFN,0))
                           IF X=""
                               QUIT 
 +18                       WRITE !,$EXTRACT($PIECE(NAME,",",1)_","_$EXTRACT($PIECE(NAME,",",2)),1,25)
 +19                       SET X1=$PIECE($GET(^PRSPC(+DFN,0)),"^",9)
                           IF X1=""
                               SET X1="XXXXXXXXX"
 +20                       WRITE ?30,$EXTRACT(X1,1,3)_"-"_$EXTRACT(X1,4,5)_"-"_$EXTRACT(X1,6,9)
 +21                       SET X1=$PIECE(X,"^",2)
 +22                       WRITE ?45,$SELECT(X1="P":"Released to Payroll",X1="X":"Transmitted to Austin",1:"T&L still updating Record")
 +23                       IF X1=""
                               WRITE !?6,"|OLD|  Record has not been released to Payroll...Cannot Decompose..."
                               QUIT 
 +24                       SET VALUE=$GET(^PRST(458,+PY,"E",+DFN,5))
 +25                       WRITE !?6,"|OLD|  ",$SELECT(VALUE'="":VALUE,1:"No Decomposition currently on File")
 +26                       if SHOW
                               QUIT 
 +27                       IF X1="X"!(VALUE'=""&('DECOM))
                               WRITE !?6,"|NEW|  "
                               Begin DoDot:3
 +28                               IF X1="X"
                                       WRITE "Record already Transmitted...Cannot update Decomposition..."
                                       QUIT 
 +29                               WRITE "Record already decomposed <see above>...Not updated per user..."
                               End DoDot:3
                               QUIT 
 +30                       DO UP
 +31                       SET VALUE(1)=$GET(^PRST(458,+PY,"E",+DFN,5))
 +32                       WRITE !?6,"|NEW| ",$SELECT(VALUE(1)=VALUE:" ",1:"*"),VALUE(1)
                       End DoDot:2
                       WRITE !
               End DoDot:1
 +33       QUIT 
 +34      ;
UP        ; --- decompose
 +1        SET PPI=PY
 +2        NEW PRS8,SHOW,VALUE,PY
 +3        SET (SEE,SHOW)=0
           SET SAVE=1
 +4        DO ONE^PRS8
 +5        QUIT 
 +6       ;
TOP       ; --- Top of Form
 +1        SET PRS8("PAGE")=PRS8("PAGE")+1
 +2        IF PRS8("PAGE")>1
               Begin DoDot:1
 +3                FOR I=$Y:1:(IOSL)-6
                       WRITE !
 +4                DO BOT
               End DoDot:1
 +5        IF PRS8("QUIT")
               QUIT 
 +6        WRITE @IOF
           SET X="Decomposition Report for T&L '"_TLU_"'"
           DO CTR
 +7        SET X="Pay Period "_PY(0)
           DO CTR
 +8        WRITE !!,"Employee Name",?30,"SSN",?45,"Current T&A Status",!
 +9        SET X=""
           SET $PIECE(X,"-",(IOM-1))=""
           WRITE X
           QUIT 
 +10      ;
BOT       ; --- bottom of form
 +1        IF IOST["C-"
               Begin DoDot:1
 +2                READ !!,"Press <RETURN> to Continue, Enter '^' to QUIT:  ",X:DTIME
 +3                IF X["^"!('$TEST)
                       SET PRS8("QUIT")=1
               End DoDot:1
               QUIT 
 +4        SET X=""
           SET $PIECE(X,"=",(IOM-1))=""
           WRITE !!,X
 +5        WRITE !,PRS8("WHO")
           SET X="Page "_PRS8("PAGE")
           DO CTR1
 +6        WRITE ?(IOM-($LENGTH(PRS8("DATE"))+2)),PRS8("DATE"),!
           QUIT 
 +7       ;
COVER     ; --- cover page
 +1        DO NOW^%DTC
           SET Y=%
           XECUTE ^DD("DD")
           SET PRS8("DATE")=Y
 +2       ;user
           SET X=$PIECE($GET(^VA(200,+$GET(DUZ),0)),"^",1)
 +3        SET PRS8("WHO")=$SELECT(X'="":X,1:"REQUESTOR UNKNOWN")
 +4        SET (PRS8("PAGE"),PRS8("QUIT"))=0
 +5        IF IOST["C-"
               QUIT 
 +6        FOR I=1:1:10
               WRITE !
 +7        SET X="D E C O M P O S I T I O N    A C T I V I T Y   R E P O R T"
           DO CTR
 +8        FOR I=1:1:5
               WRITE !
 +9        SET X="Date/Time Started"
           SET X1=PRS8("DATE")
           DO FORM
 +10       SET X="User Initiating Report"
           SET X1=PRS8("WHO")
           DO FORM
 +11       WRITE !!!
           SET X="S E A R C H   P A R A M E T E R S"
           DO CTR
 +12       WRITE !!
           SET X="Report is Run for Pay Period"
           SET X1=PY(0)
           DO FORM
 +13       SET X="Decompose or Show Data"
           SET X1=$SELECT(SHOW:"SHOW",1:"DECOMPOSE")
           DO FORM
 +14       IF 'SHOW
               SET X=$SELECT(DECOM:"",1:"*")_"Decompose All Records"
               SET X1=$SELECT(DECOM:"YES",1:"NO")
               DO FORM
 +15       SET X="Process All Records"
           SET X1=$SELECT($ORDER(TLU(0))]"":"NO",1:"YES")
           DO FORM
 +16       IF $ORDER(TLU(0))]""
               Begin DoDot:1
 +17               WRITE !
                   SET X="The following T&L's are processed in this Report:"
                   SET X1=""
                   DO CTR
 +18               SET X=""
                   SET CT=0
                   SET J=""
                   FOR I=0:0
                       SET J=$ORDER(TLU(J))
                       if J=""
                           QUIT 
                       Begin DoDot:2
 +19                       SET CT=CT+1
                           IF (CT*10)>(IOM-10)
                               SET CT=1
                               DO CTR
                               SET X=""
 +20                       SET X=X_J_"       "
                       End DoDot:2
 +21               if X'=""
                       DO CTR
               End DoDot:1
 +22       WRITE !!
           SET X=""
           SET $PIECE(X,80)=""
           DO CTR
 +23       SET X="NOTE:  Records which have not been released to Payroll are never Decomposed."
           DO CTR
 +24       SET X="Additionally, records which have been  Transmitted to Austin are not Decomposed."
           DO CTR
 +25       if DECOM!SHOW
               QUIT 
 +26       WRITE !
           SET X="* You have chosen the  feature which will  not initiate a  decomposition run for"
           DO CTR
 +27       SET X="any record already having been previously decomposed.                           "
           DO CTR
 +28       QUIT 
 +29      ;
FORM      ; --- format X and X1 then fall into CTR (Center)
 +1        SET X=$EXTRACT(X_"...............................",1,50)_" "
 +2        SET X1=$EXTRACT(X1,1,20)
           SET X1=$JUSTIFY(X1,10)
           SET X=X_X1
 +3       ;
CTR       ; --- center
 +1        WRITE !
 +2       ;
CTR1      ; --- center but don't write line feed
 +1        WRITE ?(IOM-$LENGTH(X)\2),X
 +2        KILL X,X1
           QUIT