BQITUIX ;PRXM/HC/KJH - Build Taxonomy Program ; 18 Jul 2006 12:46 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
Q
;
BLDTAX(TAX,TARGET) ; PEP
;
; Takes a taxonomy name and builds an array that can then be used
; to scan various V-File cross-references to see which records
; match an entry in the Taxonomy.
;
; Currently supported Taxonomies are as follows:
; (where FILE is field #.15 in the TAXONOMY file #9002226)
; ICD9 Diagnoses via ICD9 codes (^ICD9 - FILE 80)
; ICD9 Procedures via ICD9 codes (^ICD0 - FILE 80.1)
; CPT Procedures via CPT codes (^ICPT - FILE 81)
; Medications via NDC codes (^PSDRUG - FILE 2)
; Medications via MED IEN (^PSDRUG - FILE 50)
; Laboratory tests via LOINC codes (^LAB(60) - FILE 95.3)
; Patient Education Topics by name (^AUTTEDT - FILE 9999999.09)
; NOTE: Use BLDTAX1 below if providing a list of partial Patient Education Topic Codes to match.
; Immunizations via HL7/CVX codes (^AUTTIMM - FILE 9999999.14)
; Health Factors by Name (^AUTTHF - FILE 9999999.64)
; (where FILE is field #.09 in the LAB TAXONOMY file #9002228)
; Laboratory tests via LAB IEN (^LAB(60) - FILE 60)
; VA Drug Class (^PS(50.605 - FILE 50.605)
; Community (^AUTTCOM - FILE 9999999.05)
; Clinics (^DIC(40.7 - FILE 40.7)
;
; Input:
; TAX = Name of Taxonomy from ATXAX or ATXLAB file.
; (required)
; TARGET = Closed array reference where the output will be stored.
; (required)
; This can be a local variable or global reference.
; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
;
; Output:
; An array in the local or global TARGET of the form:
; @TARGET@(IEN)=NAME (.01 field)
;
; NOTE: Kill the output array before calling the function unless
; you intend to group several Taxonomies of the same type.
;
N FILEREF,TAXIEN,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME
I TARGET=""!(TAX="") Q
S TAXIEN=$O(^ATXAX("B",TAX,0)),TAXREF="^ATXAX"
I TAXIEN="" S TAXIEN=$O(^ATXLAB("B",TAX,0)),TAXREF="^ATXLAB"
I TAXIEN="" Q
I TAXREF="^ATXAX" S FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I")
I TAXREF="^ATXLAB" S FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")
I FILEREF="",TAX[" NDC" S FILEREF=50.67
; The following file references from Taxonomy are supported:
I $F(",40.7,80,80.1,81,2,50,95.3,9999999.09,9999999.14,9999999.64,60,50.605,9999999.05,50.67,",","_FILEREF_",")=0 Q
S ENTRY=0
F S ENTRY=$O(@TAXREF@(TAXIEN,21,ENTRY)) Q:'ENTRY D
.S VALUE=@TAXREF@(TAXIEN,21,ENTRY,0)
.S VAL=$P(VALUE,U,1),END=$P(VALUE,U,2)
.; LAB entries use the IEN and only specify one value.
.I FILEREF=60 D Q
..S NAME=$P($G(^LAB(60,VAL,0)),U,1),@TARGET@(VAL)=NAME
.; MED entries use the IEN and only specify one value.
.I FILEREF=50.605 D Q
..NEW X,NVAL
..S NVAL=$O(^PS(50.605,"B",VAL,"")) Q:NVAL=""
..S X="" F S X=$O(^PSDRUG("VAC",NVAL,X)) Q:X="" D
...S NAME=$P($G(^PSDRUG(X,0)),U,1),@TARGET@(X)=NAME
.I FILEREF=50 D Q
..S NAME=$P($G(^PSDRUG(VAL,0)),U,1),@TARGET@(VAL)=NAME
.I FILEREF=40.7 D Q
..S NAME=$P($G(^DIC(40.7,VAL,0)),U,1),@TARGET@(VAL)=NAME
.; Otherwise, treat all items as ranges (even if there is only one entry).
.I END="" S END=VAL
.D
..I FILEREF=95.3 D Q
...; The LOINC x-ref in LAB does not use the check digit (piece 2).
...S VAL=$P(VAL,"-"),END=$P(END,"-")
...S FILE="^LAB(60)",INDEX="AF"
..I FILEREF=50.67 S FILE="^PSDRUG",INDEX="D" Q
..I FILEREF=9999999.05 S FILE="^AUTTCOM",INDEX="B" Q
..I FILEREF=9999999.09 S FILE="^AUTTEDT",INDEX="B" Q
..I FILEREF=9999999.14 S FILE="^AUTTIMM",INDEX="C" Q
..I FILEREF=9999999.64 S FILE="^AUTTHF",INDEX="B" Q
..; CPT, ICD9, and ICD0 require a SPACE be added to the code.
..; Some Taxonomy entries already have the space included.
..S:$E(VAL,$L(VAL))'=" " VAL=VAL_" "
..S:$E(END,$L(END))'=" " END=END_" "
..I FILEREF=80 S FILE="^ICD9",INDEX="BA" Q
..I FILEREF=80.1 S FILE="^ICD0",INDEX="BA" Q
..I FILEREF=81 S FILE="^ICPT",INDEX="BA" Q
. I VAL?.N,FILEREF=9999999.09 S NAME=$P(@FILE@(VAL,0),U,1),@TARGET@(VAL)=NAME Q
.; Backup one entry so loop can find all the entries in the range.
.S VAL=$O(@FILE@(INDEX,VAL),-1)
.F S VAL=$O(@FILE@(INDEX,VAL)) Q:VAL="" Q:$$CHECK(VAL,END) D
..S IEN=""
..F S IEN=$O(@FILE@(INDEX,VAL,IEN)) Q:IEN="" D
...S NAME=$P($G(@FILE@(IEN,0)),U,1)
...S @TARGET@(IEN)=NAME
Q
;
CHECK(V,E) ;
N Z
I V=E Q 0
S Z(V)=""
S Z(E)=""
I $O(Z(""))=E Q 1
Q 0
;
BLDTAX1(TAX,TARGET) ;EP
;
; Takes a list of partial Patient Education topic names and
; builds an array that can then be used to scan a V-File
; cross-reference to see which records match an entry in the
; list.
;
; This tag only supports Patient Education:
; (where FILE is field #.15 in the TAXONOMY file #9002226)
; Patient Education Topic Codes (^AUTTEDT - FILE 9999999.09)
;
; Input:
; TAX = PATIENT EDUCATION TOPIC CODE LIST to search for
; (required)
;
; Example: "CD-,-CD,AOD-,-AOD"
; Example: "*BGP HIV/AIDS DXS"
;
; Returns items where the MNEMONIC field for the Patient
; Education entry contains one of the listed values.
;
; Second example shows an ICD taxonomy name.
; If used, will search for any Patient Education entry
; containing one of the values in that Taxonomy.
;
; TARGET : Closed array reference where the output will be stored.
; This can be a local variable or global reference.
; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
;
; Output:
; An array in the local or global TARGET of the form:
; @TARGET@(IEN)=NAME (.01 field)
;
; NOTE: Kill the output array before calling the function unless
; you intend to group several Taxonomies of the same type.
;
N VAL,IEN,NAME,MNEMONIC,TAX1,I,ICDIEN,FLG
F I=1:1:$L(TAX,",") S TAX1=$P(TAX,",",I) I $E(TAX1)="*" D BLDTAX($E(TAX1,2,$L(TAX1)),"ICDIEN")
S VAL=""
F S VAL=$O(^AUTTEDT("B",VAL)) Q:VAL="" D
.S IEN=""
.F S IEN=$O(^AUTTEDT("B",VAL,IEN)) Q:IEN="" D
..S NAME=$$GET1^DIQ(9999999.09,IEN,.01,"I"),MNEMONIC=$$GET1^DIQ(9999999.09,IEN,1,"I"),FLG=0
..F I=1:1:$L(TAX,",") S TAX1=$P(TAX,",",I) I $E(TAX1)'="*",MNEMONIC[TAX1 S @TARGET@(IEN)=NAME_U_MNEMONIC,FLG=1 Q
..I FLG=1 Q
..S I=""
..;If an ICD is used as the MNEMONIC it will be formatted as "ICD-abbreviation".
..;For example, if the ICD is "042." and the patient education is 'alcohol or drugs' then the MNEMONIC would be "042.-AOD".
..F S I=$O(ICDIEN(I)) Q:I="" S TAX1=ICDIEN(I)_"-" I MNEMONIC[TAX1 S @TARGET@(IEN)=NAME_U_MNEMONIC,FLG=1 Q
..I FLG=1 Q
..Q
.Q
Q
BQITUIX ;PRXM/HC/KJH - Build Taxonomy Program ; 18 Jul 2006 12:46 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 QUIT
+3 ;
BLDTAX(TAX,TARGET) ; PEP
+1 ;
+2 ; Takes a taxonomy name and builds an array that can then be used
+3 ; to scan various V-File cross-references to see which records
+4 ; match an entry in the Taxonomy.
+5 ;
+6 ; Currently supported Taxonomies are as follows:
+7 ; (where FILE is field #.15 in the TAXONOMY file #9002226)
+8 ; ICD9 Diagnoses via ICD9 codes (^ICD9 - FILE 80)
+9 ; ICD9 Procedures via ICD9 codes (^ICD0 - FILE 80.1)
+10 ; CPT Procedures via CPT codes (^ICPT - FILE 81)
+11 ; Medications via NDC codes (^PSDRUG - FILE 2)
+12 ; Medications via MED IEN (^PSDRUG - FILE 50)
+13 ; Laboratory tests via LOINC codes (^LAB(60) - FILE 95.3)
+14 ; Patient Education Topics by name (^AUTTEDT - FILE 9999999.09)
+15 ; NOTE: Use BLDTAX1 below if providing a list of partial Patient Education Topic Codes to match.
+16 ; Immunizations via HL7/CVX codes (^AUTTIMM - FILE 9999999.14)
+17 ; Health Factors by Name (^AUTTHF - FILE 9999999.64)
+18 ; (where FILE is field #.09 in the LAB TAXONOMY file #9002228)
+19 ; Laboratory tests via LAB IEN (^LAB(60) - FILE 60)
+20 ; VA Drug Class (^PS(50.605 - FILE 50.605)
+21 ; Community (^AUTTCOM - FILE 9999999.05)
+22 ; Clinics (^DIC(40.7 - FILE 40.7)
+23 ;
+24 ; Input:
+25 ; TAX = Name of Taxonomy from ATXAX or ATXLAB file.
+26 ; (required)
+27 ; TARGET = Closed array reference where the output will be stored.
+28 ; (required)
+29 ; This can be a local variable or global reference.
+30 ; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
+31 ;
+32 ; Output:
+33 ; An array in the local or global TARGET of the form:
+34 ; @TARGET@(IEN)=NAME (.01 field)
+35 ;
+36 ; NOTE: Kill the output array before calling the function unless
+37 ; you intend to group several Taxonomies of the same type.
+38 ;
+39 NEW FILEREF,TAXIEN,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME
+40 IF TARGET=""!(TAX="")
QUIT
+41 SET TAXIEN=$ORDER(^ATXAX("B",TAX,0))
SET TAXREF="^ATXAX"
+42 IF TAXIEN=""
SET TAXIEN=$ORDER(^ATXLAB("B",TAX,0))
SET TAXREF="^ATXLAB"
+43 IF TAXIEN=""
QUIT
+44 IF TAXREF="^ATXAX"
SET FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I")
+45 IF TAXREF="^ATXLAB"
SET FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")
+46 IF FILEREF=""
IF TAX[" NDC"
SET FILEREF=50.67
+47 ; The following file references from Taxonomy are supported:
+48 IF $FIND(",40.7,80,80.1,81,2,50,95.3,9999999.09,9999999.14,9999999.64,60,50.605,9999999.05,50.67,",","_FILEREF_",")=0
QUIT
+49 SET ENTRY=0
+50 FOR
SET ENTRY=$ORDER(@TAXREF@(TAXIEN,21,ENTRY))
IF 'ENTRY
QUIT
Begin DoDot:1
+51 SET VALUE=@TAXREF@(TAXIEN,21,ENTRY,0)
+52 SET VAL=$PIECE(VALUE,U,1)
SET END=$PIECE(VALUE,U,2)
+53 ; LAB entries use the IEN and only specify one value.
+54 IF FILEREF=60
Begin DoDot:2
+55 SET NAME=$PIECE($GET(^LAB(60,VAL,0)),U,1)
SET @TARGET@(VAL)=NAME
End DoDot:2
QUIT
+56 ; MED entries use the IEN and only specify one value.
+57 IF FILEREF=50.605
Begin DoDot:2
+58 NEW X,NVAL
+59 SET NVAL=$ORDER(^PS(50.605,"B",VAL,""))
IF NVAL=""
QUIT
+60 SET X=""
FOR
SET X=$ORDER(^PSDRUG("VAC",NVAL,X))
IF X=""
QUIT
Begin DoDot:3
+61 SET NAME=$PIECE($GET(^PSDRUG(X,0)),U,1)
SET @TARGET@(X)=NAME
End DoDot:3
End DoDot:2
QUIT
+62 IF FILEREF=50
Begin DoDot:2
+63 SET NAME=$PIECE($GET(^PSDRUG(VAL,0)),U,1)
SET @TARGET@(VAL)=NAME
End DoDot:2
QUIT
+64 IF FILEREF=40.7
Begin DoDot:2
+65 SET NAME=$PIECE($GET(^DIC(40.7,VAL,0)),U,1)
SET @TARGET@(VAL)=NAME
End DoDot:2
QUIT
+66 ; Otherwise, treat all items as ranges (even if there is only one entry).
+67 IF END=""
SET END=VAL
+68 Begin DoDot:2
+69 IF FILEREF=95.3
Begin DoDot:3
+70 ; The LOINC x-ref in LAB does not use the check digit (piece 2).
+71 SET VAL=$PIECE(VAL,"-")
SET END=$PIECE(END,"-")
+72 SET FILE="^LAB(60)"
SET INDEX="AF"
End DoDot:3
QUIT
+73 IF FILEREF=50.67
SET FILE="^PSDRUG"
SET INDEX="D"
QUIT
+74 IF FILEREF=9999999.05
SET FILE="^AUTTCOM"
SET INDEX="B"
QUIT
+75 IF FILEREF=9999999.09
SET FILE="^AUTTEDT"
SET INDEX="B"
QUIT
+76 IF FILEREF=9999999.14
SET FILE="^AUTTIMM"
SET INDEX="C"
QUIT
+77 IF FILEREF=9999999.64
SET FILE="^AUTTHF"
SET INDEX="B"
QUIT
+78 ; CPT, ICD9, and ICD0 require a SPACE be added to the code.
+79 ; Some Taxonomy entries already have the space included.
+80 IF $EXTRACT(VAL,$LENGTH(VAL))'=" "
SET VAL=VAL_" "
+81 IF $EXTRACT(END,$LENGTH(END))'=" "
SET END=END_" "
+82 IF FILEREF=80
SET FILE="^ICD9"
SET INDEX="BA"
QUIT
+83 IF FILEREF=80.1
SET FILE="^ICD0"
SET INDEX="BA"
QUIT
+84 IF FILEREF=81
SET FILE="^ICPT"
SET INDEX="BA"
QUIT
End DoDot:2
+85 IF VAL?.N
IF FILEREF=9999999.09
SET NAME=$PIECE(@FILE@(VAL,0),U,1)
SET @TARGET@(VAL)=NAME
QUIT
+86 ; Backup one entry so loop can find all the entries in the range.
+87 SET VAL=$ORDER(@FILE@(INDEX,VAL),-1)
+88 FOR
SET VAL=$ORDER(@FILE@(INDEX,VAL))
IF VAL=""
QUIT
IF $$CHECK(VAL,END)
QUIT
Begin DoDot:2
+89 SET IEN=""
+90 FOR
SET IEN=$ORDER(@FILE@(INDEX,VAL,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+91 SET NAME=$PIECE($GET(@FILE@(IEN,0)),U,1)
+92 SET @TARGET@(IEN)=NAME
End DoDot:3
End DoDot:2
End DoDot:1
+93 QUIT
+94 ;
CHECK(V,E) ;
+1 NEW Z
+2 IF V=E
QUIT 0
+3 SET Z(V)=""
+4 SET Z(E)=""
+5 IF $ORDER(Z(""))=E
QUIT 1
+6 QUIT 0
+7 ;
BLDTAX1(TAX,TARGET) ;EP
+1 ;
+2 ; Takes a list of partial Patient Education topic names and
+3 ; builds an array that can then be used to scan a V-File
+4 ; cross-reference to see which records match an entry in the
+5 ; list.
+6 ;
+7 ; This tag only supports Patient Education:
+8 ; (where FILE is field #.15 in the TAXONOMY file #9002226)
+9 ; Patient Education Topic Codes (^AUTTEDT - FILE 9999999.09)
+10 ;
+11 ; Input:
+12 ; TAX = PATIENT EDUCATION TOPIC CODE LIST to search for
+13 ; (required)
+14 ;
+15 ; Example: "CD-,-CD,AOD-,-AOD"
+16 ; Example: "*BGP HIV/AIDS DXS"
+17 ;
+18 ; Returns items where the MNEMONIC field for the Patient
+19 ; Education entry contains one of the listed values.
+20 ;
+21 ; Second example shows an ICD taxonomy name.
+22 ; If used, will search for any Patient Education entry
+23 ; containing one of the values in that Taxonomy.
+24 ;
+25 ; TARGET : Closed array reference where the output will be stored.
+26 ; This can be a local variable or global reference.
+27 ; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
+28 ;
+29 ; Output:
+30 ; An array in the local or global TARGET of the form:
+31 ; @TARGET@(IEN)=NAME (.01 field)
+32 ;
+33 ; NOTE: Kill the output array before calling the function unless
+34 ; you intend to group several Taxonomies of the same type.
+35 ;
+36 NEW VAL,IEN,NAME,MNEMONIC,TAX1,I,ICDIEN,FLG
+37 FOR I=1:1:$LENGTH(TAX,",")
SET TAX1=$PIECE(TAX,",",I)
IF $EXTRACT(TAX1)="*"
DO BLDTAX($EXTRACT(TAX1,2,$LENGTH(TAX1)),"ICDIEN")
+38 SET VAL=""
+39 FOR
SET VAL=$ORDER(^AUTTEDT("B",VAL))
IF VAL=""
QUIT
Begin DoDot:1
+40 SET IEN=""
+41 FOR
SET IEN=$ORDER(^AUTTEDT("B",VAL,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+42 SET NAME=$$GET1^DIQ(9999999.09,IEN,.01,"I")
SET MNEMONIC=$$GET1^DIQ(9999999.09,IEN,1,"I")
SET FLG=0
+43 FOR I=1:1:$LENGTH(TAX,",")
SET TAX1=$PIECE(TAX,",",I)
IF $EXTRACT(TAX1)'="*"
IF MNEMONIC[TAX1
SET @TARGET@(IEN)=NAME_U_MNEMONIC
SET FLG=1
QUIT
+44 IF FLG=1
QUIT
+45 SET I=""
+46 ;If an ICD is used as the MNEMONIC it will be formatted as "ICD-abbreviation".
+47 ;For example, if the ICD is "042." and the patient education is 'alcohol or drugs' then the MNEMONIC would be "042.-AOD".
+48 FOR
SET I=$ORDER(ICDIEN(I))
IF I=""
QUIT
SET TAX1=ICDIEN(I)_"-"
IF MNEMONIC[TAX1
SET @TARGET@(IEN)=NAME_U_MNEMONIC
SET FLG=1
QUIT
+49 IF FLG=1
QUIT
+50 QUIT
End DoDot:2
+51 QUIT
End DoDot:1
+52 QUIT
