- 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