- ECTPAS1 ;B'ham ISC/PTD-PAID Data for All Services - CONTINUED ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
- EN1 S (TAL,TSL,TLWOP,TAA,TCE,TCU,TUNS,TOT)=0,PGCT=1,QFLG="",$P(LN,"-",81)="",SRV=0
- I '$O(^TMP($J,0)) D HDR W !!?16,"==> NO DATA IN THE FILE FOR SELECTED DATES <==",!! G EXIT
- SRV F J=0:0 S SRV=$O(^TMP($J,SRV)) Q:'SRV D:(PGCT>1)&(BYRPP'=EYRPP) PRTCHK G:QFLG EXIT D:PGCT<2 HDR W !!?1,"SERVICE: ",$P(^ECC(730,SRV,0),"^") S (SAL,SSL,SLWOP,SAA,SCE,SCU,SUNS,SOT,YP)=0 D YP G:QFLG EXIT D SRTOT
- WRTOT W !!?14 F J=1:1:66 W "="
- W !?4,"TOTAL",?11,$J(TAL,7,2),?19,$J(TSL,7,2),?27,$J(TLWOP,7,2),?36,$J(TAA,7,2),?45,$J(TCE,7,2),?54,$J(TCU,7,2),?63,$J(TUNS,7,2),?72,$J(TOT,7,2),!!
- ;
- I $E(IOST)'="C" W @IOF
- EXIT K %,%H,%DT,%I,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIR,DTOUT,DUOUT,EMPDA,EPP,EYR,EYRPP,FLG,FST,G,J,K,L,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,SAA,SAL,SCE,SCU,SL,SL1,SL2,SLWOP,SOT,SRV,SRVDA,SRVTL,SSL,SUNS,TAA,TAL,TCE,TCU,TL,TLWOP,TMP,TOT,TSL,TUNS,UNS,UNS1,UNS2,X,Y,YP,^TMP($J),ZTDESC,ZTRTN,ZTSAVE,ZTSK D ^%ZISC I IO="" S IOP="HOME" D ^%ZIS
- Q
- ;
- YP F K=0:0 S YP=$O(^TMP($J,SRV,YP)) Q:'YP S LOC=^TMP($J,SRV,YP) D WRTLN Q:QFLG
- Q
- ;
- HDR ;PRINT REPORT MAIN HEADER
- W @IOF,!?27,"PAID DATA FOR ALL SERVICES",!?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 !!?49,"CT",?58,"CT",?65,"UNSCH",?75,"OVER",!,"PAY PERIOD",?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 !?1,$E(YP,4,5)_" - '"_$E(YP,2,3),?11,$J($P(LOC,"^"),7,2),?19,$J($P(LOC,"^",2),7,2),?27,$J($P(LOC,"^",3),7,2),?36,$J($P(LOC,"^",4),7,2),?45,$J($P(LOC,"^",5),7,2)
- W ?54,$J($P(LOC,"^",6),7,2),?63,$J($P(LOC,"^",7),7,2),?72,$J($P(LOC,"^",8),7,2)
- S SAL=SAL+$P(LOC,"^"),SSL=SSL+$P(LOC,"^",2),SLWOP=SLWOP+$P(LOC,"^",3),SAA=SAA+$P(LOC,"^",4),SCE=SCE+$P(LOC,"^",5),SCU=SCU+$P(LOC,"^",6),SUNS=SUNS+$P(LOC,"^",7),SOT=SOT+$P(LOC,"^",8)
- Q
- ;
- PRTCHK I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S QFLG=1 Q
- D HDR
- Q
- ;
- SRTOT ;WRITE SUB-TOTAL FOR SERVICE
- D:$Y+5>IOSL PRTCHK Q:QFLG I BYRPP'=EYRPP W !?14 F L=1:1:66 W "-"
- I BYRPP'=EYRPP W !?1,"SUB-TOTAL",?12,$J(SAL,6,2),?20,$J(SSL,6,2),?28,$J(SLWOP,6,2),?37,$J(SAA,6,2),?46,$J(SCE,6,2),?55,$J(SCU,6,2),?64,$J(SUNS,6,2),?73,$J(SOT,6,2),!
- S TAL=TAL+SAL,TSL=TSL+SSL,TLWOP=TLWOP+SLWOP,TAA=TAA+SAA,TCE=TCE+SCE,TCU=TCU+SCU,TUNS=TUNS+SUNS,TOT=TOT+SOT
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTPAS1 2607 printed Apr 23, 2025@18:17:06 Page 2
- ECTPAS1 ;B'ham ISC/PTD-PAID Data for All Services - CONTINUED ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
- EN1 SET (TAL,TSL,TLWOP,TAA,TCE,TCU,TUNS,TOT)=0
- SET PGCT=1
- SET QFLG=""
- SET $PIECE(LN,"-",81)=""
- SET SRV=0
- +1 IF '$ORDER(^TMP($JOB,0))
- DO HDR
- WRITE !!?16,"==> NO DATA IN THE FILE FOR SELECTED DATES <==",!!
- GOTO EXIT
- SRV FOR J=0:0
- SET SRV=$ORDER(^TMP($JOB,SRV))
- if 'SRV
- QUIT
- if (PGCT>1)&(BYRPP'=EYRPP)
- DO PRTCHK
- if QFLG
- GOTO EXIT
- if PGCT<2
- DO HDR
- WRITE !!?1,"SERVICE: ",$PIECE(^ECC(730,SRV,0),"^")
- SET (SAL,SSL,SLWOP,SAA,SCE,SCU,SUNS,SOT,YP)=0
- DO YP
- if QFLG
- GOTO EXIT
- DO SRTOT
- WRTOT WRITE !!?14
- FOR J=1:1:66
- WRITE "="
- +1 WRITE !?4,"TOTAL",?11,$JUSTIFY(TAL,7,2),?19,$JUSTIFY(TSL,7,2),?27,$JUSTIFY(TLWOP,7,2),?36,$JUSTIFY(TAA,7,2),?45,$JUSTIFY(TCE,7,2),?54,$JUSTIFY(TCU,7,2),?63,$JUSTIFY(TUNS,7,2),?72,$JUSTIFY(TOT,7,2),!!
- +2 ;
- +3 IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- EXIT KILL %,%H,%DT,%I,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIR,DTOUT,DUOUT,EMPDA,EPP,EYR,EYRPP,FLG,FST,G,J,K,L,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,SAA,SAL,SCE,SCU,SL,SL1,SL2,SLWOP,SOT,SRV,SRVDA,SRVTL,SSL,SUNS,TAA,TAL,TCE,TCU,TL,TLWOP,TMP,TOT,TSL,TUNS,UNS,UNS1,UNS2,X,Y,YP,^TMP($JOB),ZTDESC,ZTRTN,ZTSAVE,ZTSK
- DO ^%ZISC
- IF IO=""
- SET IOP="HOME"
- DO ^%ZIS
- +2 QUIT
- +3 ;
- YP FOR K=0:0
- SET YP=$ORDER(^TMP($JOB,SRV,YP))
- if 'YP
- QUIT
- SET LOC=^TMP($JOB,SRV,YP)
- DO WRTLN
- if QFLG
- QUIT
- +1 QUIT
- +2 ;
- HDR ;PRINT REPORT MAIN HEADER
- +1 WRITE @IOF,!?27,"PAID DATA FOR ALL SERVICES",!?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 !!?49,"CT",?58,"CT",?65,"UNSCH",?75,"OVER",!,"PAY PERIOD",?15,"AL",?23,"SL",?30,"LWOP",?40,"AA",?47,"EARNED",?57,"USED",?66,"REG",?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),?11,$JUSTIFY($PIECE(LOC,"^"),7,2),?19,$JUSTIFY($PIECE(LOC,"^",2),7,2),?27,$JUSTIFY($PIECE(LOC,"^",3),7,2),?36,$JUSTIFY($PIECE(LOC,"^",4),7,2),?45,$JUSTIFY($PIECE(LOC,"^",5),7,2)
- +1 WRITE ?54,$JUSTIFY($PIECE(LOC,"^",6),7,2),?63,$JUSTIFY($PIECE(LOC,"^",7),7,2),?72,$JUSTIFY($PIECE(LOC,"^",8),7,2)
- +2 SET SAL=SAL+$PIECE(LOC,"^")
- SET SSL=SSL+$PIECE(LOC,"^",2)
- SET SLWOP=SLWOP+$PIECE(LOC,"^",3)
- SET SAA=SAA+$PIECE(LOC,"^",4)
- SET SCE=SCE+$PIECE(LOC,"^",5)
- SET SCU=SCU+$PIECE(LOC,"^",6)
- SET SUNS=SUNS+$PIECE(LOC,"^",7)
- SET SOT=SOT+$PIECE(LOC,"^",8)
- +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 ;
- SRTOT ;WRITE SUB-TOTAL FOR SERVICE
- +1 if $Y+5>IOSL
- DO PRTCHK
- if QFLG
- QUIT
- IF BYRPP'=EYRPP
- WRITE !?14
- FOR L=1:1:66
- WRITE "-"
- +2 IF BYRPP'=EYRPP
- WRITE !?1,"SUB-TOTAL",?12,$JUSTIFY(SAL,6,2),?20,$JUSTIFY(SSL,6,2),?28,$JUSTIFY(SLWOP,6,2),?37,$JUSTIFY(SAA,6,2),?46,$JUSTIFY(SCE,6,2),?55,$JUSTIFY(SCU,6,2),?64,$JUSTIFY(SUNS,6,2),?73,$JUSTIFY(SOT,6,2),!
- +3 SET TAL=TAL+SAL
- SET TSL=TSL+SSL
- SET TLWOP=TLWOP+SLWOP
- SET TAA=TAA+SAA
- SET TCE=TCE+SCE
- SET TCU=TCU+SCU
- SET TUNS=TUNS+SUNS
- SET TOT=TOT+SOT
- +4 QUIT
- +5 ;
