RMPRPIUA ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; SCAN - If scanned an item's barcode locate record from
; Prosthetic Current Stock file 661.7
;
; Inputs:
; RMPR7 - array containing...
; RMPR7("STATION") - Station ien
; RMPR7("HCPCS") - HCPCS code (contained in bar code)
; RMPR7("DATE&TIME") - Date&Time (contained in bar code)
;
; Outputs:
; RMPR7 - complete array for the 661.7 record read (if any)...
; RMPR7("IEN")
; RMPR7("STATION") - Station Name
; (nb will now be in external form)
; RMPR7("HCPCS") -
; RMPR7("SEQUENCE") -
; RMPR7("HCPCS ITEM") -
; RMPR7("LOCATION") -
; RMPR7("QUANTITY") -
; RMPR7("VALUE") -
; RMPR7("UNIT") -
;
; RMPREXC - exit condition
; 0 - normal, everything ok
; 1 - multi-instance but with station match (RMPR7 set)
; 2 - single instance but with
; station mis-match (RMPR7 set)
; 3 - multi-instance and station mis-match (RMPR7 not set)
; RMPRERR - error code returned by function
; 0 - no error
; 1 - null HCPCS input
; 2 - null Date&Time entered
; 3 - corrupt file (sequence but no ien)
; 4 - corrupt file (ien but no record)
; 5 - error reading 661.7
; 99 - no instances found for input HCPCS and Date&Time
SCAN(RMPR7,RMPREXC) ;
N RMPRERR,RMPRC,RMPRSEQ,RMPRIEN,RMPRS,RMPRIEN1,RMPRIEN2,RMPRDTTM
S RMPRERR=0
S RMPREXC=0
S RMPR7("STATION")=$G(RMPR7("STATION"))
I $G(RMPR7("HCPCS"))="" S RMPRERR=1 G SCANX
I $G(RMPR7("DATE&TIME"))="" S RMPRERR=2 G SCANX
S RMPRDTTM=RMPR7("DATE&TIME")
S RMPRC=0,RMPRIEN1="",RMPRIEN2="",RMPR7("IEN")=""
S RMPRSEQ=""
;
; Get ien for current stock record
; Record number of instances for same HCPCS and Date&Time in
; RMPRC (more than 1 should be very, very rare)
; RMPRIEN1 is IEN for first instance
; RMPRIEN2 is ien for any instance with station ien matching input
L +^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM)
F S RMPRSEQ=$O(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ)) Q:RMPRSEQ="" D Q:RMPRERR
. S RMPRIEN=$O(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ,""))
. I RMPRIEN="" S RMPRERR=3 Q
. I '$D(^RMPR(661.7,RMPRIEN,0)) S RMPRERR=4 Q
. S RMPRS=^RMPR(661.7,RMPRIEN,0)
. S RMPRC=RMPRC+1
. S RMPR7("UNIT")=$P(RMPRS,U,9)
. I RMPR7("STATION")=$P(RMPRS,"^",5) S RMPRIEN2=RMPRIEN
. I RMPRC=1 S RMPRIEN1=RMPRIEN
. Q
I RMPRERR G SCANU
I 'RMPRC S RMPRERR=99 G SCANU
;
; Set exit condition
I RMPRC>1 D
. I RMPRIEN2'="" S RMPR7("IEN")=RMPRIEN2,RMPREXC=1
. E S RMPREXC=3
. Q
E D
. I RMPRIEN2="" S RMPREXC=2
. S RMPR7("IEN")=RMPRIEN1
. Q
I RMPR7("IEN")'="" D
. S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
. I RMPRERR S RMPRERR=5
. Q
SCANU L -^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM)
SCANX Q RMPRERR
;
; STOCK - For an entered Station, Location, HCPCS and Item return
; total quantity on hand for that item, the average unit cost
; and the vendor. If more than one vendor, use the first one.
;
; Inputs:
; RMPR - an array with the following elements...
; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,)
; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)
; RMPR("HCPCS") - HCPCS code (eg E0111)
; RMPR("ITEM") - HCPCS Item number (eg 1)
;
; Outputs:
; RMPR - additional elements to the input RMPR array
; RMPR("QOH") - Quantity on hand
; RMPR("UNIT COST") - Unit cost per Item
; RMPR("VENDOR") - Vendor Name
; RMPR("VENDOR IEN") - Vendor ien
;
; RMPRERR - function return...
; 0 - no errors
; 1 - null Station ien input
; 2 - null Location ien input
; 3 - null HCPCS code input
; 4 - null Item input
; 5 - problem with 661.7 file
; 6 - problem with 661.6 file
STOCK(RMPR) ;
N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST
S RMPRERR=0
S RMPRTCST=0
S RMPR("QOH")=0
S RMPR("UNIT COST")=0
S RMPR("VENDOR")=""
S RMPR("VENDOR IEN")=""
S RMPRK("STATION")=$G(RMPR("STATION IEN"))
I RMPRK("STATION")="" S RMPRERR=1 G STOCKX
S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN"))
I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX
S RMPRK("HCPCS")=$G(RMPR("HCPCS"))
I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX
S RMPRK("ITEM")=$G(RMPR("ITEM"))
I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX
L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
;
; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst
STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
I RMPRERR S RMPRERR=5 G STOCKU
I RMPREOF G STOCKU
I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU
I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU
I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU
I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU
K RMPR7 M RMPR7=RMPRK
S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
I RMPRERR S RMPRERR=5 G STOCKU
S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
S RMPRTCST=RMPRTCST+RMPR7("VALUE")
I RMPR("VENDOR IEN")="" D G:RMPRERR STOCKU
. K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
. S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
. I RMPRERR S RMPRERR=6 Q
. S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
. I RMPRERR S RMPRERR=6 Q
. S RMPR("VENDOR")=RMPR6("VENDOR")
. S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
. Q
G STOCKA
STOCKU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
I RMPR("QOH") S RMPR("UNIT COST")=RMPRTCST/RMPR("QOH")
STOCKX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIUA 5850 printed Sep 23, 2025@20:12:30 Page 2
RMPRPIUA ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; SCAN - If scanned an item's barcode locate record from
+5 ; Prosthetic Current Stock file 661.7
+6 ;
+7 ; Inputs:
+8 ; RMPR7 - array containing...
+9 ; RMPR7("STATION") - Station ien
+10 ; RMPR7("HCPCS") - HCPCS code (contained in bar code)
+11 ; RMPR7("DATE&TIME") - Date&Time (contained in bar code)
+12 ;
+13 ; Outputs:
+14 ; RMPR7 - complete array for the 661.7 record read (if any)...
+15 ; RMPR7("IEN")
+16 ; RMPR7("STATION") - Station Name
+17 ; (nb will now be in external form)
+18 ; RMPR7("HCPCS") -
+19 ; RMPR7("SEQUENCE") -
+20 ; RMPR7("HCPCS ITEM") -
+21 ; RMPR7("LOCATION") -
+22 ; RMPR7("QUANTITY") -
+23 ; RMPR7("VALUE") -
+24 ; RMPR7("UNIT") -
+25 ;
+26 ; RMPREXC - exit condition
+27 ; 0 - normal, everything ok
+28 ; 1 - multi-instance but with station match (RMPR7 set)
+29 ; 2 - single instance but with
+30 ; station mis-match (RMPR7 set)
+31 ; 3 - multi-instance and station mis-match (RMPR7 not set)
+32 ; RMPRERR - error code returned by function
+33 ; 0 - no error
+34 ; 1 - null HCPCS input
+35 ; 2 - null Date&Time entered
+36 ; 3 - corrupt file (sequence but no ien)
+37 ; 4 - corrupt file (ien but no record)
+38 ; 5 - error reading 661.7
+39 ; 99 - no instances found for input HCPCS and Date&Time
SCAN(RMPR7,RMPREXC) ;
+1 NEW RMPRERR,RMPRC,RMPRSEQ,RMPRIEN,RMPRS,RMPRIEN1,RMPRIEN2,RMPRDTTM
+2 SET RMPRERR=0
+3 SET RMPREXC=0
+4 SET RMPR7("STATION")=$GET(RMPR7("STATION"))
+5 IF $GET(RMPR7("HCPCS"))=""
SET RMPRERR=1
GOTO SCANX
+6 IF $GET(RMPR7("DATE&TIME"))=""
SET RMPRERR=2
GOTO SCANX
+7 SET RMPRDTTM=RMPR7("DATE&TIME")
+8 SET RMPRC=0
SET RMPRIEN1=""
SET RMPRIEN2=""
SET RMPR7("IEN")=""
+9 SET RMPRSEQ=""
+10 ;
+11 ; Get ien for current stock record
+12 ; Record number of instances for same HCPCS and Date&Time in
+13 ; RMPRC (more than 1 should be very, very rare)
+14 ; RMPRIEN1 is IEN for first instance
+15 ; RMPRIEN2 is ien for any instance with station ien matching input
+16 LOCK +^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM)
+17 FOR
SET RMPRSEQ=$ORDER(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ))
if RMPRSEQ=""
QUIT
Begin DoDot:1
+18 SET RMPRIEN=$ORDER(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ,""))
+19 IF RMPRIEN=""
SET RMPRERR=3
QUIT
+20 IF '$DATA(^RMPR(661.7,RMPRIEN,0))
SET RMPRERR=4
QUIT
+21 SET RMPRS=^RMPR(661.7,RMPRIEN,0)
+22 SET RMPRC=RMPRC+1
+23 SET RMPR7("UNIT")=$PIECE(RMPRS,U,9)
+24 IF RMPR7("STATION")=$PIECE(RMPRS,"^",5)
SET RMPRIEN2=RMPRIEN
+25 IF RMPRC=1
SET RMPRIEN1=RMPRIEN
+26 QUIT
End DoDot:1
if RMPRERR
QUIT
+27 IF RMPRERR
GOTO SCANU
+28 IF 'RMPRC
SET RMPRERR=99
GOTO SCANU
+29 ;
+30 ; Set exit condition
+31 IF RMPRC>1
Begin DoDot:1
+32 IF RMPRIEN2'=""
SET RMPR7("IEN")=RMPRIEN2
SET RMPREXC=1
+33 IF '$TEST
SET RMPREXC=3
+34 QUIT
End DoDot:1
+35 IF '$TEST
Begin DoDot:1
+36 IF RMPRIEN2=""
SET RMPREXC=2
+37 SET RMPR7("IEN")=RMPRIEN1
+38 QUIT
End DoDot:1
+39 IF RMPR7("IEN")'=""
Begin DoDot:1
+40 SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+41 IF RMPRERR
SET RMPRERR=5
+42 QUIT
End DoDot:1
SCANU LOCK -^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM)
SCANX QUIT RMPRERR
+1 ;
+2 ; STOCK - For an entered Station, Location, HCPCS and Item return
+3 ; total quantity on hand for that item, the average unit cost
+4 ; and the vendor. If more than one vendor, use the first one.
+5 ;
+6 ; Inputs:
+7 ; RMPR - an array with the following elements...
+8 ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,)
+9 ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)
+10 ; RMPR("HCPCS") - HCPCS code (eg E0111)
+11 ; RMPR("ITEM") - HCPCS Item number (eg 1)
+12 ;
+13 ; Outputs:
+14 ; RMPR - additional elements to the input RMPR array
+15 ; RMPR("QOH") - Quantity on hand
+16 ; RMPR("UNIT COST") - Unit cost per Item
+17 ; RMPR("VENDOR") - Vendor Name
+18 ; RMPR("VENDOR IEN") - Vendor ien
+19 ;
+20 ; RMPRERR - function return...
+21 ; 0 - no errors
+22 ; 1 - null Station ien input
+23 ; 2 - null Location ien input
+24 ; 3 - null HCPCS code input
+25 ; 4 - null Item input
+26 ; 5 - problem with 661.7 file
+27 ; 6 - problem with 661.6 file
STOCK(RMPR) ;
+1 NEW RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST
+2 SET RMPRERR=0
+3 SET RMPRTCST=0
+4 SET RMPR("QOH")=0
+5 SET RMPR("UNIT COST")=0
+6 SET RMPR("VENDOR")=""
+7 SET RMPR("VENDOR IEN")=""
+8 SET RMPRK("STATION")=$GET(RMPR("STATION IEN"))
+9 IF RMPRK("STATION")=""
SET RMPRERR=1
GOTO STOCKX
+10 SET RMPRK("LOCATION")=$GET(RMPR("LOCATION IEN"))
+11 IF RMPRK("LOCATION")=""
SET RMPRERR=2
GOTO STOCKX
+12 SET RMPRK("HCPCS")=$GET(RMPR("HCPCS"))
+13 IF RMPRK("HCPCS")=""
SET RMPRERR=3
GOTO STOCKX
+14 SET RMPRK("ITEM")=$GET(RMPR("ITEM"))
+15 IF RMPRK("ITEM")=""
SET RMPRERR=4
GOTO STOCKX
+16 LOCK +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
+17 ;
+18 ; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst
STOCKA SET RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
+1 IF RMPRERR
SET RMPRERR=5
GOTO STOCKU
+2 IF RMPREOF
GOTO STOCKU
+3 IF RMPRK("ITEM")'=RMPROLD("ITEM")
GOTO STOCKU
+4 IF RMPRK("HCPCS")'=RMPROLD("HCPCS")
GOTO STOCKU
+5 IF RMPRK("LOCATION")'=RMPROLD("LOCATION")
GOTO STOCKU
+6 IF RMPRK("STATION")'=RMPROLD("STATION")
GOTO STOCKU
+7 KILL RMPR7
MERGE RMPR7=RMPRK
+8 SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+9 IF RMPRERR
SET RMPRERR=5
GOTO STOCKU
+10 SET RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH")
+11 SET RMPRTCST=RMPRTCST+RMPR7("VALUE")
+12 IF RMPR("VENDOR IEN")=""
Begin DoDot:1
+13 KILL RMPR6
MERGE RMPR6=RMPRK
SET RMPR6("IEN")=""
+14 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
+15 IF RMPRERR
SET RMPRERR=6
QUIT
+16 SET RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
+17 IF RMPRERR
SET RMPRERR=6
QUIT
+18 SET RMPR("VENDOR")=RMPR6("VENDOR")
+19 SET RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
+20 QUIT
End DoDot:1
if RMPRERR
GOTO STOCKU
+21 GOTO STOCKA
STOCKU LOCK -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))
+1 IF RMPR("QOH")
SET RMPR("UNIT COST")=RMPRTCST/RMPR("QOH")
STOCKX QUIT RMPRERR
