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

PXRMVSTX.m

Go to the documentation of this file.
  1. PXRMVSTX ;SLC/PKR - Routines for building taxonomies for value sets. ;09/16/2014
  1. ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
  1. ;==========================================
  1. BLDCODEL(VSIEN,TAXIEN) ;Populate the code list.
  1. N CODE,CSYSIEN,IND,JND,LEXSAB,SAVEOK,TC
  1. K ^TMP("PXRMCODES",$J)
  1. S IND=0
  1. F S IND=+$O(^PXRM(802.2,VSIEN,2,IND)) Q:IND=0 D
  1. . S CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
  1. . S LEXSAB=$P(^PXRM(802.1,CSYSIEN,0),U,4)
  1. .;DBIA #5679
  1. . S TC=$P($$CSYS^LEXU(LEXSAB),U,4)_" codes from value set (imported)"
  1. . S JND=0
  1. . F S JND=+$O(^PXRM(802.2,VSIEN,2,IND,1,JND)) Q:JND=0 D
  1. .. S CODE=^PXRM(802.2,VSIEN,2,IND,1,JND,0)
  1. .. I $$CHKCODE(LEXSAB,CODE)=-1 Q
  1. .. S ^TMP("PXRMCODES",$J,TC,LEXSAB,CODE)=""
  1. ;Format is: ^TMP("PXRMCODES",$J,TC,CODESYS,CODE)=UID
  1. S SAVEOK=$$SAVETC^PXRMTXIM(TAXIEN)
  1. I 'SAVEOK W !,"Could not save terms."
  1. I SAVEOK D POSTSAVE^PXRMTXSM(TAXIEN)
  1. Q
  1. ;
  1. ;==========================================
  1. BLDTAX(VSIEN) ;Build a taxonony from a value set.
  1. N DESC,ERRMSG,NAME,OID,TXDATA,VSNAME
  1. I '$$SCSYS(VSIEN) H 2 Q
  1. ;Get the name of the taxonomy to create.
  1. S NAME=$$GETNAME(VSIEN)
  1. I (NAME="^")!(NAME="") Q
  1. S OID=$P(^PXRM(802.2,VSIEN,1),U,1)
  1. S VDATE=$P(^PXRM(802.2,VSIEN,1),U,3)
  1. S DESC(1,0)="This taxonomy was automatically generated from the value set:"
  1. S DESC(2,0)=" "_$P(^PXRM(802.2,VSIEN,0),U,1)
  1. S DESC(3,0)=" OID - "_OID
  1. S DESC(4,0)=" Version Date - "_$$FMTE^XLFDT(VDATE)
  1. S TXDATA("NAME")=NAME
  1. S TXDATA("CLASS")="L"
  1. M TXDATA("DESC")=DESC
  1. S TXDATA("OID")=OID
  1. S TXDATA("VERSION DATE")=VDATE
  1. S TAXIEN=$$CRETAX^PXRMTXIM("E",.TXDATA,.ERRMSG)
  1. I TAXIEN=0 H 2 Q
  1. W !,"Created taxonomy ",NAME
  1. W !,"Populating the code list ..."
  1. ;Populate the code list.
  1. D BLDCODEL(VSIEN,TAXIEN)
  1. ;Initialize the Change Log.
  1. D INICLOG(TAXIEN,.DESC)
  1. H 2
  1. Q
  1. ;
  1. ;==========================================
  1. CHKCODE(LEXSAB,CODE) ;Verify that a code is in the Lexicon.
  1. N CDATA,PDATA,RESULT
  1. ;DBIA #5679
  1. S RESULT=$$CSDATA^LEXU(CODE,LEXSAB,DT,.CDATA)
  1. S RESULT=$$PERIOD^LEXU(CODE,LEXSAB,.PDATA)
  1. I +RESULT=-1 D
  1. . W !,"Lexicon does not recognize the ",LEXSAB," code: ",CODE
  1. . W !,"It will not be added to the taxonomy."
  1. Q +RESULT
  1. ;
  1. ;==========================================
  1. CMPALL(OUTTYPE) ;Find all taxonomies generated from a value set and compare
  1. ;the codes in the taxonomy with those in the most recent version of
  1. ;the value set.
  1. N NL,OUTPUT,TAXIEN,VSOID
  1. S NL=0
  1. S VSOID=""
  1. F S VSOID=$O(^PXD(811.2,"VSOID",VSOID)) Q:VSOID="" D
  1. . S TAXIEN=""
  1. . F S TAXIEN=$O(^PXD(811.2,"VSOID",VSOID,TAXIEN)) Q:TAXIEN="" D
  1. .. D CMPTXVS(TAXIEN,VSOID,.NL,.OUTPUT)
  1. I OUTTYPE="B" D BROWSE^DDBR("OUTPUT","NR","Taxonomy Value Set Code Comparison")
  1. I OUTTYPE="M" D
  1. . N IND,SUBJECT,TO
  1. . S SUBJECT="VALUE SETS WERE UPDATED"
  1. . S TO(DUZ)=""
  1. . K ^TMP("PXRMXMZ",$J)
  1. .;MailMan has a built-in width of 79.
  1. . F IND=1:1:NL S ^TMP("PXRMXMZ",$J,IND,0)=$E(OUTPUT(IND),1,79)
  1. . D SEND^PXRMMSG("PXRMXMZ",SUBJECT,.TO,DUZ)
  1. . K ^TMP("PXRMXMZ",$J)
  1. Q
  1. ;
  1. ;==========================================
  1. CMPTXVS(TAXIEN,VSOID,NL,OUTPUT) ;For taxonomies that were generated from a
  1. ;value set compare the codes in the most recent version of the
  1. ;value set to the codes in the taxonomy.
  1. I $P($G(^PXD(811.2,TAXIEN,40)),U,1)'=VSOID Q
  1. N CODE,CODESYS,TAXNAME,TAXVDATE,UID,VDATE,VSIEN,VSNAME
  1. S VSIEN=$O(^PXRM(802.2,"OID",VSOID,""),-1)
  1. S VSNAME=$P(^PXRM(802.2,VSIEN,0),U,1)
  1. S VDATE=$P(^PXRM(802.2,VSIEN,1),U,3)
  1. S TAXNAME=$P(^PXD(811.2,TAXIEN,0),U,1)
  1. S TAXVDATE=$P(^PXD(811.2,TAXIEN,40),U,2)
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)="Checking taxonomy "_TAXNAME
  1. S NL=NL+1,OUTPUT(NL)=" It was generated from the value set:"
  1. S NL=NL+1,OUTPUT(NL)=" "_VSNAME
  1. S NL=NL+1,OUTPUT(NL)=" OID - "_VSOID
  1. S NL=NL+1,OUTPUT(NL)=" The most recent version of the value set is dated "_$$FMTE^XLFDT(VDATE)_"."
  1. S NL=NL+1,OUTPUT(NL)=" The taxonomy was generated from the version dated "_$$FMTE^XLFDT(TAXVDATE)_"."
  1. I TAXVDATE'=VDATE S NL=NL+1,OUTPUT(NL)=" The comparison is being made with the most recent version of the value set."
  1. ;Build a list of codes in the value set in the same structure as the
  1. ;"AE" index in the taxonomy. ^TMP($J,"VSCODES")
  1. D GVSCODES(VSIEN,"VSCODES")
  1. K ^TMP($J,"TAXCODES")
  1. M ^TMP($J,"TAXCODES")=^PXD(811.2,TAXIEN,20,"AE")
  1. ;Compare the two lists of codes, keep the differences.
  1. S CODESYS=""
  1. F S CODESYS=$O(^TMP($J,"TAXCODES",CODESYS)) Q:CODESYS="" D
  1. . S CODE=""
  1. . F S CODE=$O(^TMP($J,"TAXCODES",CODESYS,CODE)) Q:CODE="" D
  1. .. I $D(^TMP($J,"VSCODES",CODESYS,CODE)) K ^TMP($J,"VSCODES",CODESYS,CODE),^TMP($J,"TAXCODES",CODESYS,CODE)
  1. ;
  1. ;Create the result output.
  1. I $D(^TMP($J,"TAXCODES")) D
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. . S NL=NL+1,OUTPUT(NL)="The following codes are in the taxonomy but not in the value set:"
  1. . S CODESYS=""
  1. . F S CODESYS=$O(^TMP($J,"TAXCODES",CODESYS)) Q:CODESYS="" D
  1. .. S NL=NL+1,OUTPUT(NL)="Coding system "_$P($$CSYS^LEXU(CODESYS),U,4)
  1. .. S NL=NL+1,OUTPUT(NL)="Code INACT UID Description"
  1. .. S NL=NL+1,OUTPUT(NL)="------------------ ----- --- -----------"
  1. .. S CODE=""
  1. .. F S CODE=$O(^TMP($J,"TAXCODES",CODESYS,CODE)) Q:CODE="" D
  1. ... S UID=$S($D(^PXD(811.2,TAXIEN,20,"AUID",CODESYS,CODE)):1,1:0)
  1. ... D CDETAILC^PXRMTXIN(CODESYS,CODE,UID,.NL,.OUTPUT)
  1. I $D(^TMP($J,"VSCODES")) D
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. . S NL=NL+1,OUTPUT(NL)="The following codes are in the value set but not in the taxonomy:"
  1. . S CODESYS=""
  1. . F S CODESYS=$O(^TMP($J,"VSCODES",CODESYS)) Q:CODESYS="" D
  1. .. S NL=NL+1,OUTPUT(NL)="Coding system "_$P($$CSYS^LEXU(CODESYS),U,4)
  1. .. S NL=NL+1,OUTPUT(NL)="Code INACT Description"
  1. .. S NL=NL+1,OUTPUT(NL)="------------------ ----- -----------"
  1. .. S CODE=""
  1. .. F S CODE=$O(^TMP($J,"VSCODES",CODESYS,CODE)) Q:CODE="" D
  1. ... D CDETAILC^PXRMTXIN(CODESYS,CODE,"",.NL,.OUTPUT)
  1. I '$D(^TMP($J,"TAXCODES")),'$D(^TMP($J,"VSCODES")) D
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. . S NL=NL+1,OUTPUT(NL)="The list of codes in the taxonomy is identical to the list of codes in the"
  1. . S NL=NL+1,OUTPUT(NL)="value set."
  1. S NL=NL+1,OUTPUT(NL)=""
  1. K ^TMP($J,"TAXCODES"),^TMP($J,"VSCODES")
  1. Q
  1. ;
  1. ;==========================================
  1. GVSCODES(VSIEN,NODE) ;Get the codes in a value set.
  1. N CODE,CSYSIEN,IND,JND,LEXSAB
  1. K ^TMP($J,NODE)
  1. S IND=0
  1. F S IND=+$O(^PXRM(802.2,VSIEN,2,IND)) Q:IND=0 D
  1. . S CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
  1. . S LEXSAB=$P(^PXRM(802.1,CSYSIEN,0),U,4)
  1. . S JND=0
  1. . F S JND=+$O(^PXRM(802.2,VSIEN,2,IND,1,JND)) Q:JND=0 D
  1. .. S CODE=^PXRM(802.2,VSIEN,2,IND,1,JND,0)
  1. .. S ^TMP($J,NODE,LEXSAB,CODE)=""
  1. Q
  1. ;
  1. ;==========================================
  1. GETNAME(VSIEN) ;
  1. N DIR,FIELDLEN,NAME,TEXT,VSNAME,X,Y
  1. S VSNAME=$P(^PXRM(802.2,VSIEN,0),U,1)
  1. S VSNAME=$$UP^XLFSTR(VSNAME)
  1. S FIELDLEN=$$GET1^DID(811.2,.01,"","FIELD LENGTH")
  1. S DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
  1. S DIR("A")="Please enter the taxonomy name"
  1. I $L(VSNAME)'>FIELDLEN S DIR("B")=VSNAME
  1. GETNAM W ! D ^DIR
  1. S NAME=Y
  1. ;Make sure the new name is valid.
  1. I $D(^PXD(811.2,"B",NAME)) D G GETNAM
  1. . S TEXT(1)="A taxonomy named "_NAME_" already exists!"
  1. . S TEXT(2)="Please choose a unique name."
  1. . D EN^DDIOL(.TEXT)
  1. I '$$VNAME^PXRMINTR(NAME) G GETNAM
  1. Q NAME
  1. ;
  1. ;==========================================
  1. INICLOG(IEN,TEXT) ;Initialize the change log.
  1. N IENS,FDA,FDAIEN,MSG
  1. S IENS="+1,"_IEN_","
  1. S FDA(811.21,IENS,.01)=$$NOW^XLFDT
  1. S FDA(811.21,IENS,1)=DUZ
  1. S FDA(811.21,IENS,2)="TEXT"
  1. D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1. Q
  1. ;
  1. ;==========================================
  1. SCSYS(VSIEN) ;Scan the coding systems in the value set to determine if it
  1. ;contains any supported coding systems.
  1. N CSYSIEN,LEXSAB,OK,NCSYS,TEMP
  1. W !,"Scanning the coding systems used in the value set ..."
  1. S NCSYS=+$P(^PXRM(802.2,VSIEN,2,0),U,3)
  1. I NCSYS=0 D Q 0
  1. . W !,"No coding systems were found, cannot create a taxonomy."
  1. . H 2
  1. S IND=0,OK=0
  1. F S IND=+$O(^PXRM(802.2,VSIEN,2,IND)) Q:IND=0 D
  1. . S CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
  1. . S TEMP=^PXRM(802.1,CSYSIEN,0)
  1. . S LEXSAB=$P(TEMP,U,4)
  1. . I LEXSAB="" W !," ",$P(TEMP,U,1)," is not a supported coding system." Q
  1. . I $$VCSYS^PXRMTAXD(LEXSAB) S OK=1 W !," Will import ",$P(TEMP,U,1)," codes into the taxonomy."
  1. I 'OK W !,"No supported coding systems were found, cannot create a taxonomy." H 2
  1. Q OK
  1. ;