PRSDSRP2 ;HISC/GWB-STRENGTH REPORT PRINT (CONTINUED);7/22/93  13:48
 ;;4.0;PAID;**6**;Sep 21, 1995
 D HDR
 S (CLGTL,FTPTL,PTPTL,PTPFTETL,FTTTL,PTTTL,PTTFTETL,INTTL,INTFTETL)=0
 S (TSRTL,TSRFTETL,SISTL,TOTTL,FTETOTTL,VARTL,LWOPTL,FEETL)=0
MCAY 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,2)),^PRSP(454.1,CCORGIEN,2)'="",$P(^PRSP(454.1,CCORGIEN,0),U,2)="Y" D WRITE
 W !,DASHES
 I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC^PRSDSRP G:PRTC=0 EXIT D HDR
 W !,?17,"TOTAL",?24,$J(CLGTL,7,2),?33,$J(FTPTL,4),?38,$J(PTPTL,4)
 W ?43,$J(PTPFTETL,7,2),?51,$J(FTTTL,4),?56,$J(PTTTL,4)
 W ?61,$J(PTTFTETL,7,2),?69,$J(INTTL,4),?74,$J(SISTL,4)
 W ?79,$J(INTFTETL,7,2),?87,"|",?90,$J(TOTTL,4),?97,$J(FTETOTTL,7,2)
 W ?105,$J(VARTL,7,2),?113,"|",?113,$J(TSRTL,3),?117,$J(TSRFTETL,7,2)
 W ?125,$J(LWOPTL,3),?129,$J(FEETL,3)
 W !,DASHES D:$E(IOST,1)="C" PRTC^PRSDSRP G:PRTC=0 EXIT
 D LEGEND D:$E(IOST,1)="C" PRTC^PRSDSRP G:PRTC=0 EXIT W !
EXIT 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 ZERO=^PRSP(454.1,CCORGIEN,0),TWO=^PRSP(454.1,CCORGIEN,2)
 S CLG=$P(ZERO,U,5)
 S FTP=$P(TWO,U,1),FTT=$P(TWO,U,2),PTP=$P(TWO,U,3),PTPFTE=$P(TWO,U,4)
 S PTT=$P(TWO,U,5),PTTFTE=$P(TWO,U,6),INT=$P(TWO,U,7),INTFTE=$P(TWO,U,8)
 S TSR=$P(TWO,U,9),TSRFTE=$P(TWO,U,10),SIS=$P(TWO,U,11),TOT=$P(TWO,U,12)
 S FTETOT=$P(TWO,U,13),VAR=$P(TWO,U,14),LWOP=$P(TWO,U,15)
 S FEE=$P(TWO,U,16)
 S CLGTL=CLGTL+CLG,FTPTL=FTPTL+FTP,PTPTL=PTPTL+PTP
 S PTPFTETL=PTPFTETL+PTPFTE,FTTTL=FTTTL+FTT,PTTTL=PTTTL+PTT
 S PTTFTETL=PTTFTETL+PTTFTE,INTTL=INTTL+INT,INTFTETL=INTFTETL+INTFTE
 S TSRTL=TSRTL+TSR,TSRFTETL=TSRFTETL+TSRFTE,SISTL=SISTL+SIS
 S TOTTL=TOTTL+TOT,FTETOTTL=FTETOTTL+FTETOT,VARTL=VARTL+VAR
 S LWOPTL=LWOPTL+LWOP,FEETL=FEETL+FEE
 W !,$P(^PRSP(454.1,CCORGIEN,0),U,1),?24,$J(CLG,7,2),?33,$J(FTP,4)
 W ?38,$J(PTP,4),?43,$J(PTPFTE,7,2),?51,$J(FTT,4),?56,$J(PTT,4)
 W ?61,$J(PTTFTE,7,2),?69,$J(INT,4),?74,$J(SIS,4),?79,$J(INTFTE,7,2)
 W ?87,"|",?90,$J(TOT,4),?97,$J(FTETOT,7,2),?105,$J(VAR,7,2),?113,"|"
 W ?113,$J(TSR,3),?117,$J(TSRFTE,7,2),?125,$J(LWOP,3),?129,$J(FEE,3)
 W !,DASHES D:$Y>(IOSL-2) HDR Q
HDR W:$Y>0 @IOF S PAGE=PAGE+1
 W "PHYSICIAN STRENGTH REPORT",SITE,?96,"COMPILATION DATE: ",COMPDT
 W !,"PAGE: ",PAGE,?102,"PRINT DATE: ",PRNTDT,!
 W !,?80,"SISFTE"
 W !,"SERVICE NAME",?24,"CEILING",?34,"FTP",?39,"PTP",?44,"PTPFTE"
 W ?52,"FTT",?57,"PTT",?62,"PTTFTE",?70,"INT",?75,"SIS",?80,"INTFTE"
 W ?87,"|",?91,"TOT",?98,"FTETOT",?109,"VAR",?113,"|",?113,"TSR"
 W ?118,"TSRFTE",?125,"LWP",?129,"FEE"
 W !,DASHES,!,DASHES
 Q
LEGEND W !,"FTP    Full Time Permanent",?40,"SIS    Stay-in-School/Summer Aid"
 W !,"PTP    Part Time Permanent",?40,"VAR    Variance (FTETOT-CEILING)"
 W !,"FTT    Full Time Temporary",?40,"TSR    Trainee/Stipend/Resident"
 W !,"PTT    Part Time Temporary",?40,"LWP    Extended Leave Without Pay"
 W !,"INT    Intermittent",?40,"FEE    Fee Basis"
 I $D(^XTMP("CCORG")) D
 .W !!,"   The following Cost Center/Organization codes are not associated with a service name and are being counted under the service name"
 .W !,"MISCELLANEOUS.  You may assign them a service name via the Update PAID Codes option by choosing the COST CENTER/ORGANIZATION file, "
 .W !,"entering the CODE and entering a DESCRIPTION.  You must then recompile the report via the Compile/Print Strength Report option."
 .W !,"These code will then be counted under the appropriate service name.",!
 .S CCORG="" F  S CCORG=$O(^XTMP("CCORG",CCORG)) Q:CCORG=""  W !,CCORG
 Q