ECTP1S1 ;B'ham ISC/PTD-PAID Data for One Service - CONTINUED ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
EN1 S (SAL,SSL,SLWOP,SAA,SCE,SCU,SUNS,SOT)=0,PGCT=1,QFLG="",$P(LN,"-",81)="",SRV=0,YP=(BYRPP-1) D HDR
I '$O(^TMP($J,0)) W !!?15,"==> NO DATA IN THE FILE FOR SELECTED SERVICE <==",!! G EXIT
YP F J=0:0 S SRV=$O(^TMP($J,SRV)) Q:'SRV F K=0:0 S YP=$O(^TMP($J,SRV,YP)) Q:'YP S LOC=^TMP($J,SRV,YP) D WRTLN G:QFLG EXIT
WRTOT W !?14 F J=1:1:66 W "-"
W !?4,"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),!!
;
I $E(IOST)'="C" W @IOF
EXIT K %,%H,%DT,%I,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,C,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIR,DTOUT,EMPDA,EPP,EYR,EYRPP,FLG,FST,G,J,K,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,SRVNM,SRVTL,SSL,SUNS,TL,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 "_SRVNM,!?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),?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)
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTP1S1 2011 printed Apr 09, 2024@21:04:46 Page 2
ECTP1S1 ;B'ham ISC/PTD-PAID Data for One Service - CONTINUED ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;**8,10**;
EN1 SET (SAL,SSL,SLWOP,SAA,SCE,SCU,SUNS,SOT)=0
SET PGCT=1
SET QFLG=""
SET $PIECE(LN,"-",81)=""
SET SRV=0
SET YP=(BYRPP-1)
DO HDR
+1 IF '$ORDER(^TMP($JOB,0))
WRITE !!?15,"==> NO DATA IN THE FILE FOR SELECTED SERVICE <==",!!
GOTO EXIT
YP FOR J=0:0
SET SRV=$ORDER(^TMP($JOB,SRV))
if 'SRV
QUIT
FOR K=0:0
SET YP=$ORDER(^TMP($JOB,SRV,YP))
if 'YP
QUIT
SET LOC=^TMP($JOB,SRV,YP)
DO WRTLN
if QFLG
GOTO EXIT
WRTOT WRITE !?14
FOR J=1:1:66
WRITE "-"
+1 WRITE !?4,"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),!!
+2 ;
+3 IF $EXTRACT(IOST)'="C"
WRITE @IOF
EXIT KILL %,%H,%DT,%I,AA,AA1,AA2,AL,AL1,AL2,BPP,BYR,BYRPP,C,CTE,CTE1,CTE2,CTU,CTU1,CTU2,DIR,DTOUT,EMPDA,EPP,EYR,EYRPP,FLG,FST,G,J,K,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,SRVNM,SRVTL,SSL,SUNS,TL,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 "_SRVNM,!?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),?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 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 ;
