PXRMVSTX ;SLC/PKR - Routines for building taxonomies for value sets. ;09/16/2014
;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
;==========================================
BLDCODEL(VSIEN,TAXIEN) ;Populate the code list.
N CODE,CSYSIEN,IND,JND,LEXSAB,SAVEOK,TC
K ^TMP("PXRMCODES",$J)
S IND=0
F S IND=+$O(^PXRM(802.2,VSIEN,2,IND)) Q:IND=0 D
. S CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
. S LEXSAB=$P(^PXRM(802.1,CSYSIEN,0),U,4)
.;DBIA #5679
. S TC=$P($$CSYS^LEXU(LEXSAB),U,4)_" codes from value set (imported)"
. S JND=0
. F S JND=+$O(^PXRM(802.2,VSIEN,2,IND,1,JND)) Q:JND=0 D
.. S CODE=^PXRM(802.2,VSIEN,2,IND,1,JND,0)
.. I $$CHKCODE(LEXSAB,CODE)=-1 Q
.. S ^TMP("PXRMCODES",$J,TC,LEXSAB,CODE)=""
;Format is: ^TMP("PXRMCODES",$J,TC,CODESYS,CODE)=UID
S SAVEOK=$$SAVETC^PXRMTXIM(TAXIEN)
I 'SAVEOK W !,"Could not save terms."
I SAVEOK D POSTSAVE^PXRMTXSM(TAXIEN)
Q
;
;==========================================
BLDTAX(VSIEN) ;Build a taxonony from a value set.
N DESC,ERRMSG,NAME,OID,TXDATA,VSNAME
I '$$SCSYS(VSIEN) H 2 Q
;Get the name of the taxonomy to create.
S NAME=$$GETNAME(VSIEN)
I (NAME="^")!(NAME="") Q
S OID=$P(^PXRM(802.2,VSIEN,1),U,1)
S VDATE=$P(^PXRM(802.2,VSIEN,1),U,3)
S DESC(1,0)="This taxonomy was automatically generated from the value set:"
S DESC(2,0)=" "_$P(^PXRM(802.2,VSIEN,0),U,1)
S DESC(3,0)=" OID - "_OID
S DESC(4,0)=" Version Date - "_$$FMTE^XLFDT(VDATE)
S TXDATA("NAME")=NAME
S TXDATA("CLASS")="L"
M TXDATA("DESC")=DESC
S TXDATA("OID")=OID
S TXDATA("VERSION DATE")=VDATE
S TAXIEN=$$CRETAX^PXRMTXIM("E",.TXDATA,.ERRMSG)
I TAXIEN=0 H 2 Q
W !,"Created taxonomy ",NAME
W !,"Populating the code list ..."
;Populate the code list.
D BLDCODEL(VSIEN,TAXIEN)
;Initialize the Change Log.
D INICLOG(TAXIEN,.DESC)
H 2
Q
;
;==========================================
CHKCODE(LEXSAB,CODE) ;Verify that a code is in the Lexicon.
N CDATA,PDATA,RESULT
;DBIA #5679
S RESULT=$$CSDATA^LEXU(CODE,LEXSAB,DT,.CDATA)
S RESULT=$$PERIOD^LEXU(CODE,LEXSAB,.PDATA)
I +RESULT=-1 D
. W !,"Lexicon does not recognize the ",LEXSAB," code: ",CODE
. W !,"It will not be added to the taxonomy."
Q +RESULT
;
;==========================================
CMPALL(OUTTYPE) ;Find all taxonomies generated from a value set and compare
;the codes in the taxonomy with those in the most recent version of
;the value set.
N NL,OUTPUT,TAXIEN,VSOID
S NL=0
S VSOID=""
F S VSOID=$O(^PXD(811.2,"VSOID",VSOID)) Q:VSOID="" D
. S TAXIEN=""
. F S TAXIEN=$O(^PXD(811.2,"VSOID",VSOID,TAXIEN)) Q:TAXIEN="" D
.. D CMPTXVS(TAXIEN,VSOID,.NL,.OUTPUT)
I OUTTYPE="B" D BROWSE^DDBR("OUTPUT","NR","Taxonomy Value Set Code Comparison")
I OUTTYPE="M" D
. N IND,SUBJECT,TO
. S SUBJECT="VALUE SETS WERE UPDATED"
. S TO(DUZ)=""
. K ^TMP("PXRMXMZ",$J)
.;MailMan has a built-in width of 79.
. F IND=1:1:NL S ^TMP("PXRMXMZ",$J,IND,0)=$E(OUTPUT(IND),1,79)
. D SEND^PXRMMSG("PXRMXMZ",SUBJECT,.TO,DUZ)
. K ^TMP("PXRMXMZ",$J)
Q
;
;==========================================
CMPTXVS(TAXIEN,VSOID,NL,OUTPUT) ;For taxonomies that were generated from a
;value set compare the codes in the most recent version of the
;value set to the codes in the taxonomy.
I $P($G(^PXD(811.2,TAXIEN,40)),U,1)'=VSOID Q
N CODE,CODESYS,TAXNAME,TAXVDATE,UID,VDATE,VSIEN,VSNAME
S VSIEN=$O(^PXRM(802.2,"OID",VSOID,""),-1)
S VSNAME=$P(^PXRM(802.2,VSIEN,0),U,1)
S VDATE=$P(^PXRM(802.2,VSIEN,1),U,3)
S TAXNAME=$P(^PXD(811.2,TAXIEN,0),U,1)
S TAXVDATE=$P(^PXD(811.2,TAXIEN,40),U,2)
S NL=NL+1,OUTPUT(NL)=""
S NL=NL+1,OUTPUT(NL)="Checking taxonomy "_TAXNAME
S NL=NL+1,OUTPUT(NL)=" It was generated from the value set:"
S NL=NL+1,OUTPUT(NL)=" "_VSNAME
S NL=NL+1,OUTPUT(NL)=" OID - "_VSOID
S NL=NL+1,OUTPUT(NL)=" The most recent version of the value set is dated "_$$FMTE^XLFDT(VDATE)_"."
S NL=NL+1,OUTPUT(NL)=" The taxonomy was generated from the version dated "_$$FMTE^XLFDT(TAXVDATE)_"."
I TAXVDATE'=VDATE S NL=NL+1,OUTPUT(NL)=" The comparison is being made with the most recent version of the value set."
;Build a list of codes in the value set in the same structure as the
;"AE" index in the taxonomy. ^TMP($J,"VSCODES")
D GVSCODES(VSIEN,"VSCODES")
K ^TMP($J,"TAXCODES")
M ^TMP($J,"TAXCODES")=^PXD(811.2,TAXIEN,20,"AE")
;Compare the two lists of codes, keep the differences.
S CODESYS=""
F S CODESYS=$O(^TMP($J,"TAXCODES",CODESYS)) Q:CODESYS="" D
. S CODE=""
. F S CODE=$O(^TMP($J,"TAXCODES",CODESYS,CODE)) Q:CODE="" D
.. I $D(^TMP($J,"VSCODES",CODESYS,CODE)) K ^TMP($J,"VSCODES",CODESYS,CODE),^TMP($J,"TAXCODES",CODESYS,CODE)
;
;Create the result output.
I $D(^TMP($J,"TAXCODES")) D
. S NL=NL+1,OUTPUT(NL)=""
. S NL=NL+1,OUTPUT(NL)="The following codes are in the taxonomy but not in the value set:"
. S CODESYS=""
. F S CODESYS=$O(^TMP($J,"TAXCODES",CODESYS)) Q:CODESYS="" D
.. S NL=NL+1,OUTPUT(NL)="Coding system "_$P($$CSYS^LEXU(CODESYS),U,4)
.. S NL=NL+1,OUTPUT(NL)="Code INACT UID Description"
.. S NL=NL+1,OUTPUT(NL)="------------------ ----- --- -----------"
.. S CODE=""
.. F S CODE=$O(^TMP($J,"TAXCODES",CODESYS,CODE)) Q:CODE="" D
... S UID=$S($D(^PXD(811.2,TAXIEN,20,"AUID",CODESYS,CODE)):1,1:0)
... D CDETAILC^PXRMTXIN(CODESYS,CODE,UID,.NL,.OUTPUT)
I $D(^TMP($J,"VSCODES")) D
. S NL=NL+1,OUTPUT(NL)=""
. S NL=NL+1,OUTPUT(NL)="The following codes are in the value set but not in the taxonomy:"
. S CODESYS=""
. F S CODESYS=$O(^TMP($J,"VSCODES",CODESYS)) Q:CODESYS="" D
.. S NL=NL+1,OUTPUT(NL)="Coding system "_$P($$CSYS^LEXU(CODESYS),U,4)
.. S NL=NL+1,OUTPUT(NL)="Code INACT Description"
.. S NL=NL+1,OUTPUT(NL)="------------------ ----- -----------"
.. S CODE=""
.. F S CODE=$O(^TMP($J,"VSCODES",CODESYS,CODE)) Q:CODE="" D
... D CDETAILC^PXRMTXIN(CODESYS,CODE,"",.NL,.OUTPUT)
I '$D(^TMP($J,"TAXCODES")),'$D(^TMP($J,"VSCODES")) D
. S NL=NL+1,OUTPUT(NL)=""
. S NL=NL+1,OUTPUT(NL)="The list of codes in the taxonomy is identical to the list of codes in the"
. S NL=NL+1,OUTPUT(NL)="value set."
S NL=NL+1,OUTPUT(NL)=""
K ^TMP($J,"TAXCODES"),^TMP($J,"VSCODES")
Q
;
;==========================================
GVSCODES(VSIEN,NODE) ;Get the codes in a value set.
N CODE,CSYSIEN,IND,JND,LEXSAB
K ^TMP($J,NODE)
S IND=0
F S IND=+$O(^PXRM(802.2,VSIEN,2,IND)) Q:IND=0 D
. S CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
. S LEXSAB=$P(^PXRM(802.1,CSYSIEN,0),U,4)
. S JND=0
. F S JND=+$O(^PXRM(802.2,VSIEN,2,IND,1,JND)) Q:JND=0 D
.. S CODE=^PXRM(802.2,VSIEN,2,IND,1,JND,0)
.. S ^TMP($J,NODE,LEXSAB,CODE)=""
Q
;
;==========================================
GETNAME(VSIEN) ;
N DIR,FIELDLEN,NAME,TEXT,VSNAME,X,Y
S VSNAME=$P(^PXRM(802.2,VSIEN,0),U,1)
S VSNAME=$$UP^XLFSTR(VSNAME)
S FIELDLEN=$$GET1^DID(811.2,.01,"","FIELD LENGTH")
S DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
S DIR("A")="Please enter the taxonomy name"
I $L(VSNAME)'>FIELDLEN S DIR("B")=VSNAME
GETNAM W ! D ^DIR
S NAME=Y
;Make sure the new name is valid.
I $D(^PXD(811.2,"B",NAME)) D G GETNAM
. S TEXT(1)="A taxonomy named "_NAME_" already exists!"
. S TEXT(2)="Please choose a unique name."
. D EN^DDIOL(.TEXT)
I '$$VNAME^PXRMINTR(NAME) G GETNAM
Q NAME
;
;==========================================
INICLOG(IEN,TEXT) ;Initialize the change log.
N IENS,FDA,FDAIEN,MSG
S IENS="+1,"_IEN_","
S FDA(811.21,IENS,.01)=$$NOW^XLFDT
S FDA(811.21,IENS,1)=DUZ
S FDA(811.21,IENS,2)="TEXT"
D UPDATE^DIE("S","FDA","FDAIEN","MSG")
Q
;
;==========================================
SCSYS(VSIEN) ;Scan the coding systems in the value set to determine if it
;contains any supported coding systems.
N CSYSIEN,LEXSAB,OK,NCSYS,TEMP
W !,"Scanning the coding systems used in the value set ..."
S NCSYS=+$P(^PXRM(802.2,VSIEN,2,0),U,3)
I NCSYS=0 D Q 0
. W !,"No coding systems were found, cannot create a taxonomy."
. H 2
S IND=0,OK=0
F S IND=+$O(^PXRM(802.2,VSIEN,2,IND)) Q:IND=0 D
. S CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
. S TEMP=^PXRM(802.1,CSYSIEN,0)
. S LEXSAB=$P(TEMP,U,4)
. I LEXSAB="" W !," ",$P(TEMP,U,1)," is not a supported coding system." Q
. I $$VCSYS^PXRMTAXD(LEXSAB) S OK=1 W !," Will import ",$P(TEMP,U,1)," codes into the taxonomy."
I 'OK W !,"No supported coding systems were found, cannot create a taxonomy." H 2
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMVSTX 8468 printed Dec 13, 2024@01:50:03 Page 2
PXRMVSTX ;SLC/PKR - Routines for building taxonomies for value sets. ;09/16/2014
+1 ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
+2 ;==========================================
BLDCODEL(VSIEN,TAXIEN) ;Populate the code list.
+1 NEW CODE,CSYSIEN,IND,JND,LEXSAB,SAVEOK,TC
+2 KILL ^TMP("PXRMCODES",$JOB)
+3 SET IND=0
+4 FOR
SET IND=+$ORDER(^PXRM(802.2,VSIEN,2,IND))
if IND=0
QUIT
Begin DoDot:1
+5 SET CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
+6 SET LEXSAB=$PIECE(^PXRM(802.1,CSYSIEN,0),U,4)
+7 ;DBIA #5679
+8 SET TC=$PIECE($$CSYS^LEXU(LEXSAB),U,4)_" codes from value set (imported)"
+9 SET JND=0
+10 FOR
SET JND=+$ORDER(^PXRM(802.2,VSIEN,2,IND,1,JND))
if JND=0
QUIT
Begin DoDot:2
+11 SET CODE=^PXRM(802.2,VSIEN,2,IND,1,JND,0)
+12 IF $$CHKCODE(LEXSAB,CODE)=-1
QUIT
+13 SET ^TMP("PXRMCODES",$JOB,TC,LEXSAB,CODE)=""
End DoDot:2
End DoDot:1
+14 ;Format is: ^TMP("PXRMCODES",$J,TC,CODESYS,CODE)=UID
+15 SET SAVEOK=$$SAVETC^PXRMTXIM(TAXIEN)
+16 IF 'SAVEOK
WRITE !,"Could not save terms."
+17 IF SAVEOK
DO POSTSAVE^PXRMTXSM(TAXIEN)
+18 QUIT
+19 ;
+20 ;==========================================
BLDTAX(VSIEN) ;Build a taxonony from a value set.
+1 NEW DESC,ERRMSG,NAME,OID,TXDATA,VSNAME
+2 IF '$$SCSYS(VSIEN)
HANG 2
QUIT
+3 ;Get the name of the taxonomy to create.
+4 SET NAME=$$GETNAME(VSIEN)
+5 IF (NAME="^")!(NAME="")
QUIT
+6 SET OID=$PIECE(^PXRM(802.2,VSIEN,1),U,1)
+7 SET VDATE=$PIECE(^PXRM(802.2,VSIEN,1),U,3)
+8 SET DESC(1,0)="This taxonomy was automatically generated from the value set:"
+9 SET DESC(2,0)=" "_$PIECE(^PXRM(802.2,VSIEN,0),U,1)
+10 SET DESC(3,0)=" OID - "_OID
+11 SET DESC(4,0)=" Version Date - "_$$FMTE^XLFDT(VDATE)
+12 SET TXDATA("NAME")=NAME
+13 SET TXDATA("CLASS")="L"
+14 MERGE TXDATA("DESC")=DESC
+15 SET TXDATA("OID")=OID
+16 SET TXDATA("VERSION DATE")=VDATE
+17 SET TAXIEN=$$CRETAX^PXRMTXIM("E",.TXDATA,.ERRMSG)
+18 IF TAXIEN=0
HANG 2
QUIT
+19 WRITE !,"Created taxonomy ",NAME
+20 WRITE !,"Populating the code list ..."
+21 ;Populate the code list.
+22 DO BLDCODEL(VSIEN,TAXIEN)
+23 ;Initialize the Change Log.
+24 DO INICLOG(TAXIEN,.DESC)
+25 HANG 2
+26 QUIT
+27 ;
+28 ;==========================================
CHKCODE(LEXSAB,CODE) ;Verify that a code is in the Lexicon.
+1 NEW CDATA,PDATA,RESULT
+2 ;DBIA #5679
+3 SET RESULT=$$CSDATA^LEXU(CODE,LEXSAB,DT,.CDATA)
+4 SET RESULT=$$PERIOD^LEXU(CODE,LEXSAB,.PDATA)
+5 IF +RESULT=-1
Begin DoDot:1
+6 WRITE !,"Lexicon does not recognize the ",LEXSAB," code: ",CODE
+7 WRITE !,"It will not be added to the taxonomy."
End DoDot:1
+8 QUIT +RESULT
+9 ;
+10 ;==========================================
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
+2 ;the value set.
+3 NEW NL,OUTPUT,TAXIEN,VSOID
+4 SET NL=0
+5 SET VSOID=""
+6 FOR
SET VSOID=$ORDER(^PXD(811.2,"VSOID",VSOID))
if VSOID=""
QUIT
Begin DoDot:1
+7 SET TAXIEN=""
+8 FOR
SET TAXIEN=$ORDER(^PXD(811.2,"VSOID",VSOID,TAXIEN))
if TAXIEN=""
QUIT
Begin DoDot:2
+9 DO CMPTXVS(TAXIEN,VSOID,.NL,.OUTPUT)
End DoDot:2
End DoDot:1
+10 IF OUTTYPE="B"
DO BROWSE^DDBR("OUTPUT","NR","Taxonomy Value Set Code Comparison")
+11 IF OUTTYPE="M"
Begin DoDot:1
+12 NEW IND,SUBJECT,TO
+13 SET SUBJECT="VALUE SETS WERE UPDATED"
+14 SET TO(DUZ)=""
+15 KILL ^TMP("PXRMXMZ",$JOB)
+16 ;MailMan has a built-in width of 79.
+17 FOR IND=1:1:NL
SET ^TMP("PXRMXMZ",$JOB,IND,0)=$EXTRACT(OUTPUT(IND),1,79)
+18 DO SEND^PXRMMSG("PXRMXMZ",SUBJECT,.TO,DUZ)
+19 KILL ^TMP("PXRMXMZ",$JOB)
End DoDot:1
+20 QUIT
+21 ;
+22 ;==========================================
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
+2 ;value set to the codes in the taxonomy.
+3 IF $PIECE($GET(^PXD(811.2,TAXIEN,40)),U,1)'=VSOID
QUIT
+4 NEW CODE,CODESYS,TAXNAME,TAXVDATE,UID,VDATE,VSIEN,VSNAME
+5 SET VSIEN=$ORDER(^PXRM(802.2,"OID",VSOID,""),-1)
+6 SET VSNAME=$PIECE(^PXRM(802.2,VSIEN,0),U,1)
+7 SET VDATE=$PIECE(^PXRM(802.2,VSIEN,1),U,3)
+8 SET TAXNAME=$PIECE(^PXD(811.2,TAXIEN,0),U,1)
+9 SET TAXVDATE=$PIECE(^PXD(811.2,TAXIEN,40),U,2)
+10 SET NL=NL+1
SET OUTPUT(NL)=""
+11 SET NL=NL+1
SET OUTPUT(NL)="Checking taxonomy "_TAXNAME
+12 SET NL=NL+1
SET OUTPUT(NL)=" It was generated from the value set:"
+13 SET NL=NL+1
SET OUTPUT(NL)=" "_VSNAME
+14 SET NL=NL+1
SET OUTPUT(NL)=" OID - "_VSOID
+15 SET NL=NL+1
SET OUTPUT(NL)=" The most recent version of the value set is dated "_$$FMTE^XLFDT(VDATE)_"."
+16 SET NL=NL+1
SET OUTPUT(NL)=" The taxonomy was generated from the version dated "_$$FMTE^XLFDT(TAXVDATE)_"."
+17 IF TAXVDATE'=VDATE
SET NL=NL+1
SET OUTPUT(NL)=" The comparison is being made with the most recent version of the value set."
+18 ;Build a list of codes in the value set in the same structure as the
+19 ;"AE" index in the taxonomy. ^TMP($J,"VSCODES")
+20 DO GVSCODES(VSIEN,"VSCODES")
+21 KILL ^TMP($JOB,"TAXCODES")
+22 MERGE ^TMP($JOB,"TAXCODES")=^PXD(811.2,TAXIEN,20,"AE")
+23 ;Compare the two lists of codes, keep the differences.
+24 SET CODESYS=""
+25 FOR
SET CODESYS=$ORDER(^TMP($JOB,"TAXCODES",CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+26 SET CODE=""
+27 FOR
SET CODE=$ORDER(^TMP($JOB,"TAXCODES",CODESYS,CODE))
if CODE=""
QUIT
Begin DoDot:2
+28 IF $DATA(^TMP($JOB,"VSCODES",CODESYS,CODE))
KILL ^TMP($JOB,"VSCODES",CODESYS,CODE),^TMP($JOB,"TAXCODES",CODESYS,CODE)
End DoDot:2
End DoDot:1
+29 ;
+30 ;Create the result output.
+31 IF $DATA(^TMP($JOB,"TAXCODES"))
Begin DoDot:1
+32 SET NL=NL+1
SET OUTPUT(NL)=""
+33 SET NL=NL+1
SET OUTPUT(NL)="The following codes are in the taxonomy but not in the value set:"
+34 SET CODESYS=""
+35 FOR
SET CODESYS=$ORDER(^TMP($JOB,"TAXCODES",CODESYS))
if CODESYS=""
QUIT
Begin DoDot:2
+36 SET NL=NL+1
SET OUTPUT(NL)="Coding system "_$PIECE($$CSYS^LEXU(CODESYS),U,4)
+37 SET NL=NL+1
SET OUTPUT(NL)="Code INACT UID Description"
+38 SET NL=NL+1
SET OUTPUT(NL)="------------------ ----- --- -----------"
+39 SET CODE=""
+40 FOR
SET CODE=$ORDER(^TMP($JOB,"TAXCODES",CODESYS,CODE))
if CODE=""
QUIT
Begin DoDot:3
+41 SET UID=$SELECT($DATA(^PXD(811.2,TAXIEN,20,"AUID",CODESYS,CODE)):1,1:0)
+42 DO CDETAILC^PXRMTXIN(CODESYS,CODE,UID,.NL,.OUTPUT)
End DoDot:3
End DoDot:2
End DoDot:1
+43 IF $DATA(^TMP($JOB,"VSCODES"))
Begin DoDot:1
+44 SET NL=NL+1
SET OUTPUT(NL)=""
+45 SET NL=NL+1
SET OUTPUT(NL)="The following codes are in the value set but not in the taxonomy:"
+46 SET CODESYS=""
+47 FOR
SET CODESYS=$ORDER(^TMP($JOB,"VSCODES",CODESYS))
if CODESYS=""
QUIT
Begin DoDot:2
+48 SET NL=NL+1
SET OUTPUT(NL)="Coding system "_$PIECE($$CSYS^LEXU(CODESYS),U,4)
+49 SET NL=NL+1
SET OUTPUT(NL)="Code INACT Description"
+50 SET NL=NL+1
SET OUTPUT(NL)="------------------ ----- -----------"
+51 SET CODE=""
+52 FOR
SET CODE=$ORDER(^TMP($JOB,"VSCODES",CODESYS,CODE))
if CODE=""
QUIT
Begin DoDot:3
+53 DO CDETAILC^PXRMTXIN(CODESYS,CODE,"",.NL,.OUTPUT)
End DoDot:3
End DoDot:2
End DoDot:1
+54 IF '$DATA(^TMP($JOB,"TAXCODES"))
IF '$DATA(^TMP($JOB,"VSCODES"))
Begin DoDot:1
+55 SET NL=NL+1
SET OUTPUT(NL)=""
+56 SET NL=NL+1
SET OUTPUT(NL)="The list of codes in the taxonomy is identical to the list of codes in the"
+57 SET NL=NL+1
SET OUTPUT(NL)="value set."
End DoDot:1
+58 SET NL=NL+1
SET OUTPUT(NL)=""
+59 KILL ^TMP($JOB,"TAXCODES"),^TMP($JOB,"VSCODES")
+60 QUIT
+61 ;
+62 ;==========================================
GVSCODES(VSIEN,NODE) ;Get the codes in a value set.
+1 NEW CODE,CSYSIEN,IND,JND,LEXSAB
+2 KILL ^TMP($JOB,NODE)
+3 SET IND=0
+4 FOR
SET IND=+$ORDER(^PXRM(802.2,VSIEN,2,IND))
if IND=0
QUIT
Begin DoDot:1
+5 SET CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
+6 SET LEXSAB=$PIECE(^PXRM(802.1,CSYSIEN,0),U,4)
+7 SET JND=0
+8 FOR
SET JND=+$ORDER(^PXRM(802.2,VSIEN,2,IND,1,JND))
if JND=0
QUIT
Begin DoDot:2
+9 SET CODE=^PXRM(802.2,VSIEN,2,IND,1,JND,0)
+10 SET ^TMP($JOB,NODE,LEXSAB,CODE)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
+13 ;==========================================
GETNAME(VSIEN) ;
+1 NEW DIR,FIELDLEN,NAME,TEXT,VSNAME,X,Y
+2 SET VSNAME=$PIECE(^PXRM(802.2,VSIEN,0),U,1)
+3 SET VSNAME=$$UP^XLFSTR(VSNAME)
+4 SET FIELDLEN=$$GET1^DID(811.2,.01,"","FIELD LENGTH")
+5 SET DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
+6 SET DIR("A")="Please enter the taxonomy name"
+7 IF $LENGTH(VSNAME)'>FIELDLEN
SET DIR("B")=VSNAME
GETNAM WRITE !
DO ^DIR
+1 SET NAME=Y
+2 ;Make sure the new name is valid.
+3 IF $DATA(^PXD(811.2,"B",NAME))
Begin DoDot:1
+4 SET TEXT(1)="A taxonomy named "_NAME_" already exists!"
+5 SET TEXT(2)="Please choose a unique name."
+6 DO EN^DDIOL(.TEXT)
End DoDot:1
GOTO GETNAM
+7 IF '$$VNAME^PXRMINTR(NAME)
GOTO GETNAM
+8 QUIT NAME
+9 ;
+10 ;==========================================
INICLOG(IEN,TEXT) ;Initialize the change log.
+1 NEW IENS,FDA,FDAIEN,MSG
+2 SET IENS="+1,"_IEN_","
+3 SET FDA(811.21,IENS,.01)=$$NOW^XLFDT
+4 SET FDA(811.21,IENS,1)=DUZ
+5 SET FDA(811.21,IENS,2)="TEXT"
+6 DO UPDATE^DIE("S","FDA","FDAIEN","MSG")
+7 QUIT
+8 ;
+9 ;==========================================
SCSYS(VSIEN) ;Scan the coding systems in the value set to determine if it
+1 ;contains any supported coding systems.
+2 NEW CSYSIEN,LEXSAB,OK,NCSYS,TEMP
+3 WRITE !,"Scanning the coding systems used in the value set ..."
+4 SET NCSYS=+$PIECE(^PXRM(802.2,VSIEN,2,0),U,3)
+5 IF NCSYS=0
Begin DoDot:1
+6 WRITE !,"No coding systems were found, cannot create a taxonomy."
+7 HANG 2
End DoDot:1
QUIT 0
+8 SET IND=0
SET OK=0
+9 FOR
SET IND=+$ORDER(^PXRM(802.2,VSIEN,2,IND))
if IND=0
QUIT
Begin DoDot:1
+10 SET CSYSIEN=^PXRM(802.2,VSIEN,2,IND,0)
+11 SET TEMP=^PXRM(802.1,CSYSIEN,0)
+12 SET LEXSAB=$PIECE(TEMP,U,4)
+13 IF LEXSAB=""
WRITE !," ",$PIECE(TEMP,U,1)," is not a supported coding system."
QUIT
+14 IF $$VCSYS^PXRMTAXD(LEXSAB)
SET OK=1
WRITE !," Will import ",$PIECE(TEMP,U,1)," codes into the taxonomy."
End DoDot:1
+15 IF 'OK
WRITE !,"No supported coding systems were found, cannot create a taxonomy."
HANG 2
+16 QUIT OK
+17 ;
