| [613] | 1 | RMPRPIUD ;HINCIO/ODJ - 661.4 APIs ;3/8/01
|
|---|
| 2 | ;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ; LEV - check re-order level for Station, Location, HCPCS Item
|
|---|
| 6 | LEV(RMPR) ;
|
|---|
| 7 | N RMPRERR
|
|---|
| 8 | S RMPRERR=0
|
|---|
| 9 | LEVX Q RMPRERR
|
|---|
| 10 | ;
|
|---|
| 11 | ; MES - generate MailMan message if item below re-order level
|
|---|
| 12 | ; at a given location.
|
|---|
| 13 | ; this version uses the same business rules as the old
|
|---|
| 14 | ; PIP routine RMPR5NU
|
|---|
| 15 | ;
|
|---|
| 16 | ; Inputs:
|
|---|
| 17 | ; XMY
|
|---|
| 18 | MES(XMY) ;
|
|---|
| 19 | N RMPRERR,RMPRLINE,RMPRNM,RMPRGBL,RMPRSTR,RMPROBAL,RMPRLEV,RMPRQOH
|
|---|
| 20 | N XMSUB,XMDUZ,XMZ,RMPRTXT,RMPR5,RMPR11,RMPRORQ,X,Y,DA
|
|---|
| 21 | S RMPRERR=0
|
|---|
| 22 | S RMPRNM="RMPRPIUD"
|
|---|
| 23 | K ^TMP($J,RMPRNM)
|
|---|
| 24 | S RMPRERR=$$ALL(RMPRNM)
|
|---|
| 25 | MESX Q RMPRERR
|
|---|
| 26 | ;
|
|---|
| 27 | ; Generate reorder notification for all Stations
|
|---|
| 28 | ALL(RMPRNM) ;
|
|---|
| 29 | N RMPRSTN,RMPRERR,I,J,RMITEM,RMLOC,RMQUA,RMSTN
|
|---|
| 30 | S RMPRERR=0
|
|---|
| 31 | I $G(RMPRNM)="" S RMPRNM="ALL-RMPRPIUD"
|
|---|
| 32 | S (I,RMPRSTN)=""
|
|---|
| 33 | ;get current inventory from 661.7 for all HCPCS
|
|---|
| 34 | 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
|
|---|
| 35 | .I $D(^RMPR(661.7,J,0)) S RMD7=^RMPR(661.7,J,0) D
|
|---|
| 36 | ..S RMITEM=$P(RMD7,U,4),RMLOC=$P(RMD7,U,6),RMSTN=$P(RMD7,U,5)
|
|---|
| 37 | ..S RMQUA=$P(RMD7,U,7)
|
|---|
| 38 | ..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
|
|---|
| 39 | ..E S $P(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)=RMQUA
|
|---|
| 40 | ;get reorder level for all HCPCS
|
|---|
| 41 | F S RMPRSTN=$O(^RMPR(661.4,"XSHIL",RMPRSTN)) Q:RMPRSTN="" D
|
|---|
| 42 | . S RMPRERR=$$STN(RMPRNM,RMPRSTN)
|
|---|
| 43 | . Q
|
|---|
| 44 | ALLX Q RMPRERR
|
|---|
| 45 | ;
|
|---|
| 46 | ; Generate reorder/order position for single Station
|
|---|
| 47 | STN(RMPRNM,RMPRSTN) ;
|
|---|
| 48 | N RMPRERR,RMPRH,RMPRI,RMPRL,RMPRK,RMPROLD,RMPREOF,RMPRQFOR,RMPR7E
|
|---|
| 49 | N RMPR7I,RMPRTQOH,RMPRTORQ,RMPRTREO,RMPRD,RMPR11,RMPR41,RMPRIEN,RML,RME
|
|---|
| 50 | N RMDATA,RMREQUAN
|
|---|
| 51 | S RMPRERR=0
|
|---|
| 52 | I $G(RMPRNM)="" S RMPRNM="STN-RMPRPIUD"
|
|---|
| 53 | S RMPRH=""
|
|---|
| 54 | F S RMPRH=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH)) Q:RMPRH="" D
|
|---|
| 55 | . F RMPRI=0:0 S RMPRI=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI)) Q:RMPRI'>0 D
|
|---|
| 56 | .. ;set initial balance of re-order quantity
|
|---|
| 57 | .. F RML=0:0 S RML=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML)) Q:RML'>0 D
|
|---|
| 58 | ... F RME=0:0 S RME=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML,RME)) Q:RME'>0 D
|
|---|
| 59 | .... I RME,$D(^RMPR(661.4,RME,0)) S RMDATA=$G(^RMPR(661.4,RME,0))
|
|---|
| 60 | .... S RMREQUAN=$P(RMDATA,U,4) Q:'$G(RMREQUAN)
|
|---|
| 61 | .... S $P(^TMP($J,RMPRNM,RMPRSTN,RMPRH,RMPRI,"L",RML),U,1)=$G(RMREQUAN)
|
|---|
| 62 | .. ;
|
|---|
| 63 | .. ; Loop on open orders
|
|---|
| 64 | .. F STS="O","R" S RMPRD="" F S RMPRD=$O(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRH,RMPRI,RMPRD)) Q:RMPRD="" D Q:RMPRERR
|
|---|
| 65 | ... S RMPRIEN=""
|
|---|
| 66 | ... F S RMPRIEN=$O(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRH,RMPRI,RMPRD,RMPRIEN)) Q:RMPRIEN="" D Q:RMPRERR
|
|---|
| 67 | .... K RMPR41 S RMPR41("IEN")=RMPRIEN
|
|---|
| 68 | .... S RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
|
|---|
| 69 | .... I RMPRERR S RMPRERR=99 Q
|
|---|
| 70 | .... I RMPR41("BALANCE QTY")<1 Q
|
|---|
| 71 | .... S ^TMP($J,RMPRNM,RMPRSTN,RMPRH,RMPRI,"M",RMPRD,RMPRIEN)=RMPR41("ORDER QTY")_"^"_RMPR41("DATE ORDER")_"^"_RMPR41("RECEIVE QTY")
|
|---|
| 72 | .... Q
|
|---|
| 73 | ... Q
|
|---|
| 74 | .. Q
|
|---|
| 75 | . Q
|
|---|
| 76 | STNX Q RMPRERR
|
|---|
