- 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 Jan 18, 2025@03:09:07 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 ;