| 1 | PSAHELP ;BHM/DAV - UNIT OF MEASURE ASSISTANCE ;7/23/97 | 
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,17,21**; 10/24/97 | 
|---|
| 3 | Q:PSANDC=0 | 
|---|
| 4 | ; | 
|---|
| 5 | ;References to ^PSDRUG( are covered by IA# 2095 | 
|---|
| 6 | ;References to ^DIC(51.5, are covered by IA #1931 | 
|---|
| 7 | ;This routine was created because the routines that were to | 
|---|
| 8 | ;be altered, were too large for corrections. | 
|---|
| 9 | S PSAVSN=$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN") | 
|---|
| 10 | D PSANDC1 S PSANDC1=PSANDCX | 
|---|
| 11 | ;Provide an Adjusted Unit of measure if available. | 
|---|
| 12 | I '$D(PSADRG) G NOUOM | 
|---|
| 13 | S PSASYN=$P(PSADATA,"^",7) | 
|---|
| 14 | I PSASYN="" G SYN | 
|---|
| 15 | I '$D(^PSDRUG("AVSN",PSAVSN,PSADRG,PSASYN)) G SYN | 
|---|
| 16 | I $P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",2)=PSANDC1 S PSAUOM=$P(^PSDRUG(PSADRG,1,PSASYN,0),"^",5) G HAVEUOM | 
|---|
| 17 | ; | 
|---|
| 18 | SYN S PSA=0 F  S PSA=$O(^PSDRUG(PSADRG,1,PSA)) Q:PSA'>0  I $P($G(^PSDRUG(PSADRG,1,PSA,0)),"^",2)=PSANDC1 G SETUOM | 
|---|
| 19 | I $G(PSAUOM)'="" G HAVEUOM | 
|---|
| 20 | G NOUOM | 
|---|
| 21 | SETUOM S DATA=$G(^PSDRUG(PSADRG,1,PSA,0)),UOM=$S($P(DATA,"^",5)'="":$P(DATA,"^",5),$P($G(^PSDRUG(PSADRG,"660")),"^",2)'="":$P(^PSDRUG(PSADRG,"660"),"^",2),1:"") K DATA | 
|---|
| 22 | HAVEUOM ; | 
|---|
| 23 | I $G(PSAUOM)="" G NOUOM | 
|---|
| 24 | S UOM=$P($G(^DIC(51.5,PSAUOM,0)),"^"),UOMDATA=UOM_"~"_PSAUOM | 
|---|
| 25 | S $P(PSADATA,"^",12)=UOMDATA,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",12)=UOMDATA | 
|---|
| 26 | K UOMDATA,UOM Q | 
|---|
| 27 | NOUOM W ?50,"(Blank)" | 
|---|
| 28 | Q | 
|---|
| 29 | PSANDC1 ;Called to format NDC to delimited format | 
|---|
| 30 | I $L(PSANDC)=12 S PSANDCX=$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12) Q | 
|---|
| 31 | I $L(PSANDC)=11 S PSANDCX=$E(PSANDC,1,5)_"-"_$E(PSANDC,6,9)_"-"_$E(PSANDC,10,11) Q | 
|---|
| 32 | S PSANDCX=PSANDC | 
|---|
| 33 | I $G(PSANDCX)="" S PSANDCX="Unknown NDC" | 
|---|
| 34 | Q | 
|---|