| [613] | 1 | RMPRPIYT ;HINCIO/ODJ - TR - Transfer Items ;3/8/01
|
|---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;***** TR - Replaces TR option in old PIP (RMPR5NTU)
|
|---|
| 6 | ; Callable from VISTA menu, no vars required other than
|
|---|
| 7 | ; global VISTA vars (DUZ, etc)
|
|---|
| 8 | TR N RMPRERR,RMPRSTN,RMPREXC,RMPR5F,RMPR5T,RMPR1,RMPR11,RMPR,RMPRQTY
|
|---|
| 9 | N RMPRVI,RMPRVO,RMPRVNDR,RMPROVAL,RMPRLCN,RMPR6,RMPR7
|
|---|
| 10 | ;
|
|---|
| 11 | ;***** STN - Prompt for Station
|
|---|
| 12 | STN S RMPROVAL=$G(RMPRSTN("IEN"))
|
|---|
| 13 | W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
|
|---|
| 14 | I RMPRERR G TRX
|
|---|
| 15 | I RMPREXC'="" G TRX
|
|---|
| 16 | I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11
|
|---|
| 17 | ;
|
|---|
| 18 | ;***** HCPCS - prompt for HCPCS and Item
|
|---|
| 19 | HCPCS W !!,"Transfer item quantity to another location.",!
|
|---|
| 20 | HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
|
|---|
| 21 | I RMPREXC="T" G TRX
|
|---|
| 22 | I RMPREXC="P" G STN
|
|---|
| 23 | I RMPREXC="^" D G TRX
|
|---|
| 24 | . W !,"** No HCPCS selected." H 1
|
|---|
| 25 | . Q
|
|---|
| 26 | ;I $G(RMPR11("IEN"))'="" D G QTY
|
|---|
| 27 | HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC)
|
|---|
| 28 | I RMPREXC="T" G TRX
|
|---|
| 29 | I RMPREXC="P"!(RMPREXC="^") G HCPCS
|
|---|
| 30 | S RMPR11("STATION")=RMPRSTN("IEN")
|
|---|
| 31 | S RMPR11("STATION IEN")=RMPRSTN("IEN")
|
|---|
| 32 | ;
|
|---|
| 33 | ; display selected HCPCS and item and continue
|
|---|
| 34 | HCPCS4 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC"))
|
|---|
| 35 | W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER"))
|
|---|
| 36 | W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION"))
|
|---|
| 37 | ;
|
|---|
| 38 | ;***** CURST - call prompt for current stock record
|
|---|
| 39 | CURST S RMPRLCN=""
|
|---|
| 40 | D PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC)
|
|---|
| 41 | I RMPREXC="T" G TRX
|
|---|
| 42 | I RMPREXC="P" W ! G HCPCS2
|
|---|
| 43 | I RMPREXC="^" G HCPCS
|
|---|
| 44 | S RMPR5F("IEN")=RMPRLCN
|
|---|
| 45 | S RMPRERR=$$GET^RMPRPIX5(.RMPR5F)
|
|---|
| 46 | S RMPR5F("STATION IEN")=RMPRSTN("IEN")
|
|---|
| 47 | S RMPR5T("STATION IEN")=RMPRSTN("IEN")
|
|---|
| 48 | S RMPR5F("STATION")=RMPRSTN("IEN")
|
|---|
| 49 | W !
|
|---|
| 50 | ;
|
|---|
| 51 | ;***** QTY - Prompt for Quantity
|
|---|
| 52 | QTY S RMPRERR=$$QTY^RMPRPIYU(.RMPRQTY,.RMPREXC,.RMPR5F,.RMPR11)
|
|---|
| 53 | I RMPREXC="T" G TRX
|
|---|
| 54 | I RMPREXC="^" G HCPCS
|
|---|
| 55 | I RMPREXC="P" G CURST
|
|---|
| 56 | ;
|
|---|
| 57 | ;***** TLOCN - Prompt for 'TO' Location
|
|---|
| 58 | TLOCN D LOCNM^RMPRPIYU(RMPRSTN("IEN"),.RMPR5T,.RMPREXC)
|
|---|
| 59 | I RMPREXC="^" G HCPCS
|
|---|
| 60 | I RMPREXC="T" D G TRX
|
|---|
| 61 | . W !,"*** Nothing transferred."
|
|---|
| 62 | . H 1
|
|---|
| 63 | . Q
|
|---|
| 64 | I RMPREXC="P" G QTY
|
|---|
| 65 | S RMPR5T("STATION")=RMPRSTN("IEN")
|
|---|
| 66 | I RMPR5F("IEN")=RMPR5T("IEN") D G TLOCN
|
|---|
| 67 | . W !
|
|---|
| 68 | . W "*** Forwarding and Receiving Location is the same!!!!"
|
|---|
| 69 | . Q
|
|---|
| 70 | ;
|
|---|
| 71 | ;***** TRANS - Now create a transfer transaction
|
|---|
| 72 | TRANS S RMPR11("STATION")=RMPRSTN("IEN")
|
|---|
| 73 | S RMPR("QUANTITY")=RMPRQTY
|
|---|
| 74 | S RMPR("USER")=$G(DUZ)
|
|---|
| 75 | S RMPR("IEN")=$G(RMPR5T("IEN"))
|
|---|
| 76 | S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
|
|---|
| 77 | S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
|
|---|
| 78 | I RMPRERR=1 G HCPCS
|
|---|
| 79 | S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
|
|---|
| 80 | S RMPR5F("UNIT")=RMPR7I("UNIT")
|
|---|
| 81 | S RMPR5T("UNIT")=RMPR7I("UNIT")
|
|---|
| 82 | S RMPRERR=$$TRNF^RMPRPIUT(.RMPR,.RMPR5F,.RMPR5T,.RMPR11)
|
|---|
| 83 | I RMPRERR=1 D G QTY
|
|---|
| 84 | . W !
|
|---|
| 85 | . W "Quantity to transfer is greater than current balance: "
|
|---|
| 86 | . W RMPR("QOH")
|
|---|
| 87 | . Q
|
|---|
| 88 | I RMPRERR D G TRX
|
|---|
| 89 | . W !
|
|---|
| 90 | . W "There were problems with the transfer, please contact support"
|
|---|
| 91 | . H 3
|
|---|
| 92 | . Q
|
|---|
| 93 | W !
|
|---|
| 94 | W "QTY "_RMPRQTY_" transferred from "_RMPR5F("NAME")_" to "_RMPR5T("NAME")
|
|---|
| 95 | H 1
|
|---|
| 96 | K RMPR5F,RMPR5T,RMPRQTY,RMPR,RMPR6,RMPR7
|
|---|
| 97 | G HCPCS
|
|---|
| 98 | TRX D KILL^XUSCLEAN
|
|---|
| 99 | Q
|
|---|
