BQICAEXP ;VNGT/HS/ALA-Community Alerts Export ; 01 Sep 2010 8:35 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
;
EN ; Entry Point
NEW DIC,DLAYGO,X,DA,IENS,DATA,CMN,ALTYP,ALERT,CTN,CAT,DX,DFN,GRN,GRP,DIAG,DXN,LOC
NEW ASUFAC,ASUN,ASUNM,CT,DATE,DELIM,EXIEN,HDR,IEN,IN,N,VISIT,XBFLG,XBPAFN,XBS1,ZISHFL
NEW RECORD,VDATE,XBE,XBF,ZTQUEUED,FRM,VFILE,DTLMD,SUFLG,BQIUPD,ERROR,ZISHC,ZISHDA1
NEW LB,LAB,LCP,LOINC,RESULT,RIEN,SITE,FLNM
S FLNM=$S('$$PROD^XUPROD():"CANEZ",1:"CANES")
;
S ZTQUEUED=1
; Send suicide data flag
S SUFLG=+$P(^BQI(90508,1,0),U,3)
I +$P(^BQI(90508,1,0),U,5)=1 Q
; Create entry in file to log output
S DIC(0)="L",DLAYGO=90507.7,DIC="^BQI(90507.7,",X=DT
K DO,DD D FILE^DICN
S EXIEN=+Y
; Go through already calculated Community alerts
S CMN=0
F S CMN=$O(^BQI(90507.6,CMN)) Q:'CMN D
. S ALTYP=0
. F S ALTYP=$O(^BQI(90507.6,CMN,1,ALTYP)) Q:'ALTYP D
.. S ALERT=$P(^BQI(90507.6,CMN,1,ALTYP,0),U,1)
.. ; if suicide alerts and export flag is not turned on, quit
.. I ALERT="Suicidal Behavior",'SUFLG Q
.. S CTN=0
.. F S CTN=$O(^BQI(90507.6,CMN,1,ALTYP,1,CTN)) Q:'CTN D
... S CAT=$P(^BQI(90507.6,CMN,1,ALTYP,1,CTN,0),U,1)
... S DX=0
... F S DX=$O(^BQI(90507.6,CMN,1,ALTYP,1,CTN,1,DX)) Q:'DX D
.... S DATA=^BQI(90507.6,CMN,1,ALTYP,1,CTN,1,DX,0)
.... S DFN=$P(DATA,U,4),RIEN=$P(DATA,U,3),DATE=$P(DATA,U,2),DXN=$P(DATA,U,1),VISIT=$P(DATA,U,6)
.... S VFILE=$P(DATA,U,5)
.... I $D(^BQI(90507.7,"AC",DFN,CAT,RIEN,DATE)) Q
.... I $G(^DPT(DFN,0))="" Q
.... I VFILE=9000010,$G(^AUPNVSIT(VISIT,0))="" Q
.... S GRN=$O(^BQI(90507.8,"B",$E(CAT,1,30),""))
.... S GRP="O" I GRN'="" S GRP=$P(^BQI(90507.8,GRN,0),U,3)
.... ; If flag to not export is set for this alert definition, quit
.... I GRN'="",$P($G(^BQI(90507.8,GRN,2)),U,3)=1 Q
.... S DA(1)=EXIEN,DIC="^BQI(90507.7,"_DA(1)_",10,",DLAYGO=90507.701,X=DFN
.... K DO,DD D FILE^DICN
.... S DA=+Y,IENS=$$IENS^DILF(.DA)
.... S BQIUPD(90507.701,IENS,.02)=VISIT,BQIUPD(90507.701,IENS,.03)=ALERT
.... S BQIUPD(90507.701,IENS,.05)=GRP,BQIUPD(90507.701,IENS,.06)=DXN
.... S BQIUPD(90507.701,IENS,.07)=CAT,BQIUPD(90507.701,IENS,.08)=DATE
.... S BQIUPD(90507.701,IENS,.09)=VFILE,BQIUPD(90507.701,IENS,.1)=RIEN
.... D FILE^DIE("","BQIUPD","ERROR")
... S LB=0
... F S LB=$O(^BQI(90507.6,CMN,1,ALTYP,1,CTN,2,LB)) Q:'LB D
.... S DATA=^BQI(90507.6,CMN,1,ALTYP,1,CTN,2,LB,0)
.... S DFN=$P(DATA,U,4),VISIT=$P(DATA,U,3),DATE=$P(DATA,U,2),LAB=$P(DATA,U,1)
.... S VFILE=$P(DATA,U,5),RIEN=$P(DATA,U,6)
.... I $D(^BQI(90507.7,"AC",DFN,CAT,RIEN,DATE)) Q
.... S GRN=$O(^BQI(90507.8,"B",$E(CAT,1,30),""))
.... S GRP="O" I GRN'="" S GRP=$P(^BQI(90507.8,GRN,0),U,3)
.... ; If flag to not export is set for this alert definition, quit
.... I GRN'="",$P($G(^BQI(90507.8,GRN,2)),U,3)=1 Q
.... S DA(1)=EXIEN,DIC="^BQI(90507.7,"_DA(1)_",10,",DLAYGO=90507.701,X=DFN
.... K DO,DD D FILE^DICN
.... S DA=+Y,IENS=$$IENS^DILF(.DA)
.... S BQIUPD(90507.701,IENS,.02)=VISIT,BQIUPD(90507.701,IENS,.03)=ALERT
.... S BQIUPD(90507.701,IENS,.05)=GRP,BQIUPD(90507.701,IENS,.11)=LAB
.... S BQIUPD(90507.701,IENS,.07)=CAT,BQIUPD(90507.701,IENS,.08)=DATE
.... S BQIUPD(90507.701,IENS,.09)=VFILE,BQIUPD(90507.701,IENS,.1)=RIEN
.... D FILE^DIE("","BQIUPD","ERROR")
;
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,DELIM=","
F S N=$O(^BQI(90507.7,EXIEN,10,N)) Q:'N S CT=CT+1
S BQIUPD(90507.7,EXIEN_",",.04)=CT
D FILE^DIE("","BQIUPD","ERROR")
;
K ^BQIDATA($J)
; 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)
I FRM="D" S HDR=$$JDATE(DT)_DELIM_CT_DELIM_ASUNM,^BQIDATA($J,IN)=HDR
S IEN=0
F S IEN=$O(^BQI(90507.7,EXIEN,10,IEN)) Q:'IEN D
. S DATA=^BQI(90507.7,EXIEN,10,IEN,0)
. S DFN=$P(DATA,U,1),VISIT=$P(DATA,U,2),ALERT=$P(DATA,U,3),DIAG=$P(DATA,U,7),GRP=$P(DATA,U,5)
. S DXN=$P(DATA,U,6),VDATE=$P(DATA,U,8),VFILE=$P(DATA,U,9)
. S LOC=$P($G(^AUPNVSIT(VISIT,0)),U,6)
. S DIAG=$$STRIP^XLFSTR(DIAG,",")
. ; 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 ICD9 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 LAB=$P(DATA,U,11),RIEN=$P(DATA,U,10)
.. 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($G(^AUPNVLAB(RIEN,0)),U,4)
.. S ABN=$P($G(^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 LAB=$P(DATA,U,11),RIEN=$P(DATA,U,10)
.. 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
... I $P($G(^AUPNVMSR(IEN,2)),"^",1)=1 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
. 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)
... 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,LIN=IN
; Get all labs
S TMFRAME="T-30"
D LAB^BQICAVAL
D PROC^BQICAVAL
;
; If HL7
I FRM'="D" D ^BQICAHLO
D WRITE
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=FLNM_"_"_ASUFAC_"_"_$$DATE(DT)_".txt"
;S XBFN=$S(FRM="D":"CANES_"_ASUFAC_"_"_$$DATE(DT)_".txt",1:"CANES_"_ASUFAC_"HL7"_"_"_$$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
;
I XBFLG'=0 D
. I XBFLG(1)="" S BQIUPD(90507.7,EXIEN_",",.03)=1
. I XBFLG(1)'="" S BQIUPD(90507.7,EXIEN_",",.03)=0
. D FILE^DIE("I","BQIUPD","ERROR")
. Q
K ^BQIDATA($J),^BQIHL7($J)
Q
BQICAEXP ;VNGT/HS/ALA-Community Alerts Export ; 01 Sep 2010 8:35 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
+3 ;
EN ; Entry Point
+1 NEW DIC,DLAYGO,X,DA,IENS,DATA,CMN,ALTYP,ALERT,CTN,CAT,DX,DFN,GRN,GRP,DIAG,DXN,LOC
+2 NEW ASUFAC,ASUN,ASUNM,CT,DATE,DELIM,EXIEN,HDR,IEN,IN,N,VISIT,XBFLG,XBPAFN,XBS1,ZISHFL
+3 NEW RECORD,VDATE,XBE,XBF,ZTQUEUED,FRM,VFILE,DTLMD,SUFLG,BQIUPD,ERROR,ZISHC,ZISHDA1
+4 NEW LB,LAB,LCP,LOINC,RESULT,RIEN,SITE,FLNM
+5 SET FLNM=$SELECT('$$PROD^XUPROD():"CANEZ",1:"CANES")
+6 ;
+7 SET ZTQUEUED=1
+8 ; Send suicide data flag
+9 SET SUFLG=+$PIECE(^BQI(90508,1,0),U,3)
+10 IF +$PIECE(^BQI(90508,1,0),U,5)=1
QUIT
+11 ; Create entry in file to log output
+12 SET DIC(0)="L"
SET DLAYGO=90507.7
SET DIC="^BQI(90507.7,"
SET X=DT
+13 KILL DO,DD
DO FILE^DICN
+14 SET EXIEN=+Y
+15 ; Go through already calculated Community alerts
+16 SET CMN=0
+17 FOR
SET CMN=$ORDER(^BQI(90507.6,CMN))
IF 'CMN
QUIT
Begin DoDot:1
+18 SET ALTYP=0
+19 FOR
SET ALTYP=$ORDER(^BQI(90507.6,CMN,1,ALTYP))
IF 'ALTYP
QUIT
Begin DoDot:2
+20 SET ALERT=$PIECE(^BQI(90507.6,CMN,1,ALTYP,0),U,1)
+21 ; if suicide alerts and export flag is not turned on, quit
+22 IF ALERT="Suicidal Behavior"
IF 'SUFLG
QUIT
+23 SET CTN=0
+24 FOR
SET CTN=$ORDER(^BQI(90507.6,CMN,1,ALTYP,1,CTN))
IF 'CTN
QUIT
Begin DoDot:3
+25 SET CAT=$PIECE(^BQI(90507.6,CMN,1,ALTYP,1,CTN,0),U,1)
+26 SET DX=0
+27 FOR
SET DX=$ORDER(^BQI(90507.6,CMN,1,ALTYP,1,CTN,1,DX))
IF 'DX
QUIT
Begin DoDot:4
+28 SET DATA=^BQI(90507.6,CMN,1,ALTYP,1,CTN,1,DX,0)
+29 SET DFN=$PIECE(DATA,U,4)
SET RIEN=$PIECE(DATA,U,3)
SET DATE=$PIECE(DATA,U,2)
SET DXN=$PIECE(DATA,U,1)
SET VISIT=$PIECE(DATA,U,6)
+30 SET VFILE=$PIECE(DATA,U,5)
+31 IF $DATA(^BQI(90507.7,"AC",DFN,CAT,RIEN,DATE))
QUIT
+32 IF $GET(^DPT(DFN,0))=""
QUIT
+33 IF VFILE=9000010
IF $GET(^AUPNVSIT(VISIT,0))=""
QUIT
+34 SET GRN=$ORDER(^BQI(90507.8,"B",$EXTRACT(CAT,1,30),""))
+35 SET GRP="O"
IF GRN'=""
SET GRP=$PIECE(^BQI(90507.8,GRN,0),U,3)
+36 ; If flag to not export is set for this alert definition, quit
+37 IF GRN'=""
IF $PIECE($GET(^BQI(90507.8,GRN,2)),U,3)=1
QUIT
+38 SET DA(1)=EXIEN
SET DIC="^BQI(90507.7,"_DA(1)_",10,"
SET DLAYGO=90507.701
SET X=DFN
+39 KILL DO,DD
DO FILE^DICN
+40 SET DA=+Y
SET IENS=$$IENS^DILF(.DA)
+41 SET BQIUPD(90507.701,IENS,.02)=VISIT
SET BQIUPD(90507.701,IENS,.03)=ALERT
+42 SET BQIUPD(90507.701,IENS,.05)=GRP
SET BQIUPD(90507.701,IENS,.06)=DXN
+43 SET BQIUPD(90507.701,IENS,.07)=CAT
SET BQIUPD(90507.701,IENS,.08)=DATE
+44 SET BQIUPD(90507.701,IENS,.09)=VFILE
SET BQIUPD(90507.701,IENS,.1)=RIEN
+45 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:4
+46 SET LB=0
+47 FOR
SET LB=$ORDER(^BQI(90507.6,CMN,1,ALTYP,1,CTN,2,LB))
IF 'LB
QUIT
Begin DoDot:4
+48 SET DATA=^BQI(90507.6,CMN,1,ALTYP,1,CTN,2,LB,0)
+49 SET DFN=$PIECE(DATA,U,4)
SET VISIT=$PIECE(DATA,U,3)
SET DATE=$PIECE(DATA,U,2)
SET LAB=$PIECE(DATA,U,1)
+50 SET VFILE=$PIECE(DATA,U,5)
SET RIEN=$PIECE(DATA,U,6)
+51 IF $DATA(^BQI(90507.7,"AC",DFN,CAT,RIEN,DATE))
QUIT
+52 SET GRN=$ORDER(^BQI(90507.8,"B",$EXTRACT(CAT,1,30),""))
+53 SET GRP="O"
IF GRN'=""
SET GRP=$PIECE(^BQI(90507.8,GRN,0),U,3)
+54 ; If flag to not export is set for this alert definition, quit
+55 IF GRN'=""
IF $PIECE($GET(^BQI(90507.8,GRN,2)),U,3)=1
QUIT
+56 SET DA(1)=EXIEN
SET DIC="^BQI(90507.7,"_DA(1)_",10,"
SET DLAYGO=90507.701
SET X=DFN
+57 KILL DO,DD
DO FILE^DICN
+58 SET DA=+Y
SET IENS=$$IENS^DILF(.DA)
+59 SET BQIUPD(90507.701,IENS,.02)=VISIT
SET BQIUPD(90507.701,IENS,.03)=ALERT
+60 SET BQIUPD(90507.701,IENS,.05)=GRP
SET BQIUPD(90507.701,IENS,.11)=LAB
+61 SET BQIUPD(90507.701,IENS,.07)=CAT
SET BQIUPD(90507.701,IENS,.08)=DATE
+62 SET BQIUPD(90507.701,IENS,.09)=VFILE
SET BQIUPD(90507.701,IENS,.1)=RIEN
+63 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+64 ;
+65 SET ASUN=$PIECE(^AUTTSITE(1,0),U)
SET ASUFAC=$PIECE($GET(^AUTTLOC(ASUN,0)),U,10)
SET ASUNM=$PIECE(^DIC(4,ASUN,0),U)
+66 SET CT=0
SET N=0
SET DELIM=","
+67 FOR
SET N=$ORDER(^BQI(90507.7,EXIEN,10,N))
IF 'N
QUIT
SET CT=CT+1
+68 SET BQIUPD(90507.7,EXIEN_",",.04)=CT
+69 DO FILE^DIE("","BQIUPD","ERROR")
+70 ;
+71 KILL ^BQIDATA($JOB)
+72 ; Get export format type 'D' is delimited and 'H' or blank is HL7
+73 SET FRM=$PIECE($GET(^BQI(90508,1,0)),U,2)
+74 SET IN=$SELECT(FRM="D":1,1:0)
+75 IF FRM="D"
SET HDR=$$JDATE(DT)_DELIM_CT_DELIM_ASUNM
SET ^BQIDATA($JOB,IN)=HDR
+76 SET IEN=0
+77 FOR
SET IEN=$ORDER(^BQI(90507.7,EXIEN,10,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+78 SET DATA=^BQI(90507.7,EXIEN,10,IEN,0)
+79 SET DFN=$PIECE(DATA,U,1)
SET VISIT=$PIECE(DATA,U,2)
SET ALERT=$PIECE(DATA,U,3)
SET DIAG=$PIECE(DATA,U,7)
SET GRP=$PIECE(DATA,U,5)
+80 SET DXN=$PIECE(DATA,U,6)
SET VDATE=$PIECE(DATA,U,8)
SET VFILE=$PIECE(DATA,U,9)
+81 SET LOC=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,6)
+82 SET DIAG=$$STRIP^XLFSTR(DIAG,",")
+83 ; Unique Identifier
+84 SET RECORD=$$UID(DFN)
+85 ; HRN
+86 SET $PIECE(RECORD,DELIM,2)=$SELECT($$HRN^AUPNPAT(DFN,LOC)]"":$$HRN^AUPNPAT(DFN,LOC),1:$$HRN^AUPNPAT(DFN,DUZ(2)))
+87 ; Gender
+88 SET $PIECE(RECORD,DELIM,3)=$PIECE(^DPT(DFN,0),U,2)
+89 ; DOB
+90 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)))
+91 ; Age
+92 SET $PIECE(RECORD,DELIM,5)=$PIECE($$AGE^BQIAGE(DFN,"",1)," ",1)
+93 ; Age Units
+94 SET $PIECE(RECORD,DELIM,6)=$PIECE($$AGE^BQIAGE(DFN,"",1)," ",2)
+95 ; Patient Street Address
+96 SET $PIECE(RECORD,DELIM,7)=$$GET1^DIQ(2,DFN_",",.111,"E")
+97 ; Patient Address City
+98 SET $PIECE(RECORD,DELIM,8)=$$GET1^DIQ(2,DFN_",",.114,"E")
+99 ; Patient Address State
+100 NEW ST
+101 SET ST=$$GET1^DIQ(2,DFN_",",.115,"I")
+102 SET $PIECE(RECORD,DELIM,9)=$$PTR^BQIUL2(2,.115,ST,1)
+103 ; Patient Address Zip
+104 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"))
+105 ; Patient County
+106 SET $PIECE(RECORD,DELIM,11)=$$COUN^BQIULPT(DFN)
+107 ; Current community of residence
+108 SET $PIECE(RECORD,DELIM,12)=$$COMMRES^AUPNPAT(DFN,"C")
+109 ; Race
+110 NEW RACE,RCN
+111 SET RACE=$$RCE^BQIPTDMG(DFN,.01)
SET RCN=$PIECE(RACE,$CHAR(28),1)
+112 IF RCN'=""
SET $PIECE(RECORD,DELIM,13)=$PIECE(^DIC(10,RCN,0),U,3)
+113 ; Ethnicity
+114 NEW ETHN,ETN
+115 SET ETHN=$$ETHN^BQIPTDMG(DFN,.01)
SET ETN=$PIECE(ETHN,$CHAR(28),1)
+116 IF ETN'=""
SET $PIECE(RECORD,DELIM,14)=$PIECE(^DIC(10.2,ETN,0),U,2)
+117 ; ASUFAC of encounter location
+118 SET $PIECE(RECORD,DELIM,15)=$SELECT(LOC'="":$PIECE($GET(^AUTTLOC(LOC,0)),U,10),1:"")
+119 ; Visit Date
+120 SET $PIECE(RECORD,DELIM,16)=$SELECT(FRM="D":$$JDATE(VDATE),1:$$FMTHL7^XLFDT(VDATE))
+121 ; Visit ID
+122 SET $PIECE(RECORD,DELIM,17)=$SELECT($PIECE($GET(^AUPNVSIT(VISIT,11)),U,14)]"":$PIECE($GET(^AUPNVSIT(VISIT,11)),U,14),1:$$UIDV^AUPNVSIT(VISIT))
+123 ; Dxn ICD9 code
+124 SET $PIECE(RECORD,DELIM,18)=DXN
+125 ; CDC diagnosis narrative
+126 SET $PIECE(RECORD,DELIM,19)=DIAG
+127 ; Type of alert
+128 SET $PIECE(RECORD,DELIM,20)=ALERT
+129 ; Group
+130 SET $PIECE(RECORD,DELIM,21)=GRP
+131 ; Visit last modified
+132 ;S DTLMD=$S(VFILE'=9000010:$P($G(^AMHREC(VISIT,11)),U,14),1:$P($G(^AUPNVSIT(VISIT,0)),U,13))
+133 SET DTLMD=$SELECT(VFILE'[9000010:$PIECE($GET(^AMHREC(VISIT,11)),U,14),1:$PIECE($GET(^AUPNVSIT(VISIT,0)),U,13))
+134 SET $PIECE(RECORD,DELIM,22)=$SELECT(FRM="D":$$JDATE(DTLMD),1:$$FMTHL7^XLFDT(DTLMD))
+135 ; Set up Lab test result for OBX
+136 IF VFILE=9000010.09
Begin DoDot:2
+137 SET LAB=$PIECE(DATA,U,11)
SET RIEN=$PIECE(DATA,U,10)
+138 SET SITE=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,3)
SET UNITS=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,1)
+139 SET RLOW=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,4)
SET RHIGH=$PIECE($GET(^AUPNVLAB(RIEN,11)),U,5)
+140 SET RESULT=$PIECE($GET(^AUPNVLAB(RIEN,0)),U,4)
+141 SET ABN=$PIECE($GET(^AUPNVLAB(RIEN,0)),U,5)
+142 IF SITE=""
Begin DoDot:3
+143 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+144 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:3
QUIT
+145 IF SITE'=""
Begin DoDot:3
+146 SET LCP=$PIECE($GET(^LAB(60,LAB,1,SITE,95.3)),U,1)
+147 IF LCP=""
Begin DoDot:4
+148 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+149 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:4
QUIT
+150 SET LOINC=LCP_"-"_$PIECE(^LAB(95.3,LCP,0),U,15)
+151 SET $PIECE(RECORD,DELIM,25)=LOINC_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^LN="_RESULT_"^^"_$PIECE($GET(^LAB(95.3,LCP,80)),U,1)
+152 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
+153 ; for NTE
+154 SET $PIECE(RECORD,DELIM,30)=VFILE_":"_RIEN
End DoDot:3
End DoDot:2
+155 IF VFILE=9000010.25
Begin DoDot:2
+156 SET LAB=$PIECE(DATA,U,11)
SET RIEN=$PIECE(DATA,U,10)
+157 SET SITE=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,3)
SET UNITS=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,1)
+158 SET RLOW=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,4)
SET RHIGH=$PIECE($GET(^AUPNVMIC(RIEN,11)),U,5)
+159 SET RESULT=$PIECE(^AUPNVMIC(RIEN,0),U,7)
SET ABN=""
+160 IF SITE=""
Begin DoDot:3
+161 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+162 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:3
QUIT
+163 IF SITE'=""
Begin DoDot:3
+164 SET LCP=$PIECE($GET(^LAB(60,LAB,1,SITE,95.3)),U,1)
+165 IF LCP=""
Begin DoDot:4
+166 SET $PIECE(RECORD,DELIM,25)=LAB_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^99"_$PIECE(^AUTTLOC(ASUN,0),U,7)_"="_RESULT
+167 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
End DoDot:4
QUIT
+168 SET LOINC=LCP_"-"_$PIECE(^LAB(95.3,LCP,0),U,15)
+169 SET $PIECE(RECORD,DELIM,25)=LOINC_"^"_$PIECE(^LAB(60,LAB,0),U,1)_"^LN="_RESULT_"^^"_$PIECE($GET(^LAB(95.3,LCP,80)),U,1)
+170 SET $PIECE(RECORD,DELIM,31)=UNITS
SET $PIECE(RECORD,DELIM,32)=RLOW_"^"_RHIGH
SET $PIECE(RECORD,DELIM,33)=ABN
+171 ; for NTE
+172 SET $PIECE(RECORD,DELIM,30)=VFILE_":"_RIEN
End DoDot:3
End DoDot:2
+173 ; Highest Temperature for OBX
+174 ;I VDATE'="",VFILE=9000010 D
+175 IF VDATE'=""
Begin DoDot:2
+176 NEW TMN,RVDT,IEN,ZZ,RESULT
+177 SET TMN=$ORDER(^AUTTMSR("B","TMP",""))
IF TMN=""
QUIT
+178 SET RVDT=9999999-VDATE
+179 SET IEN=""
+180 FOR
SET IEN=$ORDER(^AUPNVMSR("AA",DFN,TMN,RVDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+181 SET RESULT=$PIECE($GET(^AUPNVMSR(IEN,0)),"^",4)
IF RESULT=""
QUIT
+182 IF $PIECE($GET(^AUPNVMSR(IEN,2)),"^",1)=1
QUIT
+183 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+184 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+185 SET ZZ(RESULT)=""
End DoDot:3
+186 SET $PIECE(RECORD,DELIM,23)=$ORDER(ZZ(""),-1)
End DoDot:2
+187 ; Vitals for OBX
+188 ;I VFILE=9000010 D
+189 IF VFILE[9000010
Begin DoDot:2
+190 NEW VITALS,BMI,IEN,TYP,RESULT,MEAS,XX,UID
+191 SET VITALS=""
SET UID=$JOB
+192 SET BMI=$PIECE($$PBMI^APCLV(DFN,DT),"^",1)
+193 IF BMI'=""
SET VITALS=VITALS_"BMI="_BMI_";"
+194 SET IEN=""
+195 FOR
SET IEN=$ORDER(^AUPNVMSR("AD",VISIT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+196 SET TYP=$PIECE($GET(^AUPNVMSR(IEN,0)),"^",1)
IF TYP=""
QUIT
+197 SET MEAS=$PIECE(^AUTTMSR(TYP,0),"^",1)
SET RESULT=$PIECE(^AUPNVMSR(IEN,0),"^",4)
+198 SET XX="BP,RS,PU,WT,HT"
+199 IF '$FIND(XX,MEAS)
QUIT
+200 SET VITALS=VITALS_MEAS_"="_RESULT_";"
End DoDot:3
+201 SET $PIECE(RECORD,DELIM,24)=$$TKO^BQIUL1(VITALS,";")
End DoDot:2
+202 ;
+203 SET IN=IN+1
SET ^BQIDATA($JOB,IN)=RECORD
SET LIN=IN
End DoDot:1
+204 ; Get all labs
+205 SET TMFRAME="T-30"
+206 DO LAB^BQICAVAL
+207 DO PROC^BQICAVAL
+208 ;
+209 ; If HL7
+210 IF FRM'="D"
DO ^BQICAHLO
+211 DO WRITE
+212 QUIT
+213 ;
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=FLNM_"_"_ASUFAC_"_"_$$DATE(DT)_".txt"
+8 ;S XBFN=$S(FRM="D":"CANES_"_ASUFAC_"_"_$$DATE(DT)_".txt",1:"CANES_"_ASUFAC_"HL7"_"_"_$$DATE(DT)_".txt")
+9 SET XBS1="CANE SURVEILLANCE SEND"
+10 SET XBUF=$PIECE($GET(^AUTTSITE(1,1)),"^",2)
+11 IF XBUF=""
SET XBUF=$PIECE($GET(^XTV(8989.3,1,"DEV")),"^",1)
+12 ;
+13 DO ^XBGSAVE
+14 ;
+15 IF XBFLG'=0
Begin DoDot:1
+16 IF XBFLG(1)=""
SET BQIUPD(90507.7,EXIEN_",",.03)=1
+17 IF XBFLG(1)'=""
SET BQIUPD(90507.7,EXIEN_",",.03)=0
+18 DO FILE^DIE("I","BQIUPD","ERROR")
+19 QUIT
End DoDot:1
+20 KILL ^BQIDATA($JOB),^BQIHL7($JOB)
+21 QUIT
