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)
WRITE !,XBFLG(1),!!
End DoDot:1
+16 KILL ^APCSDATA($JOB)
+17 QUIT
+18 ;
DATE(D) ;EP
+1 QUIT (1700+$EXTRACT(D,1,3))_$EXTRACT(D,4,5)_$EXTRACT(D,6,7)
+2 ;
JDATE(D) ;EP - get date
+1 IF $GET(D)=""
QUIT ""
+2 NEW A
+3 SET A=$$FMTE^XLFDT(D)
+4 QUIT $EXTRACT(D,6,7)_$$UP^XLFSTR($PIECE(A," ",1))_(1700+$EXTRACT(D,1,3))
+5 ;
UID(APCSA) ;Given DFN return unique patient record id.
+1 IF '$GET(APCSA)
QUIT ""
+2 IF '$DATA(^AUPNPAT(APCSA))
QUIT ""
+3 ;
+4 QUIT $$GET1^DIQ(9999999.06,$PIECE(^AUTTSITE(1,0),U),.32)_$EXTRACT("0000000000",1,10-$LENGTH(APCSA))_APCSA
+5 ;
EXIT ;clean up and exit
+1 DO EN^XBVK("APCS")
+2 DO ^XBFMK
+3 KILL ^APCSDATA($JOB)
+4 QUIT
+5 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT["TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
PURGE ;
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Now cleaning up host files older than 7 DAYS"
+2 KILL APCSFILE,APCSDIR
+3 SET APCSDIR=$PIECE($GET(^AUTTSITE(1,1)),"^",2)
+4 IF APCSDIR=""
SET APCSDIR=$PIECE($GET(^XTV(8989.3,1,"DEV")),"^",1)
+5 IF APCSDIR=""
QUIT
+6 SET APCSASU=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0)),U,10)
+7 SET APCSDT=$$FMADD^XLFDT(DT,-7)
+8 SET APCSDT=$$DATE(APCSDT)
+9 SET APCSFLST=$$LIST^%ZISH(APCSDIR,"FLUHL7_"_APCSASU_"*",.APCSFILE)
+10 IF '$ORDER(APCSFILE(""))
QUIT
+11 SET APCSX=0
FOR
SET APCSX=$ORDER(APCSFILE(APCSX))
IF APCSX'=+APCSX
QUIT
Begin DoDot:1
+12 SET D=$PIECE($PIECE(APCSFILE(APCSX),"."),"_",3)
+13 IF D<APCSDT
SET N=APCSFILE(APCSX)
SET APCSM=$$DEL^%ZISH(APCSDIR,N)
End DoDot:1
+14 QUIT
