Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSDSRP2

PRSDSRP2.m

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