source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXF.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

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