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
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BATLRP"")"
S XBRC="",XBRX="EXIT^BATLRP",XBIOP=0 D ^XBDBQUE
Q
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")
Q
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
Q
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
Q
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
+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
