- ECTP1TL1 ;B'ham ISC/PTD-PAID Data for One T&L Unit - CONTINUED ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
- EN1 S (TLAL,TLSL,TLLWOP,TLAA,TLCE,TLCU,TLUNS,TLOT)=0,PGCT=1,QFLG="",$P(LN,"-",81)="",TL=0,YP=(BYRPP-1) D HDR
- I '$O(^TMP($J,0)) W !!?15,"==> NO DATA IN THE FILE FOR SELECTED T&L UNIT <==",!! G EXIT
- YP F J=0:0 S TL=$O(^TMP($J,TL)) Q:'TL F K=0:0 S YP=$O(^TMP($J,TL,YP)) Q:'YP D PP S (CD,IND)="",SCD=0 D IND G:QFLG EXIT S LOC=^TMP($J,TL,YP) S IND="" W:'IND !,LN D WRTLN,INCR G:QFLG EXIT
- WRTOT W !?12 F J=1:1:68 W "="
- W !?4,"TOTAL",?12,$J(TLAL,6,2),?20,$J(TLSL,6,2),?28,$J(TLLWOP,6,2),?37,$J(TLAA,6,2),?46,$J(TLCE,6,2),?55,$J(TLCU,6,2),?64,$J(TLUNS,6,2),?73,$J(TLOT,6,2),!!
- ;
- I $E(IOST)'="C" W @IOF
- EXIT K %,%H,%DT,%I,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,C,CD,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIR,DTOUT,EMPDA,EPP,EYR,EYRPP,FLG,FST,G,IND,J,K,L,L4SSN,LN,LOC,LOC0,LOC1,LWOP,LWOP1,LWOP2,OT,OT1,OT2,PAA,PAL,PCTE,PCTU,PGCT,PLWOP,POP,POT,PSL,PUNS,QFLG
- K PC,FR,WH,M,NC,SCD,TLAA,TLAL,TLCE,TLCU,SL,SL1,SL2,TLLWOP,TLOT,TLSL,TLUNS,TL,TLDA,TLNM,TLPTR,TMP,UNS,UNS1,UNS2,X,Y,YP,^TMP($J),ZTDESC,ZTRTN,ZTSAVE,ZTSK D ^%ZISC I IO="" S IOP="HOME" D ^%ZIS
- Q
- ;
- HDR ;PRINT REPORT MAIN HEADER
- W @IOF,!?16,"PAID DATA FOR SINGLE T&L UNIT",!?16,"T&L UNIT: "_TLNM,!?16,"FROM PAY PERIOD: "_BPP_" - '"_$E(BYR,2,3)_" TO PAY PERIOD: "_EPP_" - '"_$E(EYR,2,3)
- W !!,"PAY PERIOD" D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W ?45,Y,?70,"PAGE ",PGCT S PGCT=PGCT+1
- W !!,"NAME",?49,"CT",?58,"CT",?65,"UNSCH",?75,"OVER",!,"CODE",?5,"LSSN",?15,"AL",?23,"SL",?30,"LWOP",?40,"AA",?47,"EARNED",?57,"USED",?66,"REG",?75,"TIME",!,LN
- Q
- ;
- WRTLN D:$Y+5>IOSL PRTCHK Q:QFLG W ! W:IND CD,?5,SCD W:'IND "SUB-TOTAL" W ?12,$J($P(LOC,"^"),6,2),?20,$J($P(LOC,"^",2),6,2),?28,$J($P(LOC,"^",3),6,2),?37,$J($P(LOC,"^",4),6,2),?46,$J($P(LOC,"^",5),6,2)
- W ?55,$J($P(LOC,"^",6),6,2),?64,$J($P(LOC,"^",7),6,2),?73,$J($P(LOC,"^",8),6,2)
- Q
- ;
- INCR S TLAL=TLAL+$P(LOC,"^"),TLSL=TLSL+$P(LOC,"^",2),TLLWOP=TLLWOP+$P(LOC,"^",3),TLAA=TLAA+$P(LOC,"^",4),TLCE=TLCE+$P(LOC,"^",5),TLCU=TLCU+$P(LOC,"^",6),TLUNS=TLUNS+$P(LOC,"^",7),TLOT=TLOT+$P(LOC,"^",8)
- Q
- ;
- PP W !!?1,$E(YP,4,5)_" - '"_$E(YP,2,3)
- Q
- ;
- IND S IND=1 F L=0:0 S CD=$O(^TMP($J,TL,YP,CD)) Q:CD="" Q:QFLG F M=0:0 S SCD=$O(^TMP($J,TL,YP,CD,SCD)) Q:'SCD S LOC=^TMP($J,TL,YP,CD,SCD) D WRTLN Q:QFLG
- Q
- ;
- PRTCHK I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S QFLG=1 Q
- D HDR
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTP1TL1 2427 printed Mar 13, 2025@21:07:23 Page 2
- ECTP1TL1 ;B'ham ISC/PTD-PAID Data for One T&L Unit - CONTINUED ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
- EN1 SET (TLAL,TLSL,TLLWOP,TLAA,TLCE,TLCU,TLUNS,TLOT)=0
- SET PGCT=1
- SET QFLG=""
- SET $PIECE(LN,"-",81)=""
- SET TL=0
- SET YP=(BYRPP-1)
- DO HDR
- +1 IF '$ORDER(^TMP($JOB,0))
- WRITE !!?15,"==> NO DATA IN THE FILE FOR SELECTED T&L UNIT <==",!!
- GOTO EXIT
- YP FOR J=0:0
- SET TL=$ORDER(^TMP($JOB,TL))
- if 'TL
- QUIT
- FOR K=0:0
- SET YP=$ORDER(^TMP($JOB,TL,YP))
- if 'YP
- QUIT
- DO PP
- SET (CD,IND)=""
- SET SCD=0
- DO IND
- if QFLG
- GOTO EXIT
- SET LOC=^TMP($JOB,TL,YP)
- SET IND=""
- if 'IND
- WRITE !,LN
- DO WRTLN
- DO INCR
- if QFLG
- GOTO EXIT
- WRTOT WRITE !?12
- FOR J=1:1:68
- WRITE "="
- +1 WRITE !?4,"TOTAL",?12,$JUSTIFY(TLAL,6,2),?20,$JUSTIFY(TLSL,6,2),?28,$JUSTIFY(TLLWOP,6,2),?37,$JUSTIFY(TLAA,6,2),?46,$JUSTIFY(TLCE,6,2),?55,$JUSTIFY(TLCU,6,2),?64,$JUSTIFY(TLUNS,6,2),?73,$JUSTIFY(TLOT,6,2),!!
- +2 ;
- +3 IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- EXIT KILL %,%H,%DT,%I,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,C,CD,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIR,DTOUT,EMPDA,EPP,EYR,EYRPP,FLG,FST,G,IND,J,K,L,L4SSN,LN,LOC,LOC0,LOC1,LWOP,LWOP1,LWOP2,OT,OT1,OT2,PAA,PAL,PCTE,PCTU,PGCT,PLWOP,POP,POT,PSL,PUNS,QFLG
- +1 KILL PC,FR,WH,M,NC,SCD,TLAA,TLAL,TLCE,TLCU,SL,SL1,SL2,TLLWOP,TLOT,TLSL,TLUNS,TL,TLDA,TLNM,TLPTR,TMP,UNS,UNS1,UNS2,X,Y,YP,^TMP($JOB),ZTDESC,ZTRTN,ZTSAVE,ZTSK
- DO ^%ZISC
- IF IO=""
- SET IOP="HOME"
- DO ^%ZIS
- +2 QUIT
- +3 ;
- HDR ;PRINT REPORT MAIN HEADER
- +1 WRITE @IOF,!?16,"PAID DATA FOR SINGLE T&L UNIT",!?16,"T&L UNIT: "_TLNM,!?16,"FROM PAY PERIOD: "_BPP_" - '"_$EXTRACT(BYR,2,3)_" TO PAY PERIOD: "_EPP_" - '"_$EXTRACT(EYR,2,3)
- +2 WRITE !!,"PAY PERIOD"
- DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- WRITE ?45,Y,?70,"PAGE ",PGCT
- SET PGCT=PGCT+1
- +3 WRITE !!,"NAME",?49,"CT",?58,"CT",?65,"UNSCH",?75,"OVER",!,"CODE",?5,"LSSN",?15,"AL",?23,"SL",?30,"LWOP",?40,"AA",?47,"EARNED",?57,"USED",?66,"REG",?75,"TIME",!,LN
- +4 QUIT
- +5 ;
- WRTLN if $Y+5>IOSL
- DO PRTCHK
- if QFLG
- QUIT
- WRITE !
- if IND
- WRITE CD,?5,SCD
- if 'IND
- WRITE "SUB-TOTAL"
- WRITE ?12,$JUSTIFY($PIECE(LOC,"^"),6,2),?20,$JUSTIFY($PIECE(LOC,"^",2),6,2),?28,$JUSTIFY($PIECE(LOC,"^",3),6,2),?37,$JUSTIFY($PIECE(LOC,"^",4),6,2),?46,$JUSTIFY($PIECE(LOC,"^",5),6,2)
- +1 WRITE ?55,$JUSTIFY($PIECE(LOC,"^",6),6,2),?64,$JUSTIFY($PIECE(LOC,"^",7),6,2),?73,$JUSTIFY($PIECE(LOC,"^",8),6,2)
- +2 QUIT
- +3 ;
- INCR SET TLAL=TLAL+$PIECE(LOC,"^")
- SET TLSL=TLSL+$PIECE(LOC,"^",2)
- SET TLLWOP=TLLWOP+$PIECE(LOC,"^",3)
- SET TLAA=TLAA+$PIECE(LOC,"^",4)
- SET TLCE=TLCE+$PIECE(LOC,"^",5)
- SET TLCU=TLCU+$PIECE(LOC,"^",6)
- SET TLUNS=TLUNS+$PIECE(LOC,"^",7)
- SET TLOT=TLOT+$PIECE(LOC,"^",8)
- +1 QUIT
- +2 ;
- PP WRITE !!?1,$EXTRACT(YP,4,5)_" - '"_$EXTRACT(YP,2,3)
- +1 QUIT
- +2 ;
- IND SET IND=1
- FOR L=0:0
- SET CD=$ORDER(^TMP($JOB,TL,YP,CD))
- if CD=""
- QUIT
- if QFLG
- QUIT
- FOR M=0:0
- SET SCD=$ORDER(^TMP($JOB,TL,YP,CD,SCD))
- if 'SCD
- QUIT
- SET LOC=^TMP($JOB,TL,YP,CD,SCD)
- DO WRTLN
- if QFLG
- QUIT
- +1 QUIT
- +2 ;
- PRTCHK IF $EXTRACT(IOST)="C"
- SET DIR(0)="E"
- DO ^DIR
- IF Y=0
- SET QFLG=1
- QUIT
- +1 DO HDR
- +2 QUIT
- +3 ;
