APCLSILO ; IHS/CMI/LAB - ILI surveillance export ;
;;3.0;IHS PCC REPORTS;**29,31**;FEB 05, 1997;Build 32
;
;
START ;
W:$D(IOF) @IOF
D EXIT
W !!,"This option can be used to send an ILI Surveillance (""FLU"") file or a FLU POP"
W !,"file to the IHS EPI program. This should only be done if the EPI program"
W !,"has requested that you do so because previous exports have failed.",!
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I 'Y D EXIT Q
I $P(^AUTTSITE(1,0),U)'=DUZ(2) W !!,"You must be logged into the main facility to do this export.",!,"Your main facility is: ",$$GET1^DIQ(9999999.39,1,.01),! D PAUSE^APCLVL01,EXIT Q
I '$D(^BGPSITE(DUZ(2),0)) W !!,"Your CRS Site Parameters are not setup for this facility: ",!,$P(^DIC(4,DUZ(2),0),U,1)," can not continue.",! D PAUSE^APCLVL01,EXIT Q
I $P($G(^AUTTLOC(DUZ(2),1)),U,3)="" W !!,"Your DBID is missing, cannot continue.",! D PAUSE^APCLVL01,EXIT Q
S APCLWEXP=""
S DIR(0)="S^F:FLU visit data export;P:FLU POP - Flu Population export;B:BOTH",DIR("A")="Which export would you like to run",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
S APCLWEXP=Y
I APCLWEXP="B" S APCL1ST=1
I APCLWEXP="P" S APCL1ST=1
K APCLLOCT,APCLALLT,APCLHTOT,APCLALL1
K ^APCLDATA($J) ;export global
S APCLCTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0)) ;clinic taxonomy
S APCLDTAX=$O(^ATXAX("B","SURVEILLANCE ILI",0)) ;dx taxonomy
S APCLTTAX=$O(^ATXAX("B","SURVEILLANCE ILI NO TMP NEEDED",0))
I 'APCLCTAX W !!,$P(^ATXAX(APCLCTAX,0),U,1)," is missing." D PAUSE^APCLVL01 D EXIT Q
I 'APCLDTAX W !!,$P(^ATXAX(APCLDTAX,0),U,1)," is missing." D PAUSE^APCLVL01 D EXIT Q
I 'APCLTTAX W !!,$P(^ATXAX(APCLTTAX,0),U,1)," is missing." D PAUSE^APCLVL01 D EXIT Q
I APCLWEXP="P" G ZIS ;cmi/maw 03/03/2014 skip dates if monthly FLUPOP
;
TP ;
S DIR(0)="S^1:90 days (the past 90 days);2:2009 - all visits since 01/01/2009;3:User defined Date Range",DIR("A")="For which time period would you like to export ILI/FLU visits",DIR("B")=1 KILL DA D ^DIR KILL DIR
I $D(DIRUT) G START
S APCLY=Y
I APCLY=1 S APCLSD=$$FMADD^XLFDT(DT,-91)_".9999",APCLBDAT=$$FMADD^XLFDT(DT,-90)
I APCLY=2 S APCLSD=3081231.9999,$P(^APCLILIC(1,0),U,4)=1,APCLBDAT=3090101,APCLFLF=1,APCLFLFN=1 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
I APCLY=3 S APCLFLFN=1 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
I APCLY=1!(APCLY=2) S APCLED=$$FMADD^XLFDT(DT,-1)
I APCLY=2 D G:APCLQ=1 START
.W !!,"WARNING: exporting that date range will take a while to run and will"
.W !,"require a large amount of space in the HL 7 message file."
.S APCLQ=0
.S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCLQ=1 Q
.I 'Y S APCLQ=1
I APCLY=3 D GETDATES
I APCLSD=""!(APCLED="") W !,"Dates not entered." D PAUSE^APCLVL01 G START
;GET DEVICE AND QUEUE
ZIS ;call to XBDBQUE
;S APCLFLFN=1 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
S APCLZHSD=DT
S XBRP="",XBRC="EP1^APCLSILI",XBRX="EXIT^APCLSILO",XBNS="APCL"
D ^XBDBQUE
D EXIT
Q
EXIT ;clean up and exit
D EN^XBVK("APCL")
D ^XBFMK
Q
GETDATES ;
W !!,"You will supply the beginning date, the ending date will be yesterday.",!
S (APCLSD,APCLBDAT,APCLED)=""
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"
D ^DIR
Q:$D(DIRUT)
Q:Y<1
I Y>DT W !!,"Future dates not allowed." G GETDATES
S APCLBDAT=Y
;
S APCLED=$$FMADD^XLFDT(DT,-1)
S APCLSD=$$FMADD^XLFDT(APCLBDAT,-1)_".9999"
;
I APCLED<APCLBDAT D G GETDATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
Q
APCLSILO ; IHS/CMI/LAB - ILI surveillance export ;
+1 ;;3.0;IHS PCC REPORTS;**29,31**;FEB 05, 1997;Build 32
+2 ;
+3 ;
START ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 DO EXIT
+3 WRITE !!,"This option can be used to send an ILI Surveillance (""FLU"") file or a FLU POP"
+4 WRITE !,"file to the IHS EPI program. This should only be done if the EPI program"
+5 WRITE !,"has requested that you do so because previous exports have failed.",!
+6 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
DO EXIT
QUIT
+8 IF 'Y
DO EXIT
QUIT
+9 IF $PIECE(^AUTTSITE(1,0),U)'=DUZ(2)
WRITE !!,"You must be logged into the main facility to do this export.",!,"Your main facility is: ",$$GET1^DIQ(9999999.39,1,.01),!
DO PAUSE^APCLVL01
DO EXIT
QUIT
+10 IF '$DATA(^BGPSITE(DUZ(2),0))
WRITE !!,"Your CRS Site Parameters are not setup for this facility: ",!,$PIECE(^DIC(4,DUZ(2),0),U,1)," can not continue.",!
DO PAUSE^APCLVL01
DO EXIT
QUIT
+11 IF $PIECE($GET(^AUTTLOC(DUZ(2),1)),U,3)=""
WRITE !!,"Your DBID is missing, cannot continue.",!
DO PAUSE^APCLVL01
DO EXIT
QUIT
+12 SET APCLWEXP=""
+13 SET DIR(0)="S^F:FLU visit data export;P:FLU POP - Flu Population export;B:BOTH"
SET DIR("A")="Which export would you like to run"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
DO EXIT
QUIT
+15 SET APCLWEXP=Y
+16 IF APCLWEXP="B"
SET APCL1ST=1
+17 IF APCLWEXP="P"
SET APCL1ST=1
+18 KILL APCLLOCT,APCLALLT,APCLHTOT,APCLALL1
+19 ;export global
KILL ^APCLDATA($JOB)
+20 ;clinic taxonomy
SET APCLCTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
+21 ;dx taxonomy
SET APCLDTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI",0))
+22 SET APCLTTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI NO TMP NEEDED",0))
+23 IF 'APCLCTAX
WRITE !!,$PIECE(^ATXAX(APCLCTAX,0),U,1)," is missing."
DO PAUSE^APCLVL01
DO EXIT
QUIT
+24 IF 'APCLDTAX
WRITE !!,$PIECE(^ATXAX(APCLDTAX,0),U,1)," is missing."
DO PAUSE^APCLVL01
DO EXIT
QUIT
+25 IF 'APCLTTAX
WRITE !!,$PIECE(^ATXAX(APCLTTAX,0),U,1)," is missing."
DO PAUSE^APCLVL01
DO EXIT
QUIT
+26 ;cmi/maw 03/03/2014 skip dates if monthly FLUPOP
IF APCLWEXP="P"
GOTO ZIS
+27 ;
TP ;
+1 SET DIR(0)="S^1:90 days (the past 90 days);2:2009 - all visits since 01/01/2009;3:User defined Date Range"
SET DIR("A")="For which time period would you like to export ILI/FLU visits"
SET DIR("B")=1
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO START
+3 SET APCLY=Y
+4 IF APCLY=1
SET APCLSD=$$FMADD^XLFDT(DT,-91)_".9999"
SET APCLBDAT=$$FMADD^XLFDT(DT,-90)
+5 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
IF APCLY=2
SET APCLSD=3081231.9999
SET $PIECE(^APCLILIC(1,0),U,4)=1
SET APCLBDAT=3090101
SET APCLFLF=1
SET APCLFLFN=1
+6 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
IF APCLY=3
SET APCLFLFN=1
+7 IF APCLY=1!(APCLY=2)
SET APCLED=$$FMADD^XLFDT(DT,-1)
+8 IF APCLY=2
Begin DoDot:1
+9 WRITE !!,"WARNING: exporting that date range will take a while to run and will"
+10 WRITE !,"require a large amount of space in the HL 7 message file."
+11 SET APCLQ=0
+12 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
SET APCLQ=1
QUIT
+14 IF 'Y
SET APCLQ=1
End DoDot:1
IF APCLQ=1
GOTO START
+15 IF APCLY=3
DO GETDATES
+16 IF APCLSD=""!(APCLED="")
WRITE !,"Dates not entered."
DO PAUSE^APCLVL01
GOTO START
+17 ;GET DEVICE AND QUEUE
ZIS ;call to XBDBQUE
+1 ;S APCLFLFN=1 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
+2 SET APCLZHSD=DT
+3 SET XBRP=""
SET XBRC="EP1^APCLSILI"
SET XBRX="EXIT^APCLSILO"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 DO EXIT
+6 QUIT
EXIT ;clean up and exit
+1 DO EN^XBVK("APCL")
+2 DO ^XBFMK
+3 QUIT
GETDATES ;
+1 WRITE !!,"You will supply the beginning date, the ending date will be yesterday.",!
+2 SET (APCLSD,APCLBDAT,APCLED)=""
+3 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Date"
+4 DO ^DIR
+5 IF $DATA(DIRUT)
QUIT
+6 IF Y<1
QUIT
+7 IF Y>DT
WRITE !!,"Future dates not allowed."
GOTO GETDATES
+8 SET APCLBDAT=Y
+9 ;
+10 SET APCLED=$$FMADD^XLFDT(DT,-1)
+11 SET APCLSD=$$FMADD^XLFDT(APCLBDAT,-1)_".9999"
+12 ;
+13 IF APCLED<APCLBDAT
Begin DoDot:1
+14 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO GETDATES
+15 QUIT
