APCM13ET.m

APCM13ET ;IHS/CMI/LAB - IHS MU PATIENT LIST;

 ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11

 ;

 ;

 ;

 W:$D(IOF) @IOF

 D XIT

INTRO ;

 S APCMRPTT=1 ;CONTROL VARIABLE FOR EP REPORT

 S APCMRPTC=$O(^APCMMUCN("B","INTERIM STAGE 1 2013",0))

 W !,$$CTR("*** IHS 2013 Stage 1 Meaningful Use Patient List for EPs ***"),!

 ;S X=0 F  S X=$O(^APCMMUCN(APCMRPTC,11,X)) Q:X'=+X  W ^APCMMUCN(APCMRPTC,11,X,0),!

 W !,"This Patient List will display patient-specific data used to calculate the "

 W !,"results documented in the Meaningful Use Performance Report. One or more "

 W !,"lists may be selected.",!

 K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR,DUOUT,DIRUT

 ;NOTICE

 W !!!

 S X=0 F  S X=$O(^APCMMUCN(APCMRPTC,12,X)) Q:X'=+X  W ^APCMMUCN(APCMRPTC,12,X,0),!

 S DIR(0)="Y",DIR("A")="Do you wish to continue to report",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 I 'Y D XIT Q

 ;gather up measures for this report

 S DIR(0)="S^S:Selected set of MU Performance Measures;A:All MU Performance Measures",DIR("A")="Run the report on",DIR("B")="S" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 S APCMINDZ=Y

 I APCMINDZ="S" D EN^APCM13SI I '$D(APCMIND) W !!,"No measures selected" H 2 G INTRO

 I APCMINDZ="A" S X=0 F  S X=$O(^APCM13OB(X)) Q:X'=+X  I $P(^APCM13OB(X,0),U,2)="E" S APCMIND(X)=""

SI D LISTS

SI1 ;NOW SELECT ONE OR MORE W/IN THE TOPIC

 K APCMX,APCMY,APCMINDL S APCMQ=0

 D TERM^VALM0

 ;REORDER IN AOI FORMAT

 K APCMINDO

 S APCMIND=0 F  S APCMIND=$O(APCMLIST(APCMIND)) Q:APCMIND'=+APCMIND  S APCMINDO($P(^APCM13OB(APCMIND,0),U,4),APCMIND)=""

 S APCMORD=0 F  S APCMORD=$O(APCMINDO(APCMORD)) Q:APCMORD'=+APCMORD!(APCMQ)!($D(DIRUT))  D

 .S APCMIND=$O(APCMINDO(APCMORD,0))

 .S APCMCR="AEP"

 .K APCMX S APCMO=0,X=0,APCMC=0 F  S APCMO=$O(^APCMM13L(APCMCR,APCMIND,APCMO)) Q:APCMO'=+APCMO!($D(DIRUT))  D

 ..S X=$O(^APCMM13L(APCMCR,APCMIND,APCMO,0))

 ..S APCMX(APCMO,X)="",APCMC=APCMC+1

 .;display the choices

 .W !!!,"Please select one or more of these report choices within the",!,IORVON,$P(^APCM13OB(APCMIND,0),U,5),IORVOFF," objective.",!

 .K APCMY S X=0,APCMC=0,APCMO=0 F  S APCMO=$O(APCMX(APCMO)) Q:APCMO'=+APCMO!($D(DIRUT))  S X=0 F  S X=$O(APCMX(APCMO,X)) Q:X'=+X!($D(DIRUT))  S APCMC=APCMC+1 W !?5,APCMC,")",?9,$P(^APCMM13L(X,0),U,3) S APCMY(APCMC)=X

 .S DIR(0)="L^1:"_APCMC,DIR("A")="Which item(s)"

 .D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 .I Y="" W !,"No REPORTS selected for this objective." Q

 .I $D(DIRUT) W !,"No REPORTs selected for this objective." Q

 .S APCMANS=Y,APCMC="" F APCMI=1:1 S APCMC=$P(APCMANS,",",APCMI) Q:APCMC=""  S APCMINDL(APCMIND,APCMY(APCMC))=""

 ;get report type

 I $D(DIRUT) G SI

 K APCMQUIT ;D RT^APCM13SL I '$D(APCMLIST)!($D(APCMQUIT)) G SI

