| 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
 | 
|---|