APCHAAP ; IHS/CMI/LAB - ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
EN ;
W:$D(IOF) @IOF
W !!,$$CTR("*** Print ASTHMA ACTION PLAN FORM ***"),!!
W "This option will produce an Asthma Action Plan form that",!,"can be given to the patient.",!!
PG ;
K APCHDFN
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 APCHDFN=+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 APCHOPT=Y
I Y="B" D BROWSE,EXIT Q
S XBRP="PRINT^APCHAAP",XBRC="",XBRX="EXIT^APCHAAP",XBNS="APCH"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCHAAP"")"
S XBRC="",XBRX="EXIT^APCHAAP",XBIOP=0 D ^XBDBQUE
Q
PRINT ;EP
S APCHAAP=$O(^APCHAF("B","ASTHMA ACTION PLAN",0))
S APCHPG=1 K APCHQ
W:$D(IOF) @IOF
W $$CTR("ASTHMA ACTION PLAN",80),!
W !,"NAME: "_$S($G(APCHDFN):$P(^DPT(APCHDFN,0),U),1:"____________________________________"),?55,"DATE: ",$$FMTE^XLFDT(DT),!
S APCHX=0 F S APCHX=$O(^APCHAF(APCHAAP,11,APCHX)) Q:APCHX'=+APCHX D
.I $Y>(IOSL-1) D HEADER Q:$D(APCHQ)
.W !,^APCHAF(APCHAAP,11,APCHX,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 APCHQ="" 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("APCH")
D ^XBFMK
Q
APCHAAP ; IHS/CMI/LAB - ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
EN ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CTR("*** 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 APCHDFN
+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 APCHDFN=+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 APCHOPT=Y
+4 IF Y="B"
DO BROWSE
DO EXIT
QUIT
+5 SET XBRP="PRINT^APCHAAP"
SET XBRC=""
SET XBRX="EXIT^APCHAAP"
SET XBNS="APCH"
+6 DO ^XBDBQUE
+7 DO EXIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCHAAP"")"
+2 SET XBRC=""
SET XBRX="EXIT^APCHAAP"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PRINT ;EP
+1 SET APCHAAP=$ORDER(^APCHAF("B","ASTHMA ACTION PLAN",0))
+2 SET APCHPG=1
KILL APCHQ
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE $$CTR("ASTHMA ACTION PLAN",80),!
+5 WRITE !,"NAME: "_$SELECT($GET(APCHDFN):$PIECE(^DPT(APCHDFN,0),U),1:"____________________________________"),?55,"DATE: ",$$FMTE^XLFDT(DT),!
+6 SET APCHX=0
FOR
SET APCHX=$ORDER(^APCHAF(APCHAAP,11,APCHX))
IF APCHX'=+APCHX
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-1)
DO HEADER
IF $DATA(APCHQ)
QUIT
+8 WRITE !,^APCHAF(APCHAAP,11,APCHX,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 APCHQ=""
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("APCH")
+2 DO ^XBFMK
+3 QUIT