- 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 Apr 23, 2025@18:50:53 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
