APCSSILI.m

APCSSILI ; IHS/CMI/LAB - ILI surveillance export ; 

 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009

 ;

 ;

START ;

 ;This option will create an HL7 output file of all visits for the past 90 days.

 ;

 ;

 D EXIT

 ;

INFORM ;inform user

 W:$D(IOF) @IOF

 W !!,$$CJ^XLFSTR("SURVEILLANCE ILI HL7 EXPORT",80)

 W !!,"This option is used to create a file of HL7 messages.  The messages will"

 W !,"be sent to the IHS EPI program.  Visits in the past 90 days that meet"

 W !,"the criteria defined by the EPI program for the ILI export will be sent."

 W !,"The data elements contained in the HL7 messages have been defined by the"

 W !,"EPI program.  Documentation of the message definitions can be"

 W !,"obtained from the EPI program.",!!

 W !,"This HL7 export file will be automatically ftp'ed to the EPI program.",!!

DATES ;set date range to T-91 to T-1

 ;

 S APCSBD=$$FMADD^XLFDT(DT,-91),APCSED=$$FMADD^XLFDT(DT,-1)

 W !!,"The date range for this export is: ",$$FMTE^XLFDT(APCSBD)," to ",$$FMTE^XLFDT(APCSED),".",!

CONTINUE ;

 S DIR(0)="Y",DIR("A")="Do you wish to continue and generate this export file",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I 'Y D EXIT Q

ZIS ;called xbdbque to see if they want to queue or not

 S XBRC="PROC^APCSSILI",XBRP="",XBNS="APCS",XBRX="EXIT^APCSSILI"

 D ^XBDBQUE

 D EXIT

 Q

