| [613] | 1 | PRCPEILM ;WISC/RFJ-edit inventory items (list manager) ;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 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | EN ; called from protocol file from within another protocol
|
|---|
| 6 | N CLREND,COLUMN,ITEMDA,LINE,PRCPINPT,PRCPDATA,PRCPTYPE
|
|---|
| 7 | S PRCPINPT=PRCP("I"),PRCPTYPE=PRCP("DPTYPE")
|
|---|
| 8 | F W !! S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),1,"","") Q:'ITEMDA D
|
|---|
| 9 | . L +^PRCP(445,PRCPINPT,1,ITEMDA):1 I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-1",0) Q
|
|---|
| 10 | . D ADD^PRCPULOC(445,PRCPINPT_"-1",0,"Enter/Edit Inventory Item Data")
|
|---|
| 11 | . D EN^VALM("PRCP EDIT ITEMS")
|
|---|
| 12 | . I $D(^PRCP(445,PRCPINPT,1,ITEMDA)) D BLDSEG^PRCPHLFM(3,ITEMDA,PRCPINPT) ; send supply station an update of any changes to the item
|
|---|
| 13 | . D CLEAR^PRCPULOC(445,PRCPINPT_"-1",0)
|
|---|
| 14 | . L -^PRCP(445,PRCPINPT,1,ITEMDA)
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | HDR ; build header
|
|---|
| 19 | S VALMHDR(1)="INVENTORY POINT: "_$$INVNAME^PRCPUX1(PRCPINPT)_" * * * IM#: "_ITEMDA_" * * *"
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ;
|
|---|
| 23 | INIT ; build array
|
|---|
| 24 | K PRCPDATA,^TMP($J,"PRCPEILM")
|
|---|
| 25 | D DIQ(".01:51")
|
|---|
| 26 | D DESCRIP
|
|---|
| 27 | D ISSUNITS^PRCPEIL0
|
|---|
| 28 | D LEVELS^PRCPEIL0
|
|---|
| 29 | D QUANTITY^PRCPEIL0
|
|---|
| 30 | D COSTS^PRCPEIL0
|
|---|
| 31 | D OUTSTRAN^PRCPEIL0
|
|---|
| 32 | D SPECIAL^PRCPEIL0
|
|---|
| 33 | I $P(^PRCP(445,PRCPINPT,0),"^",20)="D" D DRUGACCT^PRCPEIL0
|
|---|
| 34 | D SOURCES^PRCPEIL0
|
|---|
| 35 | S VALMCNT=45
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | DESCRIP ; build descriptive array
|
|---|
| 40 | S LINE=1,COLUMN=1,CLREND=80
|
|---|
| 41 | D SET^PRCPEIL0("Descriptive",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|---|
| 42 | D SET^PRCPEIL0("-445",LINE,12,CLREND,.7)
|
|---|
| 43 | D SET^PRCPEIL0("Description-441: "_$P($G(^PRC(441,ITEMDA,0)),"^",2),LINE+1,COLUMN,CLREND)
|
|---|
| 44 | D SET^PRCPEIL0("NSN : "_$$NSN^PRCPUX1(ITEMDA),LINE+2,COLUMN,CLREND)
|
|---|
| 45 | D SET^PRCPEIL0("Group Category ",LINE+3,COLUMN,CLREND,.5)
|
|---|
| 46 | D SET^PRCPEIL0("Main Storage Lo",LINE+4,COLUMN,CLREND,5)
|
|---|
| 47 | S X="",%=0 F S %=$O(^PRCP(445,PRCP("I"),1,ITEMDA,1,%)) Q:'% S X=X_$$STORELOC^PRCPESTO(%)_" " Q:$L(X)>240
|
|---|
| 48 | D SET^PRCPEIL0("Add Storage Loc: "_X,LINE+5,COLUMN,CLREND)
|
|---|
| 49 | S X=$S($D(^PRCP(445.7,ITEMDA)):"CASE CART",$D(^PRCP(445.8,ITEMDA)):"INSTRUMENT KIT",1:$S($$PURCHASE^PRCPU441(ITEMDA):"PURCHASABLE",1:"NOT PURCHASABLE"))
|
|---|
| 50 | S X=$E(X_$J("",30),1,30)_$S($$REUSABLE^PRCPU441(ITEMDA):"REUSABLE",1:"")
|
|---|
| 51 | D SET^PRCPEIL0("Type Of Item : "_X,LINE+6,COLUMN,CLREND)
|
|---|
| 52 | D SET^PRCPEIL0("",LINE+7,COLUMN,CLREND)
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | ;
|
|---|
| 56 | EXIT ; exit and clean up
|
|---|
| 57 | K ^TMP($J,"PRCPEILM")
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | ;
|
|---|
| 61 | DIQ(DR) ; diq call to retrieve data for dr fields
|
|---|
| 62 | N D0,DA,DIC,DIQ,DIQ2
|
|---|
| 63 | S DA(1)=PRCPINPT,DA=ITEMDA,DIQ(0)="E"
|
|---|
| 64 | S DIC="^PRCP(445,"_PRCPINPT_",1,"
|
|---|
| 65 | S DIQ="PRCPDATA" D EN^DIQ1
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | ;
|
|---|
| 69 | CHECK() ; screen for manager access to option
|
|---|
| 70 | ; return 1 for access, 0 for no access
|
|---|
| 71 | I $$KEY^PRCPUREP("PRCP"_$TR(PRCPTYPE,"WSP","W2")_" MGRKEY",DUZ) Q 1
|
|---|
| 72 | Q 0
|
|---|
