APCM25ET ;IHS/CMI/LAB - IHS MU PATIENT LIST;
;;1.0;MU PERFORMANCE REPORTS;**7,9,10**;MAR 26, 2012;Build 31
;
;
;
W:$D(IOF) @IOF
EP D XIT
INTRO ;
S APCMRPTT=1 ;CONTROL VARIABLE FOR EP REPORT
S APCMRPTC=$O(^APCMMUCN("B","MODIFIED STAGE 2 2015",0))
W !!!
;S X=0 F S X=$O(^APCMMUCN(APCMRPTC,11,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,11,X,0),!
W "*IHS Modified Stage 2 MU Performance Reports for EPS*",!
W !,"This report displays the performance measure results for Modified",!
W "Stage 2 Meaningful Use. In order to achieve Meaningful Use, an EP must",!
W "attest to meeting 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.",!
W !,"This report allows a user to review the patients that populate the",!
W "numerator and denominator of each Performance Measure."
W !!
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:One or More 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^APCM25SI S Q=0 D I Q G INTRO
.I '$D(APCMIND) W !!,"No measures selected" H 2 S Q=1 Q
.S X=0 F S X=$O(APCMIND(X)) Q:X'=+X D
..;GET ALL WITH SAME SUMMARY ORDER # AND ADD IN
..S O=0 F S O=$O(^APCM25OB(X,29,O)) Q:O'=+O S Y=$P(^APCM25OB(X,29,O,0),U,1),Y=$O(^APCM25OB("B",Y,0)) I Y S APCMIND(Y)=""
I APCMINDZ="A" S X=0 F S X=$O(^APCM25OB(X)) Q:X'=+X I $P(^APCM25OB(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(^APCM25OB(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(^APCMM25L(APCMCR,APCMIND,APCMO)) Q:APCMO'=+APCMO!($D(DIRUT)) D
..S X=$O(^APCMM25L(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(^APCM25OB(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(^APCMM25L(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^APCM25SL I '$D(APCMLIST)!($D(APCMQUIT)) G SI
RT ;
S APCMSUM="S"
TP ;
S APCMRPTP=""
;
W !
MUYEAR ;
K APCMPER,APCMVDT,APCMEDUD ;IHS/CMI/LAB - PATCH 9 06/06/2017
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 W !!,"Year entered cannot be prior to 2015.",! G MUYEAR
S APCMPER=APCMVDT
I $E(APCMPER,1,3)>316 S APCMEDUD=$E(APCMPER,1,3)_"1231" ;IHS/CMI/LAB - PATCH 10 06/20/2018
S APCMLD=$E(APCMPER,1,3)_"0101",APCMHD=$E(APCMPER,1,3)_"1231" ;LOW AND HIGH DATES ALLOWED BELOW
;
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^APCM25E 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^APCM25E 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 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 ;
K APCMADDQ
;S A=$O(^APCM25OB("B","S2.008.EP",0))
S B=$O(^APCM25OB("B","S2.003.EP",0))
I '$D(APCMIND(B)) G ATTEST
W !!,"Please answer the following exclusion questions for each provider."
D EPRES^APCM25E ;ASK ADDITIONAL QUESTIONS FOR E-PRESCRIBING
I APCMQ G DEMO
ATTEST ;get answers to attestation questions for each provider.
D ATTESTQ^APCM25E
I APCMQ G DEMO
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF IHS MODIFIED STAGE 2 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 $E(APCMPER,1,3)>316,($$HAS("S2.021.EP")!($$HAS("S2.020.EP"))!($$HAS("S2.023.EP"))) D ;IHS/CMI/LAB - PATCH 9 06/06/2017
.S C=0
.W !!,"Please note: the date range is ",$$FMTE^XLFDT(APCMBD)," to ",$$FMTE^XLFDT(APCMEDUD)," for ",!
.I $$HAS("S2.021.EP") W ?5,"Patient Education",!
.I $$HAS("S2.020.EP") W ?5,"Patient Electronic Access",!
.I $$HAS("S2.023.EP") W ?5,"Summary of Care (HIE)",!
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^APCM25SL
I APCMROT="" G DEMO
ZIS ;call to XBDBQUE
D REPORT^APCM25SL
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 POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMM14P(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D PROC^APCM25E1
U IO
D ^APCM25EP
D ^%ZISC
D XIT
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^APCM25ET",XBRX="XIT^APCM25ET",XBNS="APCM"
D ^XBDBQUE
Q
;
NODEV1 ;
D PROC^APCM25E1
D ^APCM25EP
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^APCM25E",ZTDTH="",ZTDESC="2014 MU STAGE 2 REPORT" D ^%ZTLOAD D XIT Q
Q
;
XIT ;
L -^APCMM25C
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")
;
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^APCM25SL
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
HAS(I) ;EP
NEW X,Y
S Y=0
S X=0 F S X=$O(APCMIND(X)) Q:X'=+X I $P(^APCM25OB(X,0),U,1)=I S Y=1
Q Y
APCM25ET ;IHS/CMI/LAB - IHS MU PATIENT LIST;
+1 ;;1.0;MU PERFORMANCE REPORTS;**7,9,10**;MAR 26, 2012;Build 31
+2 ;
+3 ;
+4 ;
+5 IF $DATA(IOF)
WRITE @IOF
EP DO XIT
INTRO ;
+1 ;CONTROL VARIABLE FOR EP REPORT
SET APCMRPTT=1
+2 SET APCMRPTC=$ORDER(^APCMMUCN("B","MODIFIED STAGE 2 2015",0))
+3 WRITE !!!
+4 ;S X=0 F S X=$O(^APCMMUCN(APCMRPTC,11,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,11,X,0),!
+5 WRITE "*IHS Modified Stage 2 MU Performance Reports for EPS*",!
+6 WRITE !,"This report displays the performance measure results for Modified",!
+7 WRITE "Stage 2 Meaningful Use. In order to achieve Meaningful Use, an EP must",!
+8 WRITE "attest to meeting 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 WRITE !,"This report allows a user to review the patients that populate the",!
+11 WRITE "numerator and denominator of each Performance Measure."
+12 WRITE !!
+13 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue to report"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
DO XIT
QUIT
+15 IF 'Y
DO XIT
QUIT
+16 ;gather up measures for this report
+17 SET DIR(0)="S^S:One or More Performance Measures;A:All MU Performance Measures"
SET DIR("A")="Run the report on"
SET DIR("B")="S"
KILL DA
DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)
DO XIT
QUIT
+19 SET APCMINDZ=Y
+20 IF APCMINDZ="S"
DO EN^APCM25SI
SET Q=0
Begin DoDot:1
+21 IF '$DATA(APCMIND)
WRITE !!,"No measures selected"
HANG 2
SET Q=1
QUIT
+22 SET X=0
FOR
SET X=$ORDER(APCMIND(X))
IF X'=+X
QUIT
Begin DoDot:2
+23 ;GET ALL WITH SAME SUMMARY ORDER # AND ADD IN
+24 SET O=0
FOR
SET O=$ORDER(^APCM25OB(X,29,O))
IF O'=+O
QUIT
SET Y=$PIECE(^APCM25OB(X,29,O,0),U,1)
SET Y=$ORDER(^APCM25OB("B",Y,0))
IF Y
SET APCMIND(Y)=""
End DoDot:2
End DoDot:1
IF Q
GOTO INTRO
+25 IF APCMINDZ="A"
SET X=0
FOR
SET X=$ORDER(^APCM25OB(X))
IF X'=+X
QUIT
IF $PIECE(^APCM25OB(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(^APCM25OB(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(^APCMM25L(APCMCR,APCMIND,APCMO))
IF APCMO'=+APCMO!($DATA(DIRUT))
QUIT
Begin DoDot:2
+10 SET X=$ORDER(^APCMM25L(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(^APCM25OB(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(^APCMM25L(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^APCM25SL I '$D(APCMLIST)!($D(APCMQUIT)) G SI
KILL APCMQUIT
RT ;
+1 SET APCMSUM="S"
TP ;
+1 SET APCMRPTP=""
+2 ;
+3 WRITE !
MUYEAR ;
+1 ;IHS/CMI/LAB - PATCH 9 06/06/2017
KILL APCMPER,APCMVDT,APCMEDUD
+2 KILL DIR
SET DIR(0)="D^::EP"
+3 WRITE !,"Enter the Calendar Year for which the EP is demonstrating Meaningful"
+4 SET DIR("A")="Use. Use a 4 digit year, e.g. 2015"
+5 SET DIR("?")="Enter a valid year."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
GOTO EP
+8 IF $DATA(DUOUT)
GOTO EP
+9 SET APCMVDT=Y
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO MUYEAR
+11 IF $EXTRACT(Y,1,3)<315
WRITE !!,"Year entered cannot be prior to 2015.",!
GOTO MUYEAR
+12 SET APCMPER=APCMVDT
+13 ;IHS/CMI/LAB - PATCH 10 06/20/2018
IF $EXTRACT(APCMPER,1,3)>316
SET APCMEDUD=$EXTRACT(APCMPER,1,3)_"1231"
+14 ;LOW AND HIGH DATES ALLOWED BELOW
SET APCMLD=$EXTRACT(APCMPER,1,3)_"0101"
SET APCMHD=$EXTRACT(APCMPER,1,3)_"1231"
+15 ;
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^APCM25E
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^APCM25E
QUIT
End DoDot:1
IF APCMQ
GOTO INTRO
+14 IF APCMBD=""
GOTO TP
+15 IF APCMED=""
GOTO TP
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 KILL APCMADDQ
+2 ;S A=$O(^APCM25OB("B","S2.008.EP",0))
+3 SET B=$ORDER(^APCM25OB("B","S2.003.EP",0))
+4 IF '$DATA(APCMIND(B))
GOTO ATTEST
+5 WRITE !!,"Please answer the following exclusion questions for each provider."
+6 ;ASK ADDITIONAL QUESTIONS FOR E-PRESCRIBING
DO EPRES^APCM25E
+7 IF APCMQ
GOTO DEMO
ATTEST ;get answers to attestation questions for each provider.
+1 DO ATTESTQ^APCM25E
+2 IF APCMQ
GOTO DEMO
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF IHS MODIFIED STAGE 2 MEANINGFUL USE 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 ;IHS/CMI/LAB - PATCH 9 06/06/2017
IF $EXTRACT(APCMPER,1,3)>316
IF ($$HAS("S2.021.EP")!($$HAS("S2.020.EP"))!($$HAS("S2.023.EP")))
Begin DoDot:1
+6 SET C=0
+7 WRITE !!,"Please note: the date range is ",$$FMTE^XLFDT(APCMBD)," to ",$$FMTE^XLFDT(APCMEDUD)," for ",!
+8 IF $$HAS("S2.021.EP")
WRITE ?5,"Patient Education",!
+9 IF $$HAS("S2.020.EP")
WRITE ?5,"Patient Electronic Access",!
+10 IF $$HAS("S2.023.EP")
WRITE ?5,"Summary of Care (HIE)",!
End DoDot:1
+11 WRITE !,"Providers: "
+12 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
WRITE !?5,$PIECE(^VA(200,X,0),U,1)
+13 DO PT^APCM25SL
+14 IF APCMROT=""
GOTO DEMO
ZIS ;call to XBDBQUE
+1 DO REPORT^APCM25SL
+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 POP
WRITE !,"Report Aborted"
SET DA=APCMRPT
SET DIK="^APCMM14P("
DO ^DIK
KILL DIK
DO XIT
QUIT
+8 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO PROC^APCM25E1
+2 USE IO
+3 DO ^APCM25EP
+4 DO ^%ZISC
+5 DO XIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^APCM25ET"
SET XBRX="XIT^APCM25ET"
SET XBNS="APCM"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PROC^APCM25E1
+2 DO ^APCM25EP
+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^APCM25E"
SET ZTDTH=""
SET ZTDESC="2014 MU STAGE 2 REPORT"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
XIT ;
+1 LOCK -^APCMM25C
+2 DO ^%ZISC
+3 DO EN^XBVK("APCM")
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 KILL DIRUT,DUOUT,DIR,DOD
+6 KILL DIADD,DLAYGO
+7 DO KILL^AUPNPAT
+8 KILL X,X1,X2,X3,X4,X5,X6
+9 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
+10 KILL N,N1,N2,N3,N4,N5,N6
+11 KILL BD,ED
+12 DO KILL^AUPNPAT
+13 DO ^XBFMK
+14 QUIT
+15 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
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 name of current user from ^VA(200.
+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 ;
LISTS ;any lists with measures?
+1 KILL APCMLIST,APCMQUIT
+2 WRITE !!,"PATIENT LISTS"
+3 IF '$DATA(^XUSEC("APCMZ PATIENT LISTS",DUZ))
WRITE !!,"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.",!
Begin DoDot:1
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want patient lists for any of the measures"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)!(Y="")
QUIT
+7 IF Y=0
QUIT
+8 KILL APCMLIST
+9 DO EN^APCM25SL
+10 IF '$DATA(APCMLIST)
WRITE !!,"No lists selected.",!
+11 ;I '$D(APCMLIST)!($D(APCMQUIT)) G LISTS ;get report type for each list
IF $DATA(APCMLIST)
SET APCMLIST="A"
+12 QUIT
HAS(I) ;EP
+1 NEW X,Y
+2 SET Y=0
+3 SET X=0
FOR
SET X=$ORDER(APCMIND(X))
IF X'=+X
QUIT
IF $PIECE(^APCM25OB(X,0),U,1)=I
SET Y=1
+4 QUIT Y