PROC ;EP - called from xbdbque

 K APCSLOCT

 K ^APCSDATA($J)  ;export global

 S APCSCTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))  ;clinic taxonomy

 S APCSDTAX=$O(^ATXAX("B","SURVEILLANCE ILI",0))  ;dx taxonomy

 I 'APCSCTAX D EXIT Q

 I 'APCSDTAX D EXIT Q

 ;

 S APCSSD=$$FMADD^XLFDT(DT,-91)_".9999"  ;start with 3/21/09 visits CHANGED TO 90 DAYS IN PATCH 26, AFTER THE FIRST PATCH 26 EXPORT

 S APCSED=$$FMADD^XLFDT(DT,-1)

 S APCSVTOT=0  ;visit counter

 F  S APCSSD=$O(^AUPNVSIT("B",APCSSD)) Q:APCSSD'=+APCSSD!($P(APCSSD,".")>APCSED)  D

 .S APCSV=0 F  S APCSV=$O(^AUPNVSIT("B",APCSSD,APCSV)) Q:APCSV'=+APCSV  D

 ..Q:'$D(^AUPNVSIT(APCSV,0))  ;no zero node

 ..Q:$P(^AUPNVSIT(APCSV,0),U,11)  ;deleted visit

 ..S DFN=$P(^AUPNVSIT(APCSV,0),U,5)

 ..Q:DFN=""

 ..Q:'$D(^DPT(DFN,0))

 ..Q:$P(^DPT(DFN,0),U)["DEMO,PATIENT"

 ..Q:$$DEMO^APCLUTL(DFN)

 ..S G=0,X=0 F  S X=$O(^BGPSITE(X)) Q:X'=+X  I $P($G(^BGPSITE(X,0)),U,12) I $D(^DIBT($P(^BGPSITE(X,0),U,12),1,DFN)) S G=1

 ..Q:G

 ..S APCSKV=0,APCSH1N1=0,(APCSILI,APCSHVAC,APCSIVAC,APCSADVE,APCSSRD,APCSAVM,APCSAV9)=""

 ..S APCSLOC=$P(^AUPNVSIT(APCSV,0),U,6)  Q:APCSLOC=""  ;no location ???

 ..S APCSDATE=$P($P(^AUPNVSIT(APCSV,0),U),".")

 ..S APCSASUF=$P($G(^AUTTLOC(APCSLOC,0)),U,10)

 ..I APCSASUF="" Q  ;no ASUFAC????

 ..;keep visit?

 ..S G=0 D ILIDX I G S APCSKV=1,APCSILI=G

 ..S G=0 D H1N1DX I G S APCSKV=1,APCSH1N1=G

 ..;S APCSHVAC=$$HASVAC(APCSV) I APCSHVAC S APCSKV=1

 ..S APCSIVAC=$$HASIVAC^APCLSILI(APCSV) I APCSIVAC S APCSKV=1

 ..S APCSADVE=$$HASADVN6^APCLSIL1(APCSV) I APCSADVE S APCSKV=1

 ..S APCSOVAC="" I APCSADVE S APCSOVAC=$$OTHVAC^APCLSIL1(DFN,APCSDATE)

 ..S APCSSRD=$$HASSRD7(APCSV) I APCSSRD S APCSKV=1

 ..S APCSAVM=$$HASAVM(APCSV) I APCSAVM S APCSKV=1

 ..;S APCSAV9=$$HASAV9(APCSV) I APCSAV9 S APCSKV=1

 ..I 'APCSKV Q  ;not a visit to export

 ..W:'$D(ZTQUEUED) "."

 ..D SETREC^APCSSIL2  ;set record

 ;NOW SET TOTAL IN PIECE 13

 S X=0 F  S X=$O(^APCSDATA($J,X)) Q:X'=+X  D

 .I $P(^APCSDATA($J,X),",",8)="" Q  ;not an ILI visit

 .Q:$P(^APCSDATA($J,X),",",15)="H"  ;not ambulatory

 .S L=$P(^APCSDATA($J,X),",",6),D=$P(^APCSDATA($J,X),",",7)

 .S $P(^APCSDATA($J,X),",",13)=$G(APCSLOCT(L,D))

 .Q

 ;NOW SET TOTAL IN PIECE 20

 S X=0 F  S X=$O(^APCSDATA($J,X)) Q:X'=+X  D

 .Q:$P(^APCSDATA($J,X),",",15)'="H"

 .I $P(^APCSDATA($J,X),",",8)="",$P(^APCSDATA($J,X),U,43)=""  ;not an ILI or H1N1 visit

 .S L=$P(^APCSDATA($J,X),",",6),D=$P(^APCSDATA($J,X),",",7)

 .S $P(^APCSDATA($J,X),",",20)=$G(APCSHTOT(L,D))

 .Q

 ;NOW SET TOTAL IN PIECE 42

 S X=0 F  S X=$O(^APCSDATA($J,X)) Q:X'=+X  D

 .Q:$P(^APCSDATA($J,X),",",15)="H"

 .I $P(^APCSDATA($J,X),",",43)="" Q    ;not an H1N1/ili visit

 .S L=$P(^APCSDATA($J,X),",",6),D=$P(^APCSDATA($J,X),",",7)

 .S $P(^APCSDATA($J,X),",",42)=$G(APCSALLT(L,D))

 .Q

 ;MARK - at this point you can loop through ^APCSDATA and generate HL7 messages

 I '$O(^APCSDATA($J,0)) D  Q

 .I '$D(ZTQUEUED) W !!,"There are no visits to export.",! D PAUSE^APCLVL01

 D ILI^APCSHLO("ILI")  ;parse out the APCSDATA global and create a message from it

 I '$D(ZTQUEUED) D PAUSE^APCLVL01

 ;D WRITE  ;MARK - if you stored all the HL7 messages somewhere this is where you will write them out see WRITE subroutine, I write out global APCSDATA

 Q

ILIDX ;

 Q:"AORSH"'[$P(^AUPNVSIT(APCSV,0),U,7)

 I $P(^AUPNVSIT(APCSV,0),U,7)="H" S APCSHTOT(APCSASUF,$$JDATE(APCSDATE))=$G(APCSHTOT(APCSASUF,$$JDATE(APCSDATE)))+1

 S APCSCLIN=$$CLINIC^APCLV(APCSV,"I")  ;get clinic code

 ;is there a PHN

 S X=0,P=0 F  S X=$O(^AUPNVPRV("AD",APCSV,X)) Q:X'=+X!(P)  D

 .Q:'$D(^AUPNVPRV(X,0))

 .S Y=$P(^AUPNVPRV(X,0),U)

 .S Z=$$VALI^XBDIQ1(200,Y,53.5)

 .Q:'Z

 .I $P($G(^DIC(7,Z,9999999)),U,1)=13 S P=1

 I P G ILIDX1

 I $P(^AUPNVSIT(APCSV,0),U,7)'="H" Q:APCSCLIN=""

 I $P(^AUPNVSIT(APCSV,0),U,7)'="H" Q:'$D(^ATXAX(APCSCTAX,21,"B",APCSCLIN))  ;not in clinic taxonomy

ILIDX1 ;

 I $P(^AUPNVSIT(APCSV,0),U,7)'="H" S APCSLOCT(APCSASUF,$$JDATE(APCSDATE))=$G(APCSLOCT(APCSASUF,$$JDATE(APCSDATE)))+1   ;total number of visits

 S C=0

 K G,Y S G=""

 S X=0 F  S X=$O(^AUPNVPOV("AD",APCSV,X)) Q:X'=+X  S T=$P(^AUPNVPOV(X,0),U) I $$ICD^ATXCHK(T,APCSDTAX,9) S C=C+1,Y(C)=$$VAL^XBDIQ1(9000010.07,X,.01)

 Q:'$D(Y)  ;no diagnosis

 S X=0 F  S X=$O(Y(X)) Q:X'=+X  S G=G_U_Y(X)

 S $P(G,U,1)=1

 Q

H1N1DX ;

 Q:"AORSH"'[$P(^AUPNVSIT(APCSV,0),U,7)  ;just want outpatient with dx

 S APCSCLIN=$$CLINIC^APCLV(APCSV,"I")  ;get clinic code

 ;I $P(^AUPNVSIT(APCSV,0),U,7)'="H" Q:'$D(^ATXAX(APCSCTAX,21,"B",APCSCLIN))  ;not in clinic taxonomy

 I $P(^AUPNVSIT(APCSV,0),U,7)'="H" S APCSALLT(APCSASUF,$$JDATE(APCSDATE))=$G(APCSALLT(APCSASUF,$$JDATE(APCSDATE)))+1   ;total number of visits

 S G=0

 S X=0 F  S X=$O(^AUPNVPOV("AD",APCSV,X)) Q:X'=+X!(G)  S T=$P(^AUPNVPOV(X,0),U) I $$ICD^ATXCHK(T,$O(^ATXAX("B","SURVEILLANCE H1N1 DX",0)),9) S G=1,D=$$VAL^XBDIQ1(9000010.07,X,.01)

 Q:'G  ;no diagnosis

 S G=1_U_D

 Q

HASSRD7(APCLV) ;EP

 NEW X,P,D,Y,Z,APCLCLIN,T,G,C

 I $P(^AUPNVSIT(APCLV,0),U,7)'="H" Q ""  ;just want hOSP

 S C=0

 K G,Y S G=""

 S X=0 F  S X=$O(^AUPNVPOV("AD",APCLV,X)) Q:X'=+X  S T=$P(^AUPNVPOV(X,0),U) I $$ICD^ATXCHK(T,$O(^ATXAX("B","SURVEILLANCE SEV RESP DIS DXS",0)),9) S C=C+1,Y(C)=$$VAL^XBDIQ1(9000010.07,X,.01)

 I '$D(Y) Q ""  ;no diagnosis

 S X=0 F  S X=$O(Y(X)) Q:X'=+X  S G=G_U_Y(X)

 S $P(G,U,1)=1

 Q G

HASAVM(V) ;EP

 NEW C,X,Y,Z,T,L,M,N

 S T=$O(^ATXAX("B","FLU ANTIVIRAL MEDS",0))

 S C="",X=0 F  S X=$O(^AUPNVMED("AD",V,X)) Q:X'=+X!(C)  S Y=$P($G(^AUPNVMED(X,0)),U) D

 .Q:'Y

 .Q:'$D(^PSDRUG(Y,0))

 .S Z=0

 .S N=$P(^PSDRUG(Y,0),U)

 .I $D(^ATXAX(T,21,"B",Y)) S Z=1

 .I N["OSELTAMIVIR" S Z=1

 .I N["ZANAMIVIR" S Z=1

 .I Z=1 S C=1_U_N_U_$P(^AUPNVMED(X,0),U,7)

 .Q

 Q C

 ;send file

WRITE ; use XBGSAVE to save the temp global (APCSDATA) to a delimited

 ; file that is exported to the IE system

 N XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN

 S XBGL="APCSDATA",XBMED="F",XBQ="N",XBFLT=1,XBF=$J,XBE=$J

 S XBNAR="ILI SURVEILLANCE EXPORT HL7"

 S APCSASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)  ;asufac for file name

 S XBFN="FLUHL7_"_APCSASU_"_"_$$DATE(DT)_".txt"

 S XBS1="SURVEILLANCE ILI SEND"

 ;

 D ^XBGSAVE

 ;

 I XBFLG'=0 D

 . I XBFLG(1)="" W:'$D(ZTQUEUED) !!,"VISIT ILI file successfully created",!!

 . I XBFLG(1)]"" W:'$D(ZTQUEUED) !!,"VISIT ILI file NOT successfully created",!!

 . W:'$D(ZTQUEUED) !,"File was NOT successfully transferred to IHS/CDC",!,"you will need to manually ftp it.",!

 . W:'$D(ZTQUEUED) !,XBFLG(1),!!

 K ^APCSDATA($J)

 Q

 ;

DATE(D) ;EP

 Q (1700+$E(D,1,3))_$E(D,4,5)_$E(D,6,7)

 ;

JDATE(D) ;EP - get date

 I $G(D)="" Q ""

 NEW A

 S A=$$FMTE^XLFDT(D)

 Q $E(D,6,7)_$$UP^XLFSTR($P(A," ",1))_(1700+$E(D,1,3))

 ;

UID(APCSA) ;Given DFN return unique patient record id.

 I '$G(APCSA) Q ""

 I '$D(^AUPNPAT(APCSA)) Q ""

 ;

 Q $$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)_$E("0000000000",1,10-$L(APCSA))_APCSA

 ;

