PRCPEIL1 ;WISC/RFJ-edit inventory item (list manager) calls ;01 Dec 93
V ;;5.1;IFCAP;**1,142**;Oct 20, 2000;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
DESCRIP ; edit descriptive elements
D FULL^VALM1
D DESCRIP^PRCPEITE(PRCPINPT,ITEMDA)
; rebuild array
D DIQ^PRCPEILM(".5;.7;5")
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):1 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 5236 printed Apr 09, 2024@21:02:30 Page 2
PRCPEIL1 ;WISC/RFJ-edit inventory item (list manager) calls ;01 Dec 93
V ;;5.1;IFCAP;**1,142**;Oct 20, 2000;Build 5
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 QUIT
+3 ;
+4 ;
DESCRIP ; edit descriptive elements
+1 DO FULL^VALM1
+2 DO DESCRIP^PRCPEITE(PRCPINPT,ITEMDA)
+3 ; rebuild array
+4 DO DIQ^PRCPEILM(".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):1
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