RT ;

 S APCMSUM=""

 W !!,"A full report will include an itemized listing of all performance measures"

 W !,"and will include a summary report.  The summary report excludes itemized"

 W !,"data.  The full report will produce approximately 40 pages of data for"

 W !,"each provider. Please take this into consideration when running print jobs,"

 W !,"ensuring dedicated time on your printer and sufficient paper supplies"

 W !,"to complete your job. "

 S DIR(0)="S^F:Full Report;S:Summary Report",DIR("A")="Enter Selection",DIR("B")="F" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 S APCMSUM=Y

TP ;

 S APCMRPTP=""

 W !!,""

 S DIR(0)="S^A:January 1 - December 31;B:User Defined 90-Day Report;C:User Defined Date Range",DIR("A")="Select Report Period" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G RT

 S APCMRPTP=Y

 D @APCMRPTP

 I APCMBD="" G TP

 I APCMED="" G TP

 S X=$O(^APCM13OB("B","S1.002.EP",0))

 S APCMQ=""

 I $D(APCMIND(X)),($P($G(^APCCCTRL(DUZ(2),"MU")),U,1)=""!($P($G(^APCCCTRL(DUZ(2),"MU")),U,1)'<APCMBD)) D  G:APCMQ XIT

 .S APCMQ=""

 .W !!,"You have chosen to run the Drug Interaction Checks Measure."

 .W !,"Warning: Your MU Clean Date for this measure is either blank"

 .W !,"or set to a date that is after the beginning date of the report"

 .W !,"period.  Therefore, you will not meet this measure."

 .S DIR(0)="Y",DIR("A")="Do you wish to continue to run this report",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S APCMQ=1 Q

 .I 'Y S APCMQ=1 Q

PP ;

 S APCMWPP=""

 I APCMRPTP="A" W !!,"Historical data from the previous calendar year can be included in this report."

 I APCMRPTP="B" W !!,"Historical data from the 90-days immediately preceding the currently",!,"selected report period can be included."

 W !,"IMPORTANT NOTICE: Including previous period data may significantly increase ",!,"run time.",!

 S DIR(0)="Y",DIR("A")="Do you wish to include the previous period",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G TP

 S APCMWPP=Y

PRV ;

 S APCMPLTY=""

 S DIR(0)="S^IP:Individual Provider;SEL:Selected Providers (User Defined);TAX:Provider Taxonomy List",DIR("A")="Enter Selection" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G TP

 S APCMPLTY=Y

 S APCMQUIT=""

 I APCMPLTY="IP" D  I $G(APCMQUIT) G PRV

 .K APCMPRV

 .W !!,"Enter the name of the provider for whom the Meaningful Use Patient List will be run.",!

 .S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER NAME: " D MIX^DIC1 K DIC,D

 .I Y<0 S APCMQUIT=1 Q

 .S APCMPRV(+Y)=""

 I APCMPLTY="SEL" D  I $G(APCMQUIT) G PRV

 .K APCMPRV

 .W !!,"Enter the name of the provider for whom the Meaningful Use Patient List will be run.",!

SEL1 .S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER NAME: " D MIX^DIC1 K DIC,D

 .I Y<0,'$D(APCMPRV) S APCMQUIT=1 Q

 .I Y<0 Q

 .S APCMPRV(+Y)=""

 .G SEL1

 I APCMPLTY="TAX" D  I $G(APCMQUIT) G PRV

 .W !!,"Enter the name of the provider taxonomy"

 .S DIC="^ATXAX(",DIC("S")="I $P(^(0),U,15)=200",DIC(0)="AEMQ",DIC("A")="Enter PROVIDER TAXONOMY NAME: " D ^DIC K DIC

 .I Y<0 S APCMQUIT=1 Q

 .S APCMPRTX=+Y

 .W !,"The following providers are members of this taxonomy: "

 .S X=0 F  S X=$O(^ATXAX(+Y,21,"B",X)) Q:X'=+X  S APCMPRV(X)="" W !?5,"- ",$P(^VA(200,X,0),U,1)

DEMO ;

 D DEMOCHK^APCLUTL(.APCMDEMO)

 I APCMDEMO=-1 G PRV

ASKADD ;

 ;ask additional questions

 K APCMADDQ

 S X=0 F  S X=$O(^APCM13OB(X)) Q:X'=+X  I $O(^APCM13OB(X,24,0)) S Y=0 F  S Y=$O(APCMPRV(Y)) Q:Y'=+Y  S APCMADDQ(X,Y)=""

 S APCMQ=0

 S APCMX="" F  S APCMX=$O(APCMADDQ(APCMX)) Q:APCMX'=+APCMX!(APCMQ)  D

 .Q:'$D(APCMIND(APCMX))  ;this measure not being run

 .;WRITE QUESTION

 .W !!!,"Please answer the following questions for each provider.",!!

 .S APCMY=APCMX  ;$O(^APCM13OB("B",APCMX,0))

 .S APCMZ=0 F  S APCMZ=$O(^APCM13OB(APCMY,24,APCMZ)) Q:APCMZ'=+APCMZ  W !,^APCM13OB(APCMY,24,APCMZ,0)

 .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ)  D

 ..S DIR(0)="Y",DIR("A")=$E($P(^VA(200,APCMP,0),U,1),1,25)_" 's answer",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 ..I $D(DIRUT) S APCMQ=1 Q

 ..S APCMADDQ("ANS",APCMX,24,APCMP)=$S(Y:"Yes",1:"No")

 .W ! S X=0 F  S X=$O(^APCM13OB(APCMY,25,X)) Q:X'=+X  W !,^APCM13OB(APCMY,25,X,0)

 .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ)  D

 ..S DIR(0)="Y",DIR("A")=$E($P(^VA(200,APCMP,0),U,1),1,25)_" 's answer",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 ..I $D(DIRUT) S APCMQ=1 Q

 ..S APCMADDQ("ANS",APCMX,25,APCMP)=$S(Y:"Yes",1:"No")

 I APCMQ G PRV

ATTEST ;get answers to attestation questions for each provider.

 K APCMATTE

 F X="S1.010.EP","S1.014.EP","S1.018.EP","S1.020.EP","S1.024.EP","S1.025.EP" S Y=0 F  S Y=$O(APCMPRV(Y)) Q:Y'=+Y  S APCMATTE(X,Y)=""

 W !!,"Several Stage 1 Meaningful Use Performance Measures require an attestation of "

 W !,"Yes or No for each provider for which the report is being run.",!

 S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G PRV

 I 'Y G PRV

 S APCMQ=0

 S APCMX="" F  S APCMX=$O(APCMATTE(APCMX)) Q:APCMX=""!(APCMQ)  D

 .;WRITE QUESTION

 .W !

 .S APCMY=$O(^APCM13OB("B",APCMX,0))

 .Q:'$D(APCMIND(APCMY))  ;this measure not being run

 .S X=0 F  S X=$O(^APCM13OB(APCMY,19,X)) Q:X'=+X  W !,^APCM13OB(APCMY,19,X,0)

 .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ)  D

 ..I '$P(^APCM13OB(APCMY,0),U,13) S DIR(0)="Y",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_" attest to this",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 ..I $P(^APCM13OB(APCMY,0),U,13) S DIR(0)="S^Y:YES;N:NO;X:No Registry Available",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_" attest to this",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 ..I $D(DIRUT) S APCMQ=1 Q

 ..S APCMATTE(APCMX,APCMP)=$S(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")

 I APCMQ G DEMO

SUM ;display summary of this report

 W:$D(IOF) @IOF

 W !,$$CTR("SUMMARY OF 2013 MEANINGFUL USE REPORT TO BE GENERATED")

 W !!,"The date ranges for this report are:"

 W !?5,"Report Period: ",?31,$$FMTE^XLFDT(APCMBD)," to ",?31,$$FMTE^XLFDT(APCMED)

 I $G(APCMWPP) W !?5,"Previous Period: ",?31,$$FMTE^XLFDT(APCMPBD)," to ",?31,$$FMTE^XLFDT(APCMPED)

 W !!,"Providers: "

 S X=0 F  S X=$O(APCMPRV(X)) Q:X'=+X  W !?5,$P(^VA(200,X,0),U,1)

 D PT^APCM13SL

 I APCMROT="" G DEMO

ZIS ;call to XBDBQUE

 D REPORT^APCM13SL

 I $G(APCMQUIT) D XIT Q

 I APCMRPT="" D XIT Q

 K IOP,%ZIS I APCMROT="D",APCMDELT="F" D NODEV,XIT Q

 K IOP,%ZIS W !! S %ZIS=$S(APCMDELT'="S":"PQM",1:"PM") D ^%ZIS

 I POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMM13C(" D ^DIK K DIK D XIT Q

 I POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMM13P(" D ^DIK K DIK D XIT Q

 I $D(IO("Q")) G TSKMN

DRIVER ;

 D PROC^APCM13E1

 U IO

 D ^APCM13EP

 D ^%ZISC

 D XIT

 Q

 ;

NODEV ;

 S XBRP="",XBRC="NODEV1^APCM13N",XBRX="XIT^APCM13N",XBNS="APCM"

 D ^XBDBQUE

 Q

 ;

NODEV1 ;

 D PROC^APCM13E1

 D ^APCM13EP

 D ^%ZISC

 D XIT

 Q

TSKMN ;EP ENTRY POINT FROM TASKMAN

 S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST

 I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))

 I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL

 K ZTSAVE S ZTSAVE("APCM*")=""

 S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCM13E",ZTDTH="",ZTDESC="2013 MU STAGE 1 REPORT" D ^%ZTLOAD D XIT Q

 Q

 ;

XIT ;

 L -^APCMM13C

 L -^APCMM13P

 D ^%ZISC

 D EN^XBVK("APCM")

 I $D(ZTQUEUED) S ZTREQ="@"

 K DIRUT,DUOUT,DIR,DOD

 K DIADD,DLAYGO

 D KILL^AUPNPAT

 K X,X1,X2,X3,X4,X5,X6

 K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 K N,N1,N2,N3,N4,N5,N6

 K BD,ED

 D KILL^AUPNPAT

 D ^XBFMK

 Q

 ;

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!$D(IO("S"))

 NEW DIR

 K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR KILL DIR

 Q

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return location name from file 4 based on DUZ(2).

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------

A ;fiscal year

 S (APCMPER,APCMVDT,APCMBD,APCMED)=""

 W !!,"Enter the Calendar Year for which report is to be run.  Use a 4 digit",!,"year, e.g. 2013."

 S DIR(0)="D^::EP"

 S DIR("A")="Enter Year"

 S DIR("?")="This report is compiled for a period.  Enter a valid year."

 D ^DIR KILL DIR

 I $D(DIRUT) Q

 I $D(DUOUT) S DIRUT=1 Q

 S APCMVDT=Y

 I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G A

 S APCMPER=APCMVDT

 S APCMBD=$E(APCMPER,1,3)_"0101",APCMED=$E(APCMPER,1,3)_"1231"

 S APCMPBD=($E(APCMPER,1,3)-1)_"0101",APCMPED=($E(APCMPER,1,3)-1)_"1231"

 Q

B ;

 W !!,"Enter the start date of the 90-day report period.",!

 S (APCMPER,APCMVDT,APCMBD,APCMED)=""

 W ! K DIR,X,Y S DIR(0)="D^::EP",DIR("A")="Enter Start Date for the 90-Day Report (e.g. 01/01/2013)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) Q

 S (APCMPER,APCMVDT)=Y

 S APCMBD=Y,APCMED=$$FMADD^XLFDT(APCMBD,89)

 S APCMPED=$$FMADD^XLFDT(APCMBD,-1),APCMPBD=$$FMADD^XLFDT(APCMPED,-89)

 Q

C ;

 D C^APCM13E

 Q

LISTS ;any lists with measures?

 K APCMLIST,APCMQUIT

 W !!,"PATIENT LISTS"

 I '$D(^XUSEC("APCMZ PATIENT LISTS",DUZ)) W !!,"You do not have the security access to print patient lists.",!,"Please see your supervisor or program manager if you feel you should have",!,"the APCMZ PATIENT LISTS security key.",! D  Q

 .K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR

 S DIR(0)="Y",DIR("A")="Do you want patient lists for any of the measures",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT)!(Y="") Q

 I Y=0 Q

 K APCMLIST

 D EN^APCM13SL

 I '$D(APCMLIST) W !!,"No lists selected.",!

 I $D(APCMLIST) S APCMLIST="A" ;I '$D(APCMLIST)!($D(APCMQUIT)) G LISTS ;get report type for each list

 Q

APCM13ET  ;IHS/CMI/LAB - IHS MU PATIENT LIST;

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11

 +2       ;

 +3       ;

 +4       ;

 +5        IF $DATA(IOF)

               WRITE @IOF

 +6        DO XIT

INTRO     ;

 +1       ;CONTROL VARIABLE FOR EP REPORT

           SET APCMRPTT=1

 +2        SET APCMRPTC=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2013",0))

 +3        WRITE !,$$CTR("*** IHS 2013 Stage 1 Meaningful Use Patient List for EPs ***"),!

 +4       ;S X=0 F  S X=$O(^APCMMUCN(APCMRPTC,11,X)) Q:X'=+X  W ^APCMMUCN(APCMRPTC,11,X,0),!

 +5        WRITE !,"This Patient List will display patient-specific data used to calculate the "

 +6        WRITE !,"results documented in the Meaningful Use Performance Report. One or more "

 +7        WRITE !,"lists may be selected.",!

 +8        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press Enter to Continue"

           DO ^DIR

           KILL DIR,DUOUT,DIRUT

 +9       ;NOTICE

 +10       WRITE !!!

 +11       SET X=0

           FOR 

               SET X=$ORDER(^APCMMUCN(APCMRPTC,12,X))

               IF X'=+X

                   QUIT 

               WRITE ^APCMMUCN(APCMRPTC,12,X,0),!

 +12       SET DIR(0)="Y"

           SET DIR("A")="Do you wish to continue to report"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +13       IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +14       IF 'Y

               DO XIT

               QUIT 

 +15      ;gather up measures for this report

 +16       SET DIR(0)="S^S:Selected set of MU Performance Measures;A:All MU Performance Measures"

           SET DIR("A")="Run the report on"

           SET DIR("B")="S"

           KILL DA

           DO ^DIR

           KILL DIR

 +17       IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +18       SET APCMINDZ=Y

 +19       IF APCMINDZ="S"

               DO EN^APCM13SI

               IF '$DATA(APCMIND)

                   WRITE !!,"No measures selected"

                   HANG 2

                   GOTO INTRO

 +20       IF APCMINDZ="A"

               SET X=0

               FOR 

                   SET X=$ORDER(^APCM13OB(X))

                   IF X'=+X

                       QUIT 

                   IF $PIECE(^APCM13OB(X,0),U,2)="E"

                       SET APCMIND(X)=""

SI         DO LISTS

SI1       ;NOW SELECT ONE OR MORE W/IN THE TOPIC

 +1        KILL APCMX,APCMY,APCMINDL

           SET APCMQ=0

 +2        DO TERM^VALM0

 +3       ;REORDER IN AOI FORMAT

 +4        KILL APCMINDO

 +5        SET APCMIND=0

           FOR 

               SET APCMIND=$ORDER(APCMLIST(APCMIND))

               IF APCMIND'=+APCMIND

                   QUIT 

               SET APCMINDO($PIECE(^APCM13OB(APCMIND,0),U,4),APCMIND)=""

 +6        SET APCMORD=0

           FOR 

               SET APCMORD=$ORDER(APCMINDO(APCMORD))

               IF APCMORD'=+APCMORD!(APCMQ)!($DATA(DIRUT))

                   QUIT 

               Begin DoDot:1

 +7                SET APCMIND=$ORDER(APCMINDO(APCMORD,0))

 +8                SET APCMCR="AEP"

 +9                KILL APCMX

                   SET APCMO=0

                   SET X=0

                   SET APCMC=0

                   FOR 

                       SET APCMO=$ORDER(^APCMM13L(APCMCR,APCMIND,APCMO))

                       IF APCMO'=+APCMO!($DATA(DIRUT))

                           QUIT 

                       Begin DoDot:2

 +10                       SET X=$ORDER(^APCMM13L(APCMCR,APCMIND,APCMO,0))

 +11                       SET APCMX(APCMO,X)=""

                           SET APCMC=APCMC+1

                       End DoDot:2

 +12      ;display the choices

 +13               WRITE !!!,"Please select one or more of these report choices within the",!,IORVON,$PIECE(^APCM13OB(APCMIND,0),U,5),IORVOFF," objective.",!

 +14               KILL APCMY

                   SET X=0

                   SET APCMC=0

                   SET APCMO=0

                   FOR 

                       SET APCMO=$ORDER(APCMX(APCMO))

                       IF APCMO'=+APCMO!($DATA(DIRUT))

                           QUIT 

                       SET X=0

                       FOR 

                           SET X=$ORDER(APCMX(APCMO,X))

                           IF X'=+X!($DATA(DIRUT))

                               QUIT 

                           SET APCMC=APCMC+1

                           WRITE !?5,APCMC,")",?9,$PIECE(^APCMM13L(X,0),U,3)

                           SET APCMY(APCMC)=X

 +15               SET DIR(0)="L^1:"_APCMC

                   SET DIR("A")="Which item(s)"

 +16               DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +17               IF Y=""

                       WRITE !,"No REPORTS selected for this objective."

                       QUIT 

 +18               IF $DATA(DIRUT)

                       WRITE !,"No REPORTs selected for this objective."

                       QUIT 

 +19               SET APCMANS=Y

                   SET APCMC=""

                   FOR APCMI=1:1

                       SET APCMC=$PIECE(APCMANS,",",APCMI)

                       IF APCMC=""

                           QUIT 

                       SET APCMINDL(APCMIND,APCMY(APCMC))=""

               End DoDot:1

 +20      ;get report type

 +21       IF $DATA(DIRUT)

               GOTO SI

 +22      ;D RT^APCM13SL I '$D(APCMLIST)!($D(APCMQUIT)) G SI

           KILL APCMQUIT

RT        ;

 +1        SET APCMSUM=""

 +2        WRITE !!,"A full report will include an itemized listing of all performance measures"

 +3        WRITE !,"and will include a summary report.  The summary report excludes itemized"

 +4        WRITE !,"data.  The full report will produce approximately 40 pages of data for"

 +5        WRITE !,"each provider. Please take this into consideration when running print jobs,"

 +6        WRITE !,"ensuring dedicated time on your printer and sufficient paper supplies"

 +7        WRITE !,"to complete your job. "

 +8        SET DIR(0)="S^F:Full Report;S:Summary Report"

           SET DIR("A")="Enter Selection"

           SET DIR("B")="F"

           KILL DA

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +10       SET APCMSUM=Y

TP        ;

 +1        SET APCMRPTP=""

 +2        WRITE !!,""

 +3        SET DIR(0)="S^A:January 1 - December 31;B:User Defined 90-Day Report;C:User Defined Date Range"

           SET DIR("A")="Select Report Period"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO RT

 +5        SET APCMRPTP=Y

 +6        DO @APCMRPTP

 +7        IF APCMBD=""

               GOTO TP

 +8        IF APCMED=""

               GOTO TP

 +9        SET X=$ORDER(^APCM13OB("B","S1.002.EP",0))

 +10       SET APCMQ=""

 +11       IF $DATA(APCMIND(X))

               IF ($PIECE($GET(^APCCCTRL(DUZ(2),"MU")),U,1)=""!($PIECE($GET(^APCCCTRL(DUZ(2),"MU")),U,1)'<APCMBD))

                   Begin DoDot:1

 +12                   SET APCMQ=""

 +13                   WRITE !!,"You have chosen to run the Drug Interaction Checks Measure."

 +14                   WRITE !,"Warning: Your MU Clean Date for this measure is either blank"

 +15                   WRITE !,"or set to a date that is after the beginning date of the report"

 +16                   WRITE !,"period.  Therefore, you will not meet this measure."

 +17                   SET DIR(0)="Y"

                       SET DIR("A")="Do you wish to continue to run this report"

                       SET DIR("B")="Y"

                       KILL DA

                       DO ^DIR

                       KILL DIR

 +18                   IF $DATA(DIRUT)

                           SET APCMQ=1

                           QUIT 

 +19                   IF 'Y

                           SET APCMQ=1

                           QUIT 

                   End DoDot:1

                   IF APCMQ

                       GOTO XIT

PP        ;

 +1        SET APCMWPP=""

 +2        IF APCMRPTP="A"

               WRITE !!,"Historical data from the previous calendar year can be included in this report."

 +3        IF APCMRPTP="B"

               WRITE !!,"Historical data from the 90-days immediately preceding the currently",!,"selected report period can be included."

 +4        WRITE !,"IMPORTANT NOTICE: Including previous period data may significantly increase ",!,"run time.",!

 +5        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to include the previous period"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               GOTO TP

 +7        SET APCMWPP=Y

PRV       ;

 +1        SET APCMPLTY=""

 +2        SET DIR(0)="S^IP:Individual Provider;SEL:Selected Providers (User Defined);TAX:Provider Taxonomy List"

           SET DIR("A")="Enter Selection"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO TP

 +4        SET APCMPLTY=Y

 +5        SET APCMQUIT=""

 +6        IF APCMPLTY="IP"

               Begin DoDot:1

 +7                KILL APCMPRV

 +8                WRITE !!,"Enter the name of the provider for whom the Meaningful Use Patient List will be run.",!

 +9                SET DIC="^VA(200,"

                   SET DIC(0)="AEMQ"

                   SET D="AK.PROVIDER"

                   SET DIC("A")="Enter PROVIDER NAME: "

                   DO MIX^DIC1

                   KILL DIC,D

 +10               IF Y<0

                       SET APCMQUIT=1

                       QUIT 

 +11               SET APCMPRV(+Y)=""

               End DoDot:1

               IF $GET(APCMQUIT)

                   GOTO PRV

 +12       IF APCMPLTY="SEL"

               Begin DoDot:1

 +13               KILL APCMPRV

 +14               WRITE !!,"Enter the name of the provider for whom the Meaningful Use Patient List will be run.",!

SEL1               SET DIC="^VA(200,"

                   SET DIC(0)="AEMQ"

                   SET D="AK.PROVIDER"

                   SET DIC("A")="Enter PROVIDER NAME: "

                   DO MIX^DIC1

                   KILL DIC,D

 +1                IF Y<0

                       IF '$DATA(APCMPRV)

                           SET APCMQUIT=1

                           QUIT 

 +2                IF Y<0

                       QUIT 

 +3                SET APCMPRV(+Y)=""

 +4                GOTO SEL1

               End DoDot:1

               IF $GET(APCMQUIT)

                   GOTO PRV

 +5        IF APCMPLTY="TAX"

               Begin DoDot:1

 +6                WRITE !!,"Enter the name of the provider taxonomy"

 +7                SET DIC="^ATXAX("

                   SET DIC("S")="I $P(^(0),U,15)=200"

                   SET DIC(0)="AEMQ"

                   SET DIC("A")="Enter PROVIDER TAXONOMY NAME: "

                   DO ^DIC

                   KILL DIC

 +8                IF Y<0

                       SET APCMQUIT=1

                       QUIT 

 +9                SET APCMPRTX=+Y

 +10               WRITE !,"The following providers are members of this taxonomy: "

 +11               SET X=0

                   FOR 

                       SET X=$ORDER(^ATXAX(+Y,21,"B",X))

                       IF X'=+X

                           QUIT 

                       SET APCMPRV(X)=""

                       WRITE !?5,"- ",$PIECE(^VA(200,X,0),U,1)

               End DoDot:1

               IF $GET(APCMQUIT)

                   GOTO PRV

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCMDEMO)

 +2        IF APCMDEMO=-1

               GOTO PRV

ASKADD    ;

 +1       ;ask additional questions

 +2        KILL APCMADDQ

 +3        SET X=0

           FOR 

               SET X=$ORDER(^APCM13OB(X))

               IF X'=+X

                   QUIT 

               IF $ORDER(^APCM13OB(X,24,0))

                   SET Y=0

                   FOR 

                       SET Y=$ORDER(APCMPRV(Y))

                       IF Y'=+Y

                           QUIT 

                       SET APCMADDQ(X,Y)=""

 +4        SET APCMQ=0

 +5        SET APCMX=""

           FOR 

               SET APCMX=$ORDER(APCMADDQ(APCMX))

               IF APCMX'=+APCMX!(APCMQ)

                   QUIT 

               Begin DoDot:1

 +6       ;this measure not being run

                   IF '$DATA(APCMIND(APCMX))

                       QUIT 

 +7       ;WRITE QUESTION

 +8                WRITE !!!,"Please answer the following questions for each provider.",!!

 +9       ;$O(^APCM13OB("B",APCMX,0))

                   SET APCMY=APCMX

 +10               SET APCMZ=0

                   FOR 

                       SET APCMZ=$ORDER(^APCM13OB(APCMY,24,APCMZ))

                       IF APCMZ'=+APCMZ

                           QUIT 

                       WRITE !,^APCM13OB(APCMY,24,APCMZ,0)

 +11               SET APCMP=0

                   FOR 

                       SET APCMP=$ORDER(APCMPRV(APCMP))

                       IF APCMP'=+APCMP!(APCMQ)

                           QUIT 

                       Begin DoDot:2

 +12                       SET DIR(0)="Y"

                           SET DIR("A")=$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_" 's answer"

                           SET DIR("B")="Y"

                           KILL DA

                           DO ^DIR

                           KILL DIR

 +13                       IF $DATA(DIRUT)

                               SET APCMQ=1

                               QUIT 

 +14                       SET APCMADDQ("ANS",APCMX,24,APCMP)=$SELECT(Y:"Yes",1:"No")