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 %
