source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYA.m@ 1660

Last change on this file since 1660 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1RMPRPIYA ;HINCIO/ODJ - UP - Stock Reconciliation ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; Replaces UP option in old PIP (cf UPD^RMPR5NTU)
6UP N RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR6,RMPR11,RMPRV,RMPR,RMPRI,RMPROVAL
7 N RMPR1,RMPRLCN
8 ;
9 ; Station
10STN S RMPROVAL=$G(RMPRSTN("IEN"))
11 W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
12 I RMPRERR G UPX
13 I RMPREXC'="" G UPX
14 I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11
15 ;
16 ;***** HCPCS - prompt for HCPCS and Item
17HCPCS W !!,"Reconcile Inventory item quantities on hand...",!
18 K RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1
19 D HCPCS^RMPRPIY1(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
20 I RMPREXC="P" G STN
21 I RMPREXC="T" G UPX
22 I RMPREXC="^" G UPX
23 S (RMPR11("STATION"),RMPR11("STATION IEN"))=RMPRSTN("IEN")
24 ;
25 ;***** LOCN - prompt for location (if more than 1)
26LOCN W ! S RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN"))
27 I RMPRLCN D G VEND0
28 . K RMPR5
29 . S RMPR5("IEN")=RMPRLCN
30 . S RMPRERR=$$GET^RMPRPIX5(.RMPR5)
31 . W !,"Location: "_RMPR5("NAME")
32 . Q
33 D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
34 I RMPREXC="T" G UPX
35 I RMPREXC="^" G HCPCS
36 I RMPREXC="P" G HCPCS
37 ;
38 ; Vendor
39VEND0 K RMPR
40 S RMPR("STATION IEN")=RMPRSTN("IEN")
41 S RMPR("LOCATION IEN")=RMPR5("IEN")
42 S RMPR("HCPCS")=RMPR11("HCPCS")
43 S RMPR("ITEM")=RMPR11("ITEM")
44 K RMPRV
45 S RMPRERR=$$STOCK^RMPRPIUV(.RMPR,.RMPRV)
46 I RMPRV=0 G VEND
47 S RMPRVEND("IEN")=$O(RMPRV(""))
48 S RMPRVEND("NAME")=$P(RMPRV(RMPRVEND("IEN")),"^",3)
49 S RMPRQTY=$P(RMPRV(RMPRVEND("IEN")),"^",1)
50 I RMPRV>1 D
51 . W !,"The following Vendors of the selected Item exist in this location..."
52 . S RMPRI=""
53 . F S RMPRI=$O(RMPRV(RMPRI)) Q:RMPRI="" D
54 .. W !,$E($$GETVEN(RMPRI),1,20)
55 .. W ?22,$P(RMPRV(RMPRI),"^",1)_" units on hand"
56 .. Q
57 . Q
58VEND D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC)
59 I RMPREXC="T" G UPX
60 I RMPREXC="^" G HCPCS
61 I RMPREXC="P" G HCPCS
62 ;
63 ; Quantity
64QTY D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC)
65 I RMPREXC="T" G UPX
66 I RMPREXC="^" G HCPCS
67 I RMPREXC="P" G VEND
68 ;
69 ; Now create reconciliation record
70TRANS S RMPR11("STATION")=RMPRSTN("IEN")
71 S RMPR11("STATION IEN")=RMPRSTN("IEN")
72 S RMPR6("QUANTITY")=RMPRQTY
73 S RMPR6("VENDOR")=RMPRVEND("IEN")
74 S RMPR6("VENDOR IEN")=RMPRVEND("IEN")
75 S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5)
76 I RMPRERR D
77 . W !,"*** There were problems with the reconciliation, please contact support."
78 . Q
79 E D
80 . W !,"*** Item was reconciled..."
81 . Q
82 H 1
83 K RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1
84 G HCPCS
85UPX D KILL^XUSCLEAN
86 Q
87 Q
88 ;
89 ; Return Vendor Name
90GETVEN(RMPRIEN) ;
91 N RMPRFDA,RMPRI,RMPRO,X,Y,DA
92 S RMPRI=RMPRIEN_","
93 D GETS^DIQ(440,RMPRI,".01","","RMPRO")
94 Q RMPRO(440,RMPRI,.01)
Note: See TracBrowser for help on using the repository browser.