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

BDMTAPI.m

Go to the documentation of this file. 
  1. BDMTAPI ;GDIT/HS/ALA-Taxonomy APIs ; 28 Oct 2014  4:33 PM
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**8**;JUN 14, 2007;Build 53
  1.  ;
  1. BLDSV(FILEREF,VAL,TARGET) ;PEP - Add a single value to a target
  1.  ;Description
  1.  ;  Use this if no taxonomy was given but an individual code
  1.  ;Input
  1.  ;  FILEREF - File where the code resides
  1.  ;  VAL - Value
  1.  ;  TARGET - reference where entry is to be placed
  1.  ;
  1.  ; The LOINC x-ref in LAB does not use the check digit (piece 2).
  1.  NEW INDEX,VAL,FILE,IEN,END,NAME
  1.  I FILEREF=95.3 S FILE="^LAB(60)",INDEX="AF",VAL=$P(VAL,"-")
  1.  I FILEREF=80 S FILE="^ICD9",INDEX="BA"
  1.  I FILEREF=80.1 S FILE="^ICD0",INDEX="BA"
  1.  I FILEREF=81 S FILE="^ICPT",INDEX="BA"
  1.  S END=VAL
  1.  ;
  1.  ; Backup one entry so loop can find all the entries in the range.
  1.  S VAL=$O(@FILE@(INDEX,VAL),-1)
  1.  F  S VAL=$O(@FILE@(INDEX,VAL)) Q:VAL=""  Q:$$CHECK(VAL,END)  D
  1.  .S IEN=""
  1.  .F  S IEN=$O(@FILE@(INDEX,VAL,IEN)) Q:IEN=""  D
  1.  ..S NAME=$P($G(@FILE@(IEN,0)),U,1)
  1.  ..S @TARGET@(IEN)=NAME
  1.  ;
  1.  K FILEREF,FILE,INDEX,VAL,END,NAME,IEN,TARGET
  1.  Q
  1.  ;
  1. CHECK(V,E) ;EP
  1.  N Z
  1.  I V=E Q 0
  1.  S Z(V)=""
  1.  S Z(E)=""
  1.  I $O(Z(""))=E Q 1
  1.  Q 0
  1.  ;
  1. BLDTAX(TAX,TARGET,TAXIEN,TAXTYP) ; PEP - Expand a taxonomy into a target
  1.  ;
  1.  ; Takes a taxonomy name and builds an array that can then be used
  1.  ; to scan various V-File cross-references to see which records
  1.  ; match an entry in the Taxonomy.
  1.  ;
  1.  ; Currently supported Taxonomies are as follows:
  1.  ; (where FILE is field #.15 in the TAXONOMY file #9002226)
  1.  ;     ICD9 Diagnoses via ICD9 codes    (^ICD9     - FILE 80)
  1.  ;     ICD9 Procedures via ICD9 codes   (^ICD0     - FILE 80.1)
  1.  ;     CPT Procedures via CPT codes     (^ICPT     - FILE 81)
  1.  ;     Medications via NDC codes        (^PSDRUG   - FILE 2)
  1.  ;     Medications via MED IEN          (^PSDRUG   - FILE 50)
  1.  ;     Laboratory tests via LOINC codes (^LAB(60)  - FILE 95.3)
  1.  ;     Patient Education Topics by name (^AUTTEDT  - FILE 9999999.09)
  1.  ;         NOTE: Use BLDTAX1 below if providing a list of partial Patient Education Topic Codes to match.
  1.  ;     Immunizations via HL7/CVX codes  (^AUTTIMM  - FILE 9999999.14)
  1.  ;     Health Factors by Name           (^AUTTHF   - FILE 9999999.64)
  1.  ; (where FILE is field #.09 in the LAB TAXONOMY file #9002228)
  1.  ;     Laboratory tests via LAB IEN     (^LAB(60)  - FILE 60)
  1.  ;     VA Drug Class                    (^PS(50.605 - FILE 50.605)
  1.  ;     Community                        (^AUTTCOM   - FILE 9999999.05)
  1.  ;     Clinics                          (^DIC(40.7  - FILE 40.7)
  1.  ;     Dental ADA codes                 (^AUTTDA    - FILE 9999999.31)
  1.  ; 
  1.  ; Input:
  1.  ;     TAX    = Name of Taxonomy from ATXAX or ATXLAB file.
  1.  ;              (required)
  1.  ;     TARGET = Closed array reference where the output will be stored.
  1.  ;              (required)
  1.  ;              This can be a local variable or global reference.
  1.  ;              (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
  1.  ;     TAXIEN = IEN of Taxonomy from ATXAX or ATXLAB file.
  1.  ;     TAXTYP = 'L' for lab, assumes ATXAX
  1.  ; 
  1.  ; Output:
  1.  ;     An array in the local or global TARGET of the form:
  1.  ;              @TARGET@(IEN)=NAME (.01 field)
  1.  ;
  1.  ;     NOTE: Kill the output array before calling the function unless
  1.  ;           you intend to group several Taxonomies of the same type.
  1.  ;
  1.  N FILEREF,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME,SYS,SYSN,SYSNM
  1.  N QFL,ATXNCAN
  1.  I TARGET=""!(TAX="") Q
  1.  I $G(TAX)'="",$G(TAXIEN)="" D  Q:TAXIEN=""
  1.  . I $G(TAXTYP)'="L" S TAXIEN=$O(^ATXAX("B",TAX,0)),TAXREF="^ATXAX"  ;ihs/cmi/maw 06/06/2014 p8
  1.  . I $G(TAXIEN)="" S TAXIEN=$O(^ATXLAB("B",TAX,0)),TAXREF="^ATXLAB"
  1.  ;
  1.  I $G(TAXIEN)'="" D
  1.  . I $G(TAXTYP)="L" S TAXREF="^ATXLAB" Q
  1.  . S TAXREF="^ATXAX"
  1.  ;
  1.  I TAXREF="^ATXAX" S FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I"),ATXNCAN=$$GET1^DIQ(9002226,TAXIEN,.13,"I")
  1.  I TAXREF="^ATXLAB" S FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")
  1.  ; The following file references from Taxonomy are supported:
  1.  ;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
  1.  I '$D(^ATXTYPE("C",FILEREF)) Q
  1.  S ENTRY=0
  1.  F  S ENTRY=$O(@TAXREF@(TAXIEN,21,ENTRY)) Q:'ENTRY  D
  1.  .S VALUE=@TAXREF@(TAXIEN,21,ENTRY,0)
  1.  .S VAL=$P(VALUE,U,1),END=$P(VALUE,U,2),SYS=$P(VALUE,U,3)
  1.  .I FILEREF=80 D
  1.  ..S SYSN=$S(SYS'="":SYS,1:1)
  1.  ..S SYS=$S(SYS'="":$P(^ICDS(SYS,0),U,2),1:$P(^ICDS(1,0),U,2))
  1.  ..S SYSNM=$P(^ICDS(SYSN,0),U,1)
  1.  .I FILEREF=80.1 D
  1.  ..S SYSN=$S(SYS'="":SYS,1:2)
  1.  ..S SYS=$S(SYS'="":$P(^ICDS(SYS,0),U,2),1:$P(^ICDS(2,0),U,2))
  1.  ..S SYSNM=$P(^ICDS(SYSN,0),U,1)
  1.  .I +$G(ATXNCAN)=0 S QFL=1 D  Q:QFL
  1.  ..I FILEREF'=9999999.06,FILEREF'=9999999.09 S QFL=0 Q
  1.  ..;I FILEREF=9999999.05 S QFL=0 Q
  1.  ..;I FILEREF=9999999.64 S QFL=0 Q
  1.  ..S FILE=$$ROOT^DILFD(FILEREF,"",1)
  1.  ..I $E(VAL,$L(VAL))=" " S VAL=$E(VAL,1,$L(VAL)-1)
  1.  ..I $E(END,$L(END))=" " S END=$E(END,1,$L(END)-1)
  1.  ..I FILEREF=9999999.06 S NAME=$P($G(^DIC(4,VAL,0)),U,1),@TARGET@(VAL)=NAME Q
  1.  ..I FILEREF=9999999.09,VAL'?.N S QFL=0 Q
  1.  ..S NAME=$P($G(@FILE@(VAL,0)),U,1),@TARGET@(VAL)=NAME
  1.  .D SRCH(FILEREF)
  1.  Q
  1.  ;
  1. BLDEDU(TAX,TARGET) ;PEP  - EXPAND EDU
  1.  ;
  1.  ; Takes a list of partial Patient Education topic names and
  1.  ; builds an array that can then be used to scan a V-File
  1.  ; cross-reference to see which records match an entry in the
  1.  ; list.
  1.  ;
  1.  ; This tag only supports Patient Education:
  1.  ; (where FILE is field #.15 in the TAXONOMY file #9002226)
  1.  ;     Patient Education Topic Codes (^AUTTEDT  - FILE 9999999.09)
  1.  ; 
  1.  ; Input:
  1.  ;     TAX = PATIENT EDUCATION TOPIC CODE LIST to search for
  1.  ;           (required)
  1.  ;
  1.  ;     Example: "CD-,-CD,AOD-,-AOD"
  1.  ;     Example: "*BGP HIV/AIDS DXS"
  1.  ;
  1.  ;     Returns items where the MNEMONIC field for the Patient
  1.  ;     Education entry contains one of the listed values.
  1.  ;
  1.  ;     Second example shows an ICD taxonomy name.
  1.  ;     If used, will search for any Patient Education entry
  1.  ;     containing one of the values in that Taxonomy.
  1.  ;
  1.  ;     TARGET : Closed array reference where the output will be stored.
  1.  ;              This can be a local variable or global reference.
  1.  ;              (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
  1.  ;
  1.  ; Output:
  1.  ;     An array in the local or global TARGET of the form:
  1.  ;              @TARGET@(IEN)=NAME (.01 field)
  1.  ;
  1.  ;     NOTE: Kill the output array before calling the function unless
  1.  ;           you intend to group several Taxonomies of the same type.
  1.  ;
  1.  N VAL,IEN,NAME,MNEMONIC,TAX1,I,ICDIEN,FLG
  1.  F I=1:1:$L(TAX,",") S TAX1=$P(TAX,",",I) I $E(TAX1)="*" D BLDTAX($E(TAX1,2,$L(TAX1)),"ICDIEN")
  1.  S VAL=""
  1.  F  S VAL=$O(^AUTTEDT("B",VAL)) Q:VAL=""  D
  1.  .S IEN=""
  1.  .F  S IEN=$O(^AUTTEDT("B",VAL,IEN)) Q:IEN=""  D
  1.  ..S NAME=$$GET1^DIQ(9999999.09,IEN,.01,"I"),MNEMONIC=$$GET1^DIQ(9999999.09,IEN,1,"I"),FLG=0
  1.  ..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
  1.  ..I FLG=1 Q
  1.  ..S I=""
  1.  ..;If an ICD is used as the MNEMONIC it will be formatted as "ICD-abbreviation".
  1.  ..;For example, if the ICD is "042." and the patient education is 'alcohol or drugs' then the MNEMONIC would be "042.-AOD".
  1.  ..F  S I=$O(ICDIEN(I)) Q:I=""  S TAX1=ICDIEN(I)_"-" I MNEMONIC[TAX1 S @TARGET@(IEN)=NAME_U_MNEMONIC,FLG=1 Q
  1.  ..I FLG=1 Q
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1.  ;
  1. SRCH(FILEREF) ; Search for values
  1.  ; LAB entries use the IEN and only specify one value.
  1.  I FILEREF=60 D  Q
  1.  .S NAME=$P($G(^LAB(60,VAL,0)),U,1),@TARGET@(VAL)=NAME
  1.  ; MED entries use the IEN and only specify one value.
  1.  I FILEREF=50.605 D  Q
  1.  .NEW X,NVAL
  1.  .S NVAL=$O(^PS(50.605,"B",VAL,"")) Q:NVAL=""
  1.  .S X="" F  S X=$O(^PSDRUG("VAC",NVAL,X)) Q:X=""  D
  1.  ..S NAME=$P($G(^PSDRUG(X,0)),U,1),@TARGET@(X)=NAME
  1.  I FILEREF=50 D  Q
  1.  .S NAME=$P($G(^PSDRUG(VAL,0)),U,1),@TARGET@(VAL)=NAME
  1.  I FILEREF=40.7 D  Q
  1.  .S NAME=$P($G(^DIC(40.7,VAL,0)),U,1),@TARGET@(VAL)=NAME
  1.  ; Otherwise, treat all items as ranges (even if there is only one entry).
  1.  I END="" S END=VAL
  1.  D
  1.  .I FILEREF=95.3 D  Q
  1.  ..; The LOINC x-ref in LAB does not use the check digit (piece 2).
  1.  ..S VAL=$P(VAL,"-"),END=$P(END,"-")
  1.  ..S FILE="^LAB(60)",INDEX="AF"
  1.  .I FILEREF=50.67 S FILE="^PSDRUG",INDEX="D" Q
  1.  .I FILEREF=9999999.05 S FILE="^AUTTCOM",INDEX="B" Q
  1.  .I FILEREF=9999999.09 S FILE="^AUTTEDT",INDEX="B" Q
  1.  .I FILEREF=9999999.14 S FILE="^AUTTIMM",INDEX="C" Q
  1.  .I FILEREF=9999999.64 S FILE="^AUTTHF",INDEX="B" Q
  1.  .I FILEREF=9999999.31 S FILE="^AUTTADA",INDEX="B" Q
  1.  .; CPT, ICD9, and ICD0 require a SPACE be added to the code.
  1.  .; Some Taxonomy entries already have the space included.
  1.  .S:$E(VAL,$L(VAL))'=" " VAL=VAL_" "
  1.  .S:$E(END,$L(END))'=" " END=END_" "
  1.  .I FILEREF=80 S FILE="^ICD9",INDEX="BA" Q
  1.  .I FILEREF=80.1 S FILE="^ICD0",INDEX="BA" Q
  1.  .I FILEREF=81 S FILE="^ICPT",INDEX="BA" Q
  1.  ; Backup one entry so loop can find all the entries in the range.
  1.  S VAL=$O(@FILE@(INDEX,VAL),-1)
  1.  F  S VAL=$O(@FILE@(INDEX,VAL)) Q:VAL=""  Q:$$CHECK(VAL,END)  D
  1.  .S IEN=""
  1.  .F  S IEN=$O(@FILE@(INDEX,VAL,IEN)) Q:IEN=""  D
  1.  ..S NAME=$P($G(@FILE@(IEN,0)),U,1)
  1.  ..;Does coding system match
  1.  ..I $G(SYSN),SYSN'=$P($G(@FILE@(IEN,1)),U,1) Q
  1.  ..I $G(SYSN) S SYS=$P(^ICDS(SYSN,0),U,2),SYSNM=$P(^ICDS(SYSN,0),U,1)
  1.  ..I $G(ORDER)'="CODE" S @TARGET@(IEN)=NAME_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM) Q
  1.  ..I $G(ORDER)="CODE" S @TARGET@(NAME_" ")=IEN_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM)_U_NAME
  1.  Q
  1.  ;
  1. LST(SYSN,FILEREF,CODLS,ORDER,TARGET) ;PEP -LIST
  1.  ; Input
  1.  ;    SYSN    - System IEN from 80.4 (1, 2, 30 or 31)
  1.  ;    FILEREF - File reference
  1.  ;    CODLS   - List of codes, can be range 250.00-250.99 or 250*
  1.  ;    ORDER   - Format to get data back (blank returns in IEN order, "CODE" returns in CODE order)
  1.  ;    TARGET  - Target reference
  1.  ;
  1.  NEW VAL,END,LG,IEN,SYS,NAME,SYSNM,INDEX
  1.  S SYSN=$G(SYSN)
  1.  I $G(FILEREF)="" S FILEREF=$P(^ICDS(SYSN,0),U,3)
  1.  I CODLS["-" S VAL=$P(CODLS,"-",1),END=$P(CODLS,"-",2) D SRCH(FILEREF) Q
  1.  I CODLS["*" D
  1.  .S VAL=$P(CODLS,"*",1),END=VAL,LG=$L(END)
  1.  .; CPT, ICD9, and ICD0 require a SPACE be added to the code.
  1.  .; Some Taxonomy entries already have the space included.
  1.  .S:$E(VAL,$L(VAL))'=" " VAL=VAL_" "
  1.  .I FILEREF=80 S FILE="^ICD9",INDEX="BA"
  1.  .I FILEREF=80.1 S FILE="^ICD0",INDEX="BA"
  1.  .I FILEREF=81 S FILE="^ICPT",INDEX="BA"
  1.  .;
  1.  .F  S VAL=$O(@FILE@(INDEX,VAL)) Q:VAL=""!($E(VAL,1,LG)'=END)  D
  1.  ..S IEN=""
  1.  ..F  S IEN=$O(@FILE@(INDEX,VAL,IEN)) Q:IEN=""  D
  1.  ...S NAME=$P($G(@FILE@(IEN,0)),U,1)
  1.  ...;Does coding system match
  1.  ...I $G(SYSN),SYSN'=$P($G(@FILE@(IEN,1)),U,1) Q
  1.  ...I $G(SYSN) S SYS=$P(^ICDS(SYSN,0),U,2),SYSNM=$P(^ICDS(SYSN,0),U,1)
  1.  ...I $G(ORDER)'="CODE" S @TARGET@(IEN)=NAME_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM) Q
  1.  ...I $G(ORDER)="CODE" S @TARGET@(NAME_" ")=IEN_U_$G(SYSN)_U_$G(SYS)_U_$G(SYSNM)_U_NAME
  1.  Q