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

RMPRPIUV.m

Go to the documentation of this file.
  1. RMPRPIUV ;HINCIO/ODJ - Get Current Stock for Vendors ;3/8/01
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. Q
  1. ; STOCK - For an entered Station, Location
  1. ; HCPCS and Item
  1. ; return an array of Vendors
  1. ; with quantity on hand and the unit cost for each Vendor.
  1. ;
  1. ; Inputs:
  1. ; RMPR - an array with the following elements...
  1. ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,)
  1. ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)
  1. ; RMPR("HCPCS") - HCPCS code (eg E0111)
  1. ; RMPR("ITEM") - HCPCS Item number (eg 1)
  1. ;
  1. ; Outputs:
  1. ; RMPRV - array of vendors
  1. ; piece 1 - Number of Vendors returned
  1. ; RMPRV(VENDOR IEN)
  1. ; piece 1 - Quantity on hand
  1. ; 2 - Unit cost
  1. ; 3 - Vendor Name
  1. ; (^ delimiter)
  1. ;
  1. ; RMPRERR - function return...
  1. ; 0 - no errors
  1. ; 1 - null Station ien input
  1. ; 2 - null Location ien input
  1. ; 3 - null HCPCS code input
  1. ; 4 - null Item input
  1. ; 5 - problem with 661.7 file
  1. ; 6 - problem with 661.6 file
  1. STOCK(RMPR,RMPRV) ;
  1. N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST,RMPRVS
  1. S RMPRERR=0
  1. K RMPRV
  1. S RMPRV=0
  1. S RMPRTCST=0
  1. S RMPRK("STATION")=$G(RMPR("STATION IEN"))
  1. I RMPRK("STATION")="" S RMPRERR=1 G STOCKX
  1. S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN"))
  1. I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX
  1. S RMPRK("HCPCS")=$G(RMPR("HCPCS"))
  1. I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX
  1. S RMPRK("ITEM")=$G(RMPR("ITEM"))
  1. I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX
  1. L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
  1. ;
  1. ; Loop on all records for Stn, Loc, HCPCS and Item
  1. STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
  1. I RMPRERR S RMPRERR=5 G STOCKU
  1. I RMPREOF G STOCKU
  1. I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU
  1. I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU
  1. I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU
  1. I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU
  1. K RMPR7 M RMPR7=RMPRK
  1. S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;get current stock record
  1. I RMPRERR S RMPRERR=5 G STOCKU
  1. S RMPR("IEN")=RMPR7("IEN")
  1. K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
  1. S RMPRERR=$$GET^RMPRPIX6(.RMPR6) ;get transaction record
  1. S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) ;get vendor ien
  1. I $D(RMPRV(RMPR6("VENDOR IEN"))) D
  1. . S RMPRVS=RMPRV(RMPR6("VENDOR IEN"))
  1. . S $P(RMPRVS,"^",1)=RMPR7("QUANTITY")+$P(RMPRVS,"^",1)
  1. . S $P(RMPRVS,"^",2)=RMPR7("VALUE")+$P(RMPRVS,"^",2)
  1. . Q
  1. E D
  1. . S RMPRV=RMPRV+1
  1. . S RMPRVS=RMPR7("QUANTITY")
  1. . S $P(RMPRVS,"^",2)=RMPR7("VALUE")
  1. . S $P(RMPRVS,"^",3)=RMPR6("VENDOR")
  1. . Q
  1. S RMPRV(RMPR6("VENDOR IEN"))=RMPRVS
  1. G STOCKA
  1. STOCKU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
  1. STOCKX Q RMPRERR