RMPRPIUD ;HINCIO/ODJ - 661.4 APIs ;3/8/01
;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
Q
;
; LEV - check re-order level for Station, Location, HCPCS Item
LEV(RMPR) ;
N RMPRERR
S RMPRERR=0
LEVX Q RMPRERR
;
; MES - generate MailMan message if item below re-order level
; at a given location.
; this version uses the same business rules as the old
; PIP routine RMPR5NU
;
; Inputs:
; XMY
MES(XMY) ;
N RMPRERR,RMPRLINE,RMPRNM,RMPRGBL,RMPRSTR,RMPROBAL,RMPRLEV,RMPRQOH
N XMSUB,XMDUZ,XMZ,RMPRTXT,RMPR5,RMPR11,RMPRORQ,X,Y,DA
S RMPRERR=0
S RMPRNM="RMPRPIUD"
K ^TMP($J,RMPRNM)
S RMPRERR=$$ALL(RMPRNM)
MESX Q RMPRERR
;
; Generate reorder notification for all Stations
ALL(RMPRNM) ;
N RMPRSTN,RMPRERR,I,J,RMITEM,RMLOC,RMQUA,RMSTN
S RMPRERR=0
I $G(RMPRNM)="" S RMPRNM="ALL-RMPRPIUD"
S (I,RMPRSTN)=""
;get current inventory from 661.7 for all HCPCS
F S I=$O(^RMPR(661.7,"B",I)) Q:I="" F J=0:0 S J=$O(^RMPR(661.7,"B",I,J)) Q:J'>0 D
.I $D(^RMPR(661.7,J,0)) S RMD7=^RMPR(661.7,J,0) D
..S RMITEM=$P(RMD7,U,4),RMLOC=$P(RMD7,U,6),RMSTN=$P(RMD7,U,5)
..S RMQUA=$P(RMD7,U,7)
..I $D(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC)) S $P(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)=$P(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)+RMQUA
..E S $P(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)=RMQUA
;get reorder level for all HCPCS
F S RMPRSTN=$O(^RMPR(661.4,"XSHIL",RMPRSTN)) Q:RMPRSTN="" D
. S RMPRERR=$$STN(RMPRNM,RMPRSTN)
. Q
ALLX Q RMPRERR
;
; Generate reorder/order position for single Station
STN(RMPRNM,RMPRSTN) ;
N RMPRERR,RMPRH,RMPRI,RMPRL,RMPRK,RMPROLD,RMPREOF,RMPRQFOR,RMPR7E
N RMPR7I,RMPRTQOH,RMPRTORQ,RMPRTREO,RMPRD,RMPR11,RMPR41,RMPRIEN,RML,RME
N RMDATA,RMREQUAN
S RMPRERR=0
I $G(RMPRNM)="" S RMPRNM="STN-RMPRPIUD"
S RMPRH=""
F S RMPRH=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH)) Q:RMPRH="" D
. F RMPRI=0:0 S RMPRI=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI)) Q:RMPRI'>0 D
.. ;set initial balance of re-order quantity
.. F RML=0:0 S RML=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML)) Q:RML'>0 D
... F RME=0:0 S RME=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML,RME)) Q:RME'>0 D
.... I RME,$D(^RMPR(661.4,RME,0)) S RMDATA=$G(^RMPR(661.4,RME,0))
.... S RMREQUAN=$P(RMDATA,U,4) Q:'$G(RMREQUAN)
.... S $P(^TMP($J,RMPRNM,RMPRSTN,RMPRH,RMPRI,"L",RML),U,1)=$G(RMREQUAN)
.. ;
.. ; Loop on open orders
.. F STS="O","R" S RMPRD="" F S RMPRD=$O(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRH,RMPRI,RMPRD)) Q:RMPRD="" D Q:RMPRERR
... S RMPRIEN=""
... F S RMPRIEN=$O(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRH,RMPRI,RMPRD,RMPRIEN)) Q:RMPRIEN="" D Q:RMPRERR
.... K RMPR41 S RMPR41("IEN")=RMPRIEN
.... S RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
.... I RMPRERR S RMPRERR=99 Q
.... I RMPR41("BALANCE QTY")<1 Q
.... S ^TMP($J,RMPRNM,RMPRSTN,RMPRH,RMPRI,"M",RMPRD,RMPRIEN)=RMPR41("ORDER QTY")_"^"_RMPR41("DATE ORDER")_"^"_RMPR41("RECEIVE QTY")
.... Q
... Q
.. Q
. Q
STNX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIUD 3013 printed Sep 23, 2025@20:12:33 Page 2
RMPRPIUD ;HINCIO/ODJ - 661.4 APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
+2 QUIT
+3 ;
+4 ; LEV - check re-order level for Station, Location, HCPCS Item
LEV(RMPR) ;
+1 NEW RMPRERR
+2 SET RMPRERR=0
LEVX QUIT RMPRERR
+1 ;
+2 ; MES - generate MailMan message if item below re-order level
+3 ; at a given location.
+4 ; this version uses the same business rules as the old
+5 ; PIP routine RMPR5NU
+6 ;
+7 ; Inputs:
+8 ; XMY
MES(XMY) ;
+1 NEW RMPRERR,RMPRLINE,RMPRNM,RMPRGBL,RMPRSTR,RMPROBAL,RMPRLEV,RMPRQOH
+2 NEW XMSUB,XMDUZ,XMZ,RMPRTXT,RMPR5,RMPR11,RMPRORQ,X,Y,DA
+3 SET RMPRERR=0
+4 SET RMPRNM="RMPRPIUD"
+5 KILL ^TMP($JOB,RMPRNM)
+6 SET RMPRERR=$$ALL(RMPRNM)
MESX QUIT RMPRERR
+1 ;
+2 ; Generate reorder notification for all Stations
ALL(RMPRNM) ;
+1 NEW RMPRSTN,RMPRERR,I,J,RMITEM,RMLOC,RMQUA,RMSTN
+2 SET RMPRERR=0
+3 IF $GET(RMPRNM)=""
SET RMPRNM="ALL-RMPRPIUD"
+4 SET (I,RMPRSTN)=""
+5 ;get current inventory from 661.7 for all HCPCS
+6 FOR
SET I=$ORDER(^RMPR(661.7,"B",I))
if I=""
QUIT
FOR J=0:0
SET J=$ORDER(^RMPR(661.7,"B",I,J))
if J'>0
QUIT
Begin DoDot:1
+7 IF $DATA(^RMPR(661.7,J,0))
SET RMD7=^RMPR(661.7,J,0)
Begin DoDot:2
+8 SET RMITEM=$PIECE(RMD7,U,4)
SET RMLOC=$PIECE(RMD7,U,6)
SET RMSTN=$PIECE(RMD7,U,5)
+9 SET RMQUA=$PIECE(RMD7,U,7)
+10 IF $DATA(^TMP($JOB,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC))
SET $PIECE(^TMP($JOB,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)=$PIECE(^TMP($JOB,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)+RMQUA
+11 IF '$TEST
SET $PIECE(^TMP($JOB,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)=RMQUA
End DoDot:2
End DoDot:1
+12 ;get reorder level for all HCPCS
+13 FOR
SET RMPRSTN=$ORDER(^RMPR(661.4,"XSHIL",RMPRSTN))
if RMPRSTN=""
QUIT
Begin DoDot:1
+14 SET RMPRERR=$$STN(RMPRNM,RMPRSTN)
+15 QUIT
End DoDot:1
ALLX QUIT RMPRERR
+1 ;
+2 ; Generate reorder/order position for single Station
STN(RMPRNM,RMPRSTN) ;
+1 NEW RMPRERR,RMPRH,RMPRI,RMPRL,RMPRK,RMPROLD,RMPREOF,RMPRQFOR,RMPR7E
+2 NEW RMPR7I,RMPRTQOH,RMPRTORQ,RMPRTREO,RMPRD,RMPR11,RMPR41,RMPRIEN,RML,RME
+3 NEW RMDATA,RMREQUAN
+4 SET RMPRERR=0
+5 IF $GET(RMPRNM)=""
SET RMPRNM="STN-RMPRPIUD"
+6 SET RMPRH=""
+7 FOR
SET RMPRH=$ORDER(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH))
if RMPRH=""
QUIT
Begin DoDot:1
+8 FOR RMPRI=0:0
SET RMPRI=$ORDER(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI))
if RMPRI'>0
QUIT
Begin DoDot:2
+9 ;set initial balance of re-order quantity
+10 FOR RML=0:0
SET RML=$ORDER(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML))
if RML'>0
QUIT
Begin DoDot:3
+11 FOR RME=0:0
SET RME=$ORDER(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML,RME))
if RME'>0
QUIT
Begin DoDot:4
+12 IF RME
IF $DATA(^RMPR(661.4,RME,0))
SET RMDATA=$GET(^RMPR(661.4,RME,0))
+13 SET RMREQUAN=$PIECE(RMDATA,U,4)
if '$GET(RMREQUAN)
QUIT
+14 SET $PIECE(^TMP($JOB,RMPRNM,RMPRSTN,RMPRH,RMPRI,"L",RML),U,1)=$GET(RMREQUAN)
End DoDot:4
End DoDot:3
+15 ;
+16 ; Loop on open orders
+17 FOR STS="O","R"
SET RMPRD=""
FOR
SET RMPRD=$ORDER(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRH,RMPRI,RMPRD))
if RMPRD=""
QUIT
Begin DoDot:3
+18 SET RMPRIEN=""
+19 FOR
SET RMPRIEN=$ORDER(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRH,RMPRI,RMPRD,RMPRIEN))
if RMPRIEN=""
QUIT
Begin DoDot:4
+20 KILL RMPR41
SET RMPR41("IEN")=RMPRIEN
+21 SET RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
+22 IF RMPRERR
SET RMPRERR=99
QUIT
+23 IF RMPR41("BALANCE QTY")<1
QUIT
+24 SET ^TMP($JOB,RMPRNM,RMPRSTN,RMPRH,RMPRI,"M",RMPRD,RMPRIEN)=RMPR41("ORDER QTY")_"^"_RMPR41("DATE ORDER")_"^"_RMPR41("RECEIVE QTY")
+25 QUIT
End DoDot:4
if RMPRERR
QUIT
+26 QUIT
End DoDot:3
if RMPRERR
QUIT
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
STNX QUIT RMPRERR
