BATAAP ; IHS/CMI/LAB - ;
;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
;
EN ;
W:$D(IOF) @IOF
W !!,$$CTR^BATU("*** Print ASTHMA ACTION PLAN FORM ***"),!!
W "This option will produce an Asthma Action Plan form that",!,"can be given to the patient.",!!
PG ;
K BATDFN
S DIR(0)="S^P:Print Patient's Name on Form;G:Generic Form",DIR("A")="Do you want to include the patient's name or print a generic form",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I Y'="P" G ZIS
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC
I Y=-1 D EXIT Q
S BATDFN=+Y
W !
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^BATAAP",XBRC="",XBRX="EXIT^BATAAP",XBNS="BAT"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BATAAP"")"
S XBRC="",XBRX="EXIT^BATAAP",XBIOP=0 D ^XBDBQUE
Q
PRINT ;EP
S BATAAP=$O(^BATAF("B","ASTHMA ACTION PLAN",0))
S BATPG=1 K BATQ
W:$D(IOF) @IOF
W $$CTR("ASTHMA ACTION PLAN",80),!
W !,"NAME: "_$S($G(BATDFN):$P(^DPT(BATDFN,0),U),1:"____________________________________"),?55,"DATE: ",$$FMTE^XLFDT(DT),!
S BATX=0 F S BATX=$O(^BATAF(BATAAP,11,BATX)) Q:BATX'=+BATX D
.I $Y>(IOSL-1) D HEADER Q:$D(BATQ)
.W !,^BATAF(BATAAP,11,BATX,0)
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
BATAAP ; 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 ACTION PLAN FORM ***"),!!
+3 WRITE "This option will produce an Asthma Action Plan form that",!,"can be given to the patient.",!!
PG ;
+1 KILL BATDFN
+2 SET DIR(0)="S^P:Print Patient's Name on Form;G:Generic Form"
SET DIR("A")="Do you want to include the patient's name or print a generic form"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 IF Y'="P"
GOTO ZIS
+5 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
+6 IF Y=-1
DO EXIT
QUIT
+7 SET BATDFN=+Y
+8 WRITE !
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^BATAAP"
SET XBRC=""
SET XBRX="EXIT^BATAAP"
SET XBNS="BAT"
+6 DO ^XBDBQUE
+7 DO EXIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BATAAP"")"
+2 SET XBRC=""
SET XBRX="EXIT^BATAAP"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PRINT ;EP
+1 SET BATAAP=$ORDER(^BATAF("B","ASTHMA ACTION PLAN",0))
+2 SET BATPG=1
KILL BATQ
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE $$CTR("ASTHMA ACTION PLAN",80),!
+5 WRITE !,"NAME: "_$SELECT($GET(BATDFN):$PIECE(^DPT(BATDFN,0),U),1:"____________________________________"),?55,"DATE: ",$$FMTE^XLFDT(DT),!
+6 SET BATX=0
FOR
SET BATX=$ORDER(^BATAF(BATAAP,11,BATX))
IF BATX'=+BATX
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-1)
DO HEADER
IF $DATA(BATQ)
QUIT
+8 WRITE !,^BATAF(BATAAP,11,BATX,0)
End DoDot:1
+9 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