PRSDSRP3 ;HISC/GWB-SALARY REPORT PRINT ;6/10/93 08:54
;;4.0;PAID;;Sep 21, 1995
ASKDEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP K %ZIS Q
I $D(IO("Q")) S ZTIO=ION,ZTDESC="PAID SALARY REPORT",ZTRTN="START^PRSDSRP3" D ^%ZTLOAD W:$D(ZTSK) !,"Request Queued!" D EXIT Q
U IO D START
D:$E(IOST,1)'="C" ^%ZISC
Q
START D NOW^%DTC S Y=$J(%,"",4) D DD^%DT S PRNTDT=Y
S $P(DASHES,"-",80)="-",PAGE=0,FIRST="1ST",PRTC=1
S SITE=$G(^DD("SITE")) S:SITE'="" SITE=" FOR "_SITE
S (SALTL,SALPRJTL)=0
S CCORG="" F S CCORG=$O(^PRSP(454.1,"B",CCORG)) Q:CCORG="" S CCORGIEN=0,CCORGIEN=$O(^PRSP(454.1,"B",CCORG,CCORGIEN)) I $D(^PRSP(454.1,CCORGIEN)),^PRSP(454.1,CCORGIEN,6)'="" D WRITE Q:PRTC=0
G:PRTC=0 EXIT
W !,DASHES
I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC^PRSDSRP G:PRTC=0 EXIT D HDR
W !,?23,"TOTAL",?32,$J($FN(SALTL,",",2),12),?54,$J($FN(SALPRJTL,",",2),14)
I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC^PRSDSRP G:PRTC=0 EXIT D HDR
W !,DASHES
I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC^PRSDSRP G:PRTC=0 EXIT D HDR
W ! I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC^PRSDSRP G:PRTC=0 EXIT D HDR
EXIT I $D(ZTQUEUED) S ZTREQ="@" D KILL^XUSCLEAN Q
WRITE I FIRST="1ST" S Y=$P(^PRSP(454.1,CCORGIEN,0),U,3) D DD^%DT S COMPDT=Y D HDR S FIRST=""
S SAL=$P(^PRSP(454.1,CCORGIEN,6),U,1)
S SALPRJ=$P(^PRSP(454.1,CCORGIEN,6),U,2)
S SALTL=SALTL+SAL,SALPRJTL=SALPRJTL+SALPRJ
W !,$P(^PRSP(454.1,CCORGIEN,0),U,1),?32,$J($FN(SAL,",",2),12),?54,$J($FN(SALPRJ,",",2),14)
I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC^PRSDSRP Q:PRTC=0 D HDR
W !,DASHES
I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC^PRSDSRP Q:PRTC=0 D HDR
Q
HDR W:$Y>0 @IOF S PAGE=PAGE+1
W !,"SALARY REPORT",SITE,?44,"COMPILATION DATE: ",COMPDT
W !,"PAGE: ",PAGE,?50,"PRINT DATE: ",PRNTDT
W !!
W !,"SERVICE NAME",?34,"SALARY YTD",?52,"PROJECTED SALARY"
W !,DASHES,!,DASHES
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDSRP3 1825 printed Nov 22, 2024@17:36:11 Page 2
PRSDSRP3 ;HISC/GWB-SALARY REPORT PRINT ;6/10/93 08:54
+1 ;;4.0;PAID;;Sep 21, 1995
ASKDEV KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
KILL %ZIS
QUIT
+1 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTDESC="PAID SALARY REPORT"
SET ZTRTN="START^PRSDSRP3"
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Request Queued!"
DO EXIT
QUIT
+2 USE IO
DO START
+3 if $EXTRACT(IOST,1)'="C"
DO ^%ZISC
+4 QUIT
START DO NOW^%DTC
SET Y=$JUSTIFY(%,"",4)
DO DD^%DT
SET PRNTDT=Y
+1 SET $PIECE(DASHES,"-",80)="-"
SET PAGE=0
SET FIRST="1ST"
SET PRTC=1
+2 SET SITE=$GET(^DD("SITE"))
if SITE'=""
SET SITE=" FOR "_SITE
+3 SET (SALTL,SALPRJTL)=0
+4 SET CCORG=""
FOR
SET CCORG=$ORDER(^PRSP(454.1,"B",CCORG))
if CCORG=""
QUIT
SET CCORGIEN=0
SET CCORGIEN=$ORDER(^PRSP(454.1,"B",CCORG,CCORGIEN))
IF $DATA(^PRSP(454.1,CCORGIEN))
IF ^PRSP(454.1,CCORGIEN,6)'=""
DO WRITE
if PRTC=0
QUIT
+5 if PRTC=0
GOTO EXIT
+6 WRITE !,DASHES
+7 IF $Y>(IOSL-4)
if $EXTRACT(IOST,1)="C"
DO PRTC^PRSDSRP
if PRTC=0
GOTO EXIT
DO HDR
+8 WRITE !,?23,"TOTAL",?32,$JUSTIFY($FNUMBER(SALTL,",",2),12),?54,$JUSTIFY($FNUMBER(SALPRJTL,",",2),14)
+9 IF $Y>(IOSL-4)
if $EXTRACT(IOST,1)="C"
DO PRTC^PRSDSRP
if PRTC=0
GOTO EXIT
DO HDR
+10 WRITE !,DASHES
+11 IF $Y>(IOSL-4)
if $EXTRACT(IOST,1)="C"
DO PRTC^PRSDSRP
if PRTC=0
GOTO EXIT
DO HDR
+12 WRITE !
IF $Y>(IOSL-4)
if $EXTRACT(IOST,1)="C"
DO PRTC^PRSDSRP
if PRTC=0
GOTO EXIT
DO HDR
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO KILL^XUSCLEAN
QUIT
WRITE IF FIRST="1ST"
SET Y=$PIECE(^PRSP(454.1,CCORGIEN,0),U,3)
DO DD^%DT
SET COMPDT=Y
DO HDR
SET FIRST=""
+1 SET SAL=$PIECE(^PRSP(454.1,CCORGIEN,6),U,1)
+2 SET SALPRJ=$PIECE(^PRSP(454.1,CCORGIEN,6),U,2)
+3 SET SALTL=SALTL+SAL
SET SALPRJTL=SALPRJTL+SALPRJ
+4 WRITE !,$PIECE(^PRSP(454.1,CCORGIEN,0),U,1),?32,$JUSTIFY($FNUMBER(SAL,",",2),12),?54,$JUSTIFY($FNUMBER(SALPRJ,",",2),14)
+5 IF $Y>(IOSL-4)
if $EXTRACT(IOST,1)="C"
DO PRTC^PRSDSRP
if PRTC=0
QUIT
DO HDR
+6 WRITE !,DASHES
+7 IF $Y>(IOSL-4)
if $EXTRACT(IOST,1)="C"
DO PRTC^PRSDSRP
if PRTC=0
QUIT
DO HDR
+8 QUIT
HDR if $Y>0
WRITE @IOF
SET PAGE=PAGE+1
+1 WRITE !,"SALARY REPORT",SITE,?44,"COMPILATION DATE: ",COMPDT
+2 WRITE !,"PAGE: ",PAGE,?50,"PRINT DATE: ",PRNTDT
+3 WRITE !!
+4 WRITE !,"SERVICE NAME",?34,"SALARY YTD",?52,"PROJECTED SALARY"
+5 WRITE !,DASHES,!,DASHES
+6 QUIT
