APCHAAP.m

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

HEADER ;

 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 

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