| [613] | 1 | PRCPUX1 ;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 | ;
|
|---|
| 7 | UNIT(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 | ;
|
|---|
| 15 | UNITVAL(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 | ;
|
|---|
| 22 | SKU(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 | ;
|
|---|
| 28 | UNITCODE(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 | ;
|
|---|
| 33 | NSN(ITEMDA) ; return nsn for itemda
|
|---|
| 34 | Q $P($G(^PRC(441,+ITEMDA,0)),"^",5)
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | FSC(ITEMDA) ; return FSC as NSN for a given ITEMDA
|
|---|
| 38 | Q $P($G(^PRC(441,+ITEMDA,0)),"^",3)
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | ACCT(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 | ;
|
|---|
| 46 | ACCT1(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 | ;
|
|---|
| 50 | FOOD(ITEMDA) ; return food group for itemda
|
|---|
| 51 | Q $P($G(^PRC(441,ITEMDA,3)),"^",7)
|
|---|
| 52 | ;
|
|---|
| 53 | ;
|
|---|
| 54 | DESCR(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 | ;
|
|---|
| 60 | INVNAME(INVPT) ; inventory point name for inventory point
|
|---|
| 61 | Q $P($G(^PRCP(445,+INVPT,0)),"^")
|
|---|
| 62 | ;
|
|---|
| 63 | ;
|
|---|
| 64 | FCPDA(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 | ;
|
|---|
| 70 | VENNAME(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 | ;
|
|---|
| 76 | VENDOR(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
|
|---|
