Routine: BATLRP

BATLRP ; IHS/CMI/LAB - ;

 ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003

EN ;

 W:$D(IOF) @IOF

 W !!,$$CTR^BATU("*** Print ASTHMA REMINDER LETTER for Patient's on the Asthma Register ***"),!!

 W "This option will produce an Asthma Visit Reminder Letter for patients on the ",!,"asthma register.",!!

 W !!,"You will be presented with a list of all patients on the register with an",!,"active or unreviewed status whose last asthma visit (visit on which",!,"asthma data elements were entered) was over 6 months ago.",!

 W !,"You can then choose to print a letter for all of these patients or choose",!,"selected patients for whom a letter should be printed.",!!

 S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D EXIT Q

 I 'Y D EXIT Q

GATHER ;gather up and display in list man

 K BATPATS

 D EN^BATLRP1

 I '$D(BATPATS) W !!,"No patients selected." H 2 D EXIT Q

ZIS ;

 W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) D EXIT Q

 S BATOPT=Y

 I Y="B" D BROWSE,EXIT Q

 S XBRP="PRINT^BATLRP",XBRC="",XBRX="EXIT^BATLRP",XBNS="BAT"

 D ^XBDBQUE

 D EXIT

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^BATLRP"")"

 S XBRC="",XBRX="EXIT^BATLRP",XBIOP=0 D ^XBDBQUE

PRINT ;EP

 S BATAL=$O(^BATAL("B","ASTHMA VISIT REMINDER",0))

 S BATPG=1 K BATQ

 S BATCNT=0 F  S BATCNT=$O(BATPATS(BATCNT)) Q:BATCNT'=+BATCNT  D

 .S BATDFN=BATPATS(BATCNT)

 .K ^TMP($J,"ASTHMA LETTER")

 .D SET^BATLOP(BATDFN)

 .W:$D(IOF) @IOF

 .S BATX=0 F  S BATX=$O(^TMP($J,"ASTHMA LETTER",BATX)) Q:BATX'=+BATX!($D(BATQ))  D

 ..I $Y>(IOSL-3) D HEADER Q:$D(BATQ)

 ..W !,^TMP($J,"ASTHMA LETTER",BATX)

 K ^TMP($J,"ASTHMA LETTER")

HEADER ;

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BATQ="" Q

HEAD1 ;

 W:$D(IOF) @IOF

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EXIT ;

 D EN^XBVK("BAT")

 D ^XBFMK

BATLRP    ; IHS/CMI/LAB - ;

 +1       ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003

 +2       ;

EN        ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,$$CTR^BATU("*** Print ASTHMA REMINDER LETTER for Patient's on the Asthma Register ***"),!!

 +3        WRITE "This option will produce an Asthma Visit Reminder Letter for patients on the ",!,"asthma register.",!!

 +4        WRITE !!,"You will be presented with a list of all patients on the register with an",!,"active or unreviewed status whose last asthma visit (visit on which",!,"asthma data elements were entered) was over 6 months ago.",!

 +5        WRITE !,"You can then choose to print a letter for all of these patients or choose",!,"selected patients for whom a letter should be printed.",!!

 +6        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               DO EXIT

               QUIT

 +8        IF 'Y

               DO EXIT

               QUIT

GATHER    ;gather up and display in list man

 +1        KILL BATPATS

 +2        DO EN^BATLRP1

 +3        IF '$DATA(BATPATS)

               WRITE !!,"No patients selected."

               HANG 2

               DO EXIT

               QUIT

ZIS       ;

 +1        WRITE !

           SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               DO EXIT

               QUIT

 +3        SET BATOPT=Y

 +4        IF Y="B"

               DO BROWSE

               DO EXIT

               QUIT

 +5        SET XBRP="PRINT^BATLRP"

           SET XBRC=""

           SET XBRX="EXIT^BATLRP"

           SET XBNS="BAT"

 +6        DO ^XBDBQUE

 +7        DO EXIT

 +8        QUIT

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""PRINT^BATLRP"")"

 +2        SET XBRC=""

           SET XBRX="EXIT^BATLRP"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

PRINT     ;EP

 +1        SET BATAL=$ORDER(^BATAL("B","ASTHMA VISIT REMINDER",0))

 +2        SET BATPG=1

           KILL BATQ

 +3        SET BATCNT=0

FOR

               SET BATCNT=$ORDER(BATPATS(BATCNT))

               IF BATCNT'=+BATCNT

                   QUIT

               Begin DoDot:1

 +4                SET BATDFN=BATPATS(BATCNT)

 +5                KILL ^TMP($JOB,"ASTHMA LETTER")

 +6                DO SET^BATLOP(BATDFN)

 +7                IF $DATA(IOF)

                       WRITE @IOF

 +8                SET BATX=0

FOR

                       SET BATX=$ORDER(^TMP($JOB,"ASTHMA LETTER",BATX))

                       IF BATX'=+BATX!($DATA(BATQ))

                           QUIT

                       Begin DoDot:2

 +9                        IF $Y>(IOSL-3)

                               DO HEADER

                               IF $DATA(BATQ)

                                   QUIT

 +10                       WRITE !,^TMP($JOB,"ASTHMA LETTER",BATX)

                       End DoDot:2

               End DoDot:1

 +11       KILL ^TMP($JOB,"ASTHMA LETTER")

 +12       QUIT

HEADER    ;

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET BATQ=""

                       QUIT

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

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

EXIT      ;

 +1        DO EN^XBVK("BAT")

 +2        DO ^XBFMK

 +3        QUIT

BATLRP.m