| 1 | RMPRPAT7 ;HINES-CIOFO/HNC DISPLAY NPPD KEY ITEMS CONSOLIDATED
|
|---|
| 2 | ;;3.0;PROSTHETICS;**32,34,35,77**;Feb 14, 1998
|
|---|
| 3 | ;;
|
|---|
| 4 | ;RVD 3/18/03 patch #77 - only prints item for the same pt.
|
|---|
| 5 | W !,?5,"PSAS HCPCS",?18,"DESCRIPTION",?48,"QTY",?52,"COST",?62,"ITEM"
|
|---|
| 6 | W !,RMPR("L") S HCTOT=0
|
|---|
| 7 | S HCREC=$P(IT(AN),U,1) Q:HCREC'>0
|
|---|
| 8 | S HC=$G(R19(660,HCREC,68,"E")) Q:HC=""
|
|---|
| 9 | S HC1=0
|
|---|
| 10 | F S HC1=$O(^RMPR(660,"AG",HC,HC1)) Q:HC1'>0 D
|
|---|
| 11 | .Q:$P($G(^RMPR(660,HC1,0)),U,10)'=RMPR("STA")
|
|---|
| 12 | .I $P(^RMPR(660,HC1,0),U,2)'=RMPRDFN Q
|
|---|
| 13 | .S HCQTY=$P(^RMPR(660,HC1,0),U,7)
|
|---|
| 14 | .S HCCOST=$P(^RMPR(660,HC1,0),U,16)
|
|---|
| 15 | .S HCTOT=HCTOT+HCCOST
|
|---|
| 16 | .S HCRK=$P(^RMPR(660,HC1,0),U,6)
|
|---|
| 17 | .I HCRK S HCRK=$P(^RMPR(661,HCRK,0),U,1),HCRK=$P(^PRC(441,HCRK,0),U,2)
|
|---|
| 18 | .S HCHCP=$P($G(^RMPR(660,HC1,1)),U,4)
|
|---|
| 19 | .I HCHCP S HCHCPS=$P(^RMPR(661.1,HCHCP,0),U,1),HCHCPSD=$P(^(0),U,2)
|
|---|
| 20 | .W !,?5,$G(HCHCPS),?18,$G(HCHCPSD)
|
|---|
| 21 | .W ?48,HCQTY
|
|---|
| 22 | .W ?52,"$"_$J($FN(HCCOST,"P",2),9)
|
|---|
| 23 | .W ?62,$E(HCRK,1,18)
|
|---|
| 24 | W !,?52,"========="
|
|---|
| 25 | W !,?52,"$"_$J($FN(HCTOT,"P",2),9)
|
|---|
| 26 | ;END
|
|---|
