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

RMPRPAT7.m

Go to the documentation of this file.
  1. RMPRPAT7 ;HINES-CIOFO/HNC DISPLAY NPPD KEY ITEMS CONSOLIDATED
  1. ;;3.0;PROSTHETICS;**32,34,35,77,162**;Feb 14, 1998;Build 5
  1. ;;
  1. ;RVD 3/18/03 patch #77 - only prints item for the same pt.
  1. N HCHCPS,HCHCPSD
  1. W !,?5,"PSAS HCPCS",?18,"DESCRIPTION",?48,"QTY",?52,"COST",?62,"ITEM"
  1. W !,RMPR("L") S HCTOT=0
  1. S HCREC=$P(IT(AN),U,1) Q:HCREC'>0
  1. S HC=$G(R19(660,HCREC,68,"E")) Q:HC=""
  1. S HC1=0
  1. F S HC1=$O(^TMP($J,"TTT",HC,HCREC,HC1)) Q:HC1'>0 D
  1. .Q:$P($G(^RMPR(660,HC1,0)),U,10)'=RMPR("STA") ;QUIT if different station;RMPR*3.0*162
  1. .S (HCHCPS,HCHCPSD)=""
  1. .I $P(^RMPR(660,HC1,0),U,2)'=RMPRDFN Q
  1. .S HCQTY=$P(^RMPR(660,HC1,0),U,7)
  1. .S HCCOST=$P(^RMPR(660,HC1,0),U,16)
  1. .S HCTOT=HCTOT+HCCOST
  1. .S HCRK=$P(^RMPR(660,HC1,0),U,6)
  1. .I HCRK S HCRK=$P(^RMPR(661,HCRK,0),U,1),HCRK=$P(^PRC(441,HCRK,0),U,2)
  1. .S HCHCP=$P($G(^RMPR(660,HC1,1)),U,4)
  1. .I HCHCP S HCHCPS=$P(^RMPR(661.1,HCHCP,0),U,1),HCHCPSD=$P(^(0),U,2)
  1. .I $P(^RMPR(660,HC1,0),U,17) S HCHCPSD="SHIPPING" ;modify descrip to shipping charge;RMPR*3.0*162
  1. .W !,?5,$G(HCHCPS),?18,$G(HCHCPSD)
  1. .W ?48,HCQTY
  1. .W ?52,"$"_$J($FN(HCCOST,"P",2),9)
  1. .W ?62,$E(HCRK,1,18)
  1. W !,?52,"========="
  1. W !,?52,"$"_$J($FN(HCTOT,"P",2),9)
  1. ;END