source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEILM.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRCPEILM ;WISC/RFJ-edit inventory items (list manager) ;01 Dec 93
2V ;;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"))
5EN ; 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 ;
18HDR ; build header
19 S VALMHDR(1)="INVENTORY POINT: "_$$INVNAME^PRCPUX1(PRCPINPT)_" * * * IM#: "_ITEMDA_" * * *"
20 Q
21 ;
22 ;
23INIT ; 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 ;
39DESCRIP ; 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 ;
56EXIT ; exit and clean up
57 K ^TMP($J,"PRCPEILM")
58 Q
59 ;
60 ;
61DIQ(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 ;
69CHECK() ; 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
Note: See TracBrowser for help on using the repository browser.