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