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

BQICAVAL.m

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