- 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
