RMPRPIYT ;HINCIO/ODJ - TR - Transfer Items ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** TR - Replaces TR option in old PIP (RMPR5NTU)
; Callable from VISTA menu, no vars required other than
; global VISTA vars (DUZ, etc)
TR N RMPRERR,RMPRSTN,RMPREXC,RMPR5F,RMPR5T,RMPR1,RMPR11,RMPR,RMPRQTY
N RMPRVI,RMPRVO,RMPRVNDR,RMPROVAL,RMPRLCN,RMPR6,RMPR7
;
;***** STN - Prompt for Station
STN S RMPROVAL=$G(RMPRSTN("IEN"))
W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
I RMPRERR G TRX
I RMPREXC'="" G TRX
I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11
;
;***** HCPCS - prompt for HCPCS and Item
HCPCS W !!,"Transfer item quantity to another location.",!
HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
I RMPREXC="T" G TRX
I RMPREXC="P" G STN
I RMPREXC="^" D G TRX
. W !,"** No HCPCS selected." H 1
. Q
;I $G(RMPR11("IEN"))'="" D G QTY
HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC)
I RMPREXC="T" G TRX
I RMPREXC="P"!(RMPREXC="^") G HCPCS
S RMPR11("STATION")=RMPRSTN("IEN")
S RMPR11("STATION IEN")=RMPRSTN("IEN")
;
; display selected HCPCS and item and continue
HCPCS4 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC"))
W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER"))
W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION"))
;
;***** CURST - call prompt for current stock record
CURST S RMPRLCN=""
D PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC)
I RMPREXC="T" G TRX
I RMPREXC="P" W ! G HCPCS2
I RMPREXC="^" G HCPCS
S RMPR5F("IEN")=RMPRLCN
S RMPRERR=$$GET^RMPRPIX5(.RMPR5F)
S RMPR5F("STATION IEN")=RMPRSTN("IEN")
S RMPR5T("STATION IEN")=RMPRSTN("IEN")
S RMPR5F("STATION")=RMPRSTN("IEN")
W !
;
;***** QTY - Prompt for Quantity
QTY S RMPRERR=$$QTY^RMPRPIYU(.RMPRQTY,.RMPREXC,.RMPR5F,.RMPR11)
I RMPREXC="T" G TRX
I RMPREXC="^" G HCPCS
I RMPREXC="P" G CURST
;
;***** TLOCN - Prompt for 'TO' Location
TLOCN D LOCNM^RMPRPIYU(RMPRSTN("IEN"),.RMPR5T,.RMPREXC)
I RMPREXC="^" G HCPCS
I RMPREXC="T" D G TRX
. W !,"*** Nothing transferred."
. H 1
. Q
I RMPREXC="P" G QTY
S RMPR5T("STATION")=RMPRSTN("IEN")
I RMPR5F("IEN")=RMPR5T("IEN") D G TLOCN
. W !
. W "*** Forwarding and Receiving Location is the same!!!!"
. Q
;
;***** TRANS - Now create a transfer transaction
TRANS S RMPR11("STATION")=RMPRSTN("IEN")
S RMPR("QUANTITY")=RMPRQTY
S RMPR("USER")=$G(DUZ)
S RMPR("IEN")=$G(RMPR5T("IEN"))
S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
I RMPRERR=1 G HCPCS
S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
S RMPR5F("UNIT")=RMPR7I("UNIT")
S RMPR5T("UNIT")=RMPR7I("UNIT")
S RMPRERR=$$TRNF^RMPRPIUT(.RMPR,.RMPR5F,.RMPR5T,.RMPR11)
I RMPRERR=1 D G QTY
. W !
. W "Quantity to transfer is greater than current balance: "
. W RMPR("QOH")
. Q
I RMPRERR D G TRX
. W !
. W "There were problems with the transfer, please contact support"
. H 3
. Q
W !
W "QTY "_RMPRQTY_" transferred from "_RMPR5F("NAME")_" to "_RMPR5T("NAME")
H 1
K RMPR5F,RMPR5T,RMPRQTY,RMPR,RMPR6,RMPR7
G HCPCS
TRX D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYT 3220 printed Apr 09, 2024@21:40:48 Page 2
RMPRPIYT ;HINCIO/ODJ - TR - Transfer Items ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** TR - Replaces TR option in old PIP (RMPR5NTU)
+5 ; Callable from VISTA menu, no vars required other than
+6 ; global VISTA vars (DUZ, etc)
TR NEW RMPRERR,RMPRSTN,RMPREXC,RMPR5F,RMPR5T,RMPR1,RMPR11,RMPR,RMPRQTY
+1 NEW RMPRVI,RMPRVO,RMPRVNDR,RMPROVAL,RMPRLCN,RMPR6,RMPR7
+2 ;
+3 ;***** STN - Prompt for Station
STN SET RMPROVAL=$GET(RMPRSTN("IEN"))
+1 WRITE @IOF
SET RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
+2 IF RMPRERR
GOTO TRX
+3 IF RMPREXC'=""
GOTO TRX
+4 IF RMPROVAL'=RMPRSTN("IEN")
KILL RMPR1,RMPR11
+5 ;
+6 ;***** HCPCS - prompt for HCPCS and Item
HCPCS WRITE !!,"Transfer item quantity to another location.",!
HCPCS2 DO HCPCS^RMPRPIY7(RMPRSTN("IEN"),$GET(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
+1 IF RMPREXC="T"
GOTO TRX
+2 IF RMPREXC="P"
GOTO STN
+3 IF RMPREXC="^"
Begin DoDot:1
+4 WRITE !,"** No HCPCS selected."
HANG 1
+5 QUIT
End DoDot:1
GOTO TRX
+6 ;I $G(RMPR11("IEN"))'="" D G QTY
HCPCS3 DO ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC)
+1 IF RMPREXC="T"
GOTO TRX
+2 IF RMPREXC="P"!(RMPREXC="^")
GOTO HCPCS
+3 SET RMPR11("STATION")=RMPRSTN("IEN")
+4 SET RMPR11("STATION IEN")=RMPRSTN("IEN")
+5 ;
+6 ; display selected HCPCS and item and continue
HCPCS4 WRITE !!,"HCPCS: "_$GET(RMPR1("HCPCS"))_" "_$GET(RMPR1("SHORT DESC"))
+1 WRITE !!,"IFCAP Item: ",$GET(RMPR11("ITEM MASTER"))
+2 WRITE !!,"PIP Item desc.: ",$GET(RMPR11("DESCRIPTION"))
+3 ;
+4 ;***** CURST - call prompt for current stock record
CURST SET RMPRLCN=""
+1 DO PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC)
+2 IF RMPREXC="T"
GOTO TRX
+3 IF RMPREXC="P"
WRITE !
GOTO HCPCS2
+4 IF RMPREXC="^"
GOTO HCPCS
+5 SET RMPR5F("IEN")=RMPRLCN
+6 SET RMPRERR=$$GET^RMPRPIX5(.RMPR5F)
+7 SET RMPR5F("STATION IEN")=RMPRSTN("IEN")
+8 SET RMPR5T("STATION IEN")=RMPRSTN("IEN")
+9 SET RMPR5F("STATION")=RMPRSTN("IEN")
+10 WRITE !
+11 ;
+12 ;***** QTY - Prompt for Quantity
QTY SET RMPRERR=$$QTY^RMPRPIYU(.RMPRQTY,.RMPREXC,.RMPR5F,.RMPR11)
+1 IF RMPREXC="T"
GOTO TRX
+2 IF RMPREXC="^"
GOTO HCPCS
+3 IF RMPREXC="P"
GOTO CURST
+4 ;
+5 ;***** TLOCN - Prompt for 'TO' Location
TLOCN DO LOCNM^RMPRPIYU(RMPRSTN("IEN"),.RMPR5T,.RMPREXC)
+1 IF RMPREXC="^"
GOTO HCPCS
+2 IF RMPREXC="T"
Begin DoDot:1
+3 WRITE !,"*** Nothing transferred."
+4 HANG 1
+5 QUIT
End DoDot:1
GOTO TRX
+6 IF RMPREXC="P"
GOTO QTY
+7 SET RMPR5T("STATION")=RMPRSTN("IEN")
+8 IF RMPR5F("IEN")=RMPR5T("IEN")
Begin DoDot:1
+9 WRITE !
+10 WRITE "*** Forwarding and Receiving Location is the same!!!!"
+11 QUIT
End DoDot:1
GOTO TLOCN
+12 ;
+13 ;***** TRANS - Now create a transfer transaction
TRANS SET RMPR11("STATION")=RMPRSTN("IEN")
+1 SET RMPR("QUANTITY")=RMPRQTY
+2 SET RMPR("USER")=$GET(DUZ)
+3 SET RMPR("IEN")=$GET(RMPR5T("IEN"))
+4 SET RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
+5 SET RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
+6 IF RMPRERR=1
GOTO HCPCS
+7 SET RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
+8 SET RMPR5F("UNIT")=RMPR7I("UNIT")
+9 SET RMPR5T("UNIT")=RMPR7I("UNIT")
+10 SET RMPRERR=$$TRNF^RMPRPIUT(.RMPR,.RMPR5F,.RMPR5T,.RMPR11)
+11 IF RMPRERR=1
Begin DoDot:1
+12 WRITE !
+13 WRITE "Quantity to transfer is greater than current balance: "
+14 WRITE RMPR("QOH")
+15 QUIT
End DoDot:1
GOTO QTY
+16 IF RMPRERR
Begin DoDot:1
+17 WRITE !
+18 WRITE "There were problems with the transfer, please contact support"
+19 HANG 3
+20 QUIT
End DoDot:1
GOTO TRX
+21 WRITE !
+22 WRITE "QTY "_RMPRQTY_" transferred from "_RMPR5F("NAME")_" to "_RMPR5T("NAME")
+23 HANG 1
+24 KILL RMPR5F,RMPR5T,RMPRQTY,RMPR,RMPR6,RMPR7
+25 GOTO HCPCS
TRX DO KILL^XUSCLEAN
+1 QUIT
