- ECTPIND1 ;B'ham ISC/PTD-Individual PAID Inquiry - CONTINUED ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
- EN1 S (TAL,TSL,TLWOP,TAA,TCE,TCU,TOT)=0,PGCT=1,QFLG="",$P(LN,"-",81)="",YP=(BYRPP-1) D HDR
- YP F J=0:0 S YP=$O(^TMP($J,YP)) Q:'YP S LOC=^TMP($J,YP) D WRTLN G:QFLG EXIT
- WRTOT W !?14 F J=1:1:66 W "-"
- W !?4,"TOTAL",?14,$J(TAL,6,2),?24,$J(TSL,6,2),?34,$J(TLWOP,6,2),?44,$J(TAA,6,2),?54,$J(TCE,6,2),?64,$J(TCU,6,2),?74,$J(TOT,6,2),!!
- ;
- I $E(IOST)'="C" W @IOF
- EXIT K %,%H,%I,%DT,%Y,%ZIS,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,C,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIC,DIR,DTOUT,EMPDA,EMPSN,EPP,EYR,EYRPP,FLG,FST,G,J,K,LN,LOC,LOC0,LOC1,LWOP,LWOP1,LWOP2,MS,MYP,NM,OT,OT1,OT2,PGCT,POP,QFLG,SL,SL1,SL2,SN,X,Y,YP
- K PC,FR,WH,TAA,TAL,TCE,TCU,TLWOP,TOT,TSL,ZTDESC,ZTRTN,ZTSAVE,ZTSK,^TMP($J) D ^%ZISC I IO="" S IOP="HOME" D ^%ZIS
- Q
- ;
- HDR ;PRINT REPORT MAIN HEADER
- W @IOF,!?16,"INDIVIDUAL PAID DATA FOR "_NM,!?32,"SSN: "_$E(EMPSN,1,3)_"-"_$E(EMPSN,4,5)_"-"_$E(EMPSN,6,9),!?16,"FROM PAY PERIOD: "_BPP_" - '"_$E(BYR,2,3)_" TO PAY PERIOD: "_EPP_" - '"_$E(EYR,2,3)
- D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W !!?45,Y,?70,"PAGE ",PGCT S PGCT=PGCT+1 W !!?57,"CT",?67,"CT",?75,"OVER",!,"PAY PERIOD",?17,"AL",?27,"SL",?36,"LWOP",?47,"AA",?55,"EARNED",?66,"USED",?75,"TIME",!,LN
- Q
- ;
- WRTLN D:$Y+5>IOSL PRTCHK Q:QFLG W !?1,$E(YP,4,5)_" - '"_$E(YP,2,3),?15,$J($P(LOC,"^"),5,2),?25,$J($P(LOC,"^",2),5,2),?35,$J($P(LOC,"^",3),5,2),?45,$J($P(LOC,"^",4),5,2),?55,$J($P(LOC,"^",5),5,2)
- W ?65,$J($P(LOC,"^",6),5,2),?75,$J($P(LOC,"^",7),5,2)
- S TAL=TAL+$P(LOC,"^"),TSL=TSL+$P(LOC,"^",2),TLWOP=TLWOP+$P(LOC,"^",3),TAA=TAA+$P(LOC,"^",4),TCE=TCE+$P(LOC,"^",5),TCU=TCU+$P(LOC,"^",6),TOT=TOT+$P(LOC,"^",7)
- 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[HECTPIND1 1789 printed Apr 23, 2025@18:17:10 Page 2
- ECTPIND1 ;B'ham ISC/PTD-Individual PAID Inquiry - CONTINUED ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
- EN1 SET (TAL,TSL,TLWOP,TAA,TCE,TCU,TOT)=0
- SET PGCT=1
- SET QFLG=""
- SET $PIECE(LN,"-",81)=""
- SET YP=(BYRPP-1)
- DO HDR
- YP FOR J=0:0
- SET YP=$ORDER(^TMP($JOB,YP))
- if 'YP
- QUIT
- SET LOC=^TMP($JOB,YP)
- DO WRTLN
- if QFLG
- GOTO EXIT
- WRTOT WRITE !?14
- FOR J=1:1:66
- WRITE "-"
- +1 WRITE !?4,"TOTAL",?14,$JUSTIFY(TAL,6,2),?24,$JUSTIFY(TSL,6,2),?34,$JUSTIFY(TLWOP,6,2),?44,$JUSTIFY(TAA,6,2),?54,$JUSTIFY(TCE,6,2),?64,$JUSTIFY(TCU,6,2),?74,$JUSTIFY(TOT,6,2),!!
- +2 ;
- +3 IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- EXIT KILL %,%H,%I,%DT,%Y,%ZIS,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,C,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIC,DIR,DTOUT,EMPDA,EMPSN,EPP,EYR,EYRPP,FLG,FST,G,J,K,LN,LOC,LOC0,LOC1,LWOP,LWOP1,LWOP2,MS,MYP,NM,OT,OT1,OT2,PGCT,POP,QFLG,SL,SL1,SL2,SN,X,Y,YP
- +1 KILL PC,FR,WH,TAA,TAL,TCE,TCU,TLWOP,TOT,TSL,ZTDESC,ZTRTN,ZTSAVE,ZTSK,^TMP($JOB)
- DO ^%ZISC
- IF IO=""
- SET IOP="HOME"
- DO ^%ZIS
- +2 QUIT
- +3 ;
- HDR ;PRINT REPORT MAIN HEADER
- +1 WRITE @IOF,!?16,"INDIVIDUAL PAID DATA FOR "_NM,!?32,"SSN: "_$EXTRACT(EMPSN,1,3)_"-"_$EXTRACT(EMPSN,4,5)_"-"_$EXTRACT(EMPSN,6,9),!?16,"FROM PAY PERIOD: "_BPP_" - '"_$EXTRACT(BYR,2,3)_" TO PAY PERIOD: "_EPP_" - '"_$EXTRACT(EYR,2,3)
- +2 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- WRITE !!?45,Y,?70,"PAGE ",PGCT
- SET PGCT=PGCT+1
- WRITE !!?57,"CT",?67,"CT",?75,"OVER",!,"PAY PERIOD",?17,"AL",?27,"SL",?36,"LWOP",?47,"AA",?55,"EARNED",?66,"USED",?75,"TIME",!,LN
- +3 QUIT
- +4 ;
- WRTLN if $Y+5>IOSL
- DO PRTCHK
- if QFLG
- QUIT
- WRITE !?1,$EXTRACT(YP,4,5)_" - '"_$EXTRACT(YP,2,3),?15,$JUSTIFY($PIECE(LOC,"^"),5,2),?25,$JUSTIFY($PIECE(LOC,"^",2),5,2),?35,$JUSTIFY($PIECE(LOC,"^",3),5,2),?45,$JUSTIFY($PIECE(LOC,"^",4),5,2),?55,$JUSTIFY($PIECE(LOC,"^",5),5,2)
- +1 WRITE ?65,$JUSTIFY($PIECE(LOC,"^",6),5,2),?75,$JUSTIFY($PIECE(LOC,"^",7),5,2)
- +2 SET TAL=TAL+$PIECE(LOC,"^")
- SET TSL=TSL+$PIECE(LOC,"^",2)
- SET TLWOP=TLWOP+$PIECE(LOC,"^",3)
- SET TAA=TAA+$PIECE(LOC,"^",4)
- SET TCE=TCE+$PIECE(LOC,"^",5)
- SET TCU=TCU+$PIECE(LOC,"^",6)
- SET TOT=TOT+$PIECE(LOC,"^",7)
- +3 QUIT
- +4 ;
- PRTCHK IF $EXTRACT(IOST)="C"
- SET DIR(0)="E"
- DO ^DIR
- IF Y=0
- SET QFLG=1
- QUIT
- +1 DO HDR
- +2 QUIT
- +3 ;
