- 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 Feb 19, 2025@00:02:48 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