PSAHELP ;BHM/DAV - UNIT OF MEASURE ASSISTANCE ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,17,21**; 10/24/97
Q:PSANDC=0
;
;References to ^PSDRUG( are covered by IA# 2095
;References to ^DIC(51.5, are covered by IA #1931
;This routine was created because the routines that were to
;be altered, were too large for corrections.
S PSAVSN=$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN")
D PSANDC1 S PSANDC1=PSANDCX
;Provide an Adjusted Unit of measure if available.
I '$D(PSADRG) G NOUOM
S PSASYN=$P(PSADATA,"^",7)
I PSASYN="" G SYN
I '$D(^PSDRUG("AVSN",PSAVSN,PSADRG,PSASYN)) G SYN
I $P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",2)=PSANDC1 S PSAUOM=$P(^PSDRUG(PSADRG,1,PSASYN,0),"^",5) G HAVEUOM
;
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
I $G(PSAUOM)'="" G HAVEUOM
G NOUOM
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
HAVEUOM ;
I $G(PSAUOM)="" G NOUOM
S UOM=$P($G(^DIC(51.5,PSAUOM,0)),"^"),UOMDATA=UOM_"~"_PSAUOM
S $P(PSADATA,"^",12)=UOMDATA,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",12)=UOMDATA
K UOMDATA,UOM Q
NOUOM W ?50,"(Blank)"
Q
PSANDC1 ;Called to format NDC to delimited format
I $L(PSANDC)=12 S PSANDCX=$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12) Q
I $L(PSANDC)=11 S PSANDCX=$E(PSANDC,1,5)_"-"_$E(PSANDC,6,9)_"-"_$E(PSANDC,10,11) Q
S PSANDCX=PSANDC
I $G(PSANDCX)="" S PSANDCX="Unknown NDC"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAHELP 1615 printed Sep 23, 2025@19:25:24 Page 2
PSAHELP ;BHM/DAV - UNIT OF MEASURE ASSISTANCE ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,17,21**; 10/24/97
+2 if PSANDC=0
QUIT
+3 ;
+4 ;References to ^PSDRUG( are covered by IA# 2095
+5 ;References to ^DIC(51.5, are covered by IA #1931
+6 ;This routine was created because the routines that were to
+7 ;be altered, were too large for corrections.
+8 SET PSAVSN=$SELECT($PIECE($PIECE(PSADATA,"^",5),"~")'="":$EXTRACT($PIECE($PIECE(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN")
+9 DO PSANDC1
SET PSANDC1=PSANDCX
+10 ;Provide an Adjusted Unit of measure if available.
+11 IF '$DATA(PSADRG)
GOTO NOUOM
+12 SET PSASYN=$PIECE(PSADATA,"^",7)
+13 IF PSASYN=""
GOTO SYN
+14 IF '$DATA(^PSDRUG("AVSN",PSAVSN,PSADRG,PSASYN))
GOTO SYN
+15 IF $PIECE($GET(^PSDRUG(PSADRG,1,PSASYN,0)),"^",2)=PSANDC1
SET PSAUOM=$PIECE(^PSDRUG(PSADRG,1,PSASYN,0),"^",5)
GOTO HAVEUOM
+16 ;
SYN SET PSA=0
FOR
SET PSA=$ORDER(^PSDRUG(PSADRG,1,PSA))
if PSA'>0
QUIT
IF $PIECE($GET(^PSDRUG(PSADRG,1,PSA,0)),"^",2)=PSANDC1
GOTO SETUOM
+1 IF $GET(PSAUOM)'=""
GOTO HAVEUOM
+2 GOTO NOUOM
SETUOM SET DATA=$GET(^PSDRUG(PSADRG,1,PSA,0))
SET UOM=$SELECT($PIECE(DATA,"^",5)'="":$PIECE(DATA,"^",5),$PIECE($GET(^PSDRUG(PSADRG,"660")),"^",2)'="":$PIECE(^PSDRUG(PSADRG,"660"),"^",2),1:"")
KILL DATA
HAVEUOM ;
+1 IF $GET(PSAUOM)=""
GOTO NOUOM
+2 SET UOM=$PIECE($GET(^DIC(51.5,PSAUOM,0)),"^")
SET UOMDATA=UOM_"~"_PSAUOM
+3 SET $PIECE(PSADATA,"^",12)=UOMDATA
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",12)=UOMDATA
+4 KILL UOMDATA,UOM
QUIT
NOUOM WRITE ?50,"(Blank)"
+1 QUIT
PSANDC1 ;Called to format NDC to delimited format
+1 IF $LENGTH(PSANDC)=12
SET PSANDCX=$EXTRACT(PSANDC,1,6)_"-"_$EXTRACT(PSANDC,7,10)_"-"_$EXTRACT(PSANDC,11,12)
QUIT
+2 IF $LENGTH(PSANDC)=11
SET PSANDCX=$EXTRACT(PSANDC,1,5)_"-"_$EXTRACT(PSANDC,6,9)_"-"_$EXTRACT(PSANDC,10,11)
QUIT
+3 SET PSANDCX=PSANDC
+4 IF $GET(PSANDCX)=""
SET PSANDCX="Unknown NDC"
+5 QUIT
