LEXMUCUM.m

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 ---LEXMUCUM   1774     printed  Apr 09, 2024@21:13:58                                                                                                                                                                                                    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       ;