- 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