EXIT ;clean up and exit

 D EN^XBVK("APCS")

 D ^XBFMK

 K ^APCSDATA($J)

 Q

 ;

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT["TRM")!$D(IO("S"))

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR

 Q

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return location name from file 4 based on DUZ(2).

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------

PURGE ;

 W:'$D(ZTQUEUED) !!,"Now cleaning up host files older than 7 DAYS"

 K APCSFILE,APCSDIR

 S APCSDIR=$P($G(^AUTTSITE(1,1)),"^",2)

 I APCSDIR="" S APCSDIR=$P($G(^XTV(8989.3,1,"DEV")),"^",1)

 I APCSDIR="" Q

 S APCSASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)

 S APCSDT=$$FMADD^XLFDT(DT,-7)

 S APCSDT=$$DATE(APCSDT)

 S APCSFLST=$$LIST^%ZISH(APCSDIR,"FLUHL7_"_APCSASU_"*",.APCSFILE)

 Q:'$O(APCSFILE(""))

 S APCSX=0 F  S APCSX=$O(APCSFILE(APCSX)) Q:APCSX'=+APCSX  D

 .S D=$P($P(APCSFILE(APCSX),"."),"_",3)

 .I D<APCSDT S N=APCSFILE(APCSX) S APCSM=$$DEL^%ZISH(APCSDIR,N)

 Q

APCSSILI  ; IHS/CMI/LAB - ILI surveillance export ; 

 +1       ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009

 +2       ;

 +3       ;

START     ;

 +1       ;This option will create an HL7 output file of all visits for the past 90 days.

 +2       ;

 +3       ;

 +4        DO EXIT

 +5       ;

INFORM    ;inform user

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,$$CJ^XLFSTR("SURVEILLANCE ILI HL7 EXPORT",80)

 +3        WRITE !!,"This option is used to create a file of HL7 messages.  The messages will"

 +4        WRITE !,"be sent to the IHS EPI program.  Visits in the past 90 days that meet"

 +5        WRITE !,"the criteria defined by the EPI program for the ILI export will be sent."

 +6        WRITE !,"The data elements contained in the HL7 messages have been defined by the"

 +7        WRITE !,"EPI program.  Documentation of the message definitions can be"

 +8        WRITE !,"obtained from the EPI program.",!!

 +9        WRITE !,"This HL7 export file will be automatically ftp'ed to the EPI program.",!!

DATES     ;set date range to T-91 to T-1

 +1       ;

 +2        SET APCSBD=$$FMADD^XLFDT(DT,-91)

           SET APCSED=$$FMADD^XLFDT(DT,-1)

 +3        WRITE !!,"The date range for this export is: ",$$FMTE^XLFDT(APCSBD)," to ",$$FMTE^XLFDT(APCSED),".",!

