1 | PRCPEIL1 ;WISC/RFJ-edit inventory item (list manager) calls ;01 Dec 93
|
---|
2 | V ;;5.1;IFCAP;**1**;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | ;
|
---|
7 | DESCRIP ; edit descriptive elements
|
---|
8 | D FULL^VALM1
|
---|
9 | D DESCRIP^PRCPEITE(PRCPINPT,ITEMDA)
|
---|
10 | ; rebuild array
|
---|
11 | D DIQ^PRCPEILM(".5;.7;5")
|
---|
12 | D DESCRIP^PRCPEILM
|
---|
13 | S VALMBCK="R"
|
---|
14 | Q
|
---|
15 | ;
|
---|
16 | ;
|
---|
17 | COST ; edit costing elements
|
---|
18 | D COSTEDIT^PRCPEIQT(PRCPINPT,ITEMDA)
|
---|
19 | ; rebuild array
|
---|
20 | D DIQ^PRCPEILM("4.7;4.8;4.81")
|
---|
21 | D COSTS^PRCPEIL0
|
---|
22 | S VALMBCK="R"
|
---|
23 | Q
|
---|
24 | ;
|
---|
25 | ;
|
---|
26 | ISSUNITS ; edit issue units
|
---|
27 | D FULL^VALM1
|
---|
28 | D SETUNITS^PRCPEIUI(PRCPINPT,ITEMDA)
|
---|
29 | D EDITUI^PRCPEIUI(PRCPINPT,ITEMDA)
|
---|
30 | ; rebuild array
|
---|
31 | D DIQ^PRCPEILM("16;16.5")
|
---|
32 | D ISSUNITS^PRCPEIL0
|
---|
33 | S VALMBCK="R"
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | ;
|
---|
37 | LEVELS ; edit levels
|
---|
38 | D LEVELS^PRCPEITE(PRCPINPT,ITEMDA)
|
---|
39 | ; rebuild array
|
---|
40 | D DIQ^PRCPEILM("9:11")
|
---|
41 | D LEVELS^PRCPEIL0
|
---|
42 | S VALMBCK="R"
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | ;
|
---|
46 | QUANTITY ; edit quantities
|
---|
47 | D FULL^VALM1
|
---|
48 | D QTY^PRCPEIQT(PRCPINPT,ITEMDA)
|
---|
49 | ; rebuild array
|
---|
50 | D DIQ^PRCPEILM("7;4.8;4.81")
|
---|
51 | D QUANTITY^PRCPEIL0
|
---|
52 | D COSTS^PRCPEIL0
|
---|
53 | S VALMBCK="R"
|
---|
54 | Q
|
---|
55 | ;
|
---|
56 | ;
|
---|
57 | DUEIN ; edit due-ins
|
---|
58 | D FULL^VALM1
|
---|
59 | D DUEIN^PRCPEIQT(PRCPINPT,ITEMDA)
|
---|
60 | ; rebuild array
|
---|
61 | D DIQ^PRCPEILM(8)
|
---|
62 | D QUANTITY^PRCPEIL0
|
---|
63 | D OUTSTRAN^PRCPEIL0
|
---|
64 | S VALMBCK="R"
|
---|
65 | Q
|
---|
66 | ;
|
---|
67 | ;
|
---|
68 | SPECIAL ; edit special parameters
|
---|
69 | I PRCPTYPE="W" D FULL^VALM1
|
---|
70 | D SPECIAL^PRCPEITE(PRCPINPT,ITEMDA)
|
---|
71 | ; rebuild array
|
---|
72 | D DIQ^PRCPEILM(17)
|
---|
73 | D SPECIAL^PRCPEIL0
|
---|
74 | S VALMBCK="R"
|
---|
75 | Q
|
---|
76 | ;
|
---|
77 | ;
|
---|
78 | SOURCES ; edit procurement sources
|
---|
79 | D FULL^VALM1
|
---|
80 | D SOURCES^PRCPEIPS(PRCPINPT,ITEMDA)
|
---|
81 | D SOURCES0(PRCPINPT,ITEMDA) ; restrict editing if oustanding orders
|
---|
82 | ; rebuild array
|
---|
83 | D DIQ^PRCPEILM(.4)
|
---|
84 | D SOURCES^PRCPEIL0
|
---|
85 | S VALMBCK="R"
|
---|
86 | Q
|
---|
87 | ;
|
---|
88 | SOURCES0(PRCPINPT,ITEMDA) ; allow editing of source info if no orders
|
---|
89 | N ORD S ORD=0
|
---|
90 | ; because this is sometimes called from templates, new FileMan variables
|
---|
91 | N D,D0,D1,D2,D3,D4,D5,D6,DA,DB,DC,DD,DE,DG,DH,DI,DIA,DIADD,DIC,DICR,DIE
|
---|
92 | N DIEC,DIEL,DIFLD,DIK,DIOV,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DR,DQ,DU,DV,DW
|
---|
93 | N I,J,X,Y
|
---|
94 | I $P(^PRCP(445,PRCPINPT,0),"^",3)="S" D Q:ORD
|
---|
95 | . W !,"Checking the released orders for this item..."
|
---|
96 | . S ORD=$$ORDCHK^PRCPUITM(ITEMDA,PRCPINPT,"RCE","R")
|
---|
97 | . Q:'ORD
|
---|
98 | . I ORD D EN^DDIOL("To edit these values, you must first post or delete the following order(s):")
|
---|
99 | . D LISTOO^PRCPUITM(ITEMDA,PRCPINPT,"R")
|
---|
100 | . D P^PRCPUREP ; pause to allow user read information
|
---|
101 | W !!?25,"*----------------------------*",!,"You will now have the option to override the changes I made, be careful though!",!?25,"*----------------------------*",!
|
---|
102 | D EDITSOUR^PRCPEIPU(PRCPINPT,ITEMDA)
|
---|
103 | Q
|
---|
104 | ;
|
---|
105 | ;
|
---|
106 | DRUGACCT ; edit drug accountability parameters
|
---|
107 | D DISPUNIT^PRCPEITE(PRCPINPT,ITEMDA)
|
---|
108 | ; rebuild array
|
---|
109 | D DIQ^PRCPEILM("50;51")
|
---|
110 | D DRUGACCT^PRCPEIL0
|
---|
111 | S VALMBCK="R"
|
---|
112 | Q
|
---|
113 | ;
|
---|
114 | ;
|
---|
115 | ALL ; edit all fields
|
---|
116 | D FULL^VALM1
|
---|
117 | D ALL^PRCPEITE(PRCPINPT,ITEMDA)
|
---|
118 | ; rebuild array
|
---|
119 | D INIT^PRCPEILM
|
---|
120 | S VALMBCK="R"
|
---|
121 | Q
|
---|
122 | ;
|
---|
123 | ;
|
---|
124 | DELETE ; remove item from inventory point
|
---|
125 | D DELETE^PRCPUITM(PRCPINPT,ITEMDA)
|
---|
126 | D R^PRCPUREP
|
---|
127 | S VALMBCK="R"
|
---|
128 | I '$D(^PRCP(445,PRCPINPT,1,ITEMDA,0)) K VALMBCK Q
|
---|
129 | Q
|
---|
130 | ;
|
---|
131 | ;
|
---|
132 | SECOND ; edit secondary item
|
---|
133 | D FULL^VALM1
|
---|
134 | S VALMBCK="R"
|
---|
135 | N PRCPSECO
|
---|
136 | S PRCPSECO=$$TO^PRCPUDPT(PRCPINPT) I 'PRCPSECO Q
|
---|
137 | I '$D(^PRCP(445,PRCPSECO,4,+$G(DUZ),0)) S VALMSG="NOT AN AUTHORIZED USER FOR SECONDARY INVENTORY POINT" Q
|
---|
138 | D
|
---|
139 | . N ITEMDA,PRCPINPT,PRCPTYPE
|
---|
140 | . S PRCPINPT=PRCPSECO,PRCPTYPE=$P($G(^PRCP(445,PRCPSECO,0)),"^",3)
|
---|
141 | . F W !! S ITEMDA=$$ITEM^PRCPUITM(PRCPINPT,1,"","") Q:'ITEMDA D
|
---|
142 | . . L +^PRCP(445,PRCPINPT,1,ITEMDA):1 I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-1",0) Q
|
---|
143 | . . D ADD^PRCPULOC(445,PRCPINPT_"-1",0,"Enter/Edit Inventory Item Data")
|
---|
144 | . . D EN^VALM("PRCP EDIT ITEMS")
|
---|
145 | . . I $D(^PRCP(445,PRCPINPT,1,ITEMDA)) D BLDSEG^PRCPHLFM(3,ITEMDA,PRCPINPT) ; send supply station an update of any changes to the item
|
---|
146 | . . D CLEAR^PRCPULOC(445,PRCPINPT_"-1",0)
|
---|
147 | . . L -^PRCP(445,PRCPINPT,1,ITEMDA)
|
---|
148 | . Q
|
---|
149 | D INIT^PRCPEILM
|
---|
150 | S VALMBCK="R"
|
---|
151 | Q
|
---|