RMPRPIXF ;HINES OIFO/ODJ - Cont of EI - Edit Locations ;10/7/02 14:46
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** TRANS - Modify current stock record
TRANS K RMPR7M,RMPR6M
;
I $G(RMHCC) D Q
.;call deactivate the item
.N RS,RL,RD,RV,R6
.S RS=RMPR11("STATION"),RL=RMPR5("IEN"),RD=RMPR7("DATE&TIME")
.S RMPR6("QUANTITY")=0
.S R6=$O(^RMPR(661.6,"ASLD",RS,RL,RD,0)) I $D(^RMPR(661.6,R6,0)) S RV=$P(^RMPR(661.6,R6,0),U,12)
.Q:'$G(RV)
.S RMPR6("VENDOR")=RV
.S RMPR6("VENDOR IEN")=RV
.S RMPR11("HCPCS")=RH,RMPR11("ITEM")=RI,RMPR5("IEN")=RL
.S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5)
.I RMPRERR=1 W !!,"*** ERROR IN API RMPRPIU9 ***",!
.;create a new entry
.S RMPR11("STATION")=RMPRSTN("IEN")
.S RMPR11("STATION IEN")=RMPRSTN("IEN")
.S RMPR6("QUANTITY")=RMPRQTY
.S RMPR6("VALUE")=RMPRTVAL
.S RMPR6("VENDOR")=RMPRVEND("IEN")
.S RMPR6("UNIT")=RMPRUNI("IEN")
.S RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1) ;receipt API
.I RMPRERR D
.. W !!,"** Inventory could not be updated, please contact support",!
.. Q
.E D
.. W !!,"** Inventory updated.",!
.K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST
;
; Modify Vendor in the 661.6 transaction record if changed
I RMPRVEND("IEN")'=RMPR6("VENDOR IEN") D
. S RMPR6M("VENDOR")=RMPRVEND("IEN")
. S RMPR6M("IEN")=RMPR6("IEN")
. S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)
. K RMPR6M
. Q
K RMPR6I
S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
;
;if unit of issue changed
I RMPRUNI("UNIT")'=RMPR7("UNIT") S RMPR7M("UNIT")=RMPRUNI("UNIT") D
. S RMPR7M("IEN")=RMPR7("IEN")
. S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)
; Modify Location in 661.6 and 661.7 if changed
I RMPR6I("LOCATION")'=RMPR5("IEN") D
. S RMPR6M("LOCATION")=RMPR5("IEN")
. S RMPR6M("IEN")=RMPR6("IEN")
. S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)
. S RMPR7M("LOCATION")=RMPR5("IEN")
. S RMPR7M("IEN")=RMPR7("IEN")
. S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)
. K RMPR6M,RMPR7M
. Q
;
; Modify Quantity or Value in current stock 661.7 record, the
; transaction record 661.6 and running balance 661.9, if changed
I +RMPRQTY'=+RMPR6("QUANTITY")!(+RMPRTVAL'=+RMPR6("VALUE")) D
. K RMPR69,RMPR9M
. I RMPR6I("TRAN TYPE")=9 D
.. S RMPR69("TRANS IEN")=RMPR6("IEN")
.. S RMPRERR=$$GET^RMPRPIXB(.RMPR69)
.. Q
. S (RMPR9M("TQTY"),RMPR9M("TCST"),RMPRGLQ,RMPRGLAM)=0
. I +RMPRQTY'=+RMPR6("QUANTITY") D Q:RMPR7M("QUANTITY")<0
.. S RMPR6M("QUANTITY")=RMPRQTY
.. S RMPRGLQ=RMPRQTY-RMPR6("QUANTITY")
.. S RMPR7M("QUANTITY")=RMPR7("QUANTITY")+RMPRGLQ
.. S RMPR9M("TQTY")=RMPRGLQ
.. S:$D(RMPR69) RMPR69("GAIN/LOSS")=RMPR69("GAIN/LOSS")+RMPRGLQ
.. Q
. I +RMPRTVAL'=+RMPR6("VALUE") D
.. S RMPR6M("VALUE")=RMPRTVAL
.. S RMPRGLAM=RMPRTVAL-RMPR6("VALUE")
.. S RMPR7M("VALUE")=RMPR7("VALUE")+RMPRGLAM,RMPR7M("VALUE")=$J(RMPR7M("VALUE"),0,2)
.. S RMPR9M("TCST")=RMPRGLAM
.. S:$D(RMPR69) RMPR69("GAIN/LOSS VALUE")=RMPR69("GAIN/LOSS VALUE")+RMPRGLAM
.. Q
. S RMPR7M("IEN")=RMPR7("IEN")
. S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)
. S RMPR6M("IEN")=RMPR6("IEN")
. S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)
. I $D(RMPR69) S RMPRERR=$$UPD^RMPRPIXB(.RMPR69)
. S RMPR9M("STA")=RMPRSTN("IEN")
. S RMPR9M("HCP")=RMPR11("HCPCS")
. S RMPR9M("ITE")=RMPR11("ITEM")
. S RMPRERR=$$DTIEN^RMPRPIX6(.RMPR6)
. S RMPR9M("RDT")=$P(RMPR6("DATE&TIME"),".",1)
. S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9M)
. K RMPR7M,RMPR6M,RMPR9M
. Q
I $D(RMPR7M("QUANTITY")),RMPR7M("QUANTITY")<1 D G QTY^RMPRPIY6
. W !,"The quantity cannot be allowed because it would cause a",!
. W "negative on hand quantity.",!
. W "Please check your inventory and use the reconciliation option",!
. W "as needed.",!
. Q
TRANSX I 'RMPRERR D
. W !!,"** Item "
. W RMPR11("HCPCS-ITEM")
. W " was "
. W "Edited by "
. W $$GETUSR^RMPRPIU0(DUZ)
. W:$D(RMPRGLQ) ": ("_$S(RMPRGLQ>0:"+",1:"")_RMPRGLQ_")"
. W " @ Location ",RMPR5("NAME")
. Q
E D
. W !!,"** The Item could not be modified due to a problem - please contact support"
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIXF 4012 printed Dec 13, 2024@02:36:44 Page 2
RMPRPIXF ;HINES OIFO/ODJ - Cont of EI - Edit Locations ;10/7/02 14:46
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** TRANS - Modify current stock record
TRANS KILL RMPR7M,RMPR6M
+1 ;
+2 IF $GET(RMHCC)
Begin DoDot:1
+3 ;call deactivate the item
+4 NEW RS,RL,RD,RV,R6
+5 SET RS=RMPR11("STATION")
SET RL=RMPR5("IEN")
SET RD=RMPR7("DATE&TIME")
+6 SET RMPR6("QUANTITY")=0
+7 SET R6=$ORDER(^RMPR(661.6,"ASLD",RS,RL,RD,0))
IF $DATA(^RMPR(661.6,R6,0))
SET RV=$PIECE(^RMPR(661.6,R6,0),U,12)
+8 if '$GET(RV)
QUIT
+9 SET RMPR6("VENDOR")=RV
+10 SET RMPR6("VENDOR IEN")=RV
+11 SET RMPR11("HCPCS")=RH
SET RMPR11("ITEM")=RI
SET RMPR5("IEN")=RL
+12 SET RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5)
+13 IF RMPRERR=1
WRITE !!,"*** ERROR IN API RMPRPIU9 ***",!
+14 ;create a new entry
+15 SET RMPR11("STATION")=RMPRSTN("IEN")
+16 SET RMPR11("STATION IEN")=RMPRSTN("IEN")
+17 SET RMPR6("QUANTITY")=RMPRQTY
+18 SET RMPR6("VALUE")=RMPRTVAL
+19 SET RMPR6("VENDOR")=RMPRVEND("IEN")
+20 SET RMPR6("UNIT")=RMPRUNI("IEN")
+21 ;receipt API
SET RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1)
+22 IF RMPRERR
Begin DoDot:2
+23 WRITE !!,"** Inventory could not be updated, please contact support",!
+24 QUIT
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 WRITE !!,"** Inventory updated.",!
End DoDot:2
+27 KILL RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST
End DoDot:1
QUIT
+28 ;
+29 ; Modify Vendor in the 661.6 transaction record if changed
+30 IF RMPRVEND("IEN")'=RMPR6("VENDOR IEN")
Begin DoDot:1
+31 SET RMPR6M("VENDOR")=RMPRVEND("IEN")
+32 SET RMPR6M("IEN")=RMPR6("IEN")
+33 SET RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)
+34 KILL RMPR6M
+35 QUIT
End DoDot:1
+36 KILL RMPR6I
+37 SET RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
+38 ;
+39 ;if unit of issue changed
+40 IF RMPRUNI("UNIT")'=RMPR7("UNIT")
SET RMPR7M("UNIT")=RMPRUNI("UNIT")
Begin DoDot:1
+41 SET RMPR7M("IEN")=RMPR7("IEN")
+42 SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)
End DoDot:1
+43 ; Modify Location in 661.6 and 661.7 if changed
+44 IF RMPR6I("LOCATION")'=RMPR5("IEN")
Begin DoDot:1
+45 SET RMPR6M("LOCATION")=RMPR5("IEN")
+46 SET RMPR6M("IEN")=RMPR6("IEN")
+47 SET RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)
+48 SET RMPR7M("LOCATION")=RMPR5("IEN")
+49 SET RMPR7M("IEN")=RMPR7("IEN")
+50 SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)
+51 KILL RMPR6M,RMPR7M
+52 QUIT
End DoDot:1
+53 ;
+54 ; Modify Quantity or Value in current stock 661.7 record, the
+55 ; transaction record 661.6 and running balance 661.9, if changed
+56 IF +RMPRQTY'=+RMPR6("QUANTITY")!(+RMPRTVAL'=+RMPR6("VALUE"))
Begin DoDot:1
+57 KILL RMPR69,RMPR9M
+58 IF RMPR6I("TRAN TYPE")=9
Begin DoDot:2
+59 SET RMPR69("TRANS IEN")=RMPR6("IEN")
+60 SET RMPRERR=$$GET^RMPRPIXB(.RMPR69)
+61 QUIT
End DoDot:2
+62 SET (RMPR9M("TQTY"),RMPR9M("TCST"),RMPRGLQ,RMPRGLAM)=0
+63 IF +RMPRQTY'=+RMPR6("QUANTITY")
Begin DoDot:2
+64 SET RMPR6M("QUANTITY")=RMPRQTY
+65 SET RMPRGLQ=RMPRQTY-RMPR6("QUANTITY")
+66 SET RMPR7M("QUANTITY")=RMPR7("QUANTITY")+RMPRGLQ
+67 SET RMPR9M("TQTY")=RMPRGLQ
+68 if $DATA(RMPR69)
SET RMPR69("GAIN/LOSS")=RMPR69("GAIN/LOSS")+RMPRGLQ
+69 QUIT
End DoDot:2
if RMPR7M("QUANTITY")<0
QUIT
+70 IF +RMPRTVAL'=+RMPR6("VALUE")
Begin DoDot:2
+71 SET RMPR6M("VALUE")=RMPRTVAL
+72 SET RMPRGLAM=RMPRTVAL-RMPR6("VALUE")
+73 SET RMPR7M("VALUE")=RMPR7("VALUE")+RMPRGLAM
SET RMPR7M("VALUE")=$JUSTIFY(RMPR7M("VALUE"),0,2)
+74 SET RMPR9M("TCST")=RMPRGLAM
+75 if $DATA(RMPR69)
SET RMPR69("GAIN/LOSS VALUE")=RMPR69("GAIN/LOSS VALUE")+RMPRGLAM
+76 QUIT
End DoDot:2
+77 SET RMPR7M("IEN")=RMPR7("IEN")
+78 SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,)
+79 SET RMPR6M("IEN")=RMPR6("IEN")
+80 SET RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,)
+81 IF $DATA(RMPR69)
SET RMPRERR=$$UPD^RMPRPIXB(.RMPR69)
+82 SET RMPR9M("STA")=RMPRSTN("IEN")
+83 SET RMPR9M("HCP")=RMPR11("HCPCS")
+84 SET RMPR9M("ITE")=RMPR11("ITEM")
+85 SET RMPRERR=$$DTIEN^RMPRPIX6(.RMPR6)
+86 SET RMPR9M("RDT")=$PIECE(RMPR6("DATE&TIME"),".",1)
+87 SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9M)
+88 KILL RMPR7M,RMPR6M,RMPR9M
+89 QUIT
End DoDot:1
+90 IF $DATA(RMPR7M("QUANTITY"))
IF RMPR7M("QUANTITY")<1
Begin DoDot:1
+91 WRITE !,"The quantity cannot be allowed because it would cause a",!
+92 WRITE "negative on hand quantity.",!
+93 WRITE "Please check your inventory and use the reconciliation option",!
+94 WRITE "as needed.",!
+95 QUIT
End DoDot:1
GOTO QTY^RMPRPIY6
TRANSX IF 'RMPRERR
Begin DoDot:1
+1 WRITE !!,"** Item "
+2 WRITE RMPR11("HCPCS-ITEM")
+3 WRITE " was "
+4 WRITE "Edited by "
+5 WRITE $$GETUSR^RMPRPIU0(DUZ)
+6 if $DATA(RMPRGLQ)
WRITE ": ("_$SELECT(RMPRGLQ>0:"+",1:"")_RMPRGLQ_")"
+7 WRITE " @ Location ",RMPR5("NAME")
+8 QUIT
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 WRITE !!,"** The Item could not be modified due to a problem - please contact support"
+11 QUIT
End DoDot:1
+12 QUIT
