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