Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPIYT

RMPRPIYT.m

Go to the documentation of this file. 
  1. RMPRPIYT ;HINCIO/ODJ - TR - Transfer Items ;3/8/01
  1.  ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1.  Q
  1.  ;
  1.  ;***** TR - Replaces TR option in old PIP (RMPR5NTU)
  1.  ;           Callable from VISTA menu, no vars required other than
  1.  ;           global VISTA vars (DUZ, etc)
  1. TR N RMPRERR,RMPRSTN,RMPREXC,RMPR5F,RMPR5T,RMPR1,RMPR11,RMPR,RMPRQTY
  1.  N RMPRVI,RMPRVO,RMPRVNDR,RMPROVAL,RMPRLCN,RMPR6,RMPR7
  1.  ;
  1.  ;***** STN - Prompt for Station
  1. STN S RMPROVAL=$G(RMPRSTN("IEN"))
  1.  W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
  1.  I RMPRERR G TRX
  1.  I RMPREXC'="" G TRX
  1.  I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11
  1.  ;
  1.  ;***** HCPCS - prompt for HCPCS and Item
  1. HCPCS W !!,"Transfer item quantity to another location.",!
  1. HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
  1.  I RMPREXC="T" G TRX
  1.  I RMPREXC="P" G STN
  1.  I RMPREXC="^" D  G TRX
  1.  . W !,"** No HCPCS selected." H 1
  1.  . Q
  1.  ;I $G(RMPR11("IEN"))'="" D  G QTY
  1. HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC)
  1.  I RMPREXC="T" G TRX
  1.  I RMPREXC="P"!(RMPREXC="^") G HCPCS
  1.  S RMPR11("STATION")=RMPRSTN("IEN")
  1.  S RMPR11("STATION IEN")=RMPRSTN("IEN")
  1.  ;
  1.  ; display selected HCPCS and item and continue
  1. HCPCS4 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC"))
  1.  W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER"))
  1.  W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION"))
  1.  ;
  1.  ;***** CURST - call prompt for current stock record
  1. CURST S RMPRLCN=""
  1.  D PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC)
  1.  I RMPREXC="T" G TRX
  1.  I RMPREXC="P" W ! G HCPCS2
  1.  I RMPREXC="^" G HCPCS
  1.  S RMPR5F("IEN")=RMPRLCN
  1.  S RMPRERR=$$GET^RMPRPIX5(.RMPR5F)
  1.  S RMPR5F("STATION IEN")=RMPRSTN("IEN")
  1.  S RMPR5T("STATION IEN")=RMPRSTN("IEN")
  1.  S RMPR5F("STATION")=RMPRSTN("IEN")
  1.  W !
  1.  ;
  1.  ;***** QTY - Prompt for Quantity
  1. QTY S RMPRERR=$$QTY^RMPRPIYU(.RMPRQTY,.RMPREXC,.RMPR5F,.RMPR11)
  1.  I RMPREXC="T" G TRX
  1.  I RMPREXC="^" G HCPCS
  1.  I RMPREXC="P" G CURST
  1.  ;
  1.  ;***** TLOCN - Prompt for 'TO' Location
  1. TLOCN D LOCNM^RMPRPIYU(RMPRSTN("IEN"),.RMPR5T,.RMPREXC)
  1.  I RMPREXC="^" G HCPCS
  1.  I RMPREXC="T" D  G TRX
  1.  . W !,"*** Nothing transferred."
  1.  . H 1
  1.  . Q
  1.  I RMPREXC="P" G QTY
  1.  S RMPR5T("STATION")=RMPRSTN("IEN")
  1.  I RMPR5F("IEN")=RMPR5T("IEN") D  G TLOCN
  1.  . W !
  1.  . W "*** Forwarding and Receiving Location is the same!!!!"
  1.  . Q
  1.  ;
  1.  ;***** TRANS - Now create a transfer transaction
  1. TRANS S RMPR11("STATION")=RMPRSTN("IEN")
  1.  S RMPR("QUANTITY")=RMPRQTY
  1.  S RMPR("USER")=$G(DUZ)
  1.  S RMPR("IEN")=$G(RMPR5T("IEN"))
  1.  S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
  1.  S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
  1.  I RMPRERR=1 G HCPCS
  1.  S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
  1.  S RMPR5F("UNIT")=RMPR7I("UNIT")
  1.  S RMPR5T("UNIT")=RMPR7I("UNIT")
  1.  S RMPRERR=$$TRNF^RMPRPIUT(.RMPR,.RMPR5F,.RMPR5T,.RMPR11)
  1.  I RMPRERR=1 D  G QTY
  1.  . W !
  1.  . W "Quantity to transfer is greater than current balance: "
  1.  . W RMPR("QOH")
  1.  . Q
  1.  I RMPRERR D  G TRX
  1.  . W !
  1.  . W "There were problems with the transfer, please contact support"
  1.  . H 3
  1.  . Q
  1.  W !
  1.  W "QTY "_RMPRQTY_" transferred from "_RMPR5F("NAME")_" to "_RMPR5T("NAME")
  1.  H 1
  1.  K RMPR5F,RMPR5T,RMPRQTY,RMPR,RMPR6,RMPR7
  1.  G HCPCS
  1. TRX D KILL^XUSCLEAN
  1.  Q