source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEIL1.m@ 1389

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRCPEIL1 ;WISC/RFJ-edit inventory item (list manager) calls ;01 Dec 93
2V ;;5.1;IFCAP;**1**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7DESCRIP ; 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 ;
17COST ; 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 ;
26ISSUNITS ; 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 ;
37LEVELS ; 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 ;
46QUANTITY ; 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 ;
57DUEIN ; 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 ;
68SPECIAL ; 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 ;
78SOURCES ; 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 ;
88SOURCES0(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 ;
106DRUGACCT ; 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 ;
115ALL ; 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 ;
124DELETE ; 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 ;
132SECOND ; 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
Note: See TracBrowser for help on using the repository browser.