APCM13ES ; IHS/CMI/LAB - IHS MU ;
;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11
;
;
W:$D(IOF) @IOF
W !!,$$CTR("IHS 2013 Stage 1 Meaningful Use Performance Measure Report for EPs",80),!
D XIT
INTRO ;
S APCMRPTT=1,APCMIWPL=1 ;CONTROL VARIABLE FOR EP REPORT
S APCMRPTC=$O(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
W !
S X=0 F S X=$O(^APCMMUCN(APCMRPTC,11,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,11,X,0),!
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 Objectives;A:All MU Objectives",DIR("A")="Run the report on",DIR("B")="S" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S APCMINDZ=Y
I APCMINDZ="S" D EN^APCM13SI I '$D(APCMIND) W !!,"No measures selected" H 2 G INTRO
I APCMINDZ="A" S X=0 F S X=$O(^APCM13OB(X)) Q:X'=+X I $P(^APCM13OB(X,0),U,2)="E" S APCMIND(X)=""
RT ;
S APCMSUM=""
W !!,"A full report will include an itemized listing of all performance measures"
W !,"and will include a summary report. The summary report excludes itemized"
W !,"data.",!,"The full report will produce approximately 25 pages of data for"
W !,"each provider. Please take this into consideration when running print jobs,"
W !,"ensuring dedicated time on your printer and sufficient paper supplies"
W !,"to complete your job. "
S DIR(0)="S^F:Full Report;S:Summary Report",DIR("A")="Enter Selection",DIR("B")="F" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S APCMSUM=Y
TP ;
S APCMRPTP=""
W !!,"Report may be run for a 90 day or a one year period. "
S DIR(0)="S^A:January 1 - December 31;B:User Defined 90-Day Report",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
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) S APCMQUIT=1 Q
I 'Y S APCMQUIT=1 Q
PP ;
S APCMWPP=""
I APCMRPTP="A" W !!,"Historical data from the previous calendar year can be included in this report."
I APCMRPTP="B" W !!,"Historical data from the 90-days immediately preceding the currently",!,"selected report period can be included."
W !,"IMPORTANT NOTICE: Including previous period data may significantly increase ",!,"run time.",!
S DIR(0)="Y",DIR("A")="Do you wish to include the previous period",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G TP
S APCMWPP=Y
PRV ;
S APCMPLTY=""
S DIR(0)="S^IP:Individual Provider;SEL:Selected Providers (User Defined);TAX:Provider Taxonomy List",DIR("A")="Enter Selection" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G TP
S APCMPLTY=Y
S APCMQUIT=""
I APCMPLTY="IP" D I $G(APCMQUIT) G PRV
.K APCMPRV
.W !!,"Enter the name of the provider for whom the Meaningful User 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 User 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)
PL ;do you want any patient lists
I $G(APCMIWPL) D LISTS
DEMO ;
D DEMOCHK^APCLUTL(.APCMDEMO)
I APCMDEMO=-1 G PRV
ATTEST ;get answers to attestation questions for each provider.
K APCMATTE
F X="S1.010.EP","S1.013.EP","S1.014.EP","S1.018.EP","S1.020.EP","S1.024.EP","S1.025.EP" S Y=0 F S Y=$O(APCMPRV(Y)) Q:Y'=+Y S APCMATTE(X,Y)=""
W !!,"There are several objectives in the MU Stage 1 Report that you need"
W !,"to attest to by answering Yes or No for each question for each provider (EP)."
S APCMQ=0
S APCMX="" F S APCMX=$O(APCMATTE(APCMX)) Q:APCMX=""!(APCMQ) D
.;WRITE QUESTION
.W !
.S Y=$O(^APCM13OB("B",APCMX,0))
.Q:'$D(APCMIND(Y)) ;this measure not being run
.S X=0 F S X=$O(^APCM13OB(Y,19,X)) Q:X'=+X W !,^APCM13OB(Y,19,X,0)
.S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ) D
..S DIR(0)="Y",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_" attest to this",DIR("B")="Y" KILL DA D ^DIR KILL DIR
..I $D(DIRUT) S APCMQ=1 Q
..S APCMATTE(APCMX,APCMP)=$S(Y:"Yes",1:"No")
I APCMQ G DEMO
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF 2013 MEANINGFUL USE REPORT TO BE GENERATED")
W !!,"The date ranges for this report are:"
W !?5,"Report Period: ",?31,$$FMTE^XLFDT(APCMBD)," to ",?31,$$FMTE^XLFDT(APCMED)
I $G(APCMWPP) W !?5,"Previous Period: ",?31,$$FMTE^XLFDT(APCMPBD)," to ",?31,$$FMTE^XLFDT(APCMPED)
W !!,"Providers: "
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X W !?5,$P(^VA(200,X,0),U,1)
D PT^APCM13SL
I APCMROT="" G DEMO
ZIS ;call to XBDBQUE
D REPORT^APCM13SL
I $G(APCMQUIT) D XIT Q
I APCMRPT="" D XIT Q
K IOP,%ZIS I APCMROT="D",APCMDELT="F" D NODEV,XIT Q
K IOP,%ZIS W !! S %ZIS=$S(APCMDELT'="S":"PQM",1:"PM") D ^%ZIS
I POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMM13C(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMM13P(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D PROC^APCM13E1
U IO
D ^APCM13EP
D ^%ZISC
D XIT
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^APCM13E",XBRX="XIT^APCM13E",XBNS="APCM"
D ^XBDBQUE
Q
;
NODEV1 ;
D PROC^APCM13E1
D ^APCM13EP
D ^%ZISC
D XIT
Q
TSKMN ;EP ENTRY POINT FROM TASKMAN
S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
K ZTSAVE S ZTSAVE("APCM*")=""
S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCM13E",ZTDTH="",ZTDESC="2013 MU STAGE 1 REPORT" D ^%ZTLOAD D XIT Q
Q
;
XIT ;
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^APCM13SL
I '$D(APCMLIST) W !!,"No lists selected.",!
I $D(APCMLIST) S APCMLIST="A" ;I '$D(APCMLIST)!($D(APCMQUIT)) G LISTS ;get report type for each list
Q
A ;fiscal year
S (APCMPER,APCMVDT,APCMBD,APCMED)=""
W !!,"Enter the Calendar Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2013"
S DIR(0)="D^::EP"
S DIR("A")="Enter Year"
S DIR("?")="This report is compiled for a period. Enter a valid year."
D ^DIR KILL DIR
I $D(DIRUT) Q
I $D(DUOUT) S DIRUT=1 Q
S APCMVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G A
S APCMPER=APCMVDT
S APCMBD=$E(APCMPER,1,3)_"0101",APCMED=$E(APCMPER,1,3)_"1231"
S APCMPBD=($E(APCMPER,1,3)-1)_"0101",APCMPED=($E(APCMPER,1,3)-1)_"1231"
Q
B ;
W !!,"Enter the start date of the 90-day report period.",!
S (APCMPER,APCMVDT,APCMBD,APCMED)=""
W ! K DIR,X,Y S DIR(0)="D^::EP",DIR("A")="Enter Start Date for the 90-Day Report: (e.g. 01/01/2013)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
S (APCMPER,APCMVDT)=Y
S APCMBD=Y,APCMED=$$FMADD^XLFDT(APCMBD,89)
S APCMPED=$$FMADD^XLFDT(APCMBD,-1),APCMPBD=$$FMADD^XLFDT(APCMPED,-89)
Q
C ;
S (APCMPER,APCMVDT,APCMBD,APCMED)=""
W !!,"Enter the Calendar Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2013. This is the year that will be used to find an ",!,"automated 90-Day time period.",!!
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 C
S APCMPER=APCMVDT
S APCMBD=$E(APCMPER,1,3)_"0101",APCMED=$$FMADD^XLFDT(APCMBD,89)
S APCMPBD=($E(APCMPER,1,3)-1)_"0101",APCMPED=$$FMADD^XLFDT(APCMPBD,89)
Q
APCM13ES ; IHS/CMI/LAB - IHS MU ;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,$$CTR("IHS 2013 Stage 1 Meaningful Use Performance Measure Report for EPs",80),!
+6 DO XIT
INTRO ;
+1 ;CONTROL VARIABLE FOR EP REPORT
SET APCMRPTT=1
SET APCMIWPL=1
+2 SET APCMRPTC=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
+3 WRITE !
+4 SET X=0
FOR
SET X=$ORDER(^APCMMUCN(APCMRPTC,11,X))
IF X'=+X
QUIT
WRITE ^APCMMUCN(APCMRPTC,11,X,0),!
+5 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
DO ^DIR
KILL DIR,DUOUT,DIRUT
+6 ;NOTICE
+7 WRITE !!!
+8 SET X=0
FOR
SET X=$ORDER(^APCMMUCN(APCMRPTC,12,X))
IF X'=+X
QUIT
WRITE ^APCMMUCN(APCMRPTC,12,X,0),!
+9 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue to report"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
DO XIT
QUIT
+11 IF 'Y
DO XIT
QUIT
+12 ;gather up measures for this report
+13 SET DIR(0)="S^S:Selected set of MU Objectives;A:All MU Objectives"
SET DIR("A")="Run the report on"
SET DIR("B")="S"
KILL DA
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
DO XIT
QUIT
+15 SET APCMINDZ=Y
+16 IF APCMINDZ="S"
DO EN^APCM13SI
IF '$DATA(APCMIND)
WRITE !!,"No measures selected"
HANG 2
GOTO INTRO
+17 IF APCMINDZ="A"
SET X=0
FOR
SET X=$ORDER(^APCM13OB(X))
IF X'=+X
QUIT
IF $PIECE(^APCM13OB(X,0),U,2)="E"
SET APCMIND(X)=""
RT ;
+1 SET APCMSUM=""
+2 WRITE !!,"A full report will include an itemized listing of all performance measures"
+3 WRITE !,"and will include a summary report. The summary report excludes itemized"
+4 WRITE !,"data.",!,"The full report will produce approximately 25 pages of data for"
+5 WRITE !,"each provider. Please take this into consideration when running print jobs,"
+6 WRITE !,"ensuring dedicated time on your printer and sufficient paper supplies"
+7 WRITE !,"to complete your job. "
+8 SET DIR(0)="S^F:Full Report;S:Summary Report"
SET DIR("A")="Enter Selection"
SET DIR("B")="F"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
DO XIT
QUIT
+10 SET APCMSUM=Y
TP ;
+1 SET APCMRPTP=""
+2 WRITE !!,"Report may be run for a 90 day or a one year period. "
+3 SET DIR(0)="S^A:January 1 - December 31;B:User Defined 90-Day Report"
SET DIR("A")="Select Report Period"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO RT
+5 SET APCMRPTP=Y
+6 DO @APCMRPTP
+7 IF APCMBD=""
GOTO TP
+8 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
+9 IF $DATA(DIRUT)
SET APCMQUIT=1
QUIT
+10 IF 'Y
SET APCMQUIT=1
QUIT
PP ;
+1 SET APCMWPP=""
+2 IF APCMRPTP="A"
WRITE !!,"Historical data from the previous calendar year can be included in this report."
+3 IF APCMRPTP="B"
WRITE !!,"Historical data from the 90-days immediately preceding the currently",!,"selected report period can be included."
+4 WRITE !,"IMPORTANT NOTICE: Including previous period data may significantly increase ",!,"run time.",!
+5 SET DIR(0)="Y"
SET DIR("A")="Do you wish to include the previous period"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO TP
+7 SET APCMWPP=Y
PRV ;
+1 SET APCMPLTY=""
+2 SET DIR(0)="S^IP:Individual Provider;SEL:Selected Providers (User Defined);TAX:Provider Taxonomy List"
SET DIR("A")="Enter Selection"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO TP
+4 SET APCMPLTY=Y
+5 SET APCMQUIT=""
+6 IF APCMPLTY="IP"
Begin DoDot:1
+7 KILL APCMPRV
+8 WRITE !!,"Enter the name of the provider for whom the Meaningful User 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 User 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
PL ;do you want any patient lists
+1 IF $GET(APCMIWPL)
DO LISTS
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCMDEMO)
+2 IF APCMDEMO=-1
GOTO PRV
ATTEST ;get answers to attestation questions for each provider.
+1 KILL APCMATTE
+2 FOR X="S1.010.EP","S1.013.EP","S1.014.EP","S1.018.EP","S1.020.EP","S1.024.EP","S1.025.EP"
SET Y=0
FOR
SET Y=$ORDER(APCMPRV(Y))
IF Y'=+Y
QUIT
SET APCMATTE(X,Y)=""
+3 WRITE !!,"There are several objectives in the MU Stage 1 Report that you need"
+4 WRITE !,"to attest to by answering Yes or No for each question for each provider (EP)."
+5 SET APCMQ=0
+6 SET APCMX=""
FOR
SET APCMX=$ORDER(APCMATTE(APCMX))
IF APCMX=""!(APCMQ)
QUIT
Begin DoDot:1
+7 ;WRITE QUESTION
+8 WRITE !
+9 SET Y=$ORDER(^APCM13OB("B",APCMX,0))
+10 ;this measure not being run
IF '$DATA(APCMIND(Y))
QUIT
+11 SET X=0
FOR
SET X=$ORDER(^APCM13OB(Y,19,X))
IF X'=+X
QUIT
WRITE !,^APCM13OB(Y,19,X,0)
+12 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP!(APCMQ)
QUIT
Begin DoDot:2
+13 SET DIR(0)="Y"
SET DIR("A")="Does "_$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_" attest to this"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
SET APCMQ=1
QUIT
+15 SET APCMATTE(APCMX,APCMP)=$SELECT(Y:"Yes",1:"No")
End DoDot:2
End DoDot:1
+16 IF APCMQ
GOTO DEMO
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF 2013 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 !!,"Providers: "
+7 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
WRITE !?5,$PIECE(^VA(200,X,0),U,1)
+8 DO PT^APCM13SL
+9 IF APCMROT=""
GOTO DEMO
ZIS ;call to XBDBQUE
+1 DO REPORT^APCM13SL
+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="^APCMM13C("
DO ^DIK
KILL DIK
DO XIT
QUIT
+7 IF POP
WRITE !,"Report Aborted"
SET DA=APCMRPT
SET DIK="^APCMM13P("
DO ^DIK
KILL DIK
DO XIT
QUIT
+8 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO PROC^APCM13E1
+2 USE IO
+3 DO ^APCM13EP
+4 DO ^%ZISC
+5 DO XIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^APCM13E"
SET XBRX="XIT^APCM13E"
SET XBNS="APCM"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PROC^APCM13E1
+2 DO ^APCM13EP
+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^APCM13E"
SET ZTDTH=""
SET ZTDESC="2013 MU STAGE 1 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 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 ;----------
+3 ;
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^APCM13SL
+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
A ;fiscal year
+1 SET (APCMPER,APCMVDT,APCMBD,APCMED)=""
+2 WRITE !!,"Enter the Calendar Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2013"
+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)_"0101"
SET APCMED=$EXTRACT(APCMPER,1,3)_"1231"
+13 SET APCMPBD=($EXTRACT(APCMPER,1,3)-1)_"0101"
SET APCMPED=($EXTRACT(APCMPER,1,3)-1)_"1231"
+14 QUIT
B ;
+1 WRITE !!,"Enter the start date of the 90-day report period.",!
+2 SET (APCMPER,APCMVDT,APCMBD,APCMED)=""
+3 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/2013)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
QUIT
+5 SET (APCMPER,APCMVDT)=Y
+6 SET APCMBD=Y
SET APCMED=$$FMADD^XLFDT(APCMBD,89)
+7 SET APCMPED=$$FMADD^XLFDT(APCMBD,-1)
SET APCMPBD=$$FMADD^XLFDT(APCMPED,-89)
+8 QUIT
C ;
+1 SET (APCMPER,APCMVDT,APCMBD,APCMED)=""
+2 WRITE !!,"Enter the Calendar Year for which report is to be run. Use a 4 digit",!,"year, e.g. 2013. This is the year that will be used to find an ",!,"automated 90-Day time period.",!!
+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 C
+11 SET APCMPER=APCMVDT
+12 SET APCMBD=$EXTRACT(APCMPER,1,3)_"0101"
SET APCMED=$$FMADD^XLFDT(APCMBD,89)
+13 SET APCMPBD=($EXTRACT(APCMPER,1,3)-1)_"0101"
SET APCMPED=$$FMADD^XLFDT(APCMPBD,89)
+14 QUIT
