- 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 ;----------
