152 lines
3.8 KiB
Mathematica
152 lines
3.8 KiB
Mathematica
PRCPEIL1 ;WISC/RFJ-edit inventory item (list manager) calls ;01 Dec 93
|
|
V ;;5.1;IFCAP;**1**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, 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
|
|
D FULL^VALM1
|
|
D QTY^PRCPEIQT(PRCPINPT,ITEMDA)
|
|
; rebuild array
|
|
D DIQ^PRCPEILM("7;4.8;4.81")
|
|
D QUANTITY^PRCPEIL0
|
|
D COSTS^PRCPEIL0
|
|
S VALMBCK="R"
|
|
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
|