BQICAVAL ;GDIT/HS/ALA-Community Alert Validation ; 24 Jul 2012 1:42 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
EN ;EP
S TMFRAME="T-"_$$GET1^DIQ(90508,"1,",.24,"E")
D LAB
D EXP
; Get export format type 'D' is delimited and 'H' or blank is HL7
S FRM=$P($G(^BQI(90508,1,0)),U,2)
S IN=$S(FRM="D":1,1:0)
S DELIM=$S(FRM="D":",",1:"~")
S FLNM=$S('$$PROD^XUPROD():"CANEZ",1:"CANES")
; If HL7
I FRM'="D" D ^BQICAHLO
D WRITE
K ASUFAC,BJ,DELIM,DXN,FLNM,FRM,GRP,IN,MEAS,POP,RESULT,XBPAFN,XBS1,ZISHC,ZISHDA1
Q
;
LAB ;EP - Get all labs
NEW UID,TREF,TAX
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
F TAX="BQI C.TRACH SPECIFIC LOINC","BQI C.TRACH NON-SPECIFIC LOINC","BQI C.TRACH DNA QUANT LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI C.TRACH SPECIFIC TAX","BQI C.TRACH NON-SPECIFIC TAX","BQI C.TRACH DNA QUANT TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(50)
K @TREF
;
S TAX="BQI S PNEUM SUSCEPT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
S TAX="BQI S PNEUM SUSCEPT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(45)
K @TREF
;
S TAX="SURVEILLANCE RAPID FLU LOINC" D BLD^BQITUTL(TAX,.TREF)
S TAX="SURVEILLANCE RAPID FLU TESTS" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(79)
K @TREF
;
F TAX="BQI HEP B QUAL TEST LOINC","BQI HEP B QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HEP B QUAL TEST TAX","BQI HEP B QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(56)
K @TREF
;
F TAX="BQI HEP C QUAL TEST LOINC","BQI HEP C QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF) D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HEP C CONFIRM LOINC CODES","BQI HEP C GENOTYPE LOINC","BQI HEP C SCREEN LOINC CODES" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HEP C QUAL TEST TAX","BQI HEP C QUANT TEST TAX","BQI HEP C CONFIRM TESTS" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HEP C GENOTYPE TESTS","BQI HEP C SCREEN TESTS" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(57)
K @TREF
;
F TAX="BGP CD4 LOINC CODES","BKMV CD4 ABS LOINC CODES","BGP VIRAL LOAD LOINC CODES" D BLD^BQITUTL(TAX,.TREF)
F TAX="BGP CD4 TAX","BKMV CD4 ABS TESTS TAX","BGP HIV VIRAL LOAD TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV AB QUAL SCREEN LOINC","BQI HIV QUAL CONFIRM LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV AB QUAL SCREEN TAX","BQI HIV QUAL CONFIRM TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV ID SPEC CONFIRM LOINC","BQI HIV QUAL NUC ACID LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV ID SPEC CONFIRM TAX","BQI HIV QUAL NUC ACID TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV QUAL ANTIGEN LOINC","BQI HIV VIROLOGIC TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV QUAL ANTIGEN TAX","BQI HIV VIROLOGIC TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV AB QUANT SCREEN LOINC","BQI HIV QUANT CONFIRM LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV AB QUANT SCREEN TAX","BQI HIV QUANT CONFIRM TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV QUANT NUC ACID LOINC","BQI HIV QUANT ANTIGEN LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV QUANT NUC ACID TAX","BQI HIV QUANT ANTIGEN TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(2)
K @TREF
;
F TAX="BQI MEASLES QUAL TEST LOINC","BQI MEASLES ID SPEC TEST LOINC","BQI MEASLES QUAN TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI MEASLES QUAL TEST TAX","BQI MEASLES ID SPEC TEST TAX","BQI MEASLES QUAN TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(14)
K @TREF
;
F TAX="BQI MENINGITIS QUAL TEST LOINC","BQI MENINGITIS ID SPEC LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI MENINGITIS GRAM STAIN LNC","BQI MENINGITIS QUAN LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI MENINGITIS QUAL TEST TAX","BQI MENINGITIS GRAM STAIN TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI MENINGITIS ID SPEC TAX","BQI MENINGITIS QUAN TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(4)
K @TREF
;
F TAX="BKM PPD LOINC CODES","BQI PPD DIAMETER LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BKM PPD TAX","BQI PPD DIAMETER TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI TB GAMMA REL QUAL TEST TAX","BQI TB GAMMA REL QUANT TEST TX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI TB GAMMA REL QUAL TEST LNC","BQI TB GAMMA REL QUANT TEST LC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI TB RNA DNA QUAL TEST LOINC","BQI TB RNA DNA QUANT TEST LNC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI TB RNA DNA QUAL TEST TAX","BQI TB RNA DNA QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI TB SPECIFIC AFB TEST LOINC","BQI TB NONSPEC AFB TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI TB SPECIFIC AFB TEST TAX","BQI TB NONSPEC AFB TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(29)
K @TREF
;
F TAX="BKM RPR LOINC CODES","BQI SYPH DARK FIELD TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BKM RPR TAX","BQI SYPH DARK FIELD TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI SYPHILIS QUAL TEST LOINC","BQI SYPHILIS QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI SYPHILIS QUAL TEST TAX","BQI SYPHILIS QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(46)
K @TREF
;
F TAX="BQI HIB QUAL TEST LOINC","BQI HIB CULTURE TEST LOINC","BQI HIB QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIB QUAL TEST TAX","BQI HIB CULTURE TEST TAX","BQI HIB QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(77)
K @TREF
;
F TAX="BQI S PNEUM CULTURE TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
S TAX="BQI S PNEUM CULTURE TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
D FND(78)
;
Q
;
FND(TYP) ;EP
NEW TIEN,DATE,BQDFN,LDATE,IEN
S TIEN="",DATE=$$DATE^BQIUL1(TMFRAME),DATE=9999999-DATE
F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
. S BQDFN=""
. F S BQDFN=$O(^AUPNVLAB("AA",BQDFN)) Q:BQDFN="" D
.. S LDATE=""
.. F S LDATE=$O(^AUPNVLAB("AA",BQDFN,TIEN,LDATE)) Q:LDATE=""!(LDATE'<DATE) D
... S IEN=""
... F S IEN=$O(^AUPNVLAB("AA",BQDFN,TIEN,LDATE,IEN)) Q:IEN="" D
.... I "RM"']$P($G(^AUPNVLAB(IEN,11)),U,9) Q
.... S ^XTMP("BQICAVAL",BQDFN,TYP,"LB",(9999999-LDATE),IEN)=TIEN_U_9000010.09
.. S LDATE=""
.. F S LDATE=$O(^AUPNVMIC("AA",BQDFN,TIEN,LDATE)) Q:LDATE=""!(LDATE'<DATE) D
... S IEN=""
... F S IEN=$O(^AUPNVMIC("AA",BQDFN,TIEN,LDATE,IEN)) Q:IEN="" D
.... I "RM"']$P($G(^AUPNVMIC(IEN,11)),U,9) Q
.... S ^XTMP("BQICAVAL",BQDFN,TYP,"LB",(9999999-LDATE),IEN)=TIEN_U_9000010.25
Q
;
EXP ;EP - Export data
NEW ALERT,ASUFAC,ASUN,ASUNM,BJ,CT,DELIM,DFN,DIAG,DTLMD,DXN,FLNM,FRM,GRP,I,IN,LAB,LCP,LOC,LOINC
NEW MEAS,N,POP,RECORD,RESULT,RESULTS,RIEN,SITE,TMDATA,TYP,VDATE,VFILE,VISIT,VSDTM,XBPAFN,XBS1,ZISHC,ZISHDA1
S ASUN=$P(^AUTTSITE(1,0),U),ASUFAC=$P($G(^AUTTLOC(ASUN,0)),U,10),ASUNM=$P(^DIC(4,ASUN,0),U)
S CT=0,N=0
K ^BQIDATA($J)
;
S FRM=$P($G(^BQI(90508,1,0)),U,2)
S IN=$S(FRM="D":1,1:0)
S DELIM=$S(FRM="D":",",1:"~")
I FRM="D" S HDR=$$JDATE(DT)_DELIM_CT_DELIM_ASUNM,^BQIDATA($J,IN)=HDR
S FLNM=$S('$$PROD^XUPROD():"CANEZ",1:"CANES")
;
PROC ;EP
S DFN=""
F S DFN=$O(^XTMP("BQICAVAL",DFN)) Q:DFN="" D
. S TYP=""
. F S TYP=$O(^XTMP("BQICAVAL",DFN,TYP)) Q:TYP="" D
.. S VDATE=""
.. F S VDATE=$O(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE)) Q:VDATE="" D
... S RIEN=""
... F S RIEN=$O(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN)) Q:RIEN="" D
.... S VFILE=$P(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN),U,2)
.... S LAB=$P(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN),U,1)
.... S VISIT=$S(VFILE=9000010.25:$P($G(^AUPNVMIC(RIEN,0)),U,3),1:$P($G(^AUPNVLAB(RIEN,0)),U,3))
.... I VISIT="" K ^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN) Q
.... S ALERT=$P(^BQI(90507.8,TYP,2),U,1)
.... S DIAG=$P(^BQI(90507.8,TYP,0),U,1),GRP=$P(^(0),U,3),DXN=""
.... S LOC=$P($G(^AUPNVSIT(VISIT,0)),U,6)
.... D FORM
.. S VDATE=""
.. F S VDATE=$O(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE)) Q:VDATE="" D
... S RIEN=""
... F S RIEN=$O(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN)) Q:RIEN="" D
.... S VFILE=$P(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN),U,2)
.... S DX=$P(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN),U,1)
.... S VISIT=$P($G(^AUPNVPOV(RIEN,0)),U,3)
.... I VISIT="" K ^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN) Q
.... S ALERT=$P(^BQI(90507.8,TYP,2),U,1)
.... S DIAG=$P(^BQI(90507.8,TYP,0),U,1),GRP=$P(^(0),U,3),DXN=$$GET1^DIQ(9000010.07,RIEN_",",.01,"E")
.... S LOC=$P($G(^AUPNVSIT(VISIT,0)),U,6)
.... D FORM
Q
;
FORM ; Format the data
; Unique Identifier
S RECORD=$$UID(DFN)
; HRN
S $P(RECORD,DELIM,2)=$S($$HRN^AUPNPAT(DFN,LOC)]"":$$HRN^AUPNPAT(DFN,LOC),1:$$HRN^AUPNPAT(DFN,DUZ(2)))
; Gender
S $P(RECORD,DELIM,3)=$P(^DPT(DFN,0),U,2)
; DOB
S $P(RECORD,DELIM,4)=$S(FRM="D":$$JDATE($P($G(^DPT(DFN,0)),U,3)),1:$$FMTHL7^XLFDT($P($G(^DPT(DFN,0)),U,3)))
; Age
S $P(RECORD,DELIM,5)=$P($$AGE^BQIAGE(DFN,"",1)," ",1)
; Age Units
S $P(RECORD,DELIM,6)=$P($$AGE^BQIAGE(DFN,"",1)," ",2)
; Patient Street Address
S $P(RECORD,DELIM,7)=$$GET1^DIQ(2,DFN_",",.111,"E")
; Patient Address City
S $P(RECORD,DELIM,8)=$$GET1^DIQ(2,DFN_",",.114,"E")
; Patient Address State
NEW ST
S ST=$$GET1^DIQ(2,DFN_",",.115,"I")
S $P(RECORD,DELIM,9)=$$PTR^BQIUL2(2,.115,ST,1)
; Patient Address Zip
S $P(RECORD,DELIM,10)=$S($$GET1^DIQ(2,DFN_",",.1112,"E")'="":$$GET1^DIQ(2,DFN_",",.1112,"E"),1:$$GET1^DIQ(2,DFN_",",.116,"E"))
; Patient County
S $P(RECORD,DELIM,11)=$$COUN^BQIULPT(DFN)
; Current community of residence
S $P(RECORD,DELIM,12)=$$COMMRES^AUPNPAT(DFN,"C")
; Race
NEW RACE,RCN
S RACE=$$RCE^BQIPTDMG(DFN,.01),RCN=$P(RACE,$C(28),1)
I RCN'="" S $P(RECORD,DELIM,13)=$P(^DIC(10,RCN,0),U,3)
; Ethnicity
NEW ETHN,ETN
S ETHN=$$ETHN^BQIPTDMG(DFN,.01),ETN=$P(ETHN,$C(28),1)
I ETN'="" S $P(RECORD,DELIM,14)=$P(^DIC(10.2,ETN,0),U,2)
; ASUFAC of encounter location
S $P(RECORD,DELIM,15)=$S(LOC'="":$P($G(^AUTTLOC(LOC,0)),U,10),1:"")
; Visit Date
S $P(RECORD,DELIM,16)=$S(FRM="D":$$JDATE(VDATE),1:$$FMTHL7^XLFDT(VDATE))
; Visit ID
S $P(RECORD,DELIM,17)=$S($P($G(^AUPNVSIT(VISIT,11)),U,14)]"":$P($G(^AUPNVSIT(VISIT,11)),U,14),1:$$UIDV^AUPNVSIT(VISIT))
; Dxn code
S $P(RECORD,DELIM,18)=DXN
; CDC diagnosis narrative
S $P(RECORD,DELIM,19)=DIAG
; Type of alert
S $P(RECORD,DELIM,20)=ALERT
; Group
S $P(RECORD,DELIM,21)=GRP
; Visit last modified
;S DTLMD=$S(VFILE'=9000010:$P($G(^AMHREC(VISIT,11)),U,14),1:$P($G(^AUPNVSIT(VISIT,0)),U,13))
S DTLMD=$S(VFILE'[9000010:$P($G(^AMHREC(VISIT,11)),U,14),1:$P($G(^AUPNVSIT(VISIT,0)),U,13))
S $P(RECORD,DELIM,22)=$S(FRM="D":$$JDATE(DTLMD),1:$$FMTHL7^XLFDT(DTLMD))
; Set up Lab test result for OBX
I VFILE=9000010.09 D
. S SITE=$P($G(^AUPNVLAB(RIEN,11)),U,3),UNITS=$P($G(^AUPNVLAB(RIEN,11)),U,1)
. S RLOW=$P($G(^AUPNVLAB(RIEN,11)),U,4),RHIGH=$P($G(^AUPNVLAB(RIEN,11)),U,5)
. S RESULT=$P(^AUPNVLAB(RIEN,0),U,4)
. S ABN=$P(^AUPNVLAB(RIEN,0),U,5)
. I SITE="" D Q
.. S $P(RECORD,DELIM,25)=LAB_"^"_$P(^LAB(60,LAB,0),U,1)_"^99"_$P(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
.. S $P(RECORD,DELIM,31)=UNITS,$P(RECORD,DELIM,32)=RLOW_"^"_RHIGH,$P(RECORD,DELIM,33)=ABN
. I SITE'="" D
.. S LCP=$P($G(^LAB(60,LAB,1,SITE,95.3)),U,1)
.. I LCP="" D Q
... S $P(RECORD,DELIM,25)=LAB_"^"_$P(^LAB(60,LAB,0),U,1)_"^99"_$P(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
... S $P(RECORD,DELIM,31)=UNITS,$P(RECORD,DELIM,32)=RLOW_"^"_RHIGH,$P(RECORD,DELIM,33)=ABN
.. S LOINC=LCP_"-"_$P(^LAB(95.3,LCP,0),U,15)
.. S $P(RECORD,DELIM,25)=LOINC_"^"_$P(^LAB(60,LAB,0),U,1)_"^LN="_RESULT_"^^"_$P($G(^LAB(95.3,LCP,80)),U,1)
.. S $P(RECORD,DELIM,31)=UNITS,$P(RECORD,DELIM,32)=RLOW_"^"_RHIGH,$P(RECORD,DELIM,33)=ABN
. ; for NTE
. S $P(RECORD,DELIM,30)=VFILE_":"_RIEN
I VFILE=9000010.25 D
. S SITE=$P($G(^AUPNVMIC(RIEN,11)),U,3),UNITS=$P($G(^AUPNVMIC(RIEN,11)),U,1)
. S RLOW=$P($G(^AUPNVMIC(RIEN,11)),U,4),RHIGH=$P($G(^AUPNVMIC(RIEN,11)),U,5)
. S RESULT=$P(^AUPNVMIC(RIEN,0),U,7),ABN=""
. I SITE="" D Q
.. S $P(RECORD,DELIM,25)=LAB_"^"_$P(^LAB(60,LAB,0),U,1)_"^99"_$P(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
.. S $P(RECORD,DELIM,31)=UNITS,$P(RECORD,DELIM,32)=RLOW_"^"_RHIGH,$P(RECORD,DELIM,33)=ABN
. I SITE'="" D
.. S LCP=$P($G(^LAB(60,LAB,1,SITE,95.3)),U,1)
.. I LCP="" D Q
... S $P(RECORD,DELIM,25)=LAB_"^"_$P(^LAB(60,LAB,0),U,1)_"^99"_$P(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
... S $P(RECORD,DELIM,31)=UNITS,$P(RECORD,DELIM,32)=RLOW_"^"_RHIGH,$P(RECORD,DELIM,33)=ABN
.. S LOINC=LCP_"-"_$P(^LAB(95.3,LCP,0),U,15)
.. S $P(RECORD,DELIM,25)=LOINC_"^"_$P(^LAB(60,LAB,0),U,1)_"^LN="_RESULT_"^^"_$P($G(^LAB(95.3,LCP,80)),U,1)
.. S $P(RECORD,DELIM,31)=UNITS,$P(RECORD,DELIM,32)=RLOW_"^"_RHIGH,$P(RECORD,DELIM,33)=ABN
. ; for NTE
. S $P(RECORD,DELIM,30)=VFILE_":"_RIEN
; Highest Temperature for OBX
;I VDATE'="",VFILE=9000010 D
I VDATE'="" D
. NEW TMN,RVDT,IEN,ZZ,RESULT
. S TMN=$O(^AUTTMSR("B","TMP","")) I TMN="" Q
. S RVDT=9999999-VDATE
. S IEN=""
. F S IEN=$O(^AUPNVMSR("AA",DFN,TMN,RVDT,IEN)) Q:IEN="" D
.. S RESULT=$P($G(^AUPNVMSR(IEN,0)),"^",4) I RESULT="" Q
.. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
.. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
.. S ZZ(RESULT)=""
. S $P(RECORD,DELIM,23)=$O(ZZ(""),-1)
; Vitals for OBX
I VFILE[9000010 D
. NEW VITALS,BMI,IEN,TYP,RESULT,MEAS,XX,UID
. S VITALS="",UID=$J
. S BMI=$P($$PBMI^APCLV(DFN,DT),"^",1)
. I BMI'="" S VITALS=VITALS_"BMI="_BMI_";"
. S IEN=""
. F S IEN=$O(^AUPNVMSR("AD",VISIT,IEN)) Q:IEN="" D
.. S TYP=$P($G(^AUPNVMSR(IEN,0)),"^",1) I TYP="" Q
.. S MEAS=$P(^AUTTMSR(TYP,0),"^",1),RESULT=$P(^AUPNVMSR(IEN,0),"^",4)
.. I $P($G(^AUPNVMSR(IEN,2)),U,1)=1 Q
.. S XX="BP,RS,PU,WT,HT"
.. I '$F(XX,MEAS) Q
.. S VITALS=VITALS_MEAS_"="_RESULT_";"
. S $P(RECORD,DELIM,24)=$$TKO^BQIUL1(VITALS,";")
;
S IN=IN+1,^BQIDATA($J,IN)=RECORD
Q
;
UID(BQIDFN) ;EP - Given DFN return unique patient record id.
I $G(BQIDFN)="" Q ""
I $G(^AUPNPAT(BQIDFN,0))="" Q ""
I $G(^DPT(BQIDFN,0))="" Q ""
Q $$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)_$E("0000000000",1,10-$L(BQIDFN))_BQIDFN
;
JDATE(DATE) ;EP - Format the date
I $G(DATE)="" Q ""
NEW A
S A=$$FMTE^XLFDT(DATE)
Q $E(DATE,6,7)_$$UP^XLFSTR($P(A," ",1))_(1700+$E(DATE,1,3))
;
DATE(D) ;
Q (1700+$E(D,1,3))_$E(D,4,5)_$E(D,6,7)
;
;send file
WRITE ; use XBGSAVE to save the temp global (BQIDATA) to a file that is exported
;
NEW XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN
S XBMED="F",XBQ="N",XBFLT=1,XBF=$J,XBE=$J
S XBGL=$S(FRM="D":"BQIDATA",1:"BQIHL7")
S XBNAR="CANE SURVEILLANCE EXPORT"
S ASUFAC=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10) ;asufac for file name
S XBFN="CANE3_"_ASUFAC_"_"_$$DATE(DT)_".txt"
S XBS1="CANE SURVEILLANCE SEND"
S XBUF=$P($G(^AUTTSITE(1,1)),"^",2)
I XBUF="" S XBUF=$P($G(^XTV(8989.3,1,"DEV")),"^",1)
;
D ^XBGSAVE
;
K ^BQIDATA($J),^BQIHL7($J)
K HLSTATE,XBFLG
Q
BQICAVAL ;GDIT/HS/ALA-Community Alert Validation ; 24 Jul 2012 1:42 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
EN ;EP
+1 SET TMFRAME="T-"_$$GET1^DIQ(90508,"1,",.24,"E")
+2 DO LAB
+3 DO EXP
+4 ; Get export format type 'D' is delimited and 'H' or blank is HL7
+5 SET FRM=$PIECE($GET(^BQI(90508,1,0)),U,2)
+6 SET IN=$SELECT(FRM="D":1,1:0)
+7 SET DELIM=$SELECT(FRM="D":",",1:"~")
+8 SET FLNM=$SELECT('$$PROD^XUPROD():"CANEZ",1:"CANES")
+9 ; If HL7
+10 IF FRM'="D"
DO ^BQICAHLO
+11 DO WRITE
+12 KILL ASUFAC,BJ,DELIM,DXN,FLNM,FRM,GRP,IN,MEAS,POP,RESULT,XBPAFN,XBS1,ZISHC,ZISHDA1
+13 QUIT
+14 ;
LAB ;EP - Get all labs
+1 NEW UID,TREF,TAX
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET TREF=$NAME(^TMP("BQITAX",$JOB))
KILL @TREF
+4 FOR TAX="BQI C.TRACH SPECIFIC LOINC","BQI C.TRACH NON-SPECIFIC LOINC","BQI C.TRACH DNA QUANT LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+5 FOR TAX="BQI C.TRACH SPECIFIC TAX","BQI C.TRACH NON-SPECIFIC TAX","BQI C.TRACH DNA QUANT TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+6 DO FND(50)
+7 KILL @TREF
+8 ;
+9 SET TAX="BQI S PNEUM SUSCEPT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+10 SET TAX="BQI S PNEUM SUSCEPT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+11 DO FND(45)
+12 KILL @TREF
+13 ;
+14 SET TAX="SURVEILLANCE RAPID FLU LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+15 SET TAX="SURVEILLANCE RAPID FLU TESTS"
DO BLD^BQITUTL(TAX,.TREF,"L")
+16 DO FND(79)
+17 KILL @TREF
+18 ;
+19 FOR TAX="BQI HEP B QUAL TEST LOINC","BQI HEP B QUANT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+20 FOR TAX="BQI HEP B QUAL TEST TAX","BQI HEP B QUANT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+21 DO FND(56)
+22 KILL @TREF
+23 ;
+24 FOR TAX="BQI HEP C QUAL TEST LOINC","BQI HEP C QUANT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
DO BLD^BQITUTL(TAX,.TREF)
+25 FOR TAX="BQI HEP C CONFIRM LOINC CODES","BQI HEP C GENOTYPE LOINC","BQI HEP C SCREEN LOINC CODES"
DO BLD^BQITUTL(TAX,.TREF)
+26 FOR TAX="BQI HEP C QUAL TEST TAX","BQI HEP C QUANT TEST TAX","BQI HEP C CONFIRM TESTS"
DO BLD^BQITUTL(TAX,.TREF,"L")
+27 FOR TAX="BQI HEP C GENOTYPE TESTS","BQI HEP C SCREEN TESTS"
DO BLD^BQITUTL(TAX,.TREF,"L")
+28 DO FND(57)
+29 KILL @TREF
+30 ;
+31 FOR TAX="BGP CD4 LOINC CODES","BKMV CD4 ABS LOINC CODES","BGP VIRAL LOAD LOINC CODES"
DO BLD^BQITUTL(TAX,.TREF)
+32 FOR TAX="BGP CD4 TAX","BKMV CD4 ABS TESTS TAX","BGP HIV VIRAL LOAD TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+33 FOR TAX="BQI HIV AB QUAL SCREEN LOINC","BQI HIV QUAL CONFIRM LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+34 FOR TAX="BQI HIV AB QUAL SCREEN TAX","BQI HIV QUAL CONFIRM TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+35 FOR TAX="BQI HIV ID SPEC CONFIRM LOINC","BQI HIV QUAL NUC ACID LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+36 FOR TAX="BQI HIV ID SPEC CONFIRM TAX","BQI HIV QUAL NUC ACID TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+37 FOR TAX="BQI HIV QUAL ANTIGEN LOINC","BQI HIV VIROLOGIC TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+38 FOR TAX="BQI HIV QUAL ANTIGEN TAX","BQI HIV VIROLOGIC TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+39 FOR TAX="BQI HIV AB QUANT SCREEN LOINC","BQI HIV QUANT CONFIRM LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+40 FOR TAX="BQI HIV AB QUANT SCREEN TAX","BQI HIV QUANT CONFIRM TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+41 FOR TAX="BQI HIV QUANT NUC ACID LOINC","BQI HIV QUANT ANTIGEN LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+42 FOR TAX="BQI HIV QUANT NUC ACID TAX","BQI HIV QUANT ANTIGEN TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+43 DO FND(2)
+44 KILL @TREF
+45 ;
+46 FOR TAX="BQI MEASLES QUAL TEST LOINC","BQI MEASLES ID SPEC TEST LOINC","BQI MEASLES QUAN TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+47 FOR TAX="BQI MEASLES QUAL TEST TAX","BQI MEASLES ID SPEC TEST TAX","BQI MEASLES QUAN TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+48 DO FND(14)
+49 KILL @TREF
+50 ;
+51 FOR TAX="BQI MENINGITIS QUAL TEST LOINC","BQI MENINGITIS ID SPEC LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+52 FOR TAX="BQI MENINGITIS GRAM STAIN LNC","BQI MENINGITIS QUAN LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+53 FOR TAX="BQI MENINGITIS QUAL TEST TAX","BQI MENINGITIS GRAM STAIN TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+54 FOR TAX="BQI MENINGITIS ID SPEC TAX","BQI MENINGITIS QUAN TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+55 DO FND(4)
+56 KILL @TREF
+57 ;
+58 FOR TAX="BKM PPD LOINC CODES","BQI PPD DIAMETER LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+59 FOR TAX="BKM PPD TAX","BQI PPD DIAMETER TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+60 FOR TAX="BQI TB GAMMA REL QUAL TEST TAX","BQI TB GAMMA REL QUANT TEST TX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+61 FOR TAX="BQI TB GAMMA REL QUAL TEST LNC","BQI TB GAMMA REL QUANT TEST LC"
DO BLD^BQITUTL(TAX,.TREF)
+62 FOR TAX="BQI TB RNA DNA QUAL TEST LOINC","BQI TB RNA DNA QUANT TEST LNC"
DO BLD^BQITUTL(TAX,.TREF)
+63 FOR TAX="BQI TB RNA DNA QUAL TEST TAX","BQI TB RNA DNA QUANT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+64 FOR TAX="BQI TB SPECIFIC AFB TEST LOINC","BQI TB NONSPEC AFB TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+65 FOR TAX="BQI TB SPECIFIC AFB TEST TAX","BQI TB NONSPEC AFB TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+66 DO FND(29)
+67 KILL @TREF
+68 ;
+69 FOR TAX="BKM RPR LOINC CODES","BQI SYPH DARK FIELD TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+70 FOR TAX="BKM RPR TAX","BQI SYPH DARK FIELD TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+71 FOR TAX="BQI SYPHILIS QUAL TEST LOINC","BQI SYPHILIS QUANT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+72 FOR TAX="BQI SYPHILIS QUAL TEST TAX","BQI SYPHILIS QUANT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+73 DO FND(46)
+74 KILL @TREF
+75 ;
+76 FOR TAX="BQI HIB QUAL TEST LOINC","BQI HIB CULTURE TEST LOINC","BQI HIB QUANT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+77 FOR TAX="BQI HIB QUAL TEST TAX","BQI HIB CULTURE TEST TAX","BQI HIB QUANT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+78 DO FND(77)
+79 KILL @TREF
+80 ;
+81 FOR TAX="BQI S PNEUM CULTURE TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+82 SET TAX="BQI S PNEUM CULTURE TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+83 DO FND(78)
+84 ;
+85 QUIT
+86 ;
FND(TYP) ;EP
+1 NEW TIEN,DATE,BQDFN,LDATE,IEN
+2 SET TIEN=""
SET DATE=$$DATE^BQIUL1(TMFRAME)
SET DATE=9999999-DATE
+3 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+4 SET BQDFN=""
+5 FOR
SET BQDFN=$ORDER(^AUPNVLAB("AA",BQDFN))
IF BQDFN=""
QUIT
Begin DoDot:2
+6 SET LDATE=""
+7 FOR
SET LDATE=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,LDATE))
IF LDATE=""!(LDATE'<DATE)
QUIT
Begin DoDot:3
+8 SET IEN=""
+9 FOR
SET IEN=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,LDATE,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+10 IF "RM"']$PIECE($GET(^AUPNVLAB(IEN,11)),U,9)
QUIT
+11 SET ^XTMP("BQICAVAL",BQDFN,TYP,"LB",(9999999-LDATE),IEN)=TIEN_U_9000010.09
End DoDot:4
End DoDot:3
+12 SET LDATE=""
+13 FOR
SET LDATE=$ORDER(^AUPNVMIC("AA",BQDFN,TIEN,LDATE))
IF LDATE=""!(LDATE'<DATE)
QUIT
Begin DoDot:3
+14 SET IEN=""
+15 FOR
SET IEN=$ORDER(^AUPNVMIC("AA",BQDFN,TIEN,LDATE,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+16 IF "RM"']$PIECE($GET(^AUPNVMIC(IEN,11)),U,9)
QUIT
+17 SET ^XTMP("BQICAVAL",BQDFN,TYP,"LB",(9999999-LDATE),IEN)=TIEN_U_9000010.25
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
EXP ;EP - Export data
+1 NEW ALERT,ASUFAC,ASUN,ASUNM,BJ,CT,DELIM,DFN,DIAG,DTLMD,DXN,FLNM,FRM,GRP,I,IN,LAB,LCP,LOC,LOINC
+2 NEW MEAS,N,POP,RECORD,RESULT,RESULTS,RIEN,SITE,TMDATA,TYP,VDATE,VFILE,VISIT,VSDTM,XBPAFN,XBS1,ZISHC,ZISHDA1
+3 SET ASUN=$PIECE(^AUTTSITE(1,0),U)
SET ASUFAC=$PIECE($GET(^AUTTLOC(ASUN,0)),U,10)
SET ASUNM=$PIECE(^DIC(4,ASUN,0),U)
+4 SET CT=0
SET N=0
+5 KILL ^BQIDATA($JOB)
+6 ;
+7 SET FRM=$PIECE($GET(^BQI(90508,1,0)),U,2)
+8 SET IN=$SELECT(FRM="D":1,1:0)
+9 SET DELIM=$SELECT(FRM="D":",",1:"~")
+10 IF FRM="D"
SET HDR=$$JDATE(DT)_DELIM_CT_DELIM_ASUNM
SET ^BQIDATA($JOB,IN)=HDR
+11 SET FLNM=$SELECT('$$PROD^XUPROD():"CANEZ",1:"CANES")
+12 ;
PROC ;EP
+1 SET DFN=""
+2 FOR
SET DFN=$ORDER(^XTMP("BQICAVAL",DFN))
IF DFN=""
QUIT
Begin DoDot:1
+3 SET TYP=""
+4 FOR
SET TYP=$ORDER(^XTMP("BQICAVAL",DFN,TYP))
IF TYP=""
QUIT
Begin DoDot:2
+5 SET VDATE=""
+6 FOR
SET VDATE=$ORDER(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE))
IF VDATE=""
QUIT
Begin DoDot:3
+7 SET RIEN=""
+8 FOR
SET RIEN=$ORDER(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN))
IF RIEN=""
QUIT
Begin DoDot:4
+9 SET VFILE=$PIECE(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN),U,2)
+10 SET LAB=$PIECE(^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN),U,1)
+11 SET VISIT=$SELECT(VFILE=9000010.25:$PIECE($GET(^AUPNVMIC(RIEN,0)),U,3),1:$PIECE($GET(^AUPNVLAB(RIEN,0)),U,3))
+12 IF VISIT=""
KILL ^XTMP("BQICAVAL",DFN,TYP,"LB",VDATE,RIEN)
QUIT
+13 SET ALERT=$PIECE(^BQI(90507.8,TYP,2),U,1)
+14 SET DIAG=$PIECE(^BQI(90507.8,TYP,0),U,1)
SET GRP=$PIECE(^(0),U,3)
SET DXN=""
+15 SET LOC=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,6)
+16 DO FORM
End DoDot:4
End DoDot:3
+17 SET VDATE=""
+18 FOR
SET VDATE=$ORDER(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE))
IF VDATE=""
QUIT
Begin DoDot:3
+19 SET RIEN=""
+20 FOR
SET RIEN=$ORDER(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN))
IF RIEN=""
QUIT
Begin DoDot:4
+21 SET VFILE=$PIECE(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN),U,2)
+22 SET DX=$PIECE(^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN),U,1)
+23 SET VISIT=$PIECE($GET(^AUPNVPOV(RIEN,0)),U,3)
+24 IF VISIT=""
KILL ^XTMP("BQICAVAL",DFN,TYP,"DX",VDATE,RIEN)
QUIT
+25 SET ALERT=$PIECE(^BQI(90507.8,TYP,2),U,1)
+26 SET DIAG=$PIECE(^BQI(90507.8,TYP,0),U,1)
SET GRP=$PIECE(^(0),U,3)
SET DXN=$$GET1^DIQ(9000010.07,RIEN_",",.01,"E")
+27 SET LOC=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,6)
+28 DO FORM
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
FORM ; Format the data
+1 ; Unique Identifier
+2 SET RECORD=$$UID(DFN)
+3 ; HRN
+4 SET $PIECE(RECORD,DELIM,2)=$SELECT($$HRN^AUPNPAT(DFN,LOC)]"":$$HRN^AUPNPAT(DFN,LOC),1:$$HRN^AUPNPAT(DFN,DUZ(2)))
+5 ; Gender
+6 SET $PIECE(RECORD,DELIM,3)=$PIECE(^DPT(DFN,0),U,2)
+7 ; DOB
+8 SET $PIECE(RECORD,DELIM,4)=$SELECT(FRM="D":$$JDATE($PIECE($GET(^DPT(DFN,0)),U,3)),1:$$FMTHL7^XLFDT($PIECE($GET(^DPT(DFN,0)),U,3)))
+9 ; Age
+10 SET $PIECE(RECORD,DELIM,5)=$PIECE($$AGE^BQIAGE(DFN,"",1)," ",1)
+11 ; Age Units
+12 SET $PIECE(RECORD,DELIM,6)=$PIECE($$AGE^BQIAGE(DFN,"",1)," ",2)
+13 ; Patient Street Address
+14 SET $PIECE(RECORD,DELIM,7)=$$GET1^DIQ(2,DFN_",",.111,"E")
+15 ; Patient Address City
+16 SET $PIECE(RECORD,DELIM,8)=$$GET1^DIQ(2,DFN_",",.114,"E")
+17 ; Patient Address State
+18 NEW ST
+19 SET ST=$$GET1^DIQ(2,DFN_",",.115,"I")
+20 SET $PIECE(RECORD,DELIM,9)=$$PTR^BQIUL2(2,.115,ST,1)
+21 ; Patient Address Zip
+22 SET $PIECE(RECORD,DELIM,10)=$SELECT($$GET1^DIQ(2,DFN_",",.1112,"E")'="":$$GET1^DIQ(2,DFN_",",.1112,"E"),1:$$GET1^DIQ(2,DFN_",",.116,"E"))
+23 ; Patient County
+24 SET $PIECE(RECORD,DELIM,11)=$$COUN^BQIULPT(DFN)
+25 ; Current community of residence
+26 SET $PIECE(RECORD,DELIM,12)=$$COMMRES^AUPNPAT(DFN,"C")
+27 ; Race
+28 NEW RACE,RCN
+29 SET RACE=$$RCE^BQIPTDMG(DFN,.01)
SET RCN=$PIECE(RACE,$CHAR(28),1)
+30 IF RCN'=""
SET $PIECE(RECORD,DELIM,13)=$PIECE(^DIC(10,RCN,0),U,3)
+31 ; Ethnicity
+32 NEW ETHN,ETN
+33 SET ETHN=$$ETHN^BQIPTDMG(DFN,.01)
SET ETN=$PIECE(ETHN,$CHAR(28),1)
+34 IF ETN'=""
SET $PIECE(RECORD,DELIM,14)=$PIECE(^DIC(10.2,ETN,0),U,2)
+35 ; ASUFAC of encounter location
+36 SET $PIECE(RECORD,DELIM,15)=$SELECT(LOC'="":$PIECE($GET(^AUTTLOC(LOC,0)),U,10),1:"")
+37 ; Visit Date
+38 SET $PIECE(RECORD,DELIM,16)=$SELECT(FRM="D":$$JDATE(VDATE),1:$$FMTHL7^XLFDT(VDATE))
+39 ; Visit ID
+40 SET $PIECE(RECORD,DELIM,17)=$SELECT($PIECE($GET(^AUPNVSIT(VISIT,11)),U,14)]"":$PIECE($GET(^AUPNVSIT(VISIT,11)),U,14),1:$$UIDV^AUPNVSIT(VISIT))
+41 ; Dxn code
+42 SET $PIECE(RECORD,DELIM,18)=DXN
+43 ; CDC diagnosis narrative
+44 SET $PIECE(RECORD,DELIM,19)=DIAG
+45 ; Type of alert
+46 SET $PIECE(RECORD,DELIM,20)=ALERT
+47 ; Group
+48 SET $PIECE(RECORD,DELIM,21)=GRP
+49 ; Visit last modified
+50 ;S DTLMD=$S(VFILE'=9000010:$P($G(^AMHREC(VISIT,11)),U,14),1:$P($G(^AUPNVSIT(VISIT,0)),U,13))
+51 SET DTLMD=$SELECT(VFILE'[9000010:$PIECE($GET(^AMHREC(VISIT,11)),U,14),1:$PIECE($GET(^AUPNVSIT(VISIT,0)),U,13))
+52 SET $PIECE(RECORD,DELIM,22)=$SELECT(FRM="D":$$JDATE(DTLMD),1:$$FMTHL7^XLFDT(DTLMD))
+53 ; Set up Lab test result for OBX
+54 IF VFILE=9000010.09
Begin DoDot:1
+55 SET SITE=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,3)
SET UNITS=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,1)
+56 SET RLOW=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,4)
SET RHIGH=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,5)
+57 SET RESULT=$PIECE(^AUPNVLAB(RIEN,0),U,4)
+58 SET ABN=$PIECE(^AUPNVLAB(RIEN,0),U,5)
+59 IF SITE=""
Begin DoDot:2
+60 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+61 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:2
QUIT
+62 IF SITE'=""
Begin DoDot:2
+63 SET LCP=$PIECE($GET(^LAB(60,LAB,1,SITE,95.3)),U,1)
+64 IF LCP=""
Begin DoDot:3
+65 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+66 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:3
QUIT
+67 SET LOINC=LCP_"-"_$PIECE(^LAB(95.3,LCP,0),U,15)
+68 SET $PIECE(RECORD,DELIM,25)=LOINC_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^LN="_RESULT_"^^"_$PIECE($GET(^LAB(95.3,LCP,80)),U,1)
+69 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:2
+70 ; for NTE
+71 SET $PIECE(RECORD,DELIM,30)=VFILE_":"_RIEN
End DoDot:1
+72 IF VFILE=9000010.25
Begin DoDot:1
+73 SET SITE=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,3)
SET UNITS=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,1)
+74 SET RLOW=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,4)
SET RHIGH=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,5)
+75 SET RESULT=$PIECE(^AUPNVMIC(RIEN,0),U,7)
SET ABN=""
+76 IF SITE=""
Begin DoDot:2
+77 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+78 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:2
QUIT
+79 IF SITE'=""
Begin DoDot:2
+80 SET LCP=$PIECE($GET(^LAB(60,LAB,1,SITE,95.3)),U,1)
+81 IF LCP=""
Begin DoDot:3
+82 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+83 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:3
QUIT
+84 SET LOINC=LCP_"-"_$PIECE(^LAB(95.3,LCP,0),U,15)
+85 SET $PIECE(RECORD,DELIM,25)=LOINC_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^LN="_RESULT_"^^"_$PIECE($GET(^LAB(95.3,LCP,80)),U,1)
+86 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:2
+87 ; for NTE
+88 SET $PIECE(RECORD,DELIM,30)=VFILE_":"_RIEN
End DoDot:1
+89 ; Highest Temperature for OBX
+90 ;I VDATE'="",VFILE=9000010 D
+91 IF VDATE'=""
Begin DoDot:1
+92 NEW TMN,RVDT,IEN,ZZ,RESULT
+93 SET TMN=$ORDER(^AUTTMSR("B","TMP",""))
IF TMN=""
QUIT
+94 SET RVDT=9999999-VDATE
+95 SET IEN=""
+96 FOR
SET IEN=$ORDER(^AUPNVMSR("AA",DFN,TMN,RVDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+97 SET RESULT=$PIECE($GET(^AUPNVMSR(IEN,0)),"^",4)
IF RESULT=""
QUIT
+98 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+99 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+100 SET ZZ(RESULT)=""
End DoDot:2
+101 SET $PIECE(RECORD,DELIM,23)=$ORDER(ZZ(""),-1)
End DoDot:1
+102 ; Vitals for OBX
+103 IF VFILE[9000010
Begin DoDot:1
+104 NEW VITALS,BMI,IEN,TYP,RESULT,MEAS,XX,UID
+105 SET VITALS=""
SET UID=$JOB
+106 SET BMI=$PIECE($$PBMI^APCLV(DFN,DT),"^",1)
+107 IF BMI'=""
SET VITALS=VITALS_"BMI="_BMI_";"
+108 SET IEN=""
+109 FOR
SET IEN=$ORDER(^AUPNVMSR("AD",VISIT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+110 SET TYP=$PIECE($GET(^AUPNVMSR(IEN,0)),"^",1)
IF TYP=""
QUIT
+111 SET MEAS=$PIECE(^AUTTMSR(TYP,0),"^",1)
SET RESULT=$PIECE(^AUPNVMSR(IEN,0),"^",4)
+112 IF $PIECE($GET(^AUPNVMSR(IEN,2)),U,1)=1
QUIT
+113 SET XX="BP,RS,PU,WT,HT"
+114 IF '$FIND(XX,MEAS)
QUIT
+115 SET VITALS=VITALS_MEAS_"="_RESULT_";"
End DoDot:2
+116 SET $PIECE(RECORD,DELIM,24)=$$TKO^BQIUL1(VITALS,";")
End DoDot:1
+117 ;
+118 SET IN=IN+1
SET ^BQIDATA($JOB,IN)=RECORD
+119 QUIT
+120 ;
UID(BQIDFN) ;EP - Given DFN return unique patient record id.
+1 IF $GET(BQIDFN)=""
QUIT ""
+2 IF $GET(^AUPNPAT(BQIDFN,0))=""
QUIT ""
+3 IF $GET(^DPT(BQIDFN,0))=""
QUIT ""
+4 QUIT $$GET1^DIQ(9999999.06,$PIECE(^AUTTSITE(1,0),U),.32)_$EXTRACT("0000000000",1,10-$LENGTH(BQIDFN))_BQIDFN
+5 ;
JDATE(DATE) ;EP - Format the date
+1 IF $GET(DATE)=""
QUIT ""
+2 NEW A
+3 SET A=$$FMTE^XLFDT(DATE)
+4 QUIT $EXTRACT(DATE,6,7)_$$UP^XLFSTR($PIECE(A," ",1))_(1700+$EXTRACT(DATE,1,3))
+5 ;
DATE(D) ;
+1 QUIT (1700+$EXTRACT(D,1,3))_$EXTRACT(D,4,5)_$EXTRACT(D,6,7)
+2 ;
+3 ;send file
WRITE ; use XBGSAVE to save the temp global (BQIDATA) to a file that is exported
+1 ;
+2 NEW XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN
+3 SET XBMED="F"
SET XBQ="N"
SET XBFLT=1
SET XBF=$JOB
SET XBE=$JOB
+4 SET XBGL=$SELECT(FRM="D":"BQIDATA",1:"BQIHL7")
+5 SET XBNAR="CANE SURVEILLANCE EXPORT"
+6 ;asufac for file name
SET ASUFAC=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0)),U,10)
+7 SET XBFN="CANE3_"_ASUFAC_"_"_$$DATE(DT)_".txt"
+8 SET XBS1="CANE SURVEILLANCE SEND"
+9 SET XBUF=$PIECE($GET(^AUTTSITE(1,1)),"^",2)
+10 IF XBUF=""
SET XBUF=$PIECE($GET(^XTV(8989.3,1,"DEV")),"^",1)
+11 ;
+12 DO ^XBGSAVE
+13 ;
+14 KILL ^BQIDATA($JOB),^BQIHL7($JOB)
+15 KILL HLSTATE,XBFLG
+16 QUIT
