Routine: ATXAPI

ATXAPI ;GDIT/HS/ALA-Taxonomy APIs ; 13 Feb 2012  12:02 PM

 ;;5.1;TAXONOMY;**11,13**;FEB 4, 1997;Build 13

BLDSV(FILEREF,VAL,TARGET) ;PEP - Add a single value to a target

 ;Description

 ;  Use this if no taxonomy was given but an individual code

 ;Input

 ;  FILEREF - File where the code resides

 ;  VAL - Value

 ;  TARGET - reference where entry is to be placed

 ; The LOINC x-ref in LAB does not use the check digit (piece 2).

 NEW INDEX,VAL,FILE,IEN,END,NAME

 I FILEREF=95.3 S FILE="^LAB(60)",INDEX="AF",VAL=$P(VAL,"-")

 I FILEREF=80 S FILE="^ICD9",INDEX="BA"

 I FILEREF=80.1 S FILE="^ICD0",INDEX="BA"

 I FILEREF=81 S FILE="^ICPT",INDEX="BA"

 S END=VAL

 ; 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

 K FILEREF,FILE,INDEX,VAL,END,NAME,IEN,TARGET

CHECK(V,E) ;EP

N Z

 I V=E Q 0

 S Z(V)=""

 S Z(E)=""

 I $O(Z(""))=E Q 1

Q 0

