- APCM2AE ; IHS/CMI/LAB - IHS MU ; 07 Oct 2015 1:21 PM
- ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
- ;
- ;
- W:$D(IOF) @IOF
- EP D XIT
- INTRO ;
- S APCMRPTT=1
- W !!!
- W $$CTR("***IHS Modified Stage 2 MU Performance Reports for EPS***",80),!
- W $$CTR("Alternate Stage 1 Exclusions",80),!
- W !,"This report displays the performance measure results for Modified",!
- W "Stage 2 Meaningful Use with alternate Stage 1 exclusions/thresholds.",!
- W !,"In order to achieve Meaningful Use, an EP must attest to meeting",!
- W "all 10 objectives and their associated performance measures.",!
- W !,"The report can be run for 90 days, 1 year or a user defined time period.",!
- S DIR(0)="Y",DIR("A")="Do you wish to continue to report",DIR("B")="YES" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) D XIT Q
- I 'Y D XIT Q
- ;
- W !! S X=0 F S X=$O(^APCM25OB(X)) Q:X'=+X I $P(^APCM25OB(X,0),U,2)="E" S APCMIND(X)=""
- RT ;
- S APCMSUM="S"
- TP ;
- S APCMRPTP=""
- W !
- MUYEAR ;
- K DIR S DIR(0)="D^::EP"
- W !,"Enter the Calendar Year for which the EP is demonstrating Meaningful"
- S DIR("A")="Use. Use a 4 digit year, e.g. 2015"
- S DIR("?")="Enter a valid year."
- D ^DIR KILL DIR
- I $D(DIRUT) G EP
- I $D(DUOUT) G EP
- S APCMVDT=Y
- I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G MUYEAR
- I $E(Y,1,3)'=315,$E(Y,1,3)'=316 W !!,"Calendar year must equal 2015 or 2016.",! G MUYEAR
- S APCMPER=APCMVDT
- S APCMLD=$E(APCMPER,1,3)_"0101",APCMHD=$E(APCMPER,1,3)_"1231"
- ;
- YEAR ;
- S (APCMVDT,APCMBD,APCMED)=""
- S APCMQ=0
- D G:APCMQ INTRO
- .W !!,"Select one of the following:",!
- .W !?10,"1 User Defined 90-Day Report"
- .W !?10,"2 Calendar Year"
- .W !?10,"3 User Defined Date Range"
- .W ! S DIR(0)="N^1:3:",DIR("A")="Select Report Period" KILL DA D ^DIR KILL DIR
- .I $D(DIRUT) S APCMQ=1 Q
- .S APCMRPTP=Y
- .I APCMRPTP=1 D 5 Q
- .I APCMRPTP=2 S APCMBD=APCMLD,APCMED=APCMHD W !!,"Date range is: ",$$FMTE^XLFDT(APCMBD)," - ",$$FMTE^XLFDT(APCMED),"." Q
- .I APCMRPTP=3 D 6 Q
- I APCMBD="" G TP
- I APCMED="" G TP
- ;
- 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 Report 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 Report 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 ;
- K APCMADDQ
- ;
- ATTEST ;get answers to attestation
- D ATTESTQ
- I APCMQ G PRV
- SUM ;display summary
- W:$D(IOF) @IOF
- W !,$$CTR("SUMMARY OF MODIFIED STAGE 2 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)
- 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^APCM2ASL
- I APCMROT="" G DEMO
- ZIS ;call to XBDBQUE
- D REPORT^APCM2ASL
- 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="^APCMM25C(" D ^DIK K DIK D XIT Q
- I $D(IO("Q")) G TSKMN
- DRIVER ;
- D PROC^APCM2AE1
- U IO
- D ^APCM2AEP
- D ^%ZISC
- D XIT
- Q
- ;
- NODEV ;
- S XBRP="",XBRC="NODEV1^APCM2AE",XBRX="XIT^APCM2AE",XBNS="APCM"
- D ^XBDBQUE
- Q
- ;
- NODEV1 ;
- D PROC^APCM2AE1
- D ^APCM2AEP
- 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^APCM2AE",ZTDTH="",ZTDESC="MODIFIED STAGE 2 REPORT" D ^%ZTLOAD D XIT Q
- Q
- ;
- XIT ;
- 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
- 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 USER
- 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")
- ;----------
- 6 ;EP
- C ;EP
- S (APCMVDT,APCMBD,APCMED)=""
- K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"
- D ^DIR I $D(DIRUT) S APCMQ=1 Q
- I Y<0 S APCMQ=1 Q
- I Y>DT W !!,"Future dates not allowed." G C
- I Y<APCMLD W !!,"The beginning date must be within calendar year entered." G C
- I Y>APCMHD W !!,"The beginning date must be within calendar year entered." G C
- S APCMBD=Y
- K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date"
- D ^DIR G:Y<1 C
- I Y>APCMHD W !!,"The ending date must be within calendar year entered." G C
- S APCMED=Y
- ;
- I APCMED<APCMBD D G C
- . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
- Q
- 5 ;EP - TEXT
- ;W !!,"Enter the start date of the 90-day report period.",!
- S (APCMVDT,APCMBD,APCMED)=""
- W ! K DIR,X,Y
- S DIR(0)="D^::E"
- S DIR("A")="Enter Start Date for the 90-Day Report (e.g. 01/01/2015)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) S APCMQ=1 Q
- I Y<APCMLD W !!,"The 90 day start and end dates must be within the calendar year entered." G 5
- I $$FMADD^XLFDT(Y,89)>APCMHD W !!,"The end date would be ",$$FMTE^XLFDT($$FMADD^XLFDT(Y,89)),".",!,"The 90 day start and end dates must be within the calendar year entered." G 5
- S APCMBD=Y,APCMED=$$FMADD^XLFDT(APCMBD,89)
- Q
- ;
- CXIT ;
- K DIR
- Q
- EPRES ;EP - ask additional exclusion questions for e-prescribing
- S APCMQ=0
- S APCMY=$O(^APCM25OB("B","S2.003.EP",0))
- ;Q:'$D(APCMIND(APCMY)) ;measure not being run
- K APCMADDQ("ANS",APCMY)
- ;display exclusion text/narrative
- I $O(^APCM25OB(APCMY,26,0)) D ET
- I APCMPLTY="SEL"!(APCMPLTY="TAX") D G:APCMIND=1 EIND Q
- .S APCMQ=0,APCMIND=0
- .W !,"The e-Prescribing onsite pharmacy question below may be addressed as a group or"
- .W !,"by individual provider. Do you want to answer for all selected providers as a"
- .S DIR(0)="Y",DIR("A")="group Y/N",DIR("B")="YES" KILL DA D ^DIR KILL DIR
- .I $D(DIRUT) S APCMQ=1 Q
- .I 'Y S APCMIND=1 Q
- .W !!,"Do all selected providers included in this report have an onsite"
- .S DIR(0)="Y",DIR("A")="pharmacy Y/N",DIR("B")="YES" KILL DA D ^DIR KILL DIR
- .I $D(DIRUT) S APCMQ=1 Q
- .I 'Y S APCMIND=1 Q
- .S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP S APCMADDQ("ANS",APCMY,24,APCMP)="Yes"
- EIND ;ask individually
- S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ) D
- .S APCMZ=0 F S APCMZ=$O(^APCM25OB(APCMY,24,APCMZ)) Q:APCMZ'=+APCMZ W !,^APCM25OB(APCMY,24,APCMZ,0)
- .W ! S DIR(0)="Y",DIR("A")=$E($P(^VA(200,APCMP,0),U,1),1,25)_"'s answer",DIR("B")="YES" KILL DA D ^DIR KILL DIR
- .I $D(DIRUT) S APCMQ=1 Q
- .S APCMADDQ("ANS",APCMY,24,APCMP)=$S(Y:"Yes",1:"No")
- .Q:Y
- .W ! S X=0 F S X=$O(^APCM25OB(APCMY,25,X)) Q:X'=+X W !,^APCM25OB(APCMY,25,X,0)
- .;
- .W ! S DIR(0)="Y",DIR("A")=$E($P(^VA(200,APCMP,0),U,1),1,25)_"'s answer",DIR("B")="YES" KILL DA D ^DIR KILL DIR
- .I $D(DIRUT) S APCMQ=1 Q
- .S APCMADDQ("ANS",APCMY,25,APCMP)=$S(Y:"Yes",1:"No")
- Q
- ET ;
- W ! S APCMZ=0 F S APCMZ=$O(^APCM25OB(APCMY,26,APCMZ)) Q:APCMZ'=+APCMZ W !,^APCM25OB(APCMY,26,APCMZ,0)
- W !
- Q
- ATTESTQ ;EP
- K APCMATTE
- S APCMQ=0
- S Z=0 F S Z=$O(^APCM25OB("ALTA",Z)) Q:Z'=+Z S A=0 F S A=$O(^APCM25OB("ALTA",Z,A)) Q:A'=+A I $D(APCMIND(A)) S X=$P(^APCM25OB(A,0),U,1) D
- .S Y=0 F S Y=$O(APCMPRV(Y)) Q:Y'=+Y S APCMATTE(X,Y)="",APCMORA(Z,X)=""
- I '$D(APCMATTE) Q ;no measures with attestation being run
- S APCMQ=0
- I APCMPLTY="SEL"!(APCMPLTY="TAX") D
- .W !!,"Each of the questions below may be addressed as a group or individual",!,"attestation.",!
- ;PROTECT
- I $D(APCMATTE("S2.014.EP")) D
- .S APCMQU=19,APCMAP=1,APCMX="S2.014.EP" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.010.EP.1")) D
- .S APCMQU=$S($E(APCMPER,1,3)=315:32,$E(APCMPER,1,3)=316:33,1:19),APCMAP=1,APCMX="S2.010.EP.1" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.010.EP.2")) D
- .S APCMQU=19,APCMAP=1,APCMX="S2.010.EP.2" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.001.1EP")) D
- .W !!,"CPOE Exclusions:"
- .W !,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- .W !,"reporting period in 2015 or 2016, the provider may claim the "
- .W !,"exclusions below."
- .S APCMQU=32,APCMAP=1,APCMX="S2.001.1EP" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.001.2EP")) D
- .I '$D(APCMATTE("S2.001.1EP")) D
- ..W !,"CPOE Exclusions:"
- ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- ..W !,"reporting period in 2015 or 2016, the provider may claim the "
- ..W !,"exclusions below."
- .S APCMQU=32,APCMAP=1,APCMX="S2.001.2EP" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.003.EP")) D
- .S APCMQU=32,APCMAP=1,APCMX="S2.003.EP" D EPRES
- Q:APCMQ
- I $D(APCMATTE("S2.023.EP")) D
- .I $E(APCMPER,1,3)=315 D
- ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- ..W !,"reporting period in 2015, the provider may claim one or more of the"
- ..W !,"alternate exclusions below."
- ..S APCMQU=32,APCMAP=2,APCMX="S2.023.EP" D ASK
- .;S APCMQU=19,APCMAP=1,APCMX="S2.023.EP" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.021.EP")),$E(APCMPER,1,3)=315 D
- .I '$D(APCMATTE("S2.023.EP")) D
- ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- ..W !,"reporting period in 2015, the provider may claim one or more of the"
- ..W !,"alternate exclusions below."
- .S APCMQU=32,APCMAP=1,APCMX="S2.021.EP" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.022.EP")),$E(APCMPER,1,3)=315 D
- .I '$D(APCMATTE("S2.021.EP")) D
- ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- ..W !,"reporting period in 2015, the provider may claim one or more of the"
- ..W !,"alternate exclusions below."
- .S APCMQU=32,APCMAP=1,APCMX="S2.022.EP" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.020.EP")) D
- .I $E(APCMPER,1,3)=315 D
- ..I '$D(APCMATTE("S2.022.EP")) D
- ...W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- ...W !,"reporting period in 2015, the provider may claim one or more of the"
- ...W !,"alternate exclusions below."
- ..S APCMQU=32,APCMAP=2,APCMX="S2.020.EP.1" D ASK
- .Q:APCMQ
- .;S APCMQU=19,APCMAP=1,APCMX="S2.020.EP.1" D ASK
- Q:APCMQ
- I $D(APCMATTE("S2.026.EP")),$E(APCMPER,1,3)=315 D
- .I '$D(APCMATTE("S2.020.EP")) D
- ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- ..W !,"reporting period in 2015, the provider may claim one or more of the"
- ..W !,"alternate exclusions below."
- .S APCMQU=32,APCMAP=3,APCMX="S2.026.EP" D ASK
- .;Q:$D(APCMATTE("S2.020.EP.1")) ;ALREADY ASKED
- Q:APCMQ
- I $D(APCMATTE("S2.026.EP"))!($D(APCMATTE("S2.020.EP.1"))) D
- .S APCMQU=19,APCMAP=1,APCMX="S2.026.EP" D ASK
- .I $E(APCMPER,1,3)=315 S APCMQU=31,APCMAP=2,APCMX="S2.026.EP" D ASK
- S APCMQU=19
- I $D(APCMATTE("S2.024.EP")) S APCMX="S2.024.EP",APCMQU=32 D IMMREG
- Q:APCMQ
- S APCMQU=19
- I $D(APCMATTE("S2.025.EP")) S APCMX="S2.025.EP" D IMMREG
- Q:APCMQ
- S APCMQU=19
- I $D(APCMATTE("S2.030.EP")) S APCMX="S2.030.EP" D IMMREG
- Q
- ASK ;
- D
- .S APCMY=$O(^APCM25OB("B",APCMX,0))
- .Q:'$O(^APCM25OB(APCMY,APCMQU,0))
- .W !
- .I APCMX="S2.020.EP.1",APCMAP=1 S Y=$O(^APCM25OB("B","S2.026.EP",0)) Q:$D(APCMIND(Y))
- .S X=0 F S X=$O(^APCM25OB(APCMY,APCMQU,X)) Q:X'=+X W !,^APCM25OB(APCMY,APCMQU,X,0)
- .I APCMPLTY="SEL"!(APCMPLTY="TAX") D G:APCMIND ATTIND Q
- ..S APCMIND=0
- ..I '$P(^APCM25OB(APCMY,0),U,13) D
- ...W ! S DIR(0)="Y",DIR("A")="Do all selected providers included in this report"_$$T(APCMY,APCMQU)
- ...S DIR("B")="YES" I $P(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1",APCMQU'=32 S DIR("B")="NO"
- ...I APCMQU=19,$P(^APCM25OB(APCMY,0),U,1)="S2.026.EP" S DIR("B")="NO"
- ...KILL DA D ^DIR KILL DIR
- ...I $D(DIRUT) S APCMQ=1 Q
- ...I 'Y S APCMIND=1 Q
- ...S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP I $P(APCMATTE(APCMX,APCMP),U,APCMAP)'="N/A" S $P(APCMATTE(APCMX,APCMP),U,APCMAP)="Yes"
- ..I $P(^APCM25OB(APCMY,0),U,13) D
- ...W ! S DIR(0)="Y",DIR("A")="Will the following response apply to all EPs included in this report",DIR("B")="YES" KILL DA D ^DIR KILL DIR
- ...I $D(DIRUT) S APCMQ=1 Q
- ...I 'Y S APCMIND=1 Q
- ...S DIR(0)="S^Y:YES;N:NO;X:No Registry Available",DIR("A")="All selected providers included in this report attest to (Enter Y, N or X)",DIR("B")="YES" KILL DA D ^DIR KILL DIR
- ...I $D(DIRUT) S APCMQ=1 Q
- ...S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP S $P(APCMATTE(APCMX,APCMP),U,APCMAP)=$S(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
- ATTIND .;
- .S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ) D
- ..W !
- ..I '$P(^APCM25OB(APCMY,0),U,13) S DIR(0)="Y",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_$$T(APCMY,APCMQU)
- ..S DIR("B")="YES" I $P(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1",APCMQU'=32 S DIR("B")="NO"
- ..I APCMQU=19,$P(^APCM25OB(APCMY,0),U,1)="S2.026.EP" S DIR("B")="NO"
- ..KILL DA D ^DIR KILL DIR
- ..I $P(^APCM25OB(APCMY,0),U,13) S DIR(0)="S^Y:YES;N:NO;X:No Registry Available" D
- ...S DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_$$T(APCMY,APCMQU),DIR("B")="YES" KILL DA D ^DIR KILL DIR
- ..I $D(DIRUT) S APCMQ=1 Q
- ..S $P(APCMATTE(APCMX,APCMP),U,APCMAP)=$S(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
- Q
- IMMREG ;EP - ask
- D IMMREG^APCM2AEA
- Q
- SPECREG ;
- D SPECREG^APCM2AEA
- Q
- SS D SS^APCM2AEA
- Q
- T(APCMY,APCMQU) ;
- I APCMQU=32,$P(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1" Q " claim this exclusion"
- I APCMQU=32,$P(^APCM25OB(APCMY,0),U,1)="S2.026.EP" Q " claim this exclusion"
- I APCMQU=31 Q " attest to this"
- NEW %
- S %=$S($P($G(^APCM25OB(APCMY,11)),U,1)]"":$P(^APCM25OB(APCMY,11),U,1),1:" attest to this")
- Q %
- APCM2AE ; IHS/CMI/LAB - IHS MU ; 07 Oct 2015 1:21 PM
- +1 ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
- +2 ;
- +3 ;
- +4 IF $DATA(IOF)
- WRITE @IOF
- EP DO XIT
- INTRO ;
- +1 SET APCMRPTT=1
- +2 WRITE !!!
- +3 WRITE $$CTR("***IHS Modified Stage 2 MU Performance Reports for EPS***",80),!
- +4 WRITE $$CTR("Alternate Stage 1 Exclusions",80),!
- +5 WRITE !,"This report displays the performance measure results for Modified",!
- +6 WRITE "Stage 2 Meaningful Use with alternate Stage 1 exclusions/thresholds.",!
- +7 WRITE !,"In order to achieve Meaningful Use, an EP must attest to meeting",!
- +8 WRITE "all 10 objectives and their associated performance measures.",!
- +9 WRITE !,"The report can be run for 90 days, 1 year or a user defined time period.",!
- +10 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to continue to report"
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- +11 IF $DATA(DIRUT)
- DO XIT
- QUIT
- +12 IF 'Y
- DO XIT
- QUIT
- +13 ;
- +14 WRITE !!
- SET X=0
- FOR
- SET X=$ORDER(^APCM25OB(X))
- IF X'=+X
- QUIT
- IF $PIECE(^APCM25OB(X,0),U,2)="E"
- SET APCMIND(X)=""
- RT ;
- +1 SET APCMSUM="S"
- TP ;
- +1 SET APCMRPTP=""
- +2 WRITE !
- MUYEAR ;
- +1 KILL DIR
- SET DIR(0)="D^::EP"
- +2 WRITE !,"Enter the Calendar Year for which the EP is demonstrating Meaningful"
- +3 SET DIR("A")="Use. Use a 4 digit year, e.g. 2015"
- +4 SET DIR("?")="Enter a valid year."
- +5 DO ^DIR
- KILL DIR
- +6 IF $DATA(DIRUT)
- GOTO EP
- +7 IF $DATA(DUOUT)
- GOTO EP
- +8 SET APCMVDT=Y
- +9 IF $EXTRACT(Y,4,7)'="0000"
- WRITE !!,"Please enter a year only!",!
- GOTO MUYEAR
- +10 IF $EXTRACT(Y,1,3)'=315
- IF $EXTRACT(Y,1,3)'=316
- WRITE !!,"Calendar year must equal 2015 or 2016.",!
- GOTO MUYEAR
- +11 SET APCMPER=APCMVDT
- +12 SET APCMLD=$EXTRACT(APCMPER,1,3)_"0101"
- SET APCMHD=$EXTRACT(APCMPER,1,3)_"1231"
- +13 ;
- YEAR ;
- +1 SET (APCMVDT,APCMBD,APCMED)=""
- +2 SET APCMQ=0
- +3 Begin DoDot:1
- +4 WRITE !!,"Select one of the following:",!
- +5 WRITE !?10,"1 User Defined 90-Day Report"
- +6 WRITE !?10,"2 Calendar Year"
- +7 WRITE !?10,"3 User Defined Date Range"
- +8 WRITE !
- SET DIR(0)="N^1:3:"
- SET DIR("A")="Select Report Period"
- KILL DA
- DO ^DIR
- KILL DIR
- +9 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +10 SET APCMRPTP=Y
- +11 IF APCMRPTP=1
- DO 5
- QUIT
- +12 IF APCMRPTP=2
- SET APCMBD=APCMLD
- SET APCMED=APCMHD
- WRITE !!,"Date range is: ",$$FMTE^XLFDT(APCMBD)," - ",$$FMTE^XLFDT(APCMED),"."
- QUIT
- +13 IF APCMRPTP=3
- DO 6
- QUIT
- End DoDot:1
- IF APCMQ
- GOTO INTRO
- +14 IF APCMBD=""
- GOTO TP
- +15 IF APCMED=""
- GOTO TP
- +16 ;
- 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 Report 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 Report 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 KILL APCMADDQ
- +2 ;
- ATTEST ;get answers to attestation
- +1 DO ATTESTQ
- +2 IF APCMQ
- GOTO PRV
- SUM ;display summary
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,$$CTR("SUMMARY OF MODIFIED STAGE 2 REPORT TO BE GENERATED")
- +3 WRITE !!,"The date ranges for this report are:"
- +4 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(APCMBD)," to ",?31,$$FMTE^XLFDT(APCMED)
- +5 WRITE !!,"Providers: "
- +6 SET X=0
- FOR
- SET X=$ORDER(APCMPRV(X))
- IF X'=+X
- QUIT
- WRITE !?5,$PIECE(^VA(200,X,0),U,1)
- +7 DO PT^APCM2ASL
- +8 IF APCMROT=""
- GOTO DEMO
- ZIS ;call to XBDBQUE
- +1 DO REPORT^APCM2ASL
- +2 IF $GET(APCMQUIT)
- DO XIT
- QUIT
- +3 IF APCMRPT=""
- DO XIT
- QUIT
- +4 KILL IOP,%ZIS
- IF APCMROT="D"
- IF APCMDELT="F"
- DO NODEV
- DO XIT
- QUIT
- +5 KILL IOP,%ZIS
- WRITE !!
- SET %ZIS=$SELECT(APCMDELT'="S":"PQM",1:"PM")
- DO ^%ZIS
- +6 IF POP
- WRITE !,"Report Aborted"
- SET DA=APCMRPT
- SET DIK="^APCMM25C("
- DO ^DIK
- KILL DIK
- DO XIT
- QUIT
- +7 IF $DATA(IO("Q"))
- GOTO TSKMN
- DRIVER ;
- +1 DO PROC^APCM2AE1
- +2 USE IO
- +3 DO ^APCM2AEP
- +4 DO ^%ZISC
- +5 DO XIT
- +6 QUIT
- +7 ;
- NODEV ;
- +1 SET XBRP=""
- SET XBRC="NODEV1^APCM2AE"
- SET XBRX="XIT^APCM2AE"
- SET XBNS="APCM"
- +2 DO ^XBDBQUE
- +3 QUIT
- +4 ;
- NODEV1 ;
- +1 DO PROC^APCM2AE1
- +2 DO ^APCM2AEP
- +3 DO ^%ZISC
- +4 DO XIT
- +5 QUIT
- TSKMN ;EP ENTRY POINT FROM TASKMAN
- +1 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
- IF $DATA(IOST)#2
- IF IOST]""
- SET ZTIO=ZTIO_";"_IOST
- +2 IF $GET(IO("DOC"))]""
- SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
- +3 IF $DATA(IOM)#2
- IF IOM
- SET ZTIO=ZTIO_";"_IOM
- IF $DATA(IOSL)#2
- IF IOSL
- SET ZTIO=ZTIO_";"_IOSL
- +4 KILL ZTSAVE
- SET ZTSAVE("APCM*")=""
- +5 SET ZTCPU=$GET(IOCPU)
- SET ZTRTN="DRIVER^APCM2AE"
- SET ZTDTH=""
- SET ZTDESC="MODIFIED STAGE 2 REPORT"
- DO ^%ZTLOAD
- DO XIT
- QUIT
- +6 QUIT
- +7 ;
- XIT ;
- +1 DO ^%ZISC
- +2 DO EN^XBVK("APCM")
- +3 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 KILL DIRUT,DUOUT,DIR,DOD
- +5 KILL DIADD,DLAYGO
- +6 DO KILL^AUPNPAT
- +7 KILL X,X1,X2,X3,X4,X5,X6
- +8 KILL 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
- +9 KILL N,N1,N2,N3,N4,N5,N6
- +10 KILL BD,ED
- +11 DO KILL^AUPNPAT
- +12 DO ^XBFMK
- +13 QUIT
- +14 ;
- CTR(X,Y) ;EP - Center X
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
- EOP ;EP - End of page.
- +1 IF $EXTRACT(IOST)'="C"
- QUIT
- +2 IF $DATA(ZTQUEUED)!$DATA(IO("S"))
- QUIT
- +3 NEW DIR
- +4 KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- +5 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +6 QUIT
- +7 ;----------
- USR() ;EP - Return USER
- +1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- +2 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
- 6 ;EP
- C ;EP
- +1 SET (APCMVDT,APCMBD,APCMED)=""
- +2 KILL DIR
- WRITE !
- SET DIR(0)="DO^::EXP"
- SET DIR("A")="Enter Beginning Date"
- +3 DO ^DIR
- IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +4 IF Y<0
- SET APCMQ=1
- QUIT
- +5 IF Y>DT
- WRITE !!,"Future dates not allowed."
- GOTO C
- +6 IF Y<APCMLD
- WRITE !!,"The beginning date must be within calendar year entered."
- GOTO C
- +7 IF Y>APCMHD
- WRITE !!,"The beginning date must be within calendar year entered."
- GOTO C
- +8 SET APCMBD=Y
- +9 KILL DIR
- SET DIR(0)="DO^:DT:EXP"
- SET DIR("A")="Enter Ending Date"
- +10 DO ^DIR
- IF Y<1
- GOTO C
- +11 IF Y>APCMHD
- WRITE !!,"The ending date must be within calendar year entered."
- GOTO C
- +12 SET APCMED=Y
- +13 ;
- +14 IF APCMED<APCMBD
- Begin DoDot:1
- +15 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
- End DoDot:1
- GOTO C
- +16 QUIT
- 5 ;EP - TEXT
- +1 ;W !!,"Enter the start date of the 90-day report period.",!
- +2 SET (APCMVDT,APCMBD,APCMED)=""
- +3 WRITE !
- KILL DIR,X,Y
- +4 SET DIR(0)="D^::E"
- +5 SET DIR("A")="Enter Start Date for the 90-Day Report (e.g. 01/01/2015)"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +6 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +7 IF Y<APCMLD
- WRITE !!,"The 90 day start and end dates must be within the calendar year entered."
- GOTO 5
- +8 IF $$FMADD^XLFDT(Y,89)>APCMHD
- WRITE !!,"The end date would be ",$$FMTE^XLFDT($$FMADD^XLFDT(Y,89)),".",!,"The 90 day start and end dates must be within the calendar year entered."
- GOTO 5
- +9 SET APCMBD=Y
- SET APCMED=$$FMADD^XLFDT(APCMBD,89)
- +10 QUIT
- +11 ;
- CXIT ;
- +1 KILL DIR
- +2 QUIT
- EPRES ;EP - ask additional exclusion questions for e-prescribing
- +1 SET APCMQ=0
- +2 SET APCMY=$ORDER(^APCM25OB("B","S2.003.EP",0))
- +3 ;Q:'$D(APCMIND(APCMY)) ;measure not being run
- +4 KILL APCMADDQ("ANS",APCMY)
- +5 ;display exclusion text/narrative
- +6 IF $ORDER(^APCM25OB(APCMY,26,0))
- DO ET
- +7 IF APCMPLTY="SEL"!(APCMPLTY="TAX")
- Begin DoDot:1
- +8 SET APCMQ=0
- SET APCMIND=0
- +9 WRITE !,"The e-Prescribing onsite pharmacy question below may be addressed as a group or"
- +10 WRITE !,"by individual provider. Do you want to answer for all selected providers as a"
- +11 SET DIR(0)="Y"
- SET DIR("A")="group Y/N"
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- +12 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +13 IF 'Y
- SET APCMIND=1
- QUIT
- +14 WRITE !!,"Do all selected providers included in this report have an onsite"
- +15 SET DIR(0)="Y"
- SET DIR("A")="pharmacy Y/N"
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- +16 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +17 IF 'Y
- SET APCMIND=1
- QUIT
- +18 SET APCMP=0
- FOR
- SET APCMP=$ORDER(APCMPRV(APCMP))
- IF APCMP'=+APCMP
- QUIT
- SET APCMADDQ("ANS",APCMY,24,APCMP)="Yes"
- End DoDot:1
- IF APCMIND=1
- GOTO EIND
- QUIT
- EIND ;ask individually
- +1 SET APCMP=0
- FOR
- SET APCMP=$ORDER(APCMPRV(APCMP))
- IF APCMP'=+APCMP!(APCMQ)
- QUIT
- Begin DoDot:1
- +2 SET APCMZ=0
- FOR
- SET APCMZ=$ORDER(^APCM25OB(APCMY,24,APCMZ))
- IF APCMZ'=+APCMZ
- QUIT
- WRITE !,^APCM25OB(APCMY,24,APCMZ,0)
- +3 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")=$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_"'s answer"
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +5 SET APCMADDQ("ANS",APCMY,24,APCMP)=$SELECT(Y:"Yes",1:"No")
- +6 IF Y
- QUIT
- +7 WRITE !
- SET X=0
- FOR
- SET X=$ORDER(^APCM25OB(APCMY,25,X))
- IF X'=+X
- QUIT
- WRITE !,^APCM25OB(APCMY,25,X,0)
- +8 ;
- +9 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")=$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_"'s answer"
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- +10 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +11 SET APCMADDQ("ANS",APCMY,25,APCMP)=$SELECT(Y:"Yes",1:"No")
- End DoDot:1
- +12 QUIT
- ET ;
- +1 WRITE !
- SET APCMZ=0
- FOR
- SET APCMZ=$ORDER(^APCM25OB(APCMY,26,APCMZ))
- IF APCMZ'=+APCMZ
- QUIT
- WRITE !,^APCM25OB(APCMY,26,APCMZ,0)
- +2 WRITE !
- +3 QUIT
- ATTESTQ ;EP
- +1 KILL APCMATTE
- +2 SET APCMQ=0
- +3 SET Z=0
- FOR
- SET Z=$ORDER(^APCM25OB("ALTA",Z))
- IF Z'=+Z
- QUIT
- SET A=0
- FOR
- SET A=$ORDER(^APCM25OB("ALTA",Z,A))
- IF A'=+A
- QUIT
- IF $DATA(APCMIND(A))
- SET X=$PIECE(^APCM25OB(A,0),U,1)
- Begin DoDot:1
- +4 SET Y=0
- FOR
- SET Y=$ORDER(APCMPRV(Y))
- IF Y'=+Y
- QUIT
- SET APCMATTE(X,Y)=""
- SET APCMORA(Z,X)=""
- End DoDot:1
- +5 ;no measures with attestation being run
- IF '$DATA(APCMATTE)
- QUIT
- +6 SET APCMQ=0
- +7 IF APCMPLTY="SEL"!(APCMPLTY="TAX")
- Begin DoDot:1
- +8 WRITE !!,"Each of the questions below may be addressed as a group or individual",!,"attestation.",!
- End DoDot:1
- +9 ;PROTECT
- +10 IF $DATA(APCMATTE("S2.014.EP"))
- Begin DoDot:1
- +11 SET APCMQU=19
- SET APCMAP=1
- SET APCMX="S2.014.EP"
- DO ASK
- End DoDot:1
- +12 IF APCMQ
- QUIT
- +13 IF $DATA(APCMATTE("S2.010.EP.1"))
- Begin DoDot:1
- +14 SET APCMQU=$SELECT($EXTRACT(APCMPER,1,3)=315:32,$EXTRACT(APCMPER,1,3)=316:33,1:19)
- SET APCMAP=1
- SET APCMX="S2.010.EP.1"
- DO ASK
- End DoDot:1
- +15 IF APCMQ
- QUIT
- +16 IF $DATA(APCMATTE("S2.010.EP.2"))
- Begin DoDot:1
- +17 SET APCMQU=19
- SET APCMAP=1
- SET APCMX="S2.010.EP.2"
- DO ASK
- End DoDot:1
- +18 IF APCMQ
- QUIT
- +19 IF $DATA(APCMATTE("S2.001.1EP"))
- Begin DoDot:1
- +20 WRITE !!,"CPOE Exclusions:"
- +21 WRITE !,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- +22 WRITE !,"reporting period in 2015 or 2016, the provider may claim the "
- +23 WRITE !,"exclusions below."
- +24 SET APCMQU=32
- SET APCMAP=1
- SET APCMX="S2.001.1EP"
- DO ASK
- End DoDot:1
- +25 IF APCMQ
- QUIT
- +26 IF $DATA(APCMATTE("S2.001.2EP"))
- Begin DoDot:1
- +27 IF '$DATA(APCMATTE("S2.001.1EP"))
- Begin DoDot:2
- +28 WRITE !,"CPOE Exclusions:"
- +29 WRITE !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- +30 WRITE !,"reporting period in 2015 or 2016, the provider may claim the "
- +31 WRITE !,"exclusions below."
- End DoDot:2
- +32 SET APCMQU=32
- SET APCMAP=1
- SET APCMX="S2.001.2EP"
- DO ASK
- End DoDot:1
- +33 IF APCMQ
- QUIT
- +34 IF $DATA(APCMATTE("S2.003.EP"))
- Begin DoDot:1
- +35 SET APCMQU=32
- SET APCMAP=1
- SET APCMX="S2.003.EP"
- DO EPRES
- End DoDot:1
- +36 IF APCMQ
- QUIT
- +37 IF $DATA(APCMATTE("S2.023.EP"))
- Begin DoDot:1
- +38 IF $EXTRACT(APCMPER,1,3)=315
- Begin DoDot:2
- +39 WRITE !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- +40 WRITE !,"reporting period in 2015, the provider may claim one or more of the"
- +41 WRITE !,"alternate exclusions below."
- +42 SET APCMQU=32
- SET APCMAP=2
- SET APCMX="S2.023.EP"
- DO ASK
- End DoDot:2
- +43 ;S APCMQU=19,APCMAP=1,APCMX="S2.023.EP" D ASK
- End DoDot:1
- +44 IF APCMQ
- QUIT
- +45 IF $DATA(APCMATTE("S2.021.EP"))
- IF $EXTRACT(APCMPER,1,3)=315
- Begin DoDot:1
- +46 IF '$DATA(APCMATTE("S2.023.EP"))
- Begin DoDot:2
- +47 WRITE !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- +48 WRITE !,"reporting period in 2015, the provider may claim one or more of the"
- +49 WRITE !,"alternate exclusions below."
- End DoDot:2
- +50 SET APCMQU=32
- SET APCMAP=1
- SET APCMX="S2.021.EP"
- DO ASK
- End DoDot:1
- +51 IF APCMQ
- QUIT
- +52 IF $DATA(APCMATTE("S2.022.EP"))
- IF $EXTRACT(APCMPER,1,3)=315
- Begin DoDot:1
- +53 IF '$DATA(APCMATTE("S2.021.EP"))
- Begin DoDot:2
- +54 WRITE !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- +55 WRITE !,"reporting period in 2015, the provider may claim one or more of the"
- +56 WRITE !,"alternate exclusions below."
- End DoDot:2
- +57 SET APCMQU=32
- SET APCMAP=1
- SET APCMX="S2.022.EP"
- DO ASK
- End DoDot:1
- +58 IF APCMQ
- QUIT
- +59 IF $DATA(APCMATTE("S2.020.EP"))
- Begin DoDot:1
- +60 IF $EXTRACT(APCMPER,1,3)=315
- Begin DoDot:2
- +61 IF '$DATA(APCMATTE("S2.022.EP"))
- Begin DoDot:3
- +62 WRITE !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- +63 WRITE !,"reporting period in 2015, the provider may claim one or more of the"
- +64 WRITE !,"alternate exclusions below."
- End DoDot:3
- +65 SET APCMQU=32
- SET APCMAP=2
- SET APCMX="S2.020.EP.1"
- DO ASK
- End DoDot:2
- +66 IF APCMQ
- QUIT
- +67 ;S APCMQU=19,APCMAP=1,APCMX="S2.020.EP.1" D ASK
- End DoDot:1
- +68 IF APCMQ
- QUIT
- +69 IF $DATA(APCMATTE("S2.026.EP"))
- IF $EXTRACT(APCMPER,1,3)=315
- Begin DoDot:1
- +70 IF '$DATA(APCMATTE("S2.020.EP"))
- Begin DoDot:2
- +71 WRITE !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
- +72 WRITE !,"reporting period in 2015, the provider may claim one or more of the"
- +73 WRITE !,"alternate exclusions below."
- End DoDot:2
- +74 SET APCMQU=32
- SET APCMAP=3
- SET APCMX="S2.026.EP"
- DO ASK
- +75 ;Q:$D(APCMATTE("S2.020.EP.1")) ;ALREADY ASKED
- End DoDot:1
- +76 IF APCMQ
- QUIT
- +77 IF $DATA(APCMATTE("S2.026.EP"))!($DATA(APCMATTE("S2.020.EP.1")))
- Begin DoDot:1
- +78 SET APCMQU=19
- SET APCMAP=1
- SET APCMX="S2.026.EP"
- DO ASK
- +79 IF $EXTRACT(APCMPER,1,3)=315
- SET APCMQU=31
- SET APCMAP=2
- SET APCMX="S2.026.EP"
- DO ASK
- End DoDot:1
- +80 SET APCMQU=19
- +81 IF $DATA(APCMATTE("S2.024.EP"))
- SET APCMX="S2.024.EP"
- SET APCMQU=32
- DO IMMREG
- +82 IF APCMQ
- QUIT
- +83 SET APCMQU=19
- +84 IF $DATA(APCMATTE("S2.025.EP"))
- SET APCMX="S2.025.EP"
- DO IMMREG
- +85 IF APCMQ
- QUIT
- +86 SET APCMQU=19
- +87 IF $DATA(APCMATTE("S2.030.EP"))
- SET APCMX="S2.030.EP"
- DO IMMREG
- +88 QUIT
- ASK ;
- +1 Begin DoDot:1
- +2 SET APCMY=$ORDER(^APCM25OB("B",APCMX,0))
- +3 IF '$ORDER(^APCM25OB(APCMY,APCMQU,0))
- QUIT
- +4 WRITE !
- +5 IF APCMX="S2.020.EP.1"
- IF APCMAP=1
- SET Y=$ORDER(^APCM25OB("B","S2.026.EP",0))
- IF $DATA(APCMIND(Y))
- QUIT
- +6 SET X=0
- FOR
- SET X=$ORDER(^APCM25OB(APCMY,APCMQU,X))
- IF X'=+X
- QUIT
- WRITE !,^APCM25OB(APCMY,APCMQU,X,0)
- +7 IF APCMPLTY="SEL"!(APCMPLTY="TAX")
- Begin DoDot:2
- +8 SET APCMIND=0
- +9 IF '$PIECE(^APCM25OB(APCMY,0),U,13)
- Begin DoDot:3
- +10 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Do all selected providers included in this report"_$$T(APCMY,APCMQU)
- +11 SET DIR("B")="YES"
- IF $PIECE(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1"
- IF APCMQU'=32
- SET DIR("B")="NO"
- +12 IF APCMQU=19
- IF $PIECE(^APCM25OB(APCMY,0),U,1)="S2.026.EP"
- SET DIR("B")="NO"
- +13 KILL DA
- DO ^DIR
- KILL DIR
- +14 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +15 IF 'Y
- SET APCMIND=1
- QUIT
- +16 SET APCMP=0
- FOR
- SET APCMP=$ORDER(APCMPRV(APCMP))
- IF APCMP'=+APCMP
- QUIT
- IF $PIECE(APCMATTE(APCMX,APCMP),U,APCMAP)'="N/A"
- SET $PIECE(APCMATTE(APCMX,APCMP),U,APCMAP)="Yes"
- End DoDot:3
- +17 IF $PIECE(^APCM25OB(APCMY,0),U,13)
- Begin DoDot:3
- +18 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Will the following response apply to all EPs included in this report"
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- +19 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +20 IF 'Y
- SET APCMIND=1
- QUIT
- +21 SET DIR(0)="S^Y:YES;N:NO;X:No Registry Available"
- SET DIR("A")="All selected providers included in this report attest to (Enter Y, N or X)"
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- +22 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +23 SET APCMP=0
- FOR
- SET APCMP=$ORDER(APCMPRV(APCMP))
- IF APCMP'=+APCMP
- QUIT
- SET $PIECE(APCMATTE(APCMX,APCMP),U,APCMAP)=$SELECT(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
- End DoDot:3
- End DoDot:2
- IF APCMIND
- GOTO ATTIND
- QUIT
- ATTIND ;
- +1 SET APCMP=0
- FOR
- SET APCMP=$ORDER(APCMPRV(APCMP))
- IF APCMP'=+APCMP!(APCMQ)
- QUIT
- Begin DoDot:2
- +2 WRITE !
- +3 IF '$PIECE(^APCM25OB(APCMY,0),U,13)
- SET DIR(0)="Y"
- SET DIR("A")="Does "_$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_$$T(APCMY,APCMQU)
- +4 SET DIR("B")="YES"
- IF $PIECE(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1"
- IF APCMQU'=32
- SET DIR("B")="NO"
- +5 IF APCMQU=19
- IF $PIECE(^APCM25OB(APCMY,0),U,1)="S2.026.EP"
- SET DIR("B")="NO"
- +6 KILL DA
- DO ^DIR
- KILL DIR
- +7 IF $PIECE(^APCM25OB(APCMY,0),U,13)
- SET DIR(0)="S^Y:YES;N:NO;X:No Registry Available"
- Begin DoDot:3
- +8 SET DIR("A")="Does "_$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_$$T(APCMY,APCMQU)
- SET DIR("B")="YES"
- KILL DA
- DO ^DIR
- KILL DIR
- End DoDot:3
- +9 IF $DATA(DIRUT)
- SET APCMQ=1
- QUIT
- +10 SET $PIECE(APCMATTE(APCMX,APCMP),U,APCMAP)=$SELECT(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
- End DoDot:2
- End DoDot:1
- +11 QUIT
- IMMREG ;EP - ask
- +1 DO IMMREG^APCM2AEA
- +2 QUIT
- SPECREG ;
- +1 DO SPECREG^APCM2AEA
- +2 QUIT
- SS DO SS^APCM2AEA
- +1 QUIT
- T(APCMY,APCMQU) ;
- +1 IF APCMQU=32
- IF $PIECE(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1"
- QUIT " claim this exclusion"
- +2 IF APCMQU=32
- IF $PIECE(^APCM25OB(APCMY,0),U,1)="S2.026.EP"
- QUIT " claim this exclusion"
- +3 IF APCMQU=31
- QUIT " attest to this"
- +4 NEW %
- +5 SET %=$SELECT($PIECE($GET(^APCM25OB(APCMY,11)),U,1)]"":$PIECE(^APCM25OB(APCMY,11),U,1),1:" attest to this")
- +6 QUIT %