source: FOIAVistA/trunk/r/PAID-PRS/PRSDSRP2.m@ 1535

Last change on this file since 1535 was 628, checked in by George Lilly, 15 years ago

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