PRCPEIL1 ;WISC/RFJ-edit inventory item (list manager) calls ;01 Dec 93
V ;;5.1;IFCAP;**1,142,244**;Oct 20, 2000;Build 9
;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine provides various edit functionalities for inventory items
; within the IFCAP (Integrated Funds Distribution, Control Point Activity,
; Accounting and Procurement) system. The routine includes functionalities
; for editing descriptive elements, costing elements, issue units, levels,
; quantities, due-ins, special parameters, procurement sources, and drug
; accountability parameters. It also allows editing all fields collectively,
; removing an item from the inventory, and editing secondary items. The
; routine ensures data integrity through comprehensive validation checks
; and error handling mechanisms.
;
; Key Entry Points:
; DESCRIP - Edits the descriptive elements of an inventory item.
; COST - Edits the cost elements of an inventory item.
; ISSUNITS - Edits the issue units of an inventory item.
; LEVELS - Edits the levels of an inventory item.
; QUANTITY - Edits the quantities related to an inventory item with
; checks for on-hand values and costs.
; DUEIN - Edits the due-ins for an inventory item.
; SPECIAL - Edits special parameters for an inventory item.
; SOURCES - Edits procurement sources for an inventory item.
; DRUGACCT - Edits drug accountability parameters.
; ALL - Edits all fields related to an inventory item.
; DELETE - Removes an item from the inventory point.
; SECOND - Edits information for a secondary item.
;
; Integration Control Registrations (ICRs)
; ICR #10116 - FULL^VALM1
; ICR #10103 - $$FMTE^XLFDT
; ICR #10098 - BLD^DIALOG/CALL^DIALOG
; ICR #10141 - EN^DDIOL
; ICR #10101 - DIC/DIQ^DIC
; ICR #10063 - DDGLIBR^DIALOG
; ICR #10075 - L +^DIC(1)
;
Q
;
;
DESCRIP ; edit descriptive elements
D FULL^VALM1
D DESCRIP^PRCPEITE(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM(".45;.5;.7;5") ; 244 - Add ABC Classification
D DESCRIP^PRCPEILM
S VALMBCK="R"
Q
;
;
COST ; edit costing elements
D COSTEDIT^PRCPEIQT(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM("4.7;4.8;4.81")
D COSTS^PRCPEIL0
S VALMBCK="R"
Q
;
;
ISSUNITS ; edit issue units
D FULL^VALM1
D SETUNITS^PRCPEIUI(PRCPINPT,ITEMDA)
D EDITUI^PRCPEIUI(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM("16;16.5")
D ISSUNITS^PRCPEIL0
S VALMBCK="R"
Q
;
;
LEVELS ; edit levels
D LEVELS^PRCPEITE(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM("9:11")
D LEVELS^PRCPEIL0
S VALMBCK="R"
Q
;
;
QUANTITY ; edit quantities
Q1 D FULL^VALM1
D QTY^PRCPEIQT(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM("7;4.8;4.81")
N ERR S ERR=0
I $G(PRCPDATA("445.01",ITEMDA,"7","E"))>0,($G(PRCPDATA("445.01",ITEMDA,"4.8","E"))<".01"!($G(PRCPDATA("445.01",ITEMDA,"4.81","E"))<".01")) D G:ERR=1 Q1
. W !!,"** Result ON-HAND greater than 0 CANNOT have an average cost of zero."
. W !," You MUST modify Inventory Value to something greater than zero. You cannot"
. W !," have on-hand with an inventory value of zero and no average cost. If you"
. W !," cannot enter an inventory value (not sure what to enter) then you must "
. W !," MINUS the quantity originally entered to exit the QT action.",!
. W !!,"=>> PLEASE OK IF THE ZERO INVENTORY VALUE IS DUE TO A ZERO VALUE INVENTORY ITEM",!
. W $C(7) S %A="Is this a zero value inventory item",%B="",%=2 D ^PRCFYN I %'=1 S ERR=1
I $G(PRCPDATA("445.01",ITEMDA,"4.81","E"))<0!($G(PRCPDATA("445.01",ITEMDA,"4.81","E"))<0) D G Q1
. W !!,"** Resulting Inventory Value or Average Cost CANNOT be negative. If you are"
. W !," unsure what the inventory value should be then you MUST adjust the "
. W !," quantity and inventory value back to original (zero or greater) values to "
. W !," exit the QT action."
D QUANTITY^PRCPEIL0
D COSTS^PRCPEIL0
S VALMBCK="R"
K ERR,%,%A,%B
Q
;
;
DUEIN ; edit due-ins
D FULL^VALM1
D DUEIN^PRCPEIQT(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM(8)
D QUANTITY^PRCPEIL0
D OUTSTRAN^PRCPEIL0
S VALMBCK="R"
Q
;
;
SPECIAL ; edit special parameters
I PRCPTYPE="W" D FULL^VALM1
D SPECIAL^PRCPEITE(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM(17)
D SPECIAL^PRCPEIL0
S VALMBCK="R"
Q
;
;
SOURCES ; edit procurement sources
D FULL^VALM1
D SOURCES^PRCPEIPS(PRCPINPT,ITEMDA)
D SOURCES0(PRCPINPT,ITEMDA) ; restrict editing if oustanding orders
; rebuild array
D DIQ^PRCPEILM(.4)
D SOURCES^PRCPEIL0
S VALMBCK="R"
Q
;
SOURCES0(PRCPINPT,ITEMDA) ; allow editing of source info if no orders
N ORD S ORD=0
; because this is sometimes called from templates, new FileMan variables
N D,D0,D1,D2,D3,D4,D5,D6,DA,DB,DC,DD,DE,DG,DH,DI,DIA,DIADD,DIC,DICR,DIE
N DIEC,DIEL,DIFLD,DIK,DIOV,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DR,DQ,DU,DV,DW
N I,J,X,Y
I $P(^PRCP(445,PRCPINPT,0),"^",3)="S" D Q:ORD
. W !,"Checking the released orders for this item..."
. S ORD=$$ORDCHK^PRCPUITM(ITEMDA,PRCPINPT,"RCE","R")
. Q:'ORD
. I ORD D EN^DDIOL("To edit these values, you must first post or delete the following order(s):")
. D LISTOO^PRCPUITM(ITEMDA,PRCPINPT,"R")
. D P^PRCPUREP ; pause to allow user read information
W !!?25,"*----------------------------*",!,"You will now have the option to override the changes I made, be careful though!",!?25,"*----------------------------*",!
D EDITSOUR^PRCPEIPU(PRCPINPT,ITEMDA)
Q
;
;
DRUGACCT ; edit drug accountability parameters
D DISPUNIT^PRCPEITE(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM("50;51")
D DRUGACCT^PRCPEIL0
S VALMBCK="R"
Q
;
;
ALL ; edit all fields
D FULL^VALM1
D ALL^PRCPEITE(PRCPINPT,ITEMDA)
; rebuild array
D INIT^PRCPEILM
S VALMBCK="R"
Q
;
;
DELETE ; remove item from inventory point
D DELETE^PRCPUITM(PRCPINPT,ITEMDA)
D R^PRCPUREP
S VALMBCK="R"
I '$D(^PRCP(445,PRCPINPT,1,ITEMDA,0)) K VALMBCK Q
Q
;
;
SECOND ; edit secondary item
D FULL^VALM1
S VALMBCK="R"
N PRCPSECO
S PRCPSECO=$$TO^PRCPUDPT(PRCPINPT) I 'PRCPSECO Q
I '$D(^PRCP(445,PRCPSECO,4,+$G(DUZ),0)) S VALMSG="NOT AN AUTHORIZED USER FOR SECONDARY INVENTORY POINT" Q
D
. N ITEMDA,PRCPINPT,PRCPTYPE
. S PRCPINPT=PRCPSECO,PRCPTYPE=$P($G(^PRCP(445,PRCPSECO,0)),"^",3)
. F W !! S ITEMDA=$$ITEM^PRCPUITM(PRCPINPT,1,"","") Q:'ITEMDA D
. . L +^PRCP(445,PRCPINPT,1,ITEMDA):DILOCKTM I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-1",0) Q
. . D ADD^PRCPULOC(445,PRCPINPT_"-1",0,"Enter/Edit Inventory Item Data")
. . D EN^VALM("PRCP EDIT ITEMS")
. . I $D(^PRCP(445,PRCPINPT,1,ITEMDA)) D BLDSEG^PRCPHLFM(3,ITEMDA,PRCPINPT) ; send supply station an update of any changes to the item
. . D CLEAR^PRCPULOC(445,PRCPINPT_"-1",0)
. . L -^PRCP(445,PRCPINPT,1,ITEMDA)
. Q
D INIT^PRCPEILM
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPEIL1 7027 printed Jan 29, 2026@15:12:07 Page 2
PRCPEIL1 ;WISC/RFJ-edit inventory item (list manager) calls ;01 Dec 93
V ;;5.1;IFCAP;**1,142,244**;Oct 20, 2000;Build 9
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;
+3 ; This routine provides various edit functionalities for inventory items
+4 ; within the IFCAP (Integrated Funds Distribution, Control Point Activity,
+5 ; Accounting and Procurement) system. The routine includes functionalities
+6 ; for editing descriptive elements, costing elements, issue units, levels,
+7 ; quantities, due-ins, special parameters, procurement sources, and drug
+8 ; accountability parameters. It also allows editing all fields collectively,
+9 ; removing an item from the inventory, and editing secondary items. The
+10 ; routine ensures data integrity through comprehensive validation checks
+11 ; and error handling mechanisms.
+12 ;
+13 ; Key Entry Points:
+14 ; DESCRIP - Edits the descriptive elements of an inventory item.
+15 ; COST - Edits the cost elements of an inventory item.
+16 ; ISSUNITS - Edits the issue units of an inventory item.
+17 ; LEVELS - Edits the levels of an inventory item.
+18 ; QUANTITY - Edits the quantities related to an inventory item with
+19 ; checks for on-hand values and costs.
+20 ; DUEIN - Edits the due-ins for an inventory item.
+21 ; SPECIAL - Edits special parameters for an inventory item.
+22 ; SOURCES - Edits procurement sources for an inventory item.
+23 ; DRUGACCT - Edits drug accountability parameters.
+24 ; ALL - Edits all fields related to an inventory item.
+25 ; DELETE - Removes an item from the inventory point.
+26 ; SECOND - Edits information for a secondary item.
+27 ;
+28 ; Integration Control Registrations (ICRs)
+29 ; ICR #10116 - FULL^VALM1
+30 ; ICR #10103 - $$FMTE^XLFDT
+31 ; ICR #10098 - BLD^DIALOG/CALL^DIALOG
+32 ; ICR #10141 - EN^DDIOL
+33 ; ICR #10101 - DIC/DIQ^DIC
+34 ; ICR #10063 - DDGLIBR^DIALOG
+35 ; ICR #10075 - L +^DIC(1)
+36 ;
+37 QUIT
+38 ;
+39 ;
DESCRIP ; edit descriptive elements
+1 DO FULL^VALM1
+2 DO DESCRIP^PRCPEITE(PRCPINPT,ITEMDA)
+3 ; rebuild array
+4 ; 244 - Add ABC Classification
DO DIQ^PRCPEILM(".45;.5;.7;5")
+5 DO DESCRIP^PRCPEILM
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
+9 ;
COST ; edit costing elements
+1 DO COSTEDIT^PRCPEIQT(PRCPINPT,ITEMDA)
+2 ; rebuild array
+3 DO DIQ^PRCPEILM("4.7;4.8;4.81")
+4 DO COSTS^PRCPEIL0
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;
ISSUNITS ; edit issue units
+1 DO FULL^VALM1
+2 DO SETUNITS^PRCPEIUI(PRCPINPT,ITEMDA)
+3 DO EDITUI^PRCPEIUI(PRCPINPT,ITEMDA)
+4 ; rebuild array
+5 DO DIQ^PRCPEILM("16;16.5")
+6 DO ISSUNITS^PRCPEIL0
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
+10 ;
LEVELS ; edit levels
+1 DO LEVELS^PRCPEITE(PRCPINPT,ITEMDA)
+2 ; rebuild array
+3 DO DIQ^PRCPEILM("9:11")
+4 DO LEVELS^PRCPEIL0
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;
QUANTITY ; edit quantities
Q1 DO FULL^VALM1
+1 DO QTY^PRCPEIQT(PRCPINPT,ITEMDA)
+2 ; rebuild array
+3 DO DIQ^PRCPEILM("7;4.8;4.81")
+4 NEW ERR
SET ERR=0
+5 IF $GET(PRCPDATA("445.01",ITEMDA,"7","E"))>0
IF ($GET(PRCPDATA("445.01",ITEMDA,"4.8","E"))<".01"!($GET(PRCPDATA("445.01",ITEMDA,"4.81","E"))<".01"))
Begin DoDot:1
+6 WRITE !!,"** Result ON-HAND greater than 0 CANNOT have an average cost of zero."
+7 WRITE !," You MUST modify Inventory Value to something greater than zero. You cannot"
+8 WRITE !," have on-hand with an inventory value of zero and no average cost. If you"
+9 WRITE !," cannot enter an inventory value (not sure what to enter) then you must "
+10 WRITE !," MINUS the quantity originally entered to exit the QT action.",!
+11 WRITE !!,"=>> PLEASE OK IF THE ZERO INVENTORY VALUE IS DUE TO A ZERO VALUE INVENTORY ITEM",!
+12 WRITE $CHAR(7)
SET %A="Is this a zero value inventory item"
SET %B=""
SET %=2
DO ^PRCFYN
IF %'=1
SET ERR=1
End DoDot:1
if ERR=1
GOTO Q1
+13 IF $GET(PRCPDATA("445.01",ITEMDA,"4.81","E"))<0!($GET(PRCPDATA("445.01",ITEMDA,"4.81","E"))<0)
Begin DoDot:1
+14 WRITE !!,"** Resulting Inventory Value or Average Cost CANNOT be negative. If you are"
+15 WRITE !," unsure what the inventory value should be then you MUST adjust the "
+16 WRITE !," quantity and inventory value back to original (zero or greater) values to "
+17 WRITE !," exit the QT action."
End DoDot:1
GOTO Q1
+18 DO QUANTITY^PRCPEIL0
+19 DO COSTS^PRCPEIL0
+20 SET VALMBCK="R"
+21 KILL ERR,%,%A,%B
+22 QUIT
+23 ;
+24 ;
DUEIN ; edit due-ins
+1 DO FULL^VALM1
+2 DO DUEIN^PRCPEIQT(PRCPINPT,ITEMDA)
+3 ; rebuild array
+4 DO DIQ^PRCPEILM(8)
+5 DO QUANTITY^PRCPEIL0
+6 DO OUTSTRAN^PRCPEIL0
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
+10 ;
SPECIAL ; edit special parameters
+1 IF PRCPTYPE="W"
DO FULL^VALM1
+2 DO SPECIAL^PRCPEITE(PRCPINPT,ITEMDA)
+3 ; rebuild array
+4 DO DIQ^PRCPEILM(17)
+5 DO SPECIAL^PRCPEIL0
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
+9 ;
SOURCES ; edit procurement sources
+1 DO FULL^VALM1
+2 DO SOURCES^PRCPEIPS(PRCPINPT,ITEMDA)
+3 ; restrict editing if oustanding orders
DO SOURCES0(PRCPINPT,ITEMDA)
+4 ; rebuild array
+5 DO DIQ^PRCPEILM(.4)
+6 DO SOURCES^PRCPEIL0
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
SOURCES0(PRCPINPT,ITEMDA) ; allow editing of source info if no orders
+1 NEW ORD
SET ORD=0
+2 ; because this is sometimes called from templates, new FileMan variables
+3 NEW D,D0,D1,D2,D3,D4,D5,D6,DA,DB,DC,DD,DE,DG,DH,DI,DIA,DIADD,DIC,DICR,DIE
+4 NEW DIEC,DIEL,DIFLD,DIK,DIOV,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DR,DQ,DU,DV,DW
+5 NEW I,J,X,Y
+6 IF $PIECE(^PRCP(445,PRCPINPT,0),"^",3)="S"
Begin DoDot:1
+7 WRITE !,"Checking the released orders for this item..."
+8 SET ORD=$$ORDCHK^PRCPUITM(ITEMDA,PRCPINPT,"RCE","R")
+9 if 'ORD
QUIT
+10 IF ORD
DO EN^DDIOL("To edit these values, you must first post or delete the following order(s):")
+11 DO LISTOO^PRCPUITM(ITEMDA,PRCPINPT,"R")
+12 ; pause to allow user read information
DO P^PRCPUREP
End DoDot:1
if ORD
QUIT
+13 WRITE !!?25,"*----------------------------*",!,"You will now have the option to override the changes I made, be careful though!",!?25,"*----------------------------*",!
+14 DO EDITSOUR^PRCPEIPU(PRCPINPT,ITEMDA)
+15 QUIT
+16 ;
+17 ;
DRUGACCT ; edit drug accountability parameters
+1 DO DISPUNIT^PRCPEITE(PRCPINPT,ITEMDA)
+2 ; rebuild array
+3 DO DIQ^PRCPEILM("50;51")
+4 DO DRUGACCT^PRCPEIL0
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;
ALL ; edit all fields
+1 DO FULL^VALM1
+2 DO ALL^PRCPEITE(PRCPINPT,ITEMDA)
+3 ; rebuild array
+4 DO INIT^PRCPEILM
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;
DELETE ; remove item from inventory point
+1 DO DELETE^PRCPUITM(PRCPINPT,ITEMDA)
+2 DO R^PRCPUREP
+3 SET VALMBCK="R"
+4 IF '$DATA(^PRCP(445,PRCPINPT,1,ITEMDA,0))
KILL VALMBCK
QUIT
+5 QUIT
+6 ;
+7 ;
SECOND ; edit secondary item
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW PRCPSECO
+4 SET PRCPSECO=$$TO^PRCPUDPT(PRCPINPT)
IF 'PRCPSECO
QUIT
+5 IF '$DATA(^PRCP(445,PRCPSECO,4,+$GET(DUZ),0))
SET VALMSG="NOT AN AUTHORIZED USER FOR SECONDARY INVENTORY POINT"
QUIT
+6 Begin DoDot:1
+7 NEW ITEMDA,PRCPINPT,PRCPTYPE
+8 SET PRCPINPT=PRCPSECO
SET PRCPTYPE=$PIECE($GET(^PRCP(445,PRCPSECO,0)),"^",3)
+9 FOR
WRITE !!
SET ITEMDA=$$ITEM^PRCPUITM(PRCPINPT,1,"","")
if 'ITEMDA
QUIT
Begin DoDot:2
+10 LOCK +^PRCP(445,PRCPINPT,1,ITEMDA):DILOCKTM
IF '$TEST
DO SHOWWHO^PRCPULOC(445,PRCPINPT_"-1",0)
QUIT
+11 DO ADD^PRCPULOC(445,PRCPINPT_"-1",0,"Enter/Edit Inventory Item Data")
+12 DO EN^VALM("PRCP EDIT ITEMS")
+13 ; send supply station an update of any changes to the item
IF $DATA(^PRCP(445,PRCPINPT,1,ITEMDA))
DO BLDSEG^PRCPHLFM(3,ITEMDA,PRCPINPT)
+14 DO CLEAR^PRCPULOC(445,PRCPINPT_"-1",0)
+15 LOCK -^PRCP(445,PRCPINPT,1,ITEMDA)
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO INIT^PRCPEILM
+18 SET VALMBCK="R"
+19 QUIT
