Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCLSILO

APCLSILO.m

Go to the documentation of this file.
  1. APCLSILO ; IHS/CMI/LAB - ILI surveillance export ;
  1. ;;3.0;IHS PCC REPORTS;**29,31**;FEB 05, 1997;Build 32
  1. ;
  1. ;
  1. START ;
  1. W:$D(IOF) @IOF
  1. D EXIT
  1. W !!,"This option can be used to send an ILI Surveillance (""FLU"") file or a FLU POP"
  1. W !,"file to the IHS EPI program. This should only be done if the EPI program"
  1. W !,"has requested that you do so because previous exports have failed.",!
  1. S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) D EXIT Q
  1. I 'Y D EXIT Q
  1. 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
  1. 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
  1. I $P($G(^AUTTLOC(DUZ(2),1)),U,3)="" W !!,"Your DBID is missing, cannot continue.",! D PAUSE^APCLVL01,EXIT Q
  1. S APCLWEXP=""
  1. 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
  1. I $D(DIRUT) D EXIT Q
  1. S APCLWEXP=Y
  1. I APCLWEXP="B" S APCL1ST=1
  1. I APCLWEXP="P" S APCL1ST=1
  1. K APCLLOCT,APCLALLT,APCLHTOT,APCLALL1
  1. K ^APCLDATA($J) ;export global
  1. S APCLCTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0)) ;clinic taxonomy
  1. S APCLDTAX=$O(^ATXAX("B","SURVEILLANCE ILI",0)) ;dx taxonomy
  1. S APCLTTAX=$O(^ATXAX("B","SURVEILLANCE ILI NO TMP NEEDED",0))
  1. I 'APCLCTAX W !!,$P(^ATXAX(APCLCTAX,0),U,1)," is missing." D PAUSE^APCLVL01 D EXIT Q
  1. I 'APCLDTAX W !!,$P(^ATXAX(APCLDTAX,0),U,1)," is missing." D PAUSE^APCLVL01 D EXIT Q
  1. I 'APCLTTAX W !!,$P(^ATXAX(APCLTTAX,0),U,1)," is missing." D PAUSE^APCLVL01 D EXIT Q
  1. I APCLWEXP="P" G ZIS ;cmi/maw 03/03/2014 skip dates if monthly FLUPOP
  1. ;
  1. TP ;
  1. 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
  1. I $D(DIRUT) G START
  1. S APCLY=Y
  1. I APCLY=1 S APCLSD=$$FMADD^XLFDT(DT,-91)_".9999",APCLBDAT=$$FMADD^XLFDT(DT,-90)
  1. 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
  1. I APCLY=3 S APCLFLFN=1 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
  1. I APCLY=1!(APCLY=2) S APCLED=$$FMADD^XLFDT(DT,-1)
  1. I APCLY=2 D G:APCLQ=1 START
  1. .W !!,"WARNING: exporting that date range will take a while to run and will"
  1. .W !,"require a large amount of space in the HL 7 message file."
  1. .S APCLQ=0
  1. .S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) S APCLQ=1 Q
  1. .I 'Y S APCLQ=1
  1. I APCLY=3 D GETDATES
  1. I APCLSD=""!(APCLED="") W !,"Dates not entered." D PAUSE^APCLVL01 G START
  1. ;GET DEVICE AND QUEUE
  1. ZIS ;call to XBDBQUE
  1. ;S APCLFLFN=1 ;IHS/CMI/LAB - PATCH 31 FOR FILENAME
  1. S APCLZHSD=DT
  1. S XBRP="",XBRC="EP1^APCLSILI",XBRX="EXIT^APCLSILO",XBNS="APCL"
  1. D ^XBDBQUE
  1. D EXIT
  1. Q
  1. EXIT ;clean up and exit
  1. D EN^XBVK("APCL")
  1. D ^XBFMK
  1. Q
  1. GETDATES ;
  1. W !!,"You will supply the beginning date, the ending date will be yesterday.",!
  1. S (APCLSD,APCLBDAT,APCLED)=""
  1. K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"
  1. D ^DIR
  1. Q:$D(DIRUT)
  1. Q:Y<1
  1. I Y>DT W !!,"Future dates not allowed." G GETDATES
  1. S APCLBDAT=Y
  1. ;
  1. S APCLED=$$FMADD^XLFDT(DT,-1)
  1. S APCLSD=$$FMADD^XLFDT(APCLBDAT,-1)_".9999"
  1. ;
  1. I APCLED<APCLBDAT D G GETDATES
  1. . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1. Q