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