LEXMUCUM ;SLC/PKR - UCUM APIs. ;09/04/2015
;;2.0;LEXICON UTILITY;**102**;Sep 23, 1996;Build 20
;
;==================
UCUMCODE(IEN) ;Given an IEN return the UCUM CODE.
N UCUMCODE
S UCUMCODE=$P($G(^LEX(757.5,IEN,1)),U,1)
I UCUMCODE="" Q "{unit not defined}^The entry with IEN "_IEN_" does not exist."
Q $TR(UCUMCODE,"10*","10^")
;
;==================
UCUMDATA(IDEN,UCUMDATA) ;Given an identifier, which can be an IEN, a
;Description, or a UCUM code return all the fields for that entry.
N IEN,IENL,UCUMCODE,UPIDEN
I IDEN=+IDEN S IENL(+IDEN)=""
S UPIDEN=$$UP^XLFSTR(IDEN)
I '$D(IENL) S IEN=0 F S IEN=+$O(^LEX(757.5,"B",IDEN,IEN)) Q:IEN=0 S IENL(IEN)=""
I '$D(IENL) S IEN=0 F S IEN=+$O(^LEX(757.5,"UPB",UPIDEN,IEN)) Q:IEN=0 S IENL(IEN)=""
I '$D(IENL) S IEN=0 F S IEN=+$O(^LEX(757.5,"C",IDEN,IEN)) Q:IEN=0 S IENL(IEN)=""
I '$D(IENL) S IEN=0 F S IEN=+$O(^LEX(757.5,"UPC",UPIDEN,IEN)) Q:IEN=0 S IENL(IEN)=""
I '$D(IENL) S UCUMDATA("ERROR")="The entry identified by "_IDEN_" does not exist." Q
S IEN=""
F S IEN=$O(IENL(IEN)) Q:IEN="" D
. S UCUMDATA(IEN,"IEN")=IEN
. I '$D(^LEX(757.5,IEN)) S UCUMDATA(IEN,"ERROR")="The entry identified by "_IDEN_" does not exist." Q
. S UCUMDATA(IEN,"DESCRIPTION")=^LEX(757.5,IEN,0)
. S UCUMCODE=$P(^LEX(757.5,IEN,1),U,1)
. S UCUMCODE=$TR(UCUMCODE,"10*","10^")
. S UCUMDATA(IEN,"UCUM CODE")=UCUMCODE
. S UCUMDATA(IEN,"ROW")=$P(^LEX(757.5,IEN,1),U,2)
. S UCUMDATA(IEN,"COMMENTS")=$G(^LEX(757.5,IEN,2))
Q
;
;==================
VERSION(VERDATA) ;Return the version information.
S VERDATA("NAME")="Table of Example UCUM Codes for Electronic Messaging"
S VERDATA("VERSION")="Version 1.3"
S VERDATA("DATE")="09/26/2014"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXMUCUM 1774 printed Sep 23, 2025@19:44:05 Page 2
LEXMUCUM ;SLC/PKR - UCUM APIs. ;09/04/2015
+1 ;;2.0;LEXICON UTILITY;**102**;Sep 23, 1996;Build 20
+2 ;
+3 ;==================
UCUMCODE(IEN) ;Given an IEN return the UCUM CODE.
+1 NEW UCUMCODE
+2 SET UCUMCODE=$PIECE($GET(^LEX(757.5,IEN,1)),U,1)
+3 IF UCUMCODE=""
QUIT "{unit not defined}^The entry with IEN "_IEN_" does not exist."
+4 QUIT $TRANSLATE(UCUMCODE,"10*","10^")
+5 ;
+6 ;==================
UCUMDATA(IDEN,UCUMDATA) ;Given an identifier, which can be an IEN, a
+1 ;Description, or a UCUM code return all the fields for that entry.
+2 NEW IEN,IENL,UCUMCODE,UPIDEN
+3 IF IDEN=+IDEN
SET IENL(+IDEN)=""
+4 SET UPIDEN=$$UP^XLFSTR(IDEN)
+5 IF '$DATA(IENL)
SET IEN=0
FOR
SET IEN=+$ORDER(^LEX(757.5,"B",IDEN,IEN))
if IEN=0
QUIT
SET IENL(IEN)=""
+6 IF '$DATA(IENL)
SET IEN=0
FOR
SET IEN=+$ORDER(^LEX(757.5,"UPB",UPIDEN,IEN))
if IEN=0
QUIT
SET IENL(IEN)=""
+7 IF '$DATA(IENL)
SET IEN=0
FOR
SET IEN=+$ORDER(^LEX(757.5,"C",IDEN,IEN))
if IEN=0
QUIT
SET IENL(IEN)=""
+8 IF '$DATA(IENL)
SET IEN=0
FOR
SET IEN=+$ORDER(^LEX(757.5,"UPC",UPIDEN,IEN))
if IEN=0
QUIT
SET IENL(IEN)=""
+9 IF '$DATA(IENL)
SET UCUMDATA("ERROR")="The entry identified by "_IDEN_" does not exist."
QUIT
+10 SET IEN=""
+11 FOR
SET IEN=$ORDER(IENL(IEN))
if IEN=""
QUIT
Begin DoDot:1
+12 SET UCUMDATA(IEN,"IEN")=IEN
+13 IF '$DATA(^LEX(757.5,IEN))
SET UCUMDATA(IEN,"ERROR")="The entry identified by "_IDEN_" does not exist."
QUIT
+14 SET UCUMDATA(IEN,"DESCRIPTION")=^LEX(757.5,IEN,0)
+15 SET UCUMCODE=$PIECE(^LEX(757.5,IEN,1),U,1)
+16 SET UCUMCODE=$TRANSLATE(UCUMCODE,"10*","10^")
+17 SET UCUMDATA(IEN,"UCUM CODE")=UCUMCODE
+18 SET UCUMDATA(IEN,"ROW")=$PIECE(^LEX(757.5,IEN,1),U,2)
+19 SET UCUMDATA(IEN,"COMMENTS")=$GET(^LEX(757.5,IEN,2))
End DoDot:1
+20 QUIT
+21 ;
+22 ;==================
VERSION(VERDATA) ;Return the version information.
+1 SET VERDATA("NAME")="Table of Example UCUM Codes for Electronic Messaging"
+2 SET VERDATA("VERSION")="Version 1.3"
+3 SET VERDATA("DATE")="09/26/2014"
+4 QUIT
+5 ;
