APCLSILM ;IHS/CMI/LAB - AGGREGATE ILI REPORT;
;;3.0;IHS PCC REPORTS;**24,26,27,28,29**;FEB 05, 1997;Build 35
;
START ;
W:$D(IOF) @IOF
W !,"********** LIST OF HL7 LAB EXPORTS TO THE EPI PROGRAM **********",!
D EN^XBVK("APCL")
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning date for export search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) D EOJ Q
S APCLBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending date for export search: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCLED=Y
ZIS ;
S XBRP="PRINT^APCLSILM",XBRC="PROC^APCLSILM",XBRX="EOJ^APCLSILM",XBNS="APCL"
D ^XBDBQUE
;
EOJ ;ENTRY POINT
D EN^XBVK("APCL")
Q
PROC ;EP - called from xbdbque
Q
PRINT ;
S APCLPG=0
D HEADER
S APCLSD=$$FMADD^XLFDT(APCLBD,-1)
F S APCLSD=$O(^APCLILIC(1,13,"B",APCLSD)) Q:APCLSD=""!($D(APCLQUIT))!(APCLSD>APCLED) D
.S APCLX=0 F S APCLX=$O(^APCLILIC(1,13,"B",APCLSD,APCLX)) Q:APCLX'=+APCLX!($D(APCLQUIT)) D
..I $Y>(IOSL-3) D HEADER Q:$D(APCLQUIT)
..W $$FMTE^XLFDT(APCLSD),?20,$P(^APCLILIC(1,13,APCLX,0),U,2),?61,$P(^APCLILIC(1,13,APCLX,0),U,4),?73,$S($P(^APCLILIC(1,13,APCLX,0),U,5):"YES",1:"NO"),!
D EOP
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 APCLQUIT="" Q
HEAD1 ;
I APCLPG W:$D(IOF) @IOF
S APCLPG=APCLPG+1
W ?3,$P(^DIC(4,DUZ(2),0),U),?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
W !,$$CTR("*** HL7 LAB Exports to the EPI Program***",80),!
S X="Dates: "_$$FMTE^XLFDT(APCLBD)_" through "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!!
W ?1,"DATE EXPORTED",?20,"FILENAME",?60,"# RECS",?68,"SUCCESSFULLY",!?68,"SENT?",!
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")
;----------
APCLSILM ;IHS/CMI/LAB - AGGREGATE ILI REPORT;
+1 ;;3.0;IHS PCC REPORTS;**24,26,27,28,29**;FEB 05, 1997;Build 35
+2 ;
START ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"********** LIST OF HL7 LAB EXPORTS TO THE EPI PROGRAM **********",!
+3 DO EN^XBVK("APCL")
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning date for export search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
DO EOJ
QUIT
+3 SET APCLBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCLBD_":DT:EP"
SET DIR("A")="Enter ending date for export search: "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCLED=Y
ZIS ;
+1 SET XBRP="PRINT^APCLSILM"
SET XBRC="PROC^APCLSILM"
SET XBRX="EOJ^APCLSILM"
SET XBNS="APCL"
+2 DO ^XBDBQUE
+3 ;
EOJ ;ENTRY POINT
+1 DO EN^XBVK("APCL")
+2 QUIT
PROC ;EP - called from xbdbque
+1 QUIT
PRINT ;
+1 SET APCLPG=0
+2 DO HEADER
+3 SET APCLSD=$$FMADD^XLFDT(APCLBD,-1)
+4 FOR
SET APCLSD=$ORDER(^APCLILIC(1,13,"B",APCLSD))
IF APCLSD=""!($DATA(APCLQUIT))!(APCLSD>APCLED)
QUIT
Begin DoDot:1
+5 SET APCLX=0
FOR
SET APCLX=$ORDER(^APCLILIC(1,13,"B",APCLSD,APCLX))
IF APCLX'=+APCLX!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+6 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(APCLQUIT)
QUIT
+7 WRITE $$FMTE^XLFDT(APCLSD),?20,$PIECE(^APCLILIC(1,13,APCLX,0),U,2),?61,$PIECE(^APCLILIC(1,13,APCLX,0),U,4),?73,$SELECT($PIECE(^APCLILIC(1,13,APCLX,0),U,5):"YES",1:"NO"),!
End DoDot:2
End DoDot:1
+8 DO EOP
+9 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 APCLQUIT=""
QUIT
HEAD1 ;
+1 IF APCLPG
IF $DATA(IOF)
WRITE @IOF
+2 SET APCLPG=APCLPG+1
+3 WRITE ?3,$PIECE(^DIC(4,DUZ(2),0),U),?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
+4 WRITE !,$$CTR("*** HL7 LAB Exports to the EPI Program***",80),!
+5 SET X="Dates: "_$$FMTE^XLFDT(APCLBD)_" through "_$$FMTE^XLFDT(APCLED)
WRITE $$CTR(X,80),!!
+6 WRITE ?1,"DATE EXPORTED",?20,"FILENAME",?60,"# RECS",?68,"SUCCESSFULLY",!?68,"SENT?",!
+7 WRITE $$REPEAT^XLFSTR("-",79),!
+8 QUIT
+9 ;
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 ;----------
