BQICAEXP.m

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"))