Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HMPMDUTL

HMPMDUTL.m

Go to the documentation of this file. 
  1. HMPMDUTL ;DSS/BLJ,ASMR/RRB - FileMan JSON utilities for HMP;4 November 2015 @16:51:35
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;DE2818 SQA findings Newed HMPCNT, HMPFINI, HMPLAST, TERMCHLD, TERMUNIT, and TERMQUAL ASMR/RRB
  1.  ;
  1.  Q
  1.  ;
  1. EN Q  ; Only call via linetag.
  1. TERM ; Retrieves list of terms
  1.   ; NOTE: This tag will NOT support paged retrieves unless necessary.
  1.   ;         Do not expect them.
  1.   ;
  1.   ; DE2818 SQA findings HMPCNT, HMPFINI, HMPLAST
  1.   ;
  1.   ; Gets terminology.
  1.   N HMPFINI,TERMIENS,TERMCNT,X
  1.   D LIST^DIC("704.101",,,,,,,,"I $P(^(0),U,5)=1")
  1.   M TERMIENS=^TMP("DILIST",$J,2)
  1.   S TERMCNT=$P($G(^TMP("DILIST",$J,0)),U,1)
  1.   K ^TMP("DILIST",$J)
  1.   ;
  1.   F X=0:0 S X=$O(TERMIENS(X)) Q:'X  D
  1.   . N HMPCNT,HMPLAST,RESULT
  1.   . ; term
  1.   . D ONETERM($G(TERMIENS(X)),"RESULT")
  1.   . ;
  1.   . D ADD^HMPEF("RESULT")
  1.   . S HMPCNT=X,HMPLAST=X
  1.   I 'X S HMPFINI=1
  1.   Q
  1. ONETERM(ID,TARGET) ; load one term
  1.   Q:+ID<1  ; Validate integer/id.
  1.   N $ES,$ET,ERRMSG
  1.   S ERRMSG=$$ERRMSG^HMPEF("CLiO Term",ID)
  1.   S $ET="D ERRHDLR^HMPDERRH"
  1.   N TERM,TRM,TERMTYPE
  1.   ;
  1.   D GETS^DIQ("704.101",ID_",","*","IE","TERM")
  1.   N TRM S TRM=$NA(TERM(704.101,""_ID_","))
  1.   S @TARGET@("id")=$G(@TRM@(.01,"E"))
  1.   S @TARGET@("uid")="urn:va:clioterminology:"_$G(@TARGET@("id"))
  1.   S @TARGET@("term")=$$SANITIZE($G(@TRM@(.02,"E")))
  1.   S @TARGET@("abbreviation")=$$SANITIZE($G(@TRM@(.03,"E")))
  1.   S @TARGET@("displayName")=$$SANITIZE($G(@TRM@(.04,"E")))
  1.   ; Get Term Type
  1.   S TERMTYPE=$$SANITIZE($G(@TRM@(.05,"I")))
  1.   D TERMTYPE(TERMTYPE,.TARGET)
  1.   ;
  1.   S @TARGET@("dataType")=$$SANITIZE($G(@TRM@(.06,"I")))
  1.   S @TARGET@("valueType")=$$SANITIZE($G(@TRM@(.07,"I")))
  1.   S @TARGET@("active")=$$SANITIZE($G(@TRM@(.09,"E")))
  1.   S @TARGET@("description")=$$SANITIZE($G(@TRM@(.1,"E")))
  1.   S @TARGET@("helpText")=$$SANITIZE($G(@TRM@(.2,"E")))
  1.   S @TARGET@("booleanValueTrue")=$$SANITIZE($G(@TRM@(.31,"E")))
  1.   S @TARGET@("booleanValueFalse")=$$SANITIZE($G(@TRM@(.32,"E")))
  1.   S @TARGET@("multiSelectPicklist")=$$SANITIZE($G(@TRM@(.33,"E")))
  1.   S @TARGET@("VUID")="urn:va:vuid:"_$$SANITIZE($G(@TRM@(99.99,"E")))
  1.   ; term -> child terms
  1.   ;
  1.   ; NOTE: As coded, the initial load is a function of DFN. But this load
  1.   ;        is a function of UID. May become normed either to UID or IFN.
  1.   ;
  1.   D TERMCHLD($G(@TRM@(.01,"E")),.TARGET)
  1.   ;
  1.   ; term -> unit pair
  1.   D TERMUNIT($G(@TRM@(.01,"E")),.TARGET)
  1.   ;
  1.   ; term -> qualifier pair
  1.   ;
  1.   D TERMQUAL($G(@TRM@(.01,"E")),.TARGET,ID)
  1.   ;
  1.   ; NOTE: As coded, term -> unit conversions are not retrieved.
  1.   ;        That will be part of future development.
  1.   ;
  1.   K TERMTYPE,TRM
  1.   Q
  1.   ;
  1. TERMTYPE(ID,TARGET) ; Load term types.
  1.   ;
  1.   ; TARGET is passed by reference.  
  1.   ;
  1.   Q:+ID<1  ; Validate for direct IFN lookup.
  1.   N TERMTYPE
  1.   D GETS^DIQ("704.102",ID_",","*","E","TERMTYPE") ;ICR 5748 DE2818 ASF 11/25/15
  1.   N HMPNAME S HMPNAME=$T(TTFLDS+1)
  1.   ;
  1.   N HMPEPLAC S HMPEPLAC("""")="\"""
  1.   S @TARGET@("termType",$P(HMPNAME,";",3))=ID
  1.   S @TARGET@("termType",$P(HMPNAME,";",4))=$$SANITIZE($$REPLACE^XLFSTR(TERMTYPE("704.102",ID_",",.01,"E"),.HMPEPLAC)) ;ICR 5748 DE2818 ASF 11/25/15
  1.   S @TARGET@("termType",$P(HMPNAME,";",5))=$$SANITIZE($$REPLACE^XLFSTR(TERMTYPE("704.102",ID_",",.02,"E"),.HMPEPLAC))
  1.   S @TARGET@("termType",$P(HMPNAME,";",6))=$$SANITIZE($$REPLACE^XLFSTR(TERMTYPE("704.102",ID_",",.03,"E"),.HMPEPLAC))
  1.   K TERMTYPE
  1.   Q
  1. TERMCHLD(ID,TARGET) ;Loads child terms for a term
  1.   ;
  1.   ;DE2818 SQA findings Newed TERMCHLD
  1.   N MSGROOT,TERMCHLD
  1.   S MSGROOT="TERMCHLD("""_ID_""")"
  1.   D FIND^DIC("704.106",,".02E;.03I;.04I;.05E;.06E;.07E;.08E;.09E","M",ID,,,,,MSGROOT)
  1.   ; Check to see if we actually have any children.
  1.   I +$P(TERMCHLD(ID,"DILIST",0),U,1)<1 K @MSGROOT Q
  1.   N X F X=0:0 S X=($O(TERMCHLD(ID,"DILIST","ID",X))) Q:'X  D
  1.   . ; .01 is the Term ID
  1.   . S @TARGET@("termChild",X,"childOrder")=$$SANITIZE($G(TERMCHLD(ID,"DILIST","ID",X,.02)))
  1.   . ; .03 is the Child ID
  1.   . N CHILD S CHILD=$NA(@TARGET@("termChild",X,"childTerm"))
  1.   . D ONETERM($G(TERMCHLD(ID,"DILIST","ID",X,.03)),.CHILD)
  1.   . S @TARGET@("termChild",X,"valueType")=$$SANITIZE($G(TERMCHLD(ID,"DILIST","ID",X,.05)))
  1.   . S @TARGET@("termChild",X,"valueDelimiter")=$$SANITIZE($G(TERMCHLD(ID,"DILIST","ID",X,.06)))
  1.   . S @TARGET@("termChild",X,"valueStart")=$$SANITIZE($G(TERMCHLD(ID,"DILIST","ID",X,.07)))
  1.   . S @TARGET@("termChild",X,"valueStop")=$$SANITIZE($G(TERMCHLD(ID,"DILIST","ID",X,.08)))
  1.   . S @TARGET@("termChild",X,"description")=$$SANITIZE($G(TERMCHLD(ID,"DILIST","ID",X,.09)))
  1.   K @MSGROOT
  1.   Q
  1. TERMUNIT(ID,TARGET) ;Loads Units for a term.
  1.  ;
  1.  ;DE2818 SQA findings Newed TERMUNIT
  1.  N MSGROOT,TERMUNIT
  1.  S MSGROOT="TERMUNIT("""_ID_""")"
  1.  D FIND^DIC("704.105",,".02I;.03E;.04E;.05E;.06E;.07E","M",ID,,,,,MSGROOT)
  1.  ; Check to see if we actually have any children.
  1.  I +$P(TERMUNIT(ID,"DILIST",0),U,1)<1 K @MSGROOT Q
  1.  N X F X=0:0 S X=($O(TERMUNIT(ID,"DILIST","ID",X))) Q:'X  D
  1.  . ; .01 is the Term ID
  1.  . ; .02 is the Unit ID
  1.  . N UNIT S UNIT=$NA(@TARGET@("units",X,"unitTerm"))
  1.  . D ONETERM($G(TERMUNIT(ID,"DILIST","ID",X,.02)),.UNIT)
  1.  . S @TARGET@("units",X,"minValue")=$$SANITIZE($G(TERMUNIT(ID,"DILIST","ID",X,.03)))
  1.  . S @TARGET@("units",X,"maxValue")=$$SANITIZE($G(TERMUNIT(ID,"DILIST","ID",X,.04)))
  1.  . S @TARGET@("units",X,"decPrecision")=$$SANITIZE($G(TERMUNIT(ID,"DILIST","ID",X,.05)))
  1.  . S @TARGET@("units",X,"refLow")=$$SANITIZE($G(TERMUNIT(ID,"DILIST","ID",X,.06)))
  1.  . S @TARGET@("units",X,"refHigh")=$$SANITIZE($G(TERMUNIT(ID,"DILIST","ID",X,.07)))
  1.  K @MSGROOT
  1.  Q
  1. TERMQUAL(ID,TARGET,IFN) ;Loads Qualifiers for a term
  1.  ;
  1.  ;DE2818 SQA findings Newed TERQUAL
  1.  N MSGROOT,TERMQUAL
  1.  S MSGROOT="TERMQUAL("""_ID_""")"
  1.  D FIND^DIC("704.103",,".02E;.03I;.04E","M",ID,,,,,MSGROOT)
  1.  ; Check to see if we actually have any qualifiers.
  1.  I +$P(TERMQUAL(ID,"DILIST",0),U,1)<1 K @MSGROOT Q
  1.  N X F X=0:0 S X=($O(TERMQUAL(ID,"DILIST","ID",X))) Q:'X  D
  1.  . ; .01 is the Term ID
  1.  . ; .03 is the Qualifier ID
  1.  . N QUAL S QUAL=$NA(@TARGET@("qualifiers",X,"qualTerm"))
  1.  . ; blj 28 Feb 2014: bandaid to prevent recursive calls if someone has messed up the structure of the TERM_QUALIFIER file.
  1.  . I IFN'=$G(TERMQUAL(ID,"DILIST","ID",X,.03)) D ONETERM($G(TERMQUAL(ID,"DILIST","ID",X,.03)),.QUAL)
  1.  . S @TARGET@("qualifiers",X,"qualOrder")=$$SANITIZE($G(TERMQUAL(ID,"DILIST","ID",X,.02)))
  1.  . S @TARGET@("qualifiers",X,"ranking")=$$SANITIZE($G(TERMQUAL(ID,"DILIST","ID",X,.04)))
  1.  K @MSGROOT
  1.  Q
  1. SANITIZE(VALUE) ; Makes sure values are formatted correctly.
  1.  I +VALUE'=VALUE Q VALUE
  1.  I VALUE?1".".N S VALUE="0"_VALUE
  1.  I VALUE?1"-.".N S VALUE="-0"_$E(VALUE,2,$LENGTH(VALUE))
  1.  Q VALUE
  1.  ;
  1. GENGUID() ;
  1.  N X,AB
  1.  S X="",AB=$R(4),AB=$S(AB=0:"8",AB=1:"9",AB=2:"A",1:"B")
  1.  F  S X=X_$$BASE^XLFUTL($R(16),10,16) Q:$L(X)>31
  1.  S X="{"_$E(X,1,8)_"-"_$E(X,9,12)_"-"_"4"_$E(X,14,16)_"-"_AB_$E(X,18,20)_"-"_$E(X,21,32)_"}"
  1.  Q X
  1. TRMFLDS ;Fields for terminology
  1.   ;;.01;id
  1.   ;;.02;term
  1.   ;;.03;abbreviation
  1.   ;;.04;displayName
  1.   ;;.05;termType
  1.   ;;.06;dataType
  1.   ;;.07;valueType
  1.   ;;.09;active
  1.   ;;.1;description
  1.   ;;.2;helpText;
  1.   ;;.31;booleanValueTrue
  1.   ;;.32;booleanValueFalse;
  1.   ;;.33;multiSelectPicklist
  1.   ;;99.99;VUID
  1.   ;;***
  1. TTFLDS ;Fields for Term Typea
  1.   ;;id;type;xmlTag;VUID