1 | PRCPRPC3 ;WISC/RFJ-patient distribution costs (print report totals) ;11 Mar 94
|
---|
2 | ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | ;
|
---|
7 | PRINTOTL ; print report totals
|
---|
8 | D:SCREEN P^PRCPUREP I $G(PRCPFLAG) Q
|
---|
9 | S PRCPFTOT=1 D H^PRCPRPC2
|
---|
10 | S DISTRNM="" F S DISTRNM=$O(^TMP($J,"PRCPRPCRT",1,DISTRNM)) Q:DISTRNM=""!($G(PRCPFLAG)) W !,"TOTALS BY DISTRIBUTION POINT: ",DISTRNM D TOTAL(^(DISTRNM))
|
---|
11 | I $G(PRCPFLAG) Q
|
---|
12 | W !
|
---|
13 | S SURGSPEC="" F S SURGSPEC=$O(^TMP($J,"PRCPRPCRT",2,SURGSPEC)) Q:SURGSPEC=""!($G(PRCPFLAG)) D
|
---|
14 | . W !,"TOTALS BY SURGICAL SPECIALTY: ",SURGSPEC D TOTAL($G(^TMP($J,"PRCPRPCRT",2,SURGSPEC)))
|
---|
15 | . I $G(PRCPFLAG) Q
|
---|
16 | . S INOUTPAT="" F S INOUTPAT=$O(^TMP($J,"PRCPRPCRT",2,SURGSPEC,INOUTPAT)) Q:INOUTPAT=""!($G(PRCPFLAG)) W !,$J($S(INOUTPAT="I":"INPATIENT",INOUTPAT="O":"OUTPATIENT",1:"UNKNOWN"),28),":" D TOTAL(^(INOUTPAT))
|
---|
17 | I $G(PRCPFLAG) Q
|
---|
18 | W !
|
---|
19 | S INOUTPAT="" F S INOUTPAT=$O(^TMP($J,"PRCPRPCRT",3,INOUTPAT)) Q:INOUTPAT=""!($G(PRCPFLAG)) W !,"TOTALS BY INPATIENT/OUTPATIENT: ",$S(INOUTPAT="I":"INPATIENT",INOUTPAT="O":"OUTPATIENT",1:"UNKNOWN") D TOTAL(^(INOUTPAT))
|
---|
20 | I $G(PRCPFLAG) Q
|
---|
21 | W !
|
---|
22 | S OPCODE="" F S OPCODE=$O(^TMP($J,"PRCPRPCRT",4,OPCODE)) Q:OPCODE=""!($G(PRCPFLAG)) W !,"TOTALS BY OPERATION/PROCEDURE CODE: ",OPCODE D TOTAL(^(OPCODE))
|
---|
23 | I $G(PRCPFLAG) Q
|
---|
24 | W !
|
---|
25 | S SURGEON="" F S SURGEON=$O(^TMP($J,"PRCPRPCRT",5,SURGEON)) Q:SURGEON=""!($G(PRCPFLAG)) W !,"TOTALS BY SURGEON: ",SURGEON D TOTAL(^(SURGEON))
|
---|
26 | I $G(PRCPFLAG) Q
|
---|
27 | W !!,"TOTALS BY REPORT: " D TOTAL($G(^TMP($J,"PRCPRPCRT",6)))
|
---|
28 | ;
|
---|
29 | D END^PRCPUREP
|
---|
30 | Q
|
---|
31 | ;
|
---|
32 | ;
|
---|
33 | TOTAL(VALUES) ; show totals where value = count ^ cost
|
---|
34 | S AVERAGE=$S('$P(VALUES,"^"):"",1:$P(VALUES,"^",2)/$P(VALUES,"^"))
|
---|
35 | W ?46,$J(+$P(VALUES,"^"),10),$J($P(VALUES,"^",2),12,2),$J(AVERAGE,12,2)
|
---|
36 | I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H^PRCPRPC2
|
---|
37 | Q
|
---|