APCLSIL3 ; IHS/CMI/LAB - ili surveillance ;
;;3.0;IHS PCC REPORTS;**24,26,27,28,29,30**;FEB 05, 1997;Build 27
;
;
INFORM ;
W:$D(IOF) @IOF
W !,$$CTR($$LOC)
W !,$$CTR($$USR)
W !!,"This report will create a search template of visits that meet the "
W !,"Surveillance ILI criteria. You will be asked the provide the date"
W !,"range of visits, a name for the visit search template to be created, and"
W !,"the device to which the cover page/summary will be printed.",!
W !,"The visits must meet the following criteria:"
W !?5," - must be in the date range selected by the user"
W !?5," - must have a service category of H OR A, O, R or S (outpatient)"
W !?5," - must have at least one diagnosis that is contained in the "
W !?8,"SURVEILLANCE ILI taxonomy with a temperature recorded on the visit"
W !?8,"with a value >=100 OR there must be at least one diagnosis in the"
W !?8,"SURVEILLANCE ILI NO TMP NEEDED taxonomy."
W !?5," - if ambulatory, must be to a clinic in the SURVEILLANCE ILI CLINICS taxonomy"
W !?8,"or the provider must be a PHN"
W !?5," - the patient's name must not contain 'DEMO,PATIENT' (demo patients"
W !?8,"skipped)"
W !
D EXIT
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 'APCLDTAX W !!,"SURVEILLANCE ILI ICD taxonomy missing...cannot continue." D EXIT Q
I 'APCLCTAX W !!,"SURVEILLANCE ILI CLINICS taxonomy missing...cannot continue." D EXIT Q
I 'APCLTTAX W !!,"SURVEILLANCE ILI NO TMP NEEDED taxonomy missing...cannot continue." D EXIT Q
;
DATES K APCLED,APCLBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR G:Y<1 EXIT S APCLBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
D ^DIR G:Y<1 EXIT S APCLED=Y
;
I APCLED<APCLBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
S APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
;
STMP ;
S APCLSTMP=""
D ^APCLSTMV
I APCLSTMP="" G DATES
;
ZIS ;call to XBDBQUE
S XBRP="PRINT^APCLSIL3",XBRC="PROC1^APCLSIL3",XBRX="EXIT^APCLSIL3",XBNS="APCL"
D ^XBDBQUE
D EXIT
Q
;
EXIT ;clean up and exit
D EN^XBVK("APCL")
D ^XBFMK
Q
PROC1 ;
S APCLJ=$J,APCLH=$H
S APCLCTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0)) ;clinic taxonomy
S APCLDTAX=$O(^ATXAX("B","SURVEILLANCE ILI",0)) ;dx taxonomy
I 'APCLCTAX D EXIT Q
I 'APCLDTAX D EXIT Q
I 'APCLTTAX D EXIT Q
;
S APCLVTOT=0,APCLPTOT=0 ;visit counter
F S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD'=+APCLSD!($P(APCLSD,".")>APCLED) D
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("B",APCLSD,APCLV)) Q:APCLV'=+APCLV D
..Q:'$D(^AUPNVSIT(APCLV,0)) ;no zero node
..Q:$P(^AUPNVSIT(APCLV,0),U,11) ;deleted visit
..Q:"AORHS"'[$P(^AUPNVSIT(APCLV,0),U,7) ;just want outpatient
..S X=0,P=0 F S X=$O(^AUPNVPRV("AD",APCLV,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 P
..S APCLCLIN=$$CLINIC^APCLV(APCLV,"I") ;get clinic code
..I $P(^AUPNVSIT(APCLV,0),U,7)'="H" Q:APCLCLIN=""
..I $P(^AUPNVSIT(APCLV,0),U,7)'="H" Q:'$D(^ATXAX(APCLCTAX,21,"B",APCLCLIN)) ;not in clinic taxonomy
..S APCLLOC=$P(^AUPNVSIT(APCLV,0),U,6) Q:APCLLOC="" ;no location ???
..S APCLDATE=$P($P(^AUPNVSIT(APCLV,0),U),".")
P ..S DFN=$P(^AUPNVSIT(APCLV,0),U,5)
..Q:DFN=""
..Q:'$D(^DPT(DFN,0))
..Q:$P(^DPT(DFN,0),U)["DEMO,PATIENT"
..Q:$$DEMO^APCLUTL(DFN,"E") ;exclude demo patients
..S APCLASUF=$P($G(^AUTTLOC(APCLLOC,0)),U,10)
..I APCLASUF="" Q ;no ASUFAC????
..S ^TMP($J,"APCLLOCT",APCLASUF,$$JDATE^APCLSILI(APCLDATE))=$G(^TMP($J,"APCLLOCT",APCLASUF,$$JDATE^APCLSILI(APCLDATE)))+1 ;total number of visits on this date/location
..S G=0
..S X=0 F S X=$O(^AUPNVPOV("AD",APCLV,X)) Q:X'=+X D
...S T=$P(^AUPNVPOV(X,0),U)
...I $$ICD^APCLSILU(T,APCLTTAX,9) S G=1
...I $$ICD^APCLSILU(T,APCLDTAX,9),$$TMP100^APCLSILI(APCLV) S G=1
..Q:'G ;no diagnosis
..;
..D SET
..Q
.Q
K ^XTMP("APCLSILI",APCLJ,APCLH)
Q
PRINT ;EP - called from xbdbque
S APCLPG=0
D HEADER
W !!,"Search Template Created: ",$P(^DIBT(APCLSTMP,0),U)
W !!,"Total # of visits meeting criteria and placed in the template: ",APCLVTOT
W !!,"Total # of patients for these visits: ",APCLPTOT,!
D EOP
Q
SET ;
S APCLVTOT=APCLVTOT+1
S ^DIBT(APCLSTMP,1,APCLV)=""
Q:$D(^XTMP("APCLSILI",APCLJ,APCLH,"PATS",DFN))
S APCLPTOT=APCLPTOT+1
S ^XTMP("APCLSILI",APCLJ,APCLH,"PATS",DFN)=""
Q
I 'APCLPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQ="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W $P(^VA(200,DUZ,0),U,2),?72,"Page ",APCLPG,!
W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
W !,$$CTR("SURVEILLANCE ILI VISIT SEARCH"),!
W !,$$CTR("DATE RANGE: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
W !,$$REPEAT^XLFSTR("-",79)
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")
;----------
STOPD ;EP
W !!,"This option is used to set a stop date for sending ILI surveillance"
W !,"visit data to IHS/CDC. Currently the stop date is preset for "
W !,"September 1, 2009."
W !!,"When the nightly export runs, it will check this date. If the stop "
W !,"date is less than the export date, no data will be exported."
W !!,"For example, if you want to have the export of data stop on "
W !,"August 1, 2009, then enter that date here. If you want to continue"
W !,"the export indefinitely, select a date in the future.",!
S DA=$O(^APCLCNTL("B","ILI STOP DATE",0))
I 'DA W !!,"ILI CONTROL FILE ENTRY MISSING. NOTIFY PROGRAMMER." K DA Q
S DIE="^APCLCNTL(",DR=".03"
D ^DIE
K DIE,DA
W !!
D PAUSE^APCLVL01
Q
PURGE ;EP - CALLED TO PURGE
W:'$D(ZTQUEUED) !!,"Now cleaning up host files older than 7 DAYS"
K APCLFILE,APCLDIR
S APCLDIR=$P($G(^AUTTSITE(1,1)),"^",2)
I APCLDIR="" S APCLDIR=$P($G(^XTV(8989.3,1,"DEV")),"^",1)
I APCLDIR="" Q
S APCLASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)
S APCLDT=$$FMADD^XLFDT(DT,-7)
S APCLDT=$$DATE^APCLSILI(APCLDT)
S APCLFLST=$$LIST^%ZISH(APCLDIR,"FLU_"_APCLASU_"*",.APCLFILE)
Q:'$O(APCLFILE(""))
S APCLX=0 F S APCLX=$O(APCLFILE(APCLX)) Q:APCLX'=+APCLX D
.S D=$P($P(APCLFILE(APCLX),"."),"_",3)
.I D<APCLDT S N=APCLFILE(APCLX) S APCLM=$$DEL^%ZISH(APCLDIR,N)
PURGEPOP ;
K APCLFILE
S APCLFLST=$$LIST^%ZISH(APCLDIR,"FLUPOP_"_APCLASU_"*",.APCLFILE)
Q:'$O(APCLFILE(""))
S APCLX=0 F S APCLX=$O(APCLFILE(APCLX)) Q:APCLX'=+APCLX D
.S D=$P($P(APCLFILE(APCLX),"."),"_",3)
.I D<APCLDT S N=APCLFILE(APCLX) S APCLM=$$DEL^%ZISH(APCLDIR,N)
Q
APCLSIL3 ; IHS/CMI/LAB - ili surveillance ;
+1 ;;3.0;IHS PCC REPORTS;**24,26,27,28,29,30**;FEB 05, 1997;Build 27
+2 ;
+3 ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC)
+3 WRITE !,$$CTR($$USR)
+4 WRITE !!,"This report will create a search template of visits that meet the "
+5 WRITE !,"Surveillance ILI criteria. You will be asked the provide the date"
+6 WRITE !,"range of visits, a name for the visit search template to be created, and"
+7 WRITE !,"the device to which the cover page/summary will be printed.",!
+8 WRITE !,"The visits must meet the following criteria:"
+9 WRITE !?5," - must be in the date range selected by the user"
+10 WRITE !?5," - must have a service category of H OR A, O, R or S (outpatient)"
+11 WRITE !?5," - must have at least one diagnosis that is contained in the "
+12 WRITE !?8,"SURVEILLANCE ILI taxonomy with a temperature recorded on the visit"
+13 WRITE !?8,"with a value >=100 OR there must be at least one diagnosis in the"
+14 WRITE !?8,"SURVEILLANCE ILI NO TMP NEEDED taxonomy."
+15 WRITE !?5," - if ambulatory, must be to a clinic in the SURVEILLANCE ILI CLINICS taxonomy"
+16 WRITE !?8,"or the provider must be a PHN"
+17 WRITE !?5," - the patient's name must not contain 'DEMO,PATIENT' (demo patients"
+18 WRITE !?8,"skipped)"
+19 WRITE !
+20 DO EXIT
+21 ;clinic taxonomy
SET APCLCTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
+22 ;dx taxonomy
SET APCLDTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI",0))
+23 SET APCLTTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI NO TMP NEEDED",0))
+24 IF 'APCLDTAX
WRITE !!,"SURVEILLANCE ILI ICD taxonomy missing...cannot continue."
DO EXIT
QUIT
+25 IF 'APCLCTAX
WRITE !!,"SURVEILLANCE ILI CLINICS taxonomy missing...cannot continue."
DO EXIT
QUIT
+26 IF 'APCLTTAX
WRITE !!,"SURVEILLANCE ILI NO TMP NEEDED taxonomy missing...cannot continue."
DO EXIT
QUIT
+27 ;
DATES KILL APCLED,APCLBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit Date"
+2 DO ^DIR
IF Y<1
GOTO EXIT
SET APCLBD=Y
+3 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Visit Date"
+4 DO ^DIR
IF Y<1
GOTO EXIT
SET APCLED=Y
+5 ;
+6 IF APCLED<APCLBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 SET APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
+9 ;
STMP ;
+1 SET APCLSTMP=""
+2 DO ^APCLSTMV
+3 IF APCLSTMP=""
GOTO DATES
+4 ;
ZIS ;call to XBDBQUE
+1 SET XBRP="PRINT^APCLSIL3"
SET XBRC="PROC1^APCLSIL3"
SET XBRX="EXIT^APCLSIL3"
SET XBNS="APCL"
+2 DO ^XBDBQUE
+3 DO EXIT
+4 QUIT
+5 ;
EXIT ;clean up and exit
+1 DO EN^XBVK("APCL")
+2 DO ^XBFMK
+3 QUIT
PROC1 ;
+1 SET APCLJ=$JOB
SET APCLH=$HOROLOG
+2 ;clinic taxonomy
SET APCLCTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
+3 ;dx taxonomy
SET APCLDTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI",0))
+4 IF 'APCLCTAX
DO EXIT
QUIT
+5 IF 'APCLDTAX
DO EXIT
QUIT
+6 IF 'APCLTTAX
DO EXIT
QUIT
+7 ;
+8 ;visit counter
SET APCLVTOT=0
SET APCLPTOT=0
+9 FOR
SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLSD'=+APCLSD!($PIECE(APCLSD,".")>APCLED)
QUIT
Begin DoDot:1
+10 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("B",APCLSD,APCLV))
IF APCLV'=+APCLV
QUIT
Begin DoDot:2
+11 ;no zero node
IF '$DATA(^AUPNVSIT(APCLV,0))
QUIT
+12 ;deleted visit
IF $PIECE(^AUPNVSIT(APCLV,0),U,11)
QUIT
+13 ;just want outpatient
IF "AORHS"'[$PIECE(^AUPNVSIT(APCLV,0),U,7)
QUIT
+14 SET X=0
SET P=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCLV,X))
IF X'=+X!(P)
QUIT
Begin DoDot:3
+15 IF '$DATA(^AUPNVPRV(X,0))
QUIT
+16 SET Y=$PIECE(^AUPNVPRV(X,0),U)
+17 SET Z=$$VALI^XBDIQ1(200,Y,53.5)
+18 IF 'Z
QUIT
+19 IF $PIECE($GET(^DIC(7,Z,9999999)),U,1)=13
SET P=1
End DoDot:3
+20 IF P
GOTO P
+21 ;get clinic code
SET APCLCLIN=$$CLINIC^APCLV(APCLV,"I")
+22 IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="H"
IF APCLCLIN=""
QUIT
+23 ;not in clinic taxonomy
IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="H"
IF '$DATA(^ATXAX(APCLCTAX,21,"B",APCLCLIN))
QUIT
+24 ;no location ???
SET APCLLOC=$PIECE(^AUPNVSIT(APCLV,0),U,6)
IF APCLLOC=""
QUIT
+25 SET APCLDATE=$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),".")
P SET DFN=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+1 IF DFN=""
QUIT
+2 IF '$DATA(^DPT(DFN,0))
QUIT
+3 IF $PIECE(^DPT(DFN,0),U)["DEMO,PATIENT"
QUIT
+4 ;exclude demo patients
IF $$DEMO^APCLUTL(DFN,"E")
QUIT
+5 SET APCLASUF=$PIECE($GET(^AUTTLOC(APCLLOC,0)),U,10)
+6 ;no ASUFAC????
IF APCLASUF=""
QUIT
+7 ;total number of visits on this date/location
SET ^TMP($JOB,"APCLLOCT",APCLASUF,$$JDATE^APCLSILI(APCLDATE))=$GET(^TMP($JOB,"APCLLOCT",APCLASUF,$$JDATE^APCLSILI(APCLDATE)))+1
+8 SET G=0
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",APCLV,X))
IF X'=+X
QUIT
Begin DoDot:3
+10 SET T=$PIECE(^AUPNVPOV(X,0),U)
+11 IF $$ICD^APCLSILU(T,APCLTTAX,9)
SET G=1
+12 IF $$ICD^APCLSILU(T,APCLDTAX,9)
IF $$TMP100^APCLSILI(APCLV)
SET G=1
End DoDot:3
+13 ;no diagnosis
IF 'G
QUIT
+14 ;
+15 DO SET
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 KILL ^XTMP("APCLSILI",APCLJ,APCLH)
+19 QUIT
PRINT ;EP - called from xbdbque
+1 SET APCLPG=0
+2 DO HEADER
+3 WRITE !!,"Search Template Created: ",$PIECE(^DIBT(APCLSTMP,0),U)
+4 WRITE !!,"Total # of visits meeting criteria and placed in the template: ",APCLVTOT
+5 WRITE !!,"Total # of patients for these visits: ",APCLPTOT,!
+6 DO EOP
+7 QUIT
SET ;
+1 SET APCLVTOT=APCLVTOT+1
+2 SET ^DIBT(APCLSTMP,1,APCLV)=""
+3 IF $DATA(^XTMP("APCLSILI",APCLJ,APCLH,"PATS",DFN))
QUIT
+4 SET APCLPTOT=APCLPTOT+1
+5 SET ^XTMP("APCLSILI",APCLJ,APCLH,"PATS",DFN)=""
+6 QUIT
+1 IF 'APCLPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQ=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE $PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",APCLPG,!
+3 WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!
+4 WRITE !,$$CTR("SURVEILLANCE ILI VISIT SEARCH"),!
+5 WRITE !,$$CTR("DATE RANGE: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
+6 WRITE !,$$REPEAT^XLFSTR("-",79)
+7 QUIT
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 ;----------
STOPD ;EP
+1 WRITE !!,"This option is used to set a stop date for sending ILI surveillance"
+2 WRITE !,"visit data to IHS/CDC. Currently the stop date is preset for "
+3 WRITE !,"September 1, 2009."
+4 WRITE !!,"When the nightly export runs, it will check this date. If the stop "
+5 WRITE !,"date is less than the export date, no data will be exported."
+6 WRITE !!,"For example, if you want to have the export of data stop on "
+7 WRITE !,"August 1, 2009, then enter that date here. If you want to continue"
+8 WRITE !,"the export indefinitely, select a date in the future.",!
+9 SET DA=$ORDER(^APCLCNTL("B","ILI STOP DATE",0))
+10 IF 'DA
WRITE !!,"ILI CONTROL FILE ENTRY MISSING. NOTIFY PROGRAMMER."
KILL DA
QUIT
+11 SET DIE="^APCLCNTL("
SET DR=".03"
+12 DO ^DIE
+13 KILL DIE,DA
+14 WRITE !!
+15 DO PAUSE^APCLVL01
+16 QUIT
PURGE ;EP - CALLED TO PURGE
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Now cleaning up host files older than 7 DAYS"
+2 KILL APCLFILE,APCLDIR
+3 SET APCLDIR=$PIECE($GET(^AUTTSITE(1,1)),"^",2)
+4 IF APCLDIR=""
SET APCLDIR=$PIECE($GET(^XTV(8989.3,1,"DEV")),"^",1)
+5 IF APCLDIR=""
QUIT
+6 SET APCLASU=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0)),U,10)
+7 SET APCLDT=$$FMADD^XLFDT(DT,-7)
+8 SET APCLDT=$$DATE^APCLSILI(APCLDT)
+9 SET APCLFLST=$$LIST^%ZISH(APCLDIR,"FLU_"_APCLASU_"*",.APCLFILE)
+10 IF '$ORDER(APCLFILE(""))
QUIT
+11 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLFILE(APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+12 SET D=$PIECE($PIECE(APCLFILE(APCLX),"."),"_",3)
+13 IF D<APCLDT
SET N=APCLFILE(APCLX)
SET APCLM=$$DEL^%ZISH(APCLDIR,N)
End DoDot:1
PURGEPOP ;
+1 KILL APCLFILE
+2 SET APCLFLST=$$LIST^%ZISH(APCLDIR,"FLUPOP_"_APCLASU_"*",.APCLFILE)
+3 IF '$ORDER(APCLFILE(""))
QUIT
+4 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLFILE(APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+5 SET D=$PIECE($PIECE(APCLFILE(APCLX),"."),"_",3)
+6 IF D<APCLDT
SET N=APCLFILE(APCLX)
SET APCLM=$$DEL^%ZISH(APCLDIR,N)
End DoDot:1
+7 QUIT
