APCM11N ;IHS/CMI/LAB - MU PATIENT LIST;
;;1.0;IHS MU PERFORMANCE REPORTS;**1**;MAR 26, 2012
;
;
;
W:$D(IOF) @IOF
D XIT
INTRO ;
S APCMRPTT=2 ;CONTROL VARIABLE FOR EP REPORT
S APCMRPTC=$O(^APCMMUCN("B","INTERIM STAGE 1 2011",0))
W !
;S X=0 F S X=$O(^APCMMUCN(APCMRPTC,15,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,15,X,0),!
W !,$$CTR("IHS 2011 Stage 1 MU Patient List for Hospitals/CAHs")
W !,"This report will enable a provider to review his or her Meaningful Use "
W !,"performance by patient-specific data. You will be asked to select one or "
W !,"more Performance Measures on which to report.",!
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^APCM11SI I '$D(APCMIND) W !!,"No measures selected" H 2 G INTRO
I APCMINDZ="A" S X=0 F S X=$O(^APCMMUM(X)) Q:X'=+X I $P(^APCMMUM(X,0),U,2)="H" 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(^APCMMUM(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="AH"
.K APCMX S APCMO=0,X=0,APCMC=0 F S APCMO=$O(^APCMMUPL(APCMCR,APCMIND,APCMO)) Q:APCMO'=+APCMO!($D(DIRUT)) D
..S X=$O(^APCMMUPL(APCMCR,APCMIND,APCMO,0))
..;I APCMRPTT=1,$P(^APCMMUPL(X,0),U,4)'="N" Q
..;I APCMRPTT=7,$P(^APCMMUPL(X,0),U,4)'="O" Q
..S APCMX(APCMO,X)="",APCMC=APCMC+1
.;display the choices
.W !!!,"Please select one or more of these report choices within the",!,IORVON,$P(^APCMMUM(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(^APCMMUPL(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^APCM11SL 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 data."
W !,"The full report will produce approximately 40 pages of data for the facility."
W !,"Please take this into consideration when running print jobs, ensuring"
W !,"dedicated time on your printer and sufficient paper supplies to complete "
W !,"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 !!,"Report may be run for a 90-day, one year or user defined time period. " ;The 90-day period"
;W !,"may be automatically defined or user may select a specific start date."
;W !!,"The automated reprt will return the first 90-day peiod in the calendar"
;W !,"year in which all meaningful use objectives have been met. If all"
;W !,"objectives have not been met, the report will return results on the highest"
;W !,"average 90-day performance period within the calendar year.",!
S DIR(0)="S^A:October 1 - September 30;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
;I APCMRPTP="C" D I $G(APCMQUIT) G TP
;.S APCMQUIT=""
;.W !!,$$CTR("*** IMPORTANT NOTICE ***")
;.W !,"This report may take several hours to run and could potentially slow"
;.W !,"your system performance. Please queue this report to run after normal"
;.W !,"working hours.",!
;.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) S APCMQUIT=1 Q
;.I 'Y S APCMQUIT=1 Q
S X=$O(^APCMMUM("B","S1.002.H",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 federal fiscal 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
FAC ;
S APCMFAC=""
S DIC("A")="Select Hospital or CAH: ",DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("B")=$P(^DIC(4,DUZ(2),0),U) D ^DIC K DIC,DA
G:Y<0 TP
S APCMFAC=+Y
PRV ;
;S APCMIDED=""
;S DIR(0)="S^HOS:Hospital or CAH;ID:Inpatient Department;ED:Emergency Room Department"
;S DIR("A")="Enter Selection" KILL DA D ^DIR KILL DIR
;I $D(DIRUT) G FAC
;S APCMPLTY=Y
S APCMQUIT=""
DEMO ;
D DEMOCHK^APCLUTL(.APCMDEMO)
I APCMDEMO=-1 G FAC
ATTEST ;get answers to attestation questions for each provider.
K APCMATTE
F X="S1.009.H","S1.012.H","S1.013.H","S1.014.H","S1.018.H","S1.022.H","S1.023.H","S1.024.H" D
.S Z=$O(^APCMMUM("B",X,0))
.I 'Z Q
.I '$D(APCMIND(Z)) Q
.S Y=APCMFAC S APCMATTE(X,Y)=""
I '$D(APCMATTE) G SUM
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 FAC
I 'Y G FAC
S APCMQ=0
S APCMX="" F S APCMX=$O(APCMATTE(APCMX)) Q:APCMX=""!(APCMQ) D
.;WRITE QUESTION
.W !
.S APCMY=$O(^APCMMUM("B",APCMX,0))
.S X=0 F S X=$O(^APCMMUM(APCMY,19,X)) Q:X'=+X W !,^APCMMUM(APCMY,19,X,0)
.D
..I '$P(^APCMMUM(APCMY,0),U,13) S DIR(0)="Y",DIR("A")="Does "_$E($P(^DIC(4,APCMFAC,0),U,1),1,25)_" attest to this",DIR("B")="Y" KILL DA D ^DIR KILL DIR
..I $P(^APCMMUM(APCMY,0),U,13) S DIR(0)="S^Y:YES;N:NO;X:No Registry Available",DIR("A")="Does "_$E($P(^DIC(4,APCMFAC,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,APCMFAC)=$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 2011 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 !!,"Hospital: ",$P(^DIC(4,APCMFAC,0),U,1)
D PT^APCM11SL
I APCMROT="" G DEMO
ZIS ;call to XBDBQUE
D REPORT^APCM11SL
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="^APCMMUDC(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMMUDP(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D PROC^APCM11E1
U IO
D ^APCM11EP
D ^%ZISC
D XIT
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^APCM11N",XBRX="XIT^APCM11N",XBNS="APCM"
D ^XBDBQUE
Q
;
NODEV1 ;
D PROC^APCM11E1
D ^APCM11EP
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^APCM11E",ZTDTH="",ZTDESC="2011 MU STAGE 1 REPORT" D ^%ZTLOAD D XIT Q
Q
;
XIT ;
L -^APCMMUDC
L -^APCMMUDP
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 Federal Fiscal Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2011."
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)-1)_"1001",APCMED=$E(APCMPER,1,3)_"0930"
S APCMPBD=($E(APCMPER,1,3)-2)_"1001",APCMPED=($E(APCMPER,1,3)-1)_"0930"
Q
B ;
W !!,"IMPORTANT NOTE: This report may be run for any 90-day period. For submission"
W !,"to CMS, the report should not span Federal Fiscal Years."
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/2011)" 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^APCM11E
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^APCM11SL
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
APCM11N ;IHS/CMI/LAB - MU PATIENT LIST;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**1**;MAR 26, 2012
+2 ;
+3 ;
+4 ;
+5 IF $DATA(IOF)
WRITE @IOF
+6 DO XIT
INTRO ;
+1 ;CONTROL VARIABLE FOR EP REPORT
SET APCMRPTT=2
+2 SET APCMRPTC=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2011",0))
+3 WRITE !
+4 ;S X=0 F S X=$O(^APCMMUCN(APCMRPTC,15,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,15,X,0),!
+5 WRITE !,$$CTR("IHS 2011 Stage 1 MU Patient List for Hospitals/CAHs")
+6 WRITE !,"This report will enable a provider to review his or her Meaningful Use "
+7 WRITE !,"performance by patient-specific data. You will be asked to select one or "
+8 WRITE !,"more Performance Measures on which to report.",!
+9 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
DO ^DIR
KILL DIR,DUOUT,DIRUT
+10 ;NOTICE
+11 WRITE !!!
+12 SET X=0
FOR
SET X=$ORDER(^APCMMUCN(APCMRPTC,12,X))
IF X'=+X
QUIT
WRITE ^APCMMUCN(APCMRPTC,12,X,0),!
+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: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
+18 IF $DATA(DIRUT)
DO XIT
QUIT
+19 SET APCMINDZ=Y
+20 IF APCMINDZ="S"
DO EN^APCM11SI
IF '$DATA(APCMIND)
WRITE !!,"No measures selected"
HANG 2
GOTO INTRO
+21 IF APCMINDZ="A"
SET X=0
FOR
SET X=$ORDER(^APCMMUM(X))
IF X'=+X
QUIT
IF $PIECE(^APCMMUM(X,0),U,2)="H"
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(^APCMMUM(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="AH"
+9 KILL APCMX
SET APCMO=0
SET X=0
SET APCMC=0
FOR
SET APCMO=$ORDER(^APCMMUPL(APCMCR,APCMIND,APCMO))
IF APCMO'=+APCMO!($DATA(DIRUT))
QUIT
Begin DoDot:2
+10 SET X=$ORDER(^APCMMUPL(APCMCR,APCMIND,APCMO,0))
+11 ;I APCMRPTT=1,$P(^APCMMUPL(X,0),U,4)'="N" Q
+12 ;I APCMRPTT=7,$P(^APCMMUPL(X,0),U,4)'="O" Q
+13 SET APCMX(APCMO,X)=""
SET APCMC=APCMC+1
End DoDot:2
+14 ;display the choices
+15 WRITE !!!,"Please select one or more of these report choices within the",!,IORVON,$PIECE(^APCMMUM(APCMIND,0),U,5),IORVOFF," objective.",!
+16 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(^APCMMUPL(X,0),U,3)
SET APCMY(APCMC)=X
+17 SET DIR(0)="L^1:"_APCMC
SET DIR("A")="Which item(s)"
+18 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+19 IF Y=""
WRITE !,"No REPORTS selected for this objective."
QUIT
+20 IF $DATA(DIRUT)
WRITE !,"No REPORTs selected for this objective."
QUIT
+21 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
+22 ;get report type
+23 IF $DATA(DIRUT)
GOTO SI
+24 ;D RT^APCM11SL 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 data."
+4 WRITE !,"The full report will produce approximately 40 pages of data for the facility."
+5 WRITE !,"Please take this into consideration when running print jobs, ensuring"
+6 WRITE !,"dedicated time on your printer and sufficient paper supplies to complete "
+7 WRITE !,"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 ;The 90-day period"
WRITE !!,"Report may be run for a 90-day, one year or user defined time period. "
+3 ;W !,"may be automatically defined or user may select a specific start date."
+4 ;W !!,"The automated reprt will return the first 90-day peiod in the calendar"
+5 ;W !,"year in which all meaningful use objectives have been met. If all"
+6 ;W !,"objectives have not been met, the report will return results on the highest"
+7 ;W !,"average 90-day performance period within the calendar year.",!
+8 SET DIR(0)="S^A:October 1 - September 30;B:User Defined 90-Day Report;C:User Defined Date Range"
SET DIR("A")="Select Report Period"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
GOTO RT
+10 SET APCMRPTP=Y
+11 DO @APCMRPTP
+12 IF APCMBD=""
GOTO TP
+13 IF APCMED=""
GOTO TP
+14 ;I APCMRPTP="C" D I $G(APCMQUIT) G TP
+15 ;.S APCMQUIT=""
+16 ;.W !!,$$CTR("*** IMPORTANT NOTICE ***")
+17 ;.W !,"This report may take several hours to run and could potentially slow"
+18 ;.W !,"your system performance. Please queue this report to run after normal"
+19 ;.W !,"working hours.",!
+20 ;.S DIR(0)="Y",DIR("A")="Do you wish to continue to report",DIR("B")="Y" KILL DA D ^DIR KILL DIR
+21 ;.I $D(DIRUT) S APCMQUIT=1 Q
+22 ;.I 'Y S APCMQUIT=1 Q
+23 SET X=$ORDER(^APCMMUM("B","S1.002.H",0))
+24 SET APCMQ=""
+25 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
+26 SET APCMQ=""
+27 WRITE !!,"You have chosen to run the Drug Interaction Checks Measure."
+28 WRITE !,"Warning: Your MU Clean Date for this measure is either blank"
+29 WRITE !,"or set to a date that is after the beginning date of the report"
+30 WRITE !,"period. Therefore, you will not meet this measure."
+31 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
+32 IF $DATA(DIRUT)
SET APCMQ=1
QUIT
+33 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 federal fiscal 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
FAC ;
+1 SET APCMFAC=""
+2 SET DIC("A")="Select Hospital or CAH: "
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("B")=$PIECE(^DIC(4,DUZ(2),0),U)
DO ^DIC
KILL DIC,DA
+3 IF Y<0
GOTO TP
+4 SET APCMFAC=+Y
PRV ;
+1 ;S APCMIDED=""
+2 ;S DIR(0)="S^HOS:Hospital or CAH;ID:Inpatient Department;ED:Emergency Room Department"
+3 ;S DIR("A")="Enter Selection" KILL DA D ^DIR KILL DIR
+4 ;I $D(DIRUT) G FAC
+5 ;S APCMPLTY=Y
+6 SET APCMQUIT=""
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCMDEMO)
+2 IF APCMDEMO=-1
GOTO FAC
ATTEST ;get answers to attestation questions for each provider.
+1 KILL APCMATTE
+2 FOR X="S1.009.H","S1.012.H","S1.013.H","S1.014.H","S1.018.H","S1.022.H","S1.023.H","S1.024.H"
Begin DoDot:1
+3 SET Z=$ORDER(^APCMMUM("B",X,0))
+4 IF 'Z
QUIT
+5 IF '$DATA(APCMIND(Z))
QUIT
+6 SET Y=APCMFAC
SET APCMATTE(X,Y)=""
End DoDot:1
+7 IF '$DATA(APCMATTE)
GOTO SUM
+8 WRITE !!,"Several Stage 1 Meaningful Use Performance Measures require an attestation of "
+9 WRITE !,"Yes or No for each provider for which the report is being run.",!
+10 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
GOTO FAC
+12 IF 'Y
GOTO FAC
+13 SET APCMQ=0
+14 SET APCMX=""
FOR
SET APCMX=$ORDER(APCMATTE(APCMX))
IF APCMX=""!(APCMQ)
QUIT
Begin DoDot:1
+15 ;WRITE QUESTION
+16 WRITE !
+17 SET APCMY=$ORDER(^APCMMUM("B",APCMX,0))
+18 SET X=0
FOR
SET X=$ORDER(^APCMMUM(APCMY,19,X))
IF X'=+X
QUIT
WRITE !,^APCMMUM(APCMY,19,X,0)
+19 Begin DoDot:2
+20 IF '$PIECE(^APCMMUM(APCMY,0),U,13)
SET DIR(0)="Y"
SET DIR("A")="Does "_$EXTRACT($PIECE(^DIC(4,APCMFAC,0),U,1),1,25)_" attest to this"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+21 IF $PIECE(^APCMMUM(APCMY,0),U,13)
SET DIR(0)="S^Y:YES;N:NO;X:No Registry Available"
SET DIR("A")="Does "_$EXTRACT($PIECE(^DIC(4,APCMFAC,0),U,1),1,25)_" attest to this"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+22 IF $DATA(DIRUT)
SET APCMQ=1
QUIT
+23 SET APCMATTE(APCMX,APCMFAC)=$SELECT(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
End DoDot:2
End DoDot:1
+24 IF APCMQ
GOTO DEMO
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF 2011 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 IF $GET(APCMWPP)
WRITE !?5,"Previous Period: ",?31,$$FMTE^XLFDT(APCMPBD)," to ",?31,$$FMTE^XLFDT(APCMPED)
+6 WRITE !!,"Hospital: ",$PIECE(^DIC(4,APCMFAC,0),U,1)
+7 DO PT^APCM11SL
+8 IF APCMROT=""
GOTO DEMO
ZIS ;call to XBDBQUE
+1 DO REPORT^APCM11SL
+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="^APCMMUDC("
DO ^DIK
KILL DIK
DO XIT
QUIT
+7 IF POP
WRITE !,"Report Aborted"
SET DA=APCMRPT
SET DIK="^APCMMUDP("
DO ^DIK
KILL DIK
DO XIT
QUIT
+8 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO PROC^APCM11E1
+2 USE IO
+3 DO ^APCM11EP
+4 DO ^%ZISC
+5 DO XIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^APCM11N"
SET XBRX="XIT^APCM11N"
SET XBNS="APCM"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PROC^APCM11E1
+2 DO ^APCM11EP
+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^APCM11E"
SET ZTDTH=""
SET ZTDESC="2011 MU STAGE 1 REPORT"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
XIT ;
+1 LOCK -^APCMMUDC
+2 LOCK -^APCMMUDP
+3 DO ^%ZISC
+4 DO EN^XBVK("APCM")
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 KILL DIRUT,DUOUT,DIR,DOD
+7 KILL DIADD,DLAYGO
+8 DO KILL^AUPNPAT
+9 KILL X,X1,X2,X3,X4,X5,X6
+10 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
+11 KILL N,N1,N2,N3,N4,N5,N6
+12 KILL BD,ED
+13 DO KILL^AUPNPAT
+14 DO ^XBFMK
+15 QUIT
+16 ;
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 ;----------
A ;fiscal year
+1 SET (APCMPER,APCMVDT,APCMBD,APCMED)=""
+2 WRITE !!,"Enter the Federal Fiscal Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2011."
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter Year"
+5 SET DIR("?")="This report is compiled for a period. Enter a valid year."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF $DATA(DUOUT)
SET DIRUT=1
QUIT
+9 SET APCMVDT=Y
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO A
+11 SET APCMPER=APCMVDT
+12 SET APCMBD=($EXTRACT(APCMPER,1,3)-1)_"1001"
SET APCMED=$EXTRACT(APCMPER,1,3)_"0930"
+13 SET APCMPBD=($EXTRACT(APCMPER,1,3)-2)_"1001"
SET APCMPED=($EXTRACT(APCMPER,1,3)-1)_"0930"
+14 QUIT
B ;
+1 WRITE !!,"IMPORTANT NOTE: This report may be run for any 90-day period. For submission"
+2 WRITE !,"to CMS, the report should not span Federal Fiscal Years."
+3 WRITE !!,"Enter the start date of the 90-day report period.",!
+4 SET (APCMPER,APCMVDT,APCMBD,APCMED)=""
+5 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^::EP"
SET DIR("A")="Enter Start Date for the 90-Day Report (e.g. 01/01/2011)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+6 IF $DATA(DIRUT)
QUIT
+7 SET (APCMPER,APCMVDT)=Y
+8 SET APCMBD=Y
SET APCMED=$$FMADD^XLFDT(APCMBD,89)
+9 SET APCMPED=$$FMADD^XLFDT(APCMBD,-1)
SET APCMPBD=$$FMADD^XLFDT(APCMPED,-89)
+10 QUIT
C ;
+1 DO C^APCM11E
+2 QUIT
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^APCM11SL
+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
