source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUX1.m@ 1582

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PRCPUX1 ;WISC/RFJ/DGL/DWA-extrinsic functions ; 7/22/99 3:08pm
2 ;;5.1;IFCAP;**17**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7UNIT(INVPT,ITEMDA,DELIM) ; unit per issue for inventory point and item
8 ; if delim delimiter : pkgmult delim units (1 per EA)
9 N D,Y
10 S D=$G(^PRCP(445,+INVPT,1,+ITEMDA,0)),Y=$S($P(D,"^",14):$P(D,"^",14),1:"?")_"/"_$$UNITCODE($P(D,"^",5))
11 I $G(DELIM)'="" S Y=$P(Y,"/")_DELIM_$P(Y,"/",2)
12 Q Y
13 ;
14 ;
15UNITVAL(PKGMULT,UNITS,DELIM) ; unit per issue for values passed as follows:
16 N Y
17 S Y=$S(PKGMULT:PKGMULT,1:"?")_"/"_$$UNITCODE(UNITS)
18 I $G(DELIM)'="" S Y=$P(Y,"/")_DELIM_$P(Y,"/",2)
19 Q Y
20 ;
21 ;
22SKU(INVPT,ITEMDA) ; get the sku for an item in the item master file
23 N %
24 S %=$$UNITCODE($P($G(^PRC(441,+ITEMDA,3)),"^",8)) I %["?" S %=$$UNITCODE($P($G(^PRCP(445,+INVPT,1,+ITEMDA,0)),"^",5))
25 Q %
26 ;
27 ;
28UNITCODE(UNITS) ; get 2 character unit code from file 420.5
29 N % S %=$P($G(^PRCD(420.5,+UNITS,0)),"^") S:%="" %="??"
30 Q %
31 ;
32 ;
33NSN(ITEMDA) ; return nsn for itemda
34 Q $P($G(^PRC(441,+ITEMDA,0)),"^",5)
35 ;
36 ;
37FSC(ITEMDA) ; return FSC as NSN for a given ITEMDA
38 Q $P($G(^PRC(441,+ITEMDA,0)),"^",3)
39 ;
40 ;
41ACCT(NSN) ; return account code for nsn (first 4 digits)
42 I $G(DT)="" Q 8
43 Q $S(DT>2971000:8,NSN=6505!(NSN=6508):1,$E(NSN,1,2)=65!($E(NSN,1,2)=66):2,NSN=8975:3,$E(NSN,1,2)=89:8,$E(NSN,1,2)=91:6,1:3)
44 ;
45 ;
46ACCT1(NSN) ; return account code for nsn for GIP
47 Q $S(NSN=6505!(NSN=6508):1,$E(NSN,1,2)=65!($E(NSN,1,2)=66):2,NSN=8975:3,$E(NSN,1,2)=89:8,$E(NSN,1,2)=91:6,1:3)
48 ;
49 ;
50FOOD(ITEMDA) ; return food group for itemda
51 Q $P($G(^PRC(441,ITEMDA,3)),"^",7)
52 ;
53 ;
54DESCR(INVPT,ITEMDA) ; description from inventory point or item master file
55 N Y
56 S Y=$P($G(^PRCP(445,+INVPT,1,+ITEMDA,6)),"^") I Y="" S Y=$P($G(^PRC(441,+ITEMDA,0)),"^",2)
57 Q Y
58 ;
59 ;
60INVNAME(INVPT) ; inventory point name for inventory point
61 Q $P($G(^PRCP(445,+INVPT,0)),"^")
62 ;
63 ;
64FCPDA(SITE,INVPT) ; returns fund control point da number for site and invpt
65 N Y
66 S Y=$P($G(^PRC(420,+SITE,1,+$O(^PRC(420,"AE",+SITE,+INVPT,0)),0))," ") I Y'="" S Y=SITE_Y ; Multiple FCP not supported
67 Q Y
68 ;
69 ;
70VENNAME(VENDA) ; return vendor name for da;global (445 or 440)
71 I VENDA["PRC(440" Q $P($G(^PRC(440,+VENDA,0)),"^")
72 I VENDA["PRCP(445" Q $$INVNAME(+VENDA)
73 Q ""
74 ;
75 ;
76VENDOR(INVPT,ITEMDA) ; return vendor number or name
77 N TYPE,X,Y
78 S TYPE=$P($G(^PRCP(445,INVPT,0)),"^",3),X=$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",12),Y=""
79 I TYPE="W" S Y=+X
80 I TYPE="P" S Y=$S(X["440":+X,1:"WHSE")
81 I TYPE="S" S Y=$P($$INVNAME(+X),"-",2,99)
82 Q Y
Note: See TracBrowser for help on using the repository browser.