PSAHELP.m

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

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