BKMIXX5 ;PRXM/HC/KJH - BKMV UTILITY PROGRAM; [ 7/15/2005 1:28 PM ] ; 16 Jul 2005 8:34 PM
;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
; Generic Taxonomy Utilities
; Utility for building list of referenced IENs from a Taxonomy.
Q
;
BLDTAX(TAX,TARGET) ; PEP
;
D BLD^BQITUTL(TAX,TARGET)
Q
;
I $$PATCH^XPDUTL("ATX*5.1*11") D BLDTAX^ATXAPI(TAX,TARGET) Q
;
; 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)
;
; 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")
; The following file references from Taxonomy are supported:
I $F(",80,80.1,81,2,50,95.3,9999999.09,9999999.14,9999999.64,60,",","_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 D Q
..S NAME=$P($G(^PSDRUG(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=2 S FILE="^PSDRUG",INDEX="D" 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
.; 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
;
ICD(IEN,TXIEN,TYPE) ; EP - Utility wrapper for calling $$ICD^ATXCHK
; TYPE can be 9 (ICD), 0 (PRC), or 1 (CPT)
; $$ICD^ATXCHK only checks ranges ("AA" x-ref). (ex. 200.80-200.288)
; Also need to check individual entries ("B" x-ref). (ex. 042.)
N ITEM
I $G(IEN)=""!($G(TXIEN)="")!($G(TYPE)="") Q 0
; Check ranges first (most entries are setup as ranges)
I $$PATCH^XPDUTL("ATX*5.1*11") I $$ICD^ATXAPI(IEN,TXIEN,TYPE)=1 Q 1
;
I $$ICD^ATXCHK(IEN,TXIEN,TYPE)=1 Q 1
; Check individual entries (currently only a few, but potentially more could be defined)
S ITEM=$S(TYPE=9:$P($G(^ICD9(IEN,0)),U),TYPE=0:$P($G(^ICD0(IEN,0)),U),TYPE=1:$P($G(^ICPT(IEN,0)),U),1:"")
I ITEM="" Q 0
; Under certain conditions, item will have a space at the end.
I $D(^ATXAX(TXIEN,21,"B",ITEM)) Q 1
I $D(^ATXAX(TXIEN,21,"B",ITEM_" ")) Q 1
Q 0
;
STAT(STATUS) ; Check presence on HIV registry and status = STATUS
;
N DFN,BKMDFN,HIVREG,BKMNODE,BKMIEN
; Variable Y contains the 'DFN' (IEN for file 2 in global ^DPT) from the FileMan Screen call.
S DFN=Y
Q:'+$G(DFN) 0
S (BKMIEN,BKMDFN)=$O(^BKM(90451,"B",DFN,0)) Q:'+BKMDFN 0
I '$D(^BKM(90451,BKMDFN)) Q 0
S HIVREG=1
I '$D(^BKM(90451,BKMDFN,1,HIVREG)) Q 0
S BKMNODE=$G(^BKM(90451,BKMDFN,1,HIVREG,0))
I STATUS]"" Q:$P(BKMNODE,U,7)'=STATUS 0
Q 1
BKMIXX5 ;PRXM/HC/KJH - BKMV UTILITY PROGRAM; [ 7/15/2005 1:28 PM ] ; 16 Jul 2005 8:34 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
+2 ; Generic Taxonomy Utilities
+3 ; Utility for building list of referenced IENs from a Taxonomy.
+4 QUIT
+5 ;
BLDTAX(TAX,TARGET) ; PEP
+1 ;
+2 DO BLD^BQITUTL(TAX,TARGET)
+3 QUIT
+4 ;
+5 IF $$PATCH^XPDUTL("ATX*5.1*11")
DO BLDTAX^ATXAPI(TAX,TARGET)
QUIT
+6 ;
+7 ; Takes a taxonomy name and builds an array that can then be used
+8 ; to scan various V-File cross-references to see which records
+9 ; match an entry in the Taxonomy.
+10 ;
+11 ; Currently supported Taxonomies are as follows:
+12 ; (where FILE is field #.15 in the TAXONOMY file #9002226)
+13 ; ICD9 Diagnoses via ICD9 codes (^ICD9 - FILE 80)
+14 ; ICD9 Procedures via ICD9 codes (^ICD0 - FILE 80.1)
+15 ; CPT Procedures via CPT codes (^ICPT - FILE 81)
+16 ; Medications via NDC codes (^PSDRUG - FILE 2)
+17 ; Medications via MED IEN (^PSDRUG - FILE 50)
+18 ; Laboratory tests via LOINC codes (^LAB(60) - FILE 95.3)
+19 ; Patient Education Topics by name (^AUTTEDT - FILE 9999999.09)
+20 ; NOTE: Use BLDTAX1 below if providing a list of partial Patient Education Topic Codes to match.
+21 ; Immunizations via HL7/CVX codes (^AUTTIMM - FILE 9999999.14)
+22 ; Health Factors by Name (^AUTTHF - FILE 9999999.64)
+23 ; (where FILE is field #.09 in the LAB TAXONOMY file #9002228)
+24 ; Laboratory tests via LAB IEN (^LAB(60) - FILE 60)
+25 ;
+26 ; Input:
+27 ; TAX = Name of Taxonomy from ATXAX or ATXLAB file.
+28 ; (required)
+29 ; TARGET = Closed array reference where the output will be stored.
+30 ; (required)
+31 ; This can be a local variable or global reference.
+32 ; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
+33 ;
+34 ; Output:
+35 ; An array in the local or global TARGET of the form:
+36 ; @TARGET@(IEN)=NAME (.01 field)
+37 ;
+38 ; NOTE: Kill the output array before calling the function unless
+39 ; you intend to group several Taxonomies of the same type.
+40 ;
+41 NEW FILEREF,TAXIEN,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME
+42 IF TARGET=""!(TAX="")
QUIT
+43 SET TAXIEN=$ORDER(^ATXAX("B",TAX,0))
SET TAXREF="^ATXAX"
+44 IF TAXIEN=""
SET TAXIEN=$ORDER(^ATXLAB("B",TAX,0))
SET TAXREF="^ATXLAB"
+45 IF TAXIEN=""
QUIT
+46 IF TAXREF="^ATXAX"
SET FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I")
+47 IF TAXREF="^ATXLAB"
SET FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")
+48 ; The following file references from Taxonomy are supported:
+49 IF $FIND(",80,80.1,81,2,50,95.3,9999999.09,9999999.14,9999999.64,60,",","_FILEREF_",")=0
QUIT
+50 SET ENTRY=0
+51 FOR
SET ENTRY=$ORDER(@TAXREF@(TAXIEN,21,ENTRY))
IF 'ENTRY
QUIT
Begin DoDot:1
+52 SET VALUE=@TAXREF@(TAXIEN,21,ENTRY,0)
+53 SET VAL=$PIECE(VALUE,U,1)
SET END=$PIECE(VALUE,U,2)
+54 ; LAB entries use the IEN and only specify one value.
+55 IF FILEREF=60
Begin DoDot:2
+56 SET NAME=$PIECE($GET(^LAB(60,VAL,0)),U,1)
SET @TARGET@(VAL)=NAME
End DoDot:2
QUIT
+57 ; MED entries use the IEN and only specify one value.
+58 IF FILEREF=50
Begin DoDot:2
+59 SET NAME=$PIECE($GET(^PSDRUG(VAL,0)),U,1)
SET @TARGET@(VAL)=NAME
End DoDot:2
QUIT
+60 ; Otherwise, treat all items as ranges (even if there is only one entry).
+61 IF END=""
SET END=VAL
+62 Begin DoDot:2
+63 IF FILEREF=95.3
Begin DoDot:3
+64 ; The LOINC x-ref in LAB does not use the check digit (piece 2).
+65 SET VAL=$PIECE(VAL,"-")
SET END=$PIECE(END,"-")
+66 SET FILE="^LAB(60)"
SET INDEX="AF"
End DoDot:3
QUIT
+67 IF FILEREF=2
SET FILE="^PSDRUG"
SET INDEX="D"
QUIT
+68 IF FILEREF=9999999.09
SET FILE="^AUTTEDT"
SET INDEX="B"
QUIT
+69 IF FILEREF=9999999.14
SET FILE="^AUTTIMM"
SET INDEX="C"
QUIT
+70 IF FILEREF=9999999.64
SET FILE="^AUTTHF"
SET INDEX="B"
QUIT
+71 ; CPT, ICD9, and ICD0 require a SPACE be added to the code.
+72 ; Some Taxonomy entries already have the space included.
+73 IF $EXTRACT(VAL,$LENGTH(VAL))'=" "
SET VAL=VAL_" "
+74 IF $EXTRACT(END,$LENGTH(END))'=" "
SET END=END_" "
+75 IF FILEREF=80
SET FILE="^ICD9"
SET INDEX="BA"
QUIT
+76 IF FILEREF=80.1
SET FILE="^ICD0"
SET INDEX="BA"
QUIT
+77 IF FILEREF=81
SET FILE="^ICPT"
SET INDEX="BA"
QUIT
End DoDot:2
+78 ; Backup one entry so loop can find all the entries in the range.
+79 SET VAL=$ORDER(@FILE@(INDEX,VAL),-1)
+80 FOR
SET VAL=$ORDER(@FILE@(INDEX,VAL))
IF VAL=""
QUIT
IF $$CHECK(VAL,END)
QUIT
Begin DoDot:2
+81 SET IEN=""
+82 FOR
SET IEN=$ORDER(@FILE@(INDEX,VAL,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+83 SET NAME=$PIECE($GET(@FILE@(IEN,0)),U,1)
+84 SET @TARGET@(IEN)=NAME
End DoDot:3
End DoDot:2
End DoDot:1
+85 QUIT
+86 ;
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
+53 ;
ICD(IEN,TXIEN,TYPE) ; EP - Utility wrapper for calling $$ICD^ATXCHK
+1 ; TYPE can be 9 (ICD), 0 (PRC), or 1 (CPT)
+2 ; $$ICD^ATXCHK only checks ranges ("AA" x-ref). (ex. 200.80-200.288)
+3 ; Also need to check individual entries ("B" x-ref). (ex. 042.)
+4 NEW ITEM
+5 IF $GET(IEN)=""!($GET(TXIEN)="")!($GET(TYPE)="")
QUIT 0
+6 ; Check ranges first (most entries are setup as ranges)
+7 IF $$PATCH^XPDUTL("ATX*5.1*11")
IF $$ICD^ATXAPI(IEN,TXIEN,TYPE)=1
QUIT 1
+8 ;
+9 IF $$ICD^ATXCHK(IEN,TXIEN,TYPE)=1
QUIT 1
+10 ; Check individual entries (currently only a few, but potentially more could be defined)
+11 SET ITEM=$SELECT(TYPE=9:$PIECE($GET(^ICD9(IEN,0)),U),TYPE=0:$PIECE($GET(^ICD0(IEN,0)),U),TYPE=1:$PIECE($GET(^ICPT(IEN,0)),U),1:"")
+12 IF ITEM=""
QUIT 0
+13 ; Under certain conditions, item will have a space at the end.
+14 IF $DATA(^ATXAX(TXIEN,21,"B",ITEM))
QUIT 1
+15 IF $DATA(^ATXAX(TXIEN,21,"B",ITEM_" "))
QUIT 1
+16 QUIT 0
+17 ;
STAT(STATUS) ; Check presence on HIV registry and status = STATUS
+1 ;
+2 NEW DFN,BKMDFN,HIVREG,BKMNODE,BKMIEN
+3 ; Variable Y contains the 'DFN' (IEN for file 2 in global ^DPT) from the FileMan Screen call.
+4 SET DFN=Y
+5 IF '+$GET(DFN)
QUIT 0
+6 SET (BKMIEN,BKMDFN)=$ORDER(^BKM(90451,"B",DFN,0))
IF '+BKMDFN
QUIT 0
+7 IF '$DATA(^BKM(90451,BKMDFN))
QUIT 0
+8 SET HIVREG=1
+9 IF '$DATA(^BKM(90451,BKMDFN,1,HIVREG))
QUIT 0
+10 SET BKMNODE=$GET(^BKM(90451,BKMDFN,1,HIVREG,0))
+11 IF STATUS]""
IF $PIECE(BKMNODE,U,7)'=STATUS
QUIT 0
+12 QUIT 1