CONTINUE  ;

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue and generate this export file"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF 'Y

               DO EXIT

               QUIT 

ZIS       ;called xbdbque to see if they want to queue or not

 +1        SET XBRC="PROC^APCSSILI"

           SET XBRP=""

           SET XBNS="APCS"

           SET XBRX="EXIT^APCSSILI"

 +2        DO ^XBDBQUE

 +3        DO EXIT

 +4        QUIT 

PROC      ;EP - called from xbdbque

 +1        KILL APCSLOCT

 +2       ;export global

           KILL ^APCSDATA($JOB)

 +3       ;clinic taxonomy

           SET APCSCTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))

 +4       ;dx taxonomy

           SET APCSDTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI",0))

 +5        IF 'APCSCTAX

               DO EXIT

               QUIT 

 +6        IF 'APCSDTAX

               DO EXIT

               QUIT 

 +7       ;

 +8       ;start with 3/21/09 visits CHANGED TO 90 DAYS IN PATCH 26, AFTER THE FIRST PATCH 26 EXPORT

           SET APCSSD=$$FMADD^XLFDT(DT,-91)_".9999"

 +9        SET APCSED=$$FMADD^XLFDT(DT,-1)

 +10      ;visit counter

           SET APCSVTOT=0

 +11       FOR 

               SET APCSSD=$ORDER(^AUPNVSIT("B",APCSSD))

               IF APCSSD'=+APCSSD!($PIECE(APCSSD,".")>APCSED)

                   QUIT 

               Begin DoDot:1

 +12               SET APCSV=0

                   FOR 

                       SET APCSV=$ORDER(^AUPNVSIT("B",APCSSD,APCSV))

                       IF APCSV'=+APCSV

                           QUIT 

                       Begin DoDot:2

 +13      ;no zero node

                           IF '$DATA(^AUPNVSIT(APCSV,0))

                               QUIT 

 +14      ;deleted visit

                           IF $PIECE(^AUPNVSIT(APCSV,0),U,11)

                               QUIT 

 +15                       SET DFN=$PIECE(^AUPNVSIT(APCSV,0),U,5)

 +16                       IF DFN=""

                               QUIT 

 +17                       IF '$DATA(^DPT(DFN,0))

                               QUIT 

 +18                       IF $PIECE(^DPT(DFN,0),U)["DEMO,PATIENT"

                               QUIT 

 +19                       IF $$DEMO^APCLUTL(DFN)

                               QUIT 

 +20                       SET G=0

                           SET X=0

                           FOR 

                               SET X=$ORDER(^BGPSITE(X))

                               IF X'=+X

                                   QUIT 

                               IF $PIECE($GET(^BGPSITE(X,0)),U,12)

                                   IF $DATA(^DIBT($PIECE(^BGPSITE(X,0),U,12),1,DFN))

                                       SET G=1

 +21                       IF G

                               QUIT 

 +22                       SET APCSKV=0

                           SET APCSH1N1=0

                           SET (APCSILI,APCSHVAC,APCSIVAC,APCSADVE,APCSSRD,APCSAVM,APCSAV9)=""

 +23      ;no location ???

                           SET APCSLOC=$PIECE(^AUPNVSIT(APCSV,0),U,6)

                           IF APCSLOC=""

                               QUIT 

 +24                       SET APCSDATE=$PIECE($PIECE(^AUPNVSIT(APCSV,0),U),".")

 +25                       SET APCSASUF=$PIECE($GET(^AUTTLOC(APCSLOC,0)),U,10)

 +26      ;no ASUFAC????

                           IF APCSASUF=""

                               QUIT 

 +27      ;keep visit?

 +28                       SET G=0

                           DO ILIDX

                           IF G

                               SET APCSKV=1

                               SET APCSILI=G

 +29                       SET G=0

                           DO H1N1DX

                           IF G

                               SET APCSKV=1

                               SET APCSH1N1=G

 +30      ;S APCSHVAC=$$HASVAC(APCSV) I APCSHVAC S APCSKV=1

 +31                       SET APCSIVAC=$$HASIVAC^APCLSILI(APCSV)

                           IF APCSIVAC

                               SET APCSKV=1

 +32                       SET APCSADVE=$$HASADVN6^APCLSIL1(APCSV)

                           IF APCSADVE

                               SET APCSKV=1

 +33                       SET APCSOVAC=""

                           IF APCSADVE

                               SET APCSOVAC=$$OTHVAC^APCLSIL1(DFN,APCSDATE)

 +34                       SET APCSSRD=$$HASSRD7(APCSV)

                           IF APCSSRD

                               SET APCSKV=1

 +35                       SET APCSAVM=$$HASAVM(APCSV)

                           IF APCSAVM

                               SET APCSKV=1

 +36      ;S APCSAV9=$$HASAV9(APCSV) I APCSAV9 S APCSKV=1

 +37      ;not a visit to export

                           IF 'APCSKV

                               QUIT 

 +38                       IF '$DATA(ZTQUEUED)

                               WRITE "."

 +39      ;set record

                           DO SETREC^APCSSIL2

                       End DoDot:2

               End DoDot:1

 +40      ;NOW SET TOTAL IN PIECE 13

 +41       SET X=0

           FOR 

               SET X=$ORDER(^APCSDATA($JOB,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +42      ;not an ILI visit

                   IF $PIECE(^APCSDATA($JOB,X),",",8)=""

                       QUIT 

 +43      ;not ambulatory

                   IF $PIECE(^APCSDATA($JOB,X),",",15)="H"

                       QUIT 

 +44               SET L=$PIECE(^APCSDATA($JOB,X),",",6)

                   SET D=$PIECE(^APCSDATA($JOB,X),",",7)

 +45               SET $PIECE(^APCSDATA($JOB,X),",",13)=$GET(APCSLOCT(L,D))

 +46               QUIT 

               End DoDot:1

 +47      ;NOW SET TOTAL IN PIECE 20

 +48       SET X=0

           FOR 

               SET X=$ORDER(^APCSDATA($JOB,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +49               IF $PIECE(^APCSDATA($JOB,X),",",15)'="H"

                       QUIT 

 +50      ;not an ILI or H1N1 visit

                   IF $PIECE(^APCSDATA($JOB,X),",",8)=""

                       IF $PIECE(^APCSDATA($JOB,X),U,43)=""

 +51               SET L=$PIECE(^APCSDATA($JOB,X),",",6)

                   SET D=$PIECE(^APCSDATA($JOB,X),",",7)

 +52               SET $PIECE(^APCSDATA($JOB,X),",",20)=$GET(APCSHTOT(L,D))

 +53               QUIT 

               End DoDot:1

 +54      ;NOW SET TOTAL IN PIECE 42

 +55       SET X=0

           FOR 

               SET X=$ORDER(^APCSDATA($JOB,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +56               IF $PIECE(^APCSDATA($JOB,X),",",15)="H"

                       QUIT 

 +57      ;not an H1N1/ili visit

                   IF $PIECE(^APCSDATA($JOB,X),",",43)=""

                       QUIT 

 +58               SET L=$PIECE(^APCSDATA($JOB,X),",",6)

                   SET D=$PIECE(^APCSDATA($JOB,X),",",7)

 +59               SET $PIECE(^APCSDATA($JOB,X),",",42)=$GET(APCSALLT(L,D))

 +60               QUIT 

               End DoDot:1

 +61      ;MARK - at this point you can loop through ^APCSDATA and generate HL7 messages

 +62       IF '$ORDER(^APCSDATA($JOB,0))

               Begin DoDot:1

 +63               IF '$DATA(ZTQUEUED)

                       WRITE !!,"There are no visits to export.",!

                       DO PAUSE^APCLVL01

               End DoDot:1

               QUIT 

 +64      ;parse out the APCSDATA global and create a message from it

           DO ILI^APCSHLO("ILI")

 +65       IF '$DATA(ZTQUEUED)

               DO PAUSE^APCLVL01

 +66      ;D WRITE  ;MARK - if you stored all the HL7 messages somewhere this is where you will write them out see WRITE subroutine, I write out global APCSDATA

 +67       QUIT 

ILIDX     ;

 +1        IF "AORSH"'[$PIECE(^AUPNVSIT(APCSV,0),U,7)

               QUIT 

 +2        IF $PIECE(^AUPNVSIT(APCSV,0),U,7)="H"

               SET APCSHTOT(APCSASUF,$$JDATE(APCSDATE))=$GET(APCSHTOT(APCSASUF,$$JDATE(APCSDATE)))+1

 +3       ;get clinic code

           SET APCSCLIN=$$CLINIC^APCLV(APCSV,"I")

 +4       ;is there a PHN

 +5        SET X=0

           SET P=0

           FOR 

               SET X=$ORDER(^AUPNVPRV("AD",APCSV,X))

               IF X'=+X!(P)

                   QUIT 

               Begin DoDot:1

 +6                IF '$DATA(^AUPNVPRV(X,0))

                       QUIT 

 +7                SET Y=$PIECE(^AUPNVPRV(X,0),U)

 +8                SET Z=$$VALI^XBDIQ1(200,Y,53.5)

 +9                IF 'Z

                       QUIT 

 +10               IF $PIECE($GET(^DIC(7,Z,9999999)),U,1)=13

                       SET P=1

               End DoDot:1

 +11       IF P

               GOTO ILIDX1

 +12       IF $PIECE(^AUPNVSIT(APCSV,0),U,7)'="H"

               IF APCSCLIN=""

                   QUIT 

 +13      ;not in clinic taxonomy

           IF $PIECE(^AUPNVSIT(APCSV,0),U,7)'="H"

               IF '$DATA(^ATXAX(APCSCTAX,21,"B",APCSCLIN))

                   QUIT 

ILIDX1    ;

 +1       ;total number of visits

           IF $PIECE(^AUPNVSIT(APCSV,0),U,7)'="H"

               SET APCSLOCT(APCSASUF,$$JDATE(APCSDATE))=$GET(APCSLOCT(APCSASUF,$$JDATE(APCSDATE)))+1

 +2        SET C=0

 +3        KILL G,Y

           SET G=""

 +4        SET X=0

           FOR 

               SET X=$ORDER(^AUPNVPOV("AD",APCSV,X))

               IF X'=+X

                   QUIT 

               SET T=$PIECE(^AUPNVPOV(X,0),U)

               IF $$ICD^ATXCHK(T,APCSDTAX,9)

                   SET C=C+1

                   SET Y(C)=$$VAL^XBDIQ1(9000010.07,X,.01)

 +5       ;no diagnosis

           IF '$DATA(Y)

               QUIT 

 +6        SET X=0

           FOR 

               SET X=$ORDER(Y(X))

               IF X'=+X

                   QUIT 

               SET G=G_U_Y(X)

 +7        SET $PIECE(G,U,1)=1

 +8        QUIT 

H1N1DX    ;

 +1       ;just want outpatient with dx

           IF "AORSH"'[$PIECE(^AUPNVSIT(APCSV,0),U,7)

               QUIT 

 +2       ;get clinic code

           SET APCSCLIN=$$CLINIC^APCLV(APCSV,"I")

 +3       ;I $P(^AUPNVSIT(APCSV,0),U,7)'="H" Q:'$D(^ATXAX(APCSCTAX,21,"B",APCSCLIN))  ;not in clinic taxonomy

 +4       ;total number of visits

           IF $PIECE(^AUPNVSIT(APCSV,0),U,7)'="H"

               SET APCSALLT(APCSASUF,$$JDATE(APCSDATE))=$GET(APCSALLT(APCSASUF,$$JDATE(APCSDATE)))+1

 +5        SET G=0

 +6        SET X=0

           FOR 

               SET X=$ORDER(^AUPNVPOV("AD",APCSV,X))

               IF X'=+X!(G)

                   QUIT 

               SET T=$PIECE(^AUPNVPOV(X,0),U)

               IF $$ICD^ATXCHK(T,$ORDER(^ATXAX("B","SURVEILLANCE H1N1 DX",0)),9)

                   SET G=1

                   SET D=$$VAL^XBDIQ1(9000010.07,X,.01)

 +7       ;no diagnosis

           IF 'G

               QUIT 

 +8        SET G=1_U_D

 +9        QUIT 

HASSRD7(APCLV) ;EP

 +1        NEW X,P,D,Y,Z,APCLCLIN,T,G,C

 +2       ;just want hOSP

           IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="H"

               QUIT ""

 +3        SET C=0

 +4        KILL G,Y

           SET G=""

 +5        SET X=0

           FOR 

               SET X=$ORDER(^AUPNVPOV("AD",APCLV,X))

               IF X'=+X

                   QUIT 

               SET T=$PIECE(^AUPNVPOV(X,0),U)

               IF $$ICD^ATXCHK(T,$ORDER(^ATXAX("B","SURVEILLANCE SEV RESP DIS DXS",0)),9)

                   SET C=C+1

                   SET Y(C)=$$VAL^XBDIQ1(9000010.07,X,.01)

 +6       ;no diagnosis

           IF '$DATA(Y)

               QUIT ""

 +7        SET X=0

           FOR 

               SET X=$ORDER(Y(X))

               IF X'=+X

                   QUIT 

               SET G=G_U_Y(X)

 +8        SET $PIECE(G,U,1)=1

 +9        QUIT G

HASAVM(V) ;EP

 +1        NEW C,X,Y,Z,T,L,M,N

 +2        SET T=$ORDER(^ATXAX("B","FLU ANTIVIRAL MEDS",0))

 +3        SET C=""

           SET X=0

           FOR 

               SET X=$ORDER(^AUPNVMED("AD",V,X))

               IF X'=+X!(C)

                   QUIT 

               SET Y=$PIECE($GET(^AUPNVMED(X,0)),U)

               Begin DoDot:1

 +4                IF 'Y

                       QUIT 

 +5                IF '$DATA(^PSDRUG(Y,0))

                       QUIT 

 +6                SET Z=0

 +7                SET N=$PIECE(^PSDRUG(Y,0),U)

 +8                IF $DATA(^ATXAX(T,21,"B",Y))

                       SET Z=1

 +9                IF N["OSELTAMIVIR"

                       SET Z=1

 +10               IF N["ZANAMIVIR"

                       SET Z=1

 +11               IF Z=1

                       SET C=1_U_N_U_$PIECE(^AUPNVMED(X,0),U,7)

 +12               QUIT 

               End DoDot:1

 +13       QUIT C

 +14      ;send file

WRITE     ; use XBGSAVE to save the temp global (APCSDATA) to a delimited

 +1       ; file that is exported to the IE system

 +2        NEW XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN

 +3        SET XBGL="APCSDATA"

           SET XBMED="F"

           SET XBQ="N"

           SET XBFLT=1

           SET XBF=$JOB

           SET XBE=$JOB

 +4        SET XBNAR="ILI SURVEILLANCE EXPORT HL7"

 +5       ;asufac for file name

           SET APCSASU=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0)),U,10)

 +6        SET XBFN="FLUHL7_"_APCSASU_"_"_$$DATE(DT)_".txt"

 +7        SET XBS1="SURVEILLANCE ILI SEND"

 +8       ;

 +9        DO ^XBGSAVE

 +10      ;

 +11       IF XBFLG'=0

               Begin DoDot:1

 +12               IF XBFLG(1)=""

                       IF '$DATA(ZTQUEUED)

                           WRITE !!,"VISIT ILI file successfully created",!!

 +13               IF XBFLG(1)]""

                       IF '$DATA(ZTQUEUED)

                           WRITE !!,"VISIT ILI file NOT successfully created",!!

 +14               IF '$DATA(ZTQUEUED)

                       WRITE !,"File was NOT successfully transferred to IHS/CDC",!,"you will need to manually ftp it.",!

 +15               IF '$DATA(ZTQUEUED)