BKMIXX ;PRXM/HC/CLT - TAXONOMY ACCESS UTILITIES ; 11 Mar 2005 12:26 PM
;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
; Generic Taxonomy Utilities
; Checks V-Files for patients that meet a Taxonomy's criteria, within
; a specific date range.
;
;**************NOTE***********************
; Input for all entry points are the same
;*****************************************
;
; Input:
; DFN = IEN from Patient file (#90000001)
; (required)
; TAX = Name of Taxonomy (From Lab Taxonomy ^ATXLAB or ICD Taxonomy ^ATXAX)
; (required)
; EDATE = End date of the report. The default is "Today"
; (optional)
; SDATE = Start date of the report.
; (optional)
; TARGET = Target root (global or local) for collection of data
; (optional)
; Example: ^TMP("RTN NAME",$J,"DESC",DFN,VSTDT,VISIT) or TEMP(VSTDT,VISIT)
; Output:
; LDATE = Last date found in the selected date range
; (optional - pass by reference)
; LIEN = Last IEN found in the selected date range
; (optional - pass by reference)
; CNT = Count of number of records found in selected date range
; (optional - pass by reference)
;
Q
LABTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
; Lab Taxonomy Check
;
N TXIEN,TEST,VISIT,VSTDT,RESULT,LAB,COLDTM
I DFN="" Q
I TAX="" Q
S TXIEN=$O(^ATXLAB("B",TAX,""))
I TXIEN="" Q
S TEST="",CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNVLAB("AC",DFN,TEST),-1) Q:TEST="" D
.S LAB=$$GET1^DIQ(9000010.09,TEST,.01,"I")
.I LAB="" Q
.I '$D(^ATXLAB(TXIEN,21,"B",LAB)) Q
.S VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I") I VISIT="" Q
.S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSTDT="" Q
.I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.; Get collection date/time
.S COLDTM=$P($G(^AUPNVLAB(TEST,12)),U,1)\1
.;S COLDTM=$$GET1^DIQ(9000010.09,TEST,1201,"I")\1
.I COLDTM'=0 S VSTDT=COLDTM
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.S RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
.S CNT=CNT+1
.I $G(TARGET)]"" S @TARGET=RESULT
Q
;
CPTTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
; CPT Taxonomy Check
;
NEW I,TEST,PRM,CNTR,ARRAY
I DFN="" Q
I $TR(TAX,$C(29))="" Q
;
S CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
;Parse out input parameters into array
F I=1:1:$L(TAX,$C(29)) D
.N TX,TXN,EDT,SDT,TGT,LDT,LIN
.S TX=$P(TAX,$C(29),I) Q:TX=""
.S TXN=$O(^ATXAX("B",TX,"")) Q:TXN=""
.S EDT=$P(EDATE,$C(29),I)
.S SDT=$P(SDATE,$C(29),I)
.;S TGT=$P(TARGET,$C(29),I) Q:TGT=""
.S TGT=$P(TARGET,$C(29),I)
.S LDT=$P(LDATE,$C(29),I)
.S LIN=$P(LIEN,$C(29),I)
.S PRM(TX_$C(29)_TXN_$C(29)_SDT_$C(29)_EDT_$C(29)_TGT_$C(29)_LDT_$C(29)_LIN)=I
;
S TEST="",CNT=0
F S TEST=$O(^AUPNVCPT("AC",DFN,TEST)) Q:TEST="" D
.;S CPT=$$GET1^DIQ(9000010.18,TEST,.01,"I") I CPT="" Q
.S CPT=$P($G(^AUPNVCPT(TEST,0)),"^",1) I CPT="" Q
.;
.S TXN="" F S TXN=$O(PRM(TXN)) Q:TXN="" D
..;N TAX,EDATE,SDATE,TARGET,LDATE,LIEN,TXIEN,VISIT,VSTDT,RESULT,CT,EXIST
..;N TAX,EDATE,SDATE,TARGET,LIEN,TXIEN,VISIT,VSTDT,RESULT,CT,EXIST
..N TAX,EDATE,SDATE,TARGET,TXIEN,VISIT,VSTDT,RESULT,CT,EXIST
..S TAX=$P(TXN,$C(29))
..S TXIEN=$P(TXN,$C(29),2)
..S SDATE=$P(TXN,$C(29),3)
..S EDATE=$P(TXN,$C(29),4)
..S TARGET=$P(TXN,$C(29),5)
..S LDATE=$P(TXN,$C(29),6)
..S LIEN=$P(TXN,$C(29),7)
..S CT=$G(PRM(TXN))
..;
..I $$PATCH^XPDUTL("ATX*5.1*11") S EXIST=$$ICD^ATXAPI(CPT,TXIEN,1)
..E S EXIST=$$ICD^BKMIXX5(CPT,TXIEN,1)
..I EXIST=0 Q
..S VISIT=$P($G(^AUPNVCPT(TEST,0)),"^",3) I VISIT="" Q
..;S VISIT=$$GET1^DIQ(9000010.18,TEST,.03,"I") I VISIT="" Q
..;S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSTDT="" Q
..S VSTDT=$P($G(^AUPNVSIT(VISIT,0)),"^",1) I VSTDT="" Q
..S VSTDT=VSTDT\1
..I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
..I $G(SDATE)'="",(VSTDT\1<SDATE) Q
..I $G(EDATE)'="",(VSTDT\1>EDATE) Q
..I VSTDT>LDATE S LDATE=VSTDT\1,LIEN=TEST
..I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
..;S RESULT=$$GET1^DIQ(9000010.18,TEST,.04,"E")
..S RESULT=$P(^AUPNVCPT(TEST,0),"^",4),ARRAY(VSTDT,TEST)=RESULT
..;S RESULT=$S($P(N0,U,4)]"":$P($G(^AUTNPOV($P(N0,U,4),0)),U),1:"")
..S CNTR(CT)=$G(CNTR(CT))+1
..I $G(TARGET)]"" S @TARGET=RESULT
;
;Handle Single/Multiple Counts
I $L(TAX,$C(29))=1 S CNT=$G(CNTR(1))
E M CNT=CNTR
I $G(LDATE)="" D
.S LDATE=$O(ARRAY(""),-1) I LDATE="" Q
.S LIEN=$O(ARRAY(LDATE,""),-1)
.I $G(TARGET)="" Q
.S VSTDT=LDATE,TEST=LIEN
.I VSTDT["." K @TARGET S VSTDT=VSTDT\1,@TARGET="",LDATE=VSTDT
Q
;
LOINC(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
; LOINC Taxonomy Check
;
N TXIEN,TEST,VISIT,VSTDT,RESULT,LOINC
I DFN="" Q
I TAX="" Q
S TXIEN=$O(^ATXAX("B",TAX,""))
I TXIEN="" Q
S TEST="",CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNVLAB("AC",DFN,TEST)) Q:TEST="" D
.S LOINC=$$GET1^DIQ(9000010.09,TEST,1113,"E")
.I LOINC="" Q
.I '$D(^ATXAX(TXIEN,21,"B",LOINC)) Q
.S VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I") I VISIT="" Q
.S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSTDT="" Q
.I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.; Get collection date/time
.S COLDTM=$P($G(^AUPNVLAB(TEST,12)),U,1)\1
.;S COLDTM=$$GET1^DIQ(9000010.09,TEST,1201,"I")\1
.I COLDTM'=0 S VSTDT=COLDTM
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.S RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
.S CNT=CNT+1
.I $G(TARGET)]"" S @TARGET=RESULT
Q
;
HFTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
; Health Factors Taxonomy Check (includes health factor)
;
N TXIEN,TEST,VISIT,VSTDT,RESULT,HF,CODE
I DFN="" Q
I TAX="" Q
S TXIEN=$O(^ATXAX("B",TAX,""))
I TXIEN="" Q
S TEST="",CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNVHF("AC",DFN,TEST)) Q:TEST="" D
.S HF=$$GET1^DIQ(9000010.23,TEST,.01,"E")
.I HF="" Q
.I '$D(^ATXAX(TXIEN,21,"B",HF)) Q
.S VISIT=$$GET1^DIQ(9000010.23,TEST,.03,"I") I VISIT="" Q
.S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSTDT="" Q
.I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.S RESULT=$$GET1^DIQ(9000010.23,TEST,.04,"E")
.S CODE=$$GET1^DIQ(9000010.23,TEST,.01,"E")
.S CNT=CNT+1
.I $G(TARGET)]"" S @TARGET=RESULT_U_CODE
Q
;
PRBTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
; ICD Taxonomy Check (using PROBLEM file)
;
N TXIEN,TEST,VISIT,VSTDT,RESULT,PROB,EXIST
I DFN="" Q
I TAX="" Q
S TXIEN=$O(^ATXAX("B",TAX,""))
I TXIEN="" Q
S TEST="",CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNPROB("AC",DFN,TEST)) Q:TEST="" D
.S PROB=$$GET1^DIQ(9000011,TEST,.01,"I")
.I PROB="" Q
.I $$PATCH^XPDUTL("ATX*5.1*11") S EXIST=$$ICD^ATXAPI(PROB,TXIEN,9)
.E S EXIST=$$ICD^BKMIXX5(PROB,TXIEN,9)
.I EXIST=0 Q
.; Not related to Visit File (#9000010)
.S VISIT="N/A"
.; Problem does not connect to a visit so VSTDT is calculated differently.
.S VSTDT=$$PROB^BKMVUTL(TEST)
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.S RESULT=$$GET1^DIQ(9000011,TEST,.05,"E")
.S CNT=CNT+1
.I $G(TARGET)]"" S @TARGET=RESULT
Q
;
MEDTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
; Medication Taxonomy Check (using Medication IEN)
;
N TXIEN,TEST,VISIT,VSTDT,RESULT,DRGPTR,SIG,QTY,DAY
I DFN="" Q
I TAX="" Q
S TXIEN=$O(^ATXAX("B",TAX,""))
I TXIEN="" Q
S TEST="",CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNVMED("AC",DFN,TEST)) Q:TEST="" D
.S DRGPTR=$$GET1^DIQ(9000010.14,TEST,.01,"I")
.I DRGPTR="" Q
.I '$D(^ATXAX(TXIEN,21,"B",DRGPTR)) Q
.S VISIT=$$GET1^DIQ(9000010.14,TEST,.03,"I") I VISIT="" Q
.S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSTDT="" Q
.I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.S SIG=$$GET1^DIQ(9000010.14,TEST,.05,"E")
.S QTY=$$GET1^DIQ(9000010.14,TEST,.06,"E")
.S DAY=$$GET1^DIQ(9000010.14,TEST,.07,"E")
.S RESULT=$$GET1^DIQ(9000010.14,TEST,.01,"E")
.S CNT=CNT+1
.I $G(TARGET)]"" S @TARGET=RESULT_U_SIG_U_QTY_U_DAY
Q
;
ADATAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
; ADA Code Taxonomy Check (using ADA Code)
;
N TXIEN,TEST,VISIT,VSTDT,RESULT,ADA
I DFN="" Q
I TAX="" Q
S TXIEN=$O(^ATXAX("B",TAX,""))
I TXIEN="" Q
S TEST="",CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNVDEN("AC",DFN,TEST)) Q:TEST="" D
.S ADA=$$GET1^DIQ(9000010.05,TEST,.01,"E")
.I ADA="" Q
.I '$D(^ATXAX(TXIEN,21,"B",ADA)) Q
.S VISIT=$$GET1^DIQ(9000010.05,TEST,.03,"I") I VISIT="" Q
.S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSTDT="" Q
.I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.;Nothing identified in file as a 'RESULT'. Using "N/A" for now for consistency with other functions.
.;S RESULT=$$GET1^DIQ(9000010.05,TEST,.04,"I")
.S RESULT="N/A"
.S CNT=CNT+1
.I $G(TARGET)]"" S @TARGET=RESULT
Q
;
; For this entry point only:
;
; 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.
;
; The data in this file is too volatile to use Taxonomies for most entries.
; Variables are still named the same for consistency with other functions.
;
PTEDTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT,SVTX) ; PEP
; Patient Education Taxonomy check (by Education Code List) (includes topic)
; PTEDTAX^BKMIXX1 does this by Taxonomy
;
N TXIEN,TEST,VISIT,VSTDT,RESULT,PTED,CODE
I DFN="" Q
I TAX="" Q
;Not really needed, but set to maintain same variable list as other functions.
S TXIEN=TAX
I TXIEN="" Q
;Build a list of Education Code Entries based on the code list supplied.
I $D(SVTX(TAX)) M TXIEN=SVTX(TAX)
E D BLDTAX1^BKMIXX5(TAX,"TXIEN") M SVTX(TAX)=TXIEN
S TEST="",CNT=0,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNVPED("AC",DFN,TEST)) Q:TEST="" D
.S PTED=$$GET1^DIQ(9000010.16,TEST,.01,"I")
.I PTED="" Q
.I '$D(TXIEN(PTED)) Q
.S VISIT=$$GET1^DIQ(9000010.16,TEST,.03,"I") I VISIT="" Q
.S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VISIT="" Q
.I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.S RESULT=$$GET1^DIQ(9000010.16,TEST,.04,"E")
.S CODE=$$GET1^DIQ(9000010.16,TEST,.01,"E")
.S CNT=CNT+1
.I $G(TARGET)]"" S @TARGET=RESULT_U_CODE
Q
BKMIXX ;PRXM/HC/CLT - TAXONOMY ACCESS UTILITIES ; 11 Mar 2005 12:26 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
+2 ; Generic Taxonomy Utilities
+3 ; Checks V-Files for patients that meet a Taxonomy's criteria, within
+4 ; a specific date range.
+5 ;
+6 ;**************NOTE***********************
+7 ; Input for all entry points are the same
+8 ;*****************************************
+9 ;
+10 ; Input:
+11 ; DFN = IEN from Patient file (#90000001)
+12 ; (required)
+13 ; TAX = Name of Taxonomy (From Lab Taxonomy ^ATXLAB or ICD Taxonomy ^ATXAX)
+14 ; (required)
+15 ; EDATE = End date of the report. The default is "Today"
+16 ; (optional)
+17 ; SDATE = Start date of the report.
+18 ; (optional)
+19 ; TARGET = Target root (global or local) for collection of data
+20 ; (optional)
+21 ; Example: ^TMP("RTN NAME",$J,"DESC",DFN,VSTDT,VISIT) or TEMP(VSTDT,VISIT)
+22 ; Output:
+23 ; LDATE = Last date found in the selected date range
+24 ; (optional - pass by reference)
+25 ; LIEN = Last IEN found in the selected date range
+26 ; (optional - pass by reference)
+27 ; CNT = Count of number of records found in selected date range
+28 ; (optional - pass by reference)
+29 ;
+30 QUIT
LABTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
+1 ; Lab Taxonomy Check
+2 ;
+3 NEW TXIEN,TEST,VISIT,VSTDT,RESULT,LAB,COLDTM
+4 IF DFN=""
QUIT
+5 IF TAX=""
QUIT
+6 SET TXIEN=$ORDER(^ATXLAB("B",TAX,""))
+7 IF TXIEN=""
QUIT
+8 SET TEST=""
SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+9 FOR
SET TEST=$ORDER(^AUPNVLAB("AC",DFN,TEST),-1)
IF TEST=""
QUIT
Begin DoDot:1
+10 SET LAB=$$GET1^DIQ(9000010.09,TEST,.01,"I")
+11 IF LAB=""
QUIT
+12 IF '$DATA(^ATXLAB(TXIEN,21,"B",LAB))
QUIT
+13 SET VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I")
IF VISIT=""
QUIT
+14 SET VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSTDT=""
QUIT
+15 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+16 ; Get collection date/time
+17 SET COLDTM=$PIECE($GET(^AUPNVLAB(TEST,12)),U,1)\1
+18 ;S COLDTM=$$GET1^DIQ(9000010.09,TEST,1201,"I")\1
+19 IF COLDTM'=0
SET VSTDT=COLDTM
+20 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+21 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+22 IF VSTDT>LDATE
SET LDATE=VSTDT
SET LIEN=TEST
+23 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+24 SET RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
+25 SET CNT=CNT+1
+26 IF $GET(TARGET)]""
SET @TARGET=RESULT
End DoDot:1
+27 QUIT
+28 ;
CPTTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
+1 ; CPT Taxonomy Check
+2 ;
+3 NEW I,TEST,PRM,CNTR,ARRAY
+4 IF DFN=""
QUIT
+5 IF $TRANSLATE(TAX,$CHAR(29))=""
QUIT
+6 ;
+7 SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+8 ;Parse out input parameters into array
+9 FOR I=1:1:$LENGTH(TAX,$CHAR(29))
Begin DoDot:1
+10 NEW TX,TXN,EDT,SDT,TGT,LDT,LIN
+11 SET TX=$PIECE(TAX,$CHAR(29),I)
IF TX=""
QUIT
+12 SET TXN=$ORDER(^ATXAX("B",TX,""))
IF TXN=""
QUIT
+13 SET EDT=$PIECE(EDATE,$CHAR(29),I)
+14 SET SDT=$PIECE(SDATE,$CHAR(29),I)
+15 ;S TGT=$P(TARGET,$C(29),I) Q:TGT=""
+16 SET TGT=$PIECE(TARGET,$CHAR(29),I)
+17 SET LDT=$PIECE(LDATE,$CHAR(29),I)
+18 SET LIN=$PIECE(LIEN,$CHAR(29),I)
+19 SET PRM(TX_$CHAR(29)_TXN_$CHAR(29)_SDT_$CHAR(29)_EDT_$CHAR(29)_TGT_$CHAR(29)_LDT_$CHAR(29)_LIN)=I
End DoDot:1
+20 ;
+21 SET TEST=""
SET CNT=0
+22 FOR
SET TEST=$ORDER(^AUPNVCPT("AC",DFN,TEST))
IF TEST=""
QUIT
Begin DoDot:1
+23 ;S CPT=$$GET1^DIQ(9000010.18,TEST,.01,"I") I CPT="" Q
+24 SET CPT=$PIECE($GET(^AUPNVCPT(TEST,0)),"^",1)
IF CPT=""
QUIT
+25 ;
+26 SET TXN=""
FOR
SET TXN=$ORDER(PRM(TXN))
IF TXN=""
QUIT
Begin DoDot:2
+27 ;N TAX,EDATE,SDATE,TARGET,LDATE,LIEN,TXIEN,VISIT,VSTDT,RESULT,CT,EXIST
+28 ;N TAX,EDATE,SDATE,TARGET,LIEN,TXIEN,VISIT,VSTDT,RESULT,CT,EXIST
+29 NEW TAX,EDATE,SDATE,TARGET,TXIEN,VISIT,VSTDT,RESULT,CT,EXIST
+30 SET TAX=$PIECE(TXN,$CHAR(29))
+31 SET TXIEN=$PIECE(TXN,$CHAR(29),2)
+32 SET SDATE=$PIECE(TXN,$CHAR(29),3)
+33 SET EDATE=$PIECE(TXN,$CHAR(29),4)
+34 SET TARGET=$PIECE(TXN,$CHAR(29),5)
+35 SET LDATE=$PIECE(TXN,$CHAR(29),6)
+36 SET LIEN=$PIECE(TXN,$CHAR(29),7)
+37 SET CT=$GET(PRM(TXN))
+38 ;
+39 IF $$PATCH^XPDUTL("ATX*5.1*11")
SET EXIST=$$ICD^ATXAPI(CPT,TXIEN,1)
+40 IF '$TEST
SET EXIST=$$ICD^BKMIXX5(CPT,TXIEN,1)
+41 IF EXIST=0
QUIT
+42 SET VISIT=$PIECE($GET(^AUPNVCPT(TEST,0)),"^",3)
IF VISIT=""
QUIT
+43 ;S VISIT=$$GET1^DIQ(9000010.18,TEST,.03,"I") I VISIT="" Q
+44 ;S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSTDT="" Q
+45 SET VSTDT=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)
IF VSTDT=""
QUIT
+46 SET VSTDT=VSTDT\1
+47 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+48 IF $GET(SDATE)'=""
IF (VSTDT\1<SDATE)
QUIT
+49 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+50 IF VSTDT>LDATE
SET LDATE=VSTDT\1
SET LIEN=TEST
+51 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+52 ;S RESULT=$$GET1^DIQ(9000010.18,TEST,.04,"E")
+53 SET RESULT=$PIECE(^AUPNVCPT(TEST,0),"^",4)
SET ARRAY(VSTDT,TEST)=RESULT
+54 ;S RESULT=$S($P(N0,U,4)]"":$P($G(^AUTNPOV($P(N0,U,4),0)),U),1:"")
+55 SET CNTR(CT)=$GET(CNTR(CT))+1
+56 IF $GET(TARGET)]""
SET @TARGET=RESULT
End DoDot:2
End DoDot:1
+57 ;
+58 ;Handle Single/Multiple Counts
+59 IF $LENGTH(TAX,$CHAR(29))=1
SET CNT=$GET(CNTR(1))
+60 IF '$TEST
MERGE CNT=CNTR
+61 IF $GET(LDATE)=""
Begin DoDot:1
+62 SET LDATE=$ORDER(ARRAY(""),-1)
IF LDATE=""
QUIT
+63 SET LIEN=$ORDER(ARRAY(LDATE,""),-1)
+64 IF $GET(TARGET)=""
QUIT
+65 SET VSTDT=LDATE
SET TEST=LIEN
+66 IF VSTDT["."
KILL @TARGET
SET VSTDT=VSTDT\1
SET @TARGET=""
SET LDATE=VSTDT
End DoDot:1
+67 QUIT
+68 ;
LOINC(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
+1 ; LOINC Taxonomy Check
+2 ;
+3 NEW TXIEN,TEST,VISIT,VSTDT,RESULT,LOINC
+4 IF DFN=""
QUIT
+5 IF TAX=""
QUIT
+6 SET TXIEN=$ORDER(^ATXAX("B",TAX,""))
+7 IF TXIEN=""
QUIT
+8 SET TEST=""
SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+9 FOR
SET TEST=$ORDER(^AUPNVLAB("AC",DFN,TEST))
IF TEST=""
QUIT
Begin DoDot:1
+10 SET LOINC=$$GET1^DIQ(9000010.09,TEST,1113,"E")
+11 IF LOINC=""
QUIT
+12 IF '$DATA(^ATXAX(TXIEN,21,"B",LOINC))
QUIT
+13 SET VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I")
IF VISIT=""
QUIT
+14 SET VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSTDT=""
QUIT
+15 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+16 ; Get collection date/time
+17 SET COLDTM=$PIECE($GET(^AUPNVLAB(TEST,12)),U,1)\1
+18 ;S COLDTM=$$GET1^DIQ(9000010.09,TEST,1201,"I")\1
+19 IF COLDTM'=0
SET VSTDT=COLDTM
+20 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+21 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+22 IF VSTDT>LDATE
SET LDATE=VSTDT
SET LIEN=TEST
+23 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+24 SET RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
+25 SET CNT=CNT+1
+26 IF $GET(TARGET)]""
SET @TARGET=RESULT
End DoDot:1
+27 QUIT
+28 ;
HFTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
+1 ; Health Factors Taxonomy Check (includes health factor)
+2 ;
+3 NEW TXIEN,TEST,VISIT,VSTDT,RESULT,HF,CODE
+4 IF DFN=""
QUIT
+5 IF TAX=""
QUIT
+6 SET TXIEN=$ORDER(^ATXAX("B",TAX,""))
+7 IF TXIEN=""
QUIT
+8 SET TEST=""
SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+9 FOR
SET TEST=$ORDER(^AUPNVHF("AC",DFN,TEST))
IF TEST=""
QUIT
Begin DoDot:1
+10 SET HF=$$GET1^DIQ(9000010.23,TEST,.01,"E")
+11 IF HF=""
QUIT
+12 IF '$DATA(^ATXAX(TXIEN,21,"B",HF))
QUIT
+13 SET VISIT=$$GET1^DIQ(9000010.23,TEST,.03,"I")
IF VISIT=""
QUIT
+14 SET VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSTDT=""
QUIT
+15 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+16 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+17 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+18 IF VSTDT>LDATE
SET LDATE=VSTDT
SET LIEN=TEST
+19 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+20 SET RESULT=$$GET1^DIQ(9000010.23,TEST,.04,"E")
+21 SET CODE=$$GET1^DIQ(9000010.23,TEST,.01,"E")
+22 SET CNT=CNT+1
+23 IF $GET(TARGET)]""
SET @TARGET=RESULT_U_CODE
End DoDot:1
+24 QUIT
+25 ;
PRBTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
+1 ; ICD Taxonomy Check (using PROBLEM file)
+2 ;
+3 NEW TXIEN,TEST,VISIT,VSTDT,RESULT,PROB,EXIST
+4 IF DFN=""
QUIT
+5 IF TAX=""
QUIT
+6 SET TXIEN=$ORDER(^ATXAX("B",TAX,""))
+7 IF TXIEN=""
QUIT
+8 SET TEST=""
SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+9 FOR
SET TEST=$ORDER(^AUPNPROB("AC",DFN,TEST))
IF TEST=""
QUIT
Begin DoDot:1
+10 SET PROB=$$GET1^DIQ(9000011,TEST,.01,"I")
+11 IF PROB=""
QUIT
+12 IF $$PATCH^XPDUTL("ATX*5.1*11")
SET EXIST=$$ICD^ATXAPI(PROB,TXIEN,9)
+13 IF '$TEST
SET EXIST=$$ICD^BKMIXX5(PROB,TXIEN,9)
+14 IF EXIST=0
QUIT
+15 ; Not related to Visit File (#9000010)
+16 SET VISIT="N/A"
+17 ; Problem does not connect to a visit so VSTDT is calculated differently.
+18 SET VSTDT=$$PROB^BKMVUTL(TEST)
+19 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+20 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+21 IF VSTDT>LDATE
SET LDATE=VSTDT
SET LIEN=TEST
+22 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+23 SET RESULT=$$GET1^DIQ(9000011,TEST,.05,"E")
+24 SET CNT=CNT+1
+25 IF $GET(TARGET)]""
SET @TARGET=RESULT
End DoDot:1
+26 QUIT
+27 ;
MEDTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
+1 ; Medication Taxonomy Check (using Medication IEN)
+2 ;
+3 NEW TXIEN,TEST,VISIT,VSTDT,RESULT,DRGPTR,SIG,QTY,DAY
+4 IF DFN=""
QUIT
+5 IF TAX=""
QUIT
+6 SET TXIEN=$ORDER(^ATXAX("B",TAX,""))
+7 IF TXIEN=""
QUIT
+8 SET TEST=""
SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+9 FOR
SET TEST=$ORDER(^AUPNVMED("AC",DFN,TEST))
IF TEST=""
QUIT
Begin DoDot:1
+10 SET DRGPTR=$$GET1^DIQ(9000010.14,TEST,.01,"I")
+11 IF DRGPTR=""
QUIT
+12 IF '$DATA(^ATXAX(TXIEN,21,"B",DRGPTR))
QUIT
+13 SET VISIT=$$GET1^DIQ(9000010.14,TEST,.03,"I")
IF VISIT=""
QUIT
+14 SET VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSTDT=""
QUIT
+15 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+16 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+17 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+18 IF VSTDT>LDATE
SET LDATE=VSTDT
SET LIEN=TEST
+19 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+20 SET SIG=$$GET1^DIQ(9000010.14,TEST,.05,"E")
+21 SET QTY=$$GET1^DIQ(9000010.14,TEST,.06,"E")
+22 SET DAY=$$GET1^DIQ(9000010.14,TEST,.07,"E")
+23 SET RESULT=$$GET1^DIQ(9000010.14,TEST,.01,"E")
+24 SET CNT=CNT+1
+25 IF $GET(TARGET)]""
SET @TARGET=RESULT_U_SIG_U_QTY_U_DAY
End DoDot:1
+26 QUIT
+27 ;
ADATAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT) ; PEP
+1 ; ADA Code Taxonomy Check (using ADA Code)
+2 ;
+3 NEW TXIEN,TEST,VISIT,VSTDT,RESULT,ADA
+4 IF DFN=""
QUIT
+5 IF TAX=""
QUIT
+6 SET TXIEN=$ORDER(^ATXAX("B",TAX,""))
+7 IF TXIEN=""
QUIT
+8 SET TEST=""
SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+9 FOR
SET TEST=$ORDER(^AUPNVDEN("AC",DFN,TEST))
IF TEST=""
QUIT
Begin DoDot:1
+10 SET ADA=$$GET1^DIQ(9000010.05,TEST,.01,"E")
+11 IF ADA=""
QUIT
+12 IF '$DATA(^ATXAX(TXIEN,21,"B",ADA))
QUIT
+13 SET VISIT=$$GET1^DIQ(9000010.05,TEST,.03,"I")
IF VISIT=""
QUIT
+14 SET VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSTDT=""
QUIT
+15 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+16 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+17 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+18 IF VSTDT>LDATE
SET LDATE=VSTDT
SET LIEN=TEST
+19 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+20 ;Nothing identified in file as a 'RESULT'. Using "N/A" for now for consistency with other functions.
+21 ;S RESULT=$$GET1^DIQ(9000010.05,TEST,.04,"I")
+22 SET RESULT="N/A"
+23 SET CNT=CNT+1
+24 IF $GET(TARGET)]""
SET @TARGET=RESULT
End DoDot:1
+25 QUIT
+26 ;
+27 ; For this entry point only:
+28 ;
+29 ; Input:
+30 ; TAX = PATIENT EDUCATION TOPIC CODE LIST to search for
+31 ; (required)
+32 ;
+33 ; Example: "CD-,-CD,AOD-,-AOD"
+34 ; Example: "*BGP HIV/AIDS DXS"
+35 ;
+36 ; Returns items where the MNEMONIC field for the Patient
+37 ; Education entry contains one of the listed values.
+38 ;
+39 ; Second example shows an ICD taxonomy name.
+40 ; If used, will search for any Patient Education entry
+41 ; containing one of the values in that Taxonomy.
+42 ;
+43 ; The data in this file is too volatile to use Taxonomies for most entries.
+44 ; Variables are still named the same for consistency with other functions.
+45 ;
PTEDTAX(DFN,TAX,EDATE,SDATE,TARGET,LDATE,LIEN,CNT,SVTX) ; PEP
+1 ; Patient Education Taxonomy check (by Education Code List) (includes topic)
+2 ; PTEDTAX^BKMIXX1 does this by Taxonomy
+3 ;
+4 NEW TXIEN,TEST,VISIT,VSTDT,RESULT,PTED,CODE
+5 IF DFN=""
QUIT
+6 IF TAX=""
QUIT
+7 ;Not really needed, but set to maintain same variable list as other functions.
+8 SET TXIEN=TAX
+9 IF TXIEN=""
QUIT
+10 ;Build a list of Education Code Entries based on the code list supplied.
+11 IF $DATA(SVTX(TAX))
MERGE TXIEN=SVTX(TAX)
+12 IF '$TEST
DO BLDTAX1^BKMIXX5(TAX,"TXIEN")
MERGE SVTX(TAX)=TXIEN
+13 SET TEST=""
SET CNT=0
SET LDATE=$GET(LDATE,"")
SET LIEN=$GET(LIEN,"")
+14 FOR
SET TEST=$ORDER(^AUPNVPED("AC",DFN,TEST))
IF TEST=""
QUIT
Begin DoDot:1
+15 SET PTED=$$GET1^DIQ(9000010.16,TEST,.01,"I")
+16 IF PTED=""
QUIT
+17 IF '$DATA(TXIEN(PTED))
QUIT
+18 SET VISIT=$$GET1^DIQ(9000010.16,TEST,.03,"I")
IF VISIT=""
QUIT
+19 SET VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VISIT=""
QUIT
+20 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+21 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+22 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+23 IF VSTDT>LDATE
SET LDATE=VSTDT
SET LIEN=TEST
+24 IF VSTDT=LDATE
IF TEST>LIEN
SET LDATE=VSTDT
SET LIEN=TEST
+25 SET RESULT=$$GET1^DIQ(9000010.16,TEST,.04,"E")
+26 SET CODE=$$GET1^DIQ(9000010.16,TEST,.01,"E")
+27 SET CNT=CNT+1
+28 IF $GET(TARGET)]""
SET @TARGET=RESULT_U_CODE
End DoDot:1
+29 QUIT