BLDTAX(TAX,TARGET,TAXIEN,TAXTYP) ; PEP - Expand a taxonomy into a target

 ; 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)

 ;     Dental ADA codes                 (^AUTTDA    - FILE 9999999.31)

 ; 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)"

 ;     TAXIEN = IEN of Taxonomy from ATXAX or ATXLAB file.

 ;     TAXTYP = 'L' for lab, assumes ATXAX

 ; 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,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME,SYS,SYSN,SYSNM

 N QFL,ATXNCAN

 I $G(TARGET)=""!($G(TAX)="") Q

 S TAXTYP=$G(TAXTYP,"")

 I $G(TAXIEN)'="" D

 . I $G(TAXTYP)="L" S TAXREF="^ATXLAB" Q

 . S TAXREF="^ATXAX"

 . I $P($G(@TAXREF@(TAXIEN,0)),U,1)'=TAX S TAXTYP="L",TAXREF="^ATXLAB"

 I $G(TAXIEN)="" D

 . I $G(TAXTYP)="L" S TAXIEN=$O(^ATXLAB("B",TAX,0)),TAXREF="^ATXLAB" Q

 . S TAXIEN=$O(^ATXAX("B",TAX,0)),TAXREF="^ATXAX"

 I TAXIEN="" Q

 I TAXREF="^ATXAX" S FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I"),ATXNCAN=$$GET1^DIQ(9002226,TAXIEN,.13,"I")

 I TAXREF="^ATXLAB" S FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")

 ; The following file references from Taxonomy are supported:

 ;I $F(",40.7,80,80.1,81,50.67,50,95.3,9999999.09,9999999.14,9999999.64,60,50.605,9999999.05,",","_FILEREF_",")=0 Q

 I '$D(^ATXTYPE("C",FILEREF)) 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),SYS=$P(VALUE,U,3)

 .I FILEREF=80 D

 ..S SYSN=$S(SYS'="":SYS,1:1)

 ..S SYS=$S(SYS'="":$P(^ICDS(SYS,0),U,2),1:$P(^ICDS(1,0),U,2))

 ..S SYSNM=$P(^ICDS(SYSN,0),U,1)

 .I FILEREF=80.1 D

 ..S SYSN=$S(SYS'="":SYS,1:2)

 ..S SYS=$S(SYS'="":$P(^ICDS(SYS,0),U,2),1:$P(^ICDS(2,0),U,2))

 ..S SYSNM=$P(^ICDS(SYSN,0),U,1)

 .I +$G(ATXNCAN)=0 S QFL=1 D  Q:QFL

 ..I FILEREF'=9999999.06,FILEREF'=9999999.09 S QFL=0 Q

 ..;I FILEREF=9999999.05 S QFL=0 Q

 ..;I FILEREF=9999999.64 S QFL=0 Q

 ..S FILE=$$ROOT^DILFD(FILEREF,"",1)

 ..I $E(VAL,$L(VAL))=" " S VAL=$E(VAL,1,$L(VAL)-1)

 ..I $E(END,$L(END))=" " S END=$E(END,1,$L(END)-1)

 ..I FILEREF=9999999.06 S NAME=$P($G(^DIC(4,VAL,0)),U,1),@TARGET@(VAL)=NAME Q

 ..I FILEREF=9999999.09,VAL'?.N S QFL=0 Q

 ..S NAME=$P($G(@FILE@(VAL,0)),U,1),@TARGET@(VAL)=NAME

 .D SRCH(FILEREF)

BLDEDU(TAX,TARGET) ;PEP - EDUCATION

 ; 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

ICD(TAXDX,TAX,TAXTY) ;PEP - Checks to see if ICD code is found in certain taxonomy

 ; Input:

 ;    TAXDX=dx ifn

 ;    TAX=taxonomy

 ;    TAXTY=9 for dx or 0 for proc 1 for cpt

 NEW TAXICD,TAXBEG,TAXEND,TAXFLG,TAXIEN,TAXREF,TAXARR

 I TAX?.N S TAXIEN=TAX

 I TAX'?.N D

 . S TAXIEN=$O(^ATXAX("B",TAX,0)),TAXREF="^ATXAX"

 S TAXFLG=0 I '$D(TAXDX)!'$D(TAXIEN)!'$D(TAXTY) Q TAXFLG

 I (TAXDX="")!(TAXIEN="") Q TAXFLG

 ;I TAXTY=9 S SYS=$$CSI^ICDEX(80,TAXDX) S:SYS="" SYS=1

 ;I TAXTY=0 S SYS=$$CSI^ICDEX(80.1,TAXDX) S:SYS="" SYS=2

 ;S TAXICD=$S(TAXTY=1:$P($$CPT^ICPTCOD(TAXDX),U,2),1:$P($$ICDDX^ICDEX(SYS,TAXDX),U,2))

 ;IHS/CMI/LAB  GDIT/ARLIS - MODIFIED TO USE AC IF IT EXISTS

 S TAXARR=$NA(^ATXAX(TAXIEN,21,"AC"))

 I '$D(^ATXAX(TAXIEN,21,"AC")) D BLDTAX($P(^ATXAX(TAXIEN,0),U),.TAXARR,TAXIEN)

 I $D(^ATXAX(TAXIEN,21,"AC",TAXDX)) Q 1

 Q TAXFLG

SRCH(FILEREF) ; Search for values

 ; 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

 .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

 .I FILEREF=9999999.31 S FILE="^AUTTADA",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

 ; 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)

 ..;Does coding system match

 ..I $G(SYSN),SYSN'=$P($G(@FILE@(IEN,1)),U,1) Q

 ..I $G(SYSN) S SYS=$P(^ICDS(SYSN,0),U,2),SYSNM=$P(^ICDS(SYSN,0),U,1)

 ..I $G(ORDER)'="CODE" S @TARGET@(IEN)=NAME_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM) Q

 ..I $G(ORDER)="CODE" S @TARGET@(NAME_" ")=IEN_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM)_U_NAME

LST(SYSN,FILEREF,CODLS,ORDER,TARGET) ;PEP - LIST

 ; Input

 ;    SYSN    - System IEN from 80.4 (1, 2, 30 or 31)

 ;    FILEREF - File reference

 ;    CODLS   - List of codes, can be range 250.00-250.99 or 250*

 ;    ORDER   - Format to get data back (blank returns in IEN order, "CODE" returns in CODE order)

 ;    TARGET  - Target reference

 NEW VAL,END,LG,IEN,SYS,NAME,SYSNM,INDEX

 S SYSN=$G(SYSN)

 I $G(FILEREF)="" S FILEREF=$P(^ICDS(SYSN,0),U,3)

 I CODLS["-" S VAL=$P(CODLS,"-",1),END=$P(CODLS,"-",2) D SRCH(FILEREF) Q

 I CODLS["*" D

 .S VAL=$P(CODLS,"*",1),END=VAL,LG=$L(END)

 .; 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_" "

 .I FILEREF=80 S FILE="^ICD9",INDEX="BA"

 .I FILEREF=80.1 S FILE="^ICD0",INDEX="BA"

 .I FILEREF=81 S FILE="^ICPT",INDEX="BA"

.;

 .F  S VAL=$O(@FILE@(INDEX,VAL)) Q:VAL=""!($E(VAL,1,LG)'=END)  D

 ..S IEN=""

 ..F  S IEN=$O(@FILE@(INDEX,VAL,IEN)) Q:IEN=""  D

 ...S NAME=$P($G(@FILE@(IEN,0)),U,1)

 ...;Does coding system match

 ...I $G(SYSN),SYSN'=$P($G(@FILE@(IEN,1)),U,1) Q

 ...I $G(SYSN) S SYS=$P(^ICDS(SYSN,0),U,2),SYSNM=$P(^ICDS(SYSN,0),U,1)

 ...I $G(ORDER)'="CODE" S @TARGET@(IEN)=NAME_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM) Q

 ...I $G(ORDER)="CODE" S @TARGET@(NAME_" ")=IEN_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM)_U_NAME

ATXAPI    ;GDIT/HS/ALA-Taxonomy APIs ; 13 Feb 2012  12:02 PM

 +1       ;;5.1;TAXONOMY;**11,13**;FEB 4, 1997;Build 13

 +2       ;

BLDSV(FILEREF,VAL,TARGET) ;PEP - Add a single value to a target

 +1       ;Description

 +2       ;  Use this if no taxonomy was given but an individual code

 +3       ;Input

 +4       ;  FILEREF - File where the code resides

 +5       ;  VAL - Value

 +6       ;  TARGET - reference where entry is to be placed

 +7       ;

 +8       ; The LOINC x-ref in LAB does not use the check digit (piece 2).

 +9        NEW INDEX,VAL,FILE,IEN,END,NAME

 +10       IF FILEREF=95.3

               SET FILE="^LAB(60)"

               SET INDEX="AF"

               SET VAL=$PIECE(VAL,"-")

 +11       IF FILEREF=80

               SET FILE="^ICD9"

               SET INDEX="BA"

 +12       IF FILEREF=80.1

               SET FILE="^ICD0"

               SET INDEX="BA"

 +13       IF FILEREF=81

               SET FILE="^ICPT"

               SET INDEX="BA"

 +14       SET END=VAL

 +15      ;

 +16      ; Backup one entry so loop can find all the entries in the range.

 +17       SET VAL=$ORDER(@FILE@(INDEX,VAL),-1)

 +18       FOR

               SET VAL=$ORDER(@FILE@(INDEX,VAL))

               IF VAL=""

                   QUIT

               IF $$CHECK(VAL,END)

                   QUIT

               Begin DoDot:1

 +19               SET IEN=""

 +20               FOR

                       SET IEN=$ORDER(@FILE@(INDEX,VAL,IEN))

                       IF IEN=""

                           QUIT

                       Begin DoDot:2

 +21                       SET NAME=$PIECE($GET(@FILE@(IEN,0)),U,1)

 +22                       SET @TARGET@(IEN)=NAME

                       End DoDot:2

               End DoDot:1

 +23      ;

 +24       KILL FILEREF,FILE,INDEX,VAL,END,NAME,IEN,TARGET

 +25       QUIT

 +26      ;

CHECK(V,E) ;EP

 +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       ;

BLDTAX(TAX,TARGET,TAXIEN,TAXTYP) ; PEP - Expand a taxonomy into a target

 +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      ;     Dental ADA codes                 (^AUTTDA    - FILE 9999999.31)

 +24      ;

 +25      ; Input:

 +26      ;     TAX    = Name of Taxonomy from ATXAX or ATXLAB file.

 +27      ;              (required)

 +28      ;     TARGET = Closed array reference where the output will be stored.

 +29      ;              (required)

 +30      ;              This can be a local variable or global reference.

 +31      ;              (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"

 +32      ;     TAXIEN = IEN of Taxonomy from ATXAX or ATXLAB file.

 +33      ;     TAXTYP = 'L' for lab, assumes ATXAX

 +34      ;

 +35      ; Output:

 +36      ;     An array in the local or global TARGET of the form:

 +37      ;              @TARGET@(IEN)=NAME (.01 field)

 +38      ;

 +39      ;     NOTE: Kill the output array before calling the function unless

 +40      ;           you intend to group several Taxonomies of the same type.

 +41      ;

 +42       NEW FILEREF,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME,SYS,SYSN,SYSNM

 +43       NEW QFL,ATXNCAN

 +44      ;

 +45       IF $GET(TARGET)=""!($GET(TAX)="")

               QUIT

 +46       SET TAXTYP=$GET(TAXTYP,"")

 +47      ;

 +48       IF $GET(TAXIEN)'=""

               Begin DoDot:1

 +49               IF $GET(TAXTYP)="L"

                       SET TAXREF="^ATXLAB"

                       QUIT

 +50               SET TAXREF="^ATXAX"

 +51               IF $PIECE($GET(@TAXREF@(TAXIEN,0)),U,1)'=TAX

                       SET TAXTYP="L"

                       SET TAXREF="^ATXLAB"

               End DoDot:1

 +52      ;

 +53       IF $GET(TAXIEN)=""

               Begin DoDot:1

 +54               IF $GET(TAXTYP)="L"

                       SET TAXIEN=$ORDER(^ATXLAB("B",TAX,0))

                       SET TAXREF="^ATXLAB"

                       QUIT

 +55               SET TAXIEN=$ORDER(^ATXAX("B",TAX,0))

                   SET TAXREF="^ATXAX"

               End DoDot:1

 +56      ;

 +57       IF TAXIEN=""

               QUIT

 +58      ;

 +59       IF TAXREF="^ATXAX"

               SET FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I")

               SET ATXNCAN=$$GET1^DIQ(9002226,TAXIEN,.13,"I")

 +60       IF TAXREF="^ATXLAB"

               SET FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")

 +61      ; The following file references from Taxonomy are supported:

 +62      ;I $F(",40.7,80,80.1,81,50.67,50,95.3,9999999.09,9999999.14,9999999.64,60,50.605,9999999.05,",","_FILEREF_",")=0 Q

 +63       IF '$DATA(^ATXTYPE("C",FILEREF))

               QUIT

 +64       SET ENTRY=0

 +65       FOR

               SET ENTRY=$ORDER(@TAXREF@(TAXIEN,21,ENTRY))

               IF 'ENTRY

                   QUIT

               Begin DoDot:1

 +66               SET VALUE=@TAXREF@(TAXIEN,21,ENTRY,0)

 +67               SET VAL=$PIECE(VALUE,U,1)

                   SET END=$PIECE(VALUE,U,2)

                   SET SYS=$PIECE(VALUE,U,3)

 +68               IF FILEREF=80

                       Begin DoDot:2

 +69                       SET SYSN=$SELECT(SYS'="":SYS,1:1)

 +70                       SET SYS=$SELECT(SYS'="":$PIECE(^ICDS(SYS,0),U,2),1:$PIECE(^ICDS(1,0),U,2))

 +71                       SET SYSNM=$PIECE(^ICDS(SYSN,0),U,1)

                       End DoDot:2

 +72               IF FILEREF=80.1

                       Begin DoDot:2

 +73                       SET SYSN=$SELECT(SYS'="":SYS,1:2)

 +74                       SET SYS=$SELECT(SYS'="":$PIECE(^ICDS(SYS,0),U,2),1:$PIECE(^ICDS(2,0),U,2))

 +75                       SET SYSNM=$PIECE(^ICDS(SYSN,0),U,1)

                       End DoDot:2

 +76               IF +$GET(ATXNCAN)=0

                       SET QFL=1

                       Begin DoDot:2

 +77                       IF FILEREF'=9999999.06

                               IF FILEREF'=9999999.09

                                   SET QFL=0

                                   QUIT

 +78      ;I FILEREF=9999999.05 S QFL=0 Q

 +79      ;I FILEREF=9999999.64 S QFL=0 Q

 +80                       SET FILE=$$ROOT^DILFD(FILEREF,"",1)

 +81                       IF $EXTRACT(VAL,$LENGTH(VAL))=" "

                               SET VAL=$EXTRACT(VAL,1,$LENGTH(VAL)-1)

 +82                       IF $EXTRACT(END,$LENGTH(END))=" "

                               SET END=$EXTRACT(END,1,$LENGTH(END)-1)

 +83                       IF FILEREF=9999999.06

                               SET NAME=$PIECE($GET(^DIC(4,VAL,0)),U,1)

                               SET @TARGET@(VAL)=NAME

                               QUIT

 +84                       IF FILEREF=9999999.09

                               IF VAL'?.N

                                   SET QFL=0

                                   QUIT

 +85                       SET NAME=$PIECE($GET(@FILE@(VAL,0)),U,1)

                           SET @TARGET@(VAL)=NAME

                       End DoDot:2

                       IF QFL

                           QUIT

 +86               DO SRCH(FILEREF)

               End DoDot:1

 +87       QUIT

 +88      ;

BLDEDU(TAX,TARGET) ;PEP - EDUCATION

 +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

 +53      ;

ICD(TAXDX,TAX,TAXTY) ;PEP - Checks to see if ICD code is found in certain taxonomy

 +1       ; Input:

 +2       ;    TAXDX=dx ifn

 +3       ;    TAX=taxonomy

 +4       ;    TAXTY=9 for dx or 0 for proc 1 for cpt

 +5        NEW TAXICD,TAXBEG,TAXEND,TAXFLG,TAXIEN,TAXREF,TAXARR

 +6        IF TAX?.N

               SET TAXIEN=TAX

 +7        IF TAX'?.N

               Begin DoDot:1

 +8                SET TAXIEN=$ORDER(^ATXAX("B",TAX,0))

                   SET TAXREF="^ATXAX"

               End DoDot:1

 +9        SET TAXFLG=0

           IF '$DATA(TAXDX)!'$DATA(TAXIEN)!'$DATA(TAXTY)

               QUIT TAXFLG

 +10       IF (TAXDX="")!(TAXIEN="")

               QUIT TAXFLG

 +11      ;I TAXTY=9 S SYS=$$CSI^ICDEX(80,TAXDX) S:SYS="" SYS=1

 +12      ;I TAXTY=0 S SYS=$$CSI^ICDEX(80.1,TAXDX) S:SYS="" SYS=2

 +13      ;S TAXICD=$S(TAXTY=1:$P($$CPT^ICPTCOD(TAXDX),U,2),1:$P($$ICDDX^ICDEX(SYS,TAXDX),U,2))

 +14      ;IHS/CMI/LAB  GDIT/ARLIS - MODIFIED TO USE AC IF IT EXISTS

 +15       SET TAXARR=$NAME(^ATXAX(TAXIEN,21,"AC"))

 +16       IF '$DATA(^ATXAX(TAXIEN,21,"AC"))

               DO BLDTAX($PIECE(^ATXAX(TAXIEN,0),U),.TAXARR,TAXIEN)

 +17       IF $DATA(^ATXAX(TAXIEN,21,"AC",TAXDX))

               QUIT 1

 +18       QUIT TAXFLG

 +19      ;

SRCH(FILEREF) ; Search for values

 +1       ; LAB entries use the IEN and only specify one value.

 +2        IF FILEREF=60

               Begin DoDot:1

 +3                SET NAME=$PIECE($GET(^LAB(60,VAL,0)),U,1)

                   SET @TARGET@(VAL)=NAME

               End DoDot:1

               QUIT

 +4       ; MED entries use the IEN and only specify one value.

 +5        IF FILEREF=50.605

               Begin DoDot:1

 +6                NEW X,NVAL

 +7                SET NVAL=$ORDER(^PS(50.605,"B",VAL,""))

                   IF NVAL=""

                       QUIT

 +8                SET X=""

FOR

                       SET X=$ORDER(^PSDRUG("VAC",NVAL,X))

                       IF X=""

                           QUIT

                       Begin DoDot:2

 +9                        SET NAME=$PIECE($GET(^PSDRUG(X,0)),U,1)

                           SET @TARGET@(X)=NAME

                       End DoDot:2

               End DoDot:1

               QUIT

 +10       IF FILEREF=50

               Begin DoDot:1

 +11               SET NAME=$PIECE($GET(^PSDRUG(VAL,0)),U,1)

                   SET @TARGET@(VAL)=NAME

               End DoDot:1

               QUIT

 +12       IF FILEREF=40.7

               Begin DoDot:1

 +13               SET NAME=$PIECE($GET(^DIC(40.7,VAL,0)),U,1)

                   SET @TARGET@(VAL)=NAME

               End DoDot:1

               QUIT

 +14      ; Otherwise, treat all items as ranges (even if there is only one entry).

 +15       IF END=""

               SET END=VAL

 +16       Begin DoDot:1

 +17           IF FILEREF=95.3

                   Begin DoDot:2

 +18      ; The LOINC x-ref in LAB does not use the check digit (piece 2).

 +19                   SET VAL=$PIECE(VAL,"-")

                       SET END=$PIECE(END,"-")

 +20                   SET FILE="^LAB(60)"

                       SET INDEX="AF"

                   End DoDot:2

                   QUIT

 +21           IF FILEREF=50.67

                   SET FILE="^PSDRUG"

                   SET INDEX="D"

                   QUIT

 +22           IF FILEREF=9999999.05

                   SET FILE="^AUTTCOM"

                   SET INDEX="B"

                   QUIT

 +23           IF FILEREF=9999999.09

                   SET FILE="^AUTTEDT"

                   SET INDEX="B"

                   QUIT

 +24           IF FILEREF=9999999.14

                   SET FILE="^AUTTIMM"

                   SET INDEX="C"

                   QUIT

 +25           IF FILEREF=9999999.64

                   SET FILE="^AUTTHF"

                   SET INDEX="B"

                   QUIT

 +26           IF FILEREF=9999999.31

                   SET FILE="^AUTTADA"

                   SET INDEX="B"

                   QUIT

 +27      ; CPT, ICD9, and ICD0 require a SPACE be added to the code.

 +28      ; Some Taxonomy entries already have the space included.

 +29           IF $EXTRACT(VAL,$LENGTH(VAL))'=" "

                   SET VAL=VAL_" "

 +30           IF $EXTRACT(END,$LENGTH(END))'=" "

                   SET END=END_" "

 +31           IF FILEREF=80

                   SET FILE="^ICD9"

                   SET INDEX="BA"

                   QUIT

 +32           IF FILEREF=80.1

                   SET FILE="^ICD0"

                   SET INDEX="BA"

                   QUIT

 +33           IF FILEREF=81

                   SET FILE="^ICPT"

                   SET INDEX="BA"

                   QUIT

           End DoDot:1

 +34      ; Backup one entry so loop can find all the entries in the range.

 +35       SET VAL=$ORDER(@FILE@(INDEX,VAL),-1)

 +36       FOR

               SET VAL=$ORDER(@FILE@(INDEX,VAL))

               IF VAL=""

                   QUIT

               IF $$CHECK(VAL,END)

                   QUIT

               Begin DoDot:1

 +37               SET IEN=""

 +38               FOR

                       SET IEN=$ORDER(@FILE@(INDEX,VAL,IEN))

                       IF IEN=""

                           QUIT

                       Begin DoDot:2

 +39                       SET NAME=$PIECE($GET(@FILE@(IEN,0)),U,1)

 +40      ;Does coding system match

 +41                       IF $GET(SYSN)

                               IF SYSN'=$PIECE($GET(@FILE@(IEN,1)),U,1)

                                   QUIT

 +42                       IF $GET(SYSN)

                               SET SYS=$PIECE(^ICDS(SYSN,0),U,2)

                               SET SYSNM=$PIECE(^ICDS(SYSN,0),U,1)

 +43                       IF $GET(ORDER)'="CODE"

                               SET @TARGET@(IEN)=NAME_U_$GET(SYSN)_U_$GET(SYS)_U_$GET(SYSNM)

                               QUIT

 +44                       IF $GET(ORDER)="CODE"

                               SET @TARGET@(NAME_" ")=IEN_U_$GET(SYSN)_U_$GET(SYS)_U_$GET(SYSNM)_U_NAME

                       End DoDot:2

               End DoDot:1

 +45       QUIT

 +46      ;

LST(SYSN,FILEREF,CODLS,ORDER,TARGET) ;PEP - LIST

 +1       ; Input

 +2       ;    SYSN    - System IEN from 80.4 (1, 2, 30 or 31)

 +3       ;    FILEREF - File reference

 +4       ;    CODLS   - List of codes, can be range 250.00-250.99 or 250*

 +5       ;    ORDER   - Format to get data back (blank returns in IEN order, "CODE" returns in CODE order)

 +6       ;    TARGET  - Target reference

 +7       ;

 +8        NEW VAL,END,LG,IEN,SYS,NAME,SYSNM,INDEX

 +9        SET SYSN=$GET(SYSN)

 +10       IF $GET(FILEREF)=""

               SET FILEREF=$PIECE(^ICDS(SYSN,0),U,3)

 +11       IF CODLS["-"

               SET VAL=$PIECE(CODLS,"-",1)

               SET END=$PIECE(CODLS,"-",2)

               DO SRCH(FILEREF)

               QUIT

 +12       IF CODLS["*"

               Begin DoDot:1

 +13               SET VAL=$PIECE(CODLS,"*",1)

                   SET END=VAL

                   SET LG=$LENGTH(END)

 +14      ; CPT, ICD9, and ICD0 require a SPACE be added to the code.

 +15      ; Some Taxonomy entries already have the space included.

 +16               IF $EXTRACT(VAL,$LENGTH(VAL))'=" "

                       SET VAL=VAL_" "

 +17               IF FILEREF=80

                       SET FILE="^ICD9"

                       SET INDEX="BA"

 +18               IF FILEREF=80.1

                       SET FILE="^ICD0"

                       SET INDEX="BA"

 +19               IF FILEREF=81

                       SET FILE="^ICPT"

                       SET INDEX="BA"

 +20      ;

 +21               FOR

                       SET VAL=$ORDER(@FILE@(INDEX,VAL))

                       IF VAL=""!($EXTRACT(VAL,1,LG)'=END)

                           QUIT

                       Begin DoDot:2

 +22                       SET IEN=""

 +23                       FOR

                               SET IEN=$ORDER(@FILE@(INDEX,VAL,IEN))

                               IF IEN=""

                                   QUIT

                               Begin DoDot:3

 +24                               SET NAME=$PIECE($GET(@FILE@(IEN,0)),U,1)

 +25      ;Does coding system match

 +26                               IF $GET(SYSN)

                                       IF SYSN'=$PIECE($GET(@FILE@(IEN,1)),U,1)

                                           QUIT

 +27                               IF $GET(SYSN)

                                       SET SYS=$PIECE(^ICDS(SYSN,0),U,2)

                                       SET SYSNM=$PIECE(^ICDS(SYSN,0),U,1)

 +28                               IF $GET(ORDER)'="CODE"

                                       SET @TARGET@(IEN)=NAME_U_$GET(SYSN)_U_$GET(SYS)_U_$GET(SYSNM)

                                       QUIT

 +29                               IF $GET(ORDER)="CODE"

                                       SET @TARGET@(NAME_" ")=IEN_U_$GET(SYSN)_U_$GET(SYS)_U_$GET(SYSNM)_U_NAME

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +30       QUIT

ATXAPI.m