APCM13H ; IHS/CMI/LAB - IHS MU ;
;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11
;
;
W:$D(IOF) @IOF
D XIT
INTRO ;
S APCMRPTT=2 ;CONTROL VARIABLE FOR CAH REPORT
S APCMRPTC=$O(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
W !
S X=0 F S X=$O(^APCMMUCN(APCMRPTC,15,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,15,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 X=0 F S X=$O(^APCM13OB(X)) Q:X'=+X I $P(^APCM13OB(X,0),U,2)="H" 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 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 a 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(^APCM13OB("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(^APCM13OB("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(^APCM13OB("B",APCMX,0))
.S X=0 F S X=$O(^APCM13OB(APCMY,19,X)) Q:X'=+X W !,^APCM13OB(APCMY,19,X,0)
.D
..I '$P(^APCM13OB(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(^APCM13OB(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 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 !!,"Hospital: ",$P(^DIC(4,APCMFAC,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^APCM13H",XBRX="XIT^APCM13H",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")
;----------
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. 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)-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/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 ;
D C^APCM13E
Q
APCM13H ; 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 DO XIT
INTRO ;
+1 ;CONTROL VARIABLE FOR CAH REPORT
SET APCMRPTT=2
+2 SET APCMRPTC=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
+3 WRITE !
+4 SET X=0
FOR
SET X=$ORDER(^APCMMUCN(APCMRPTC,15,X))
IF X'=+X
QUIT
WRITE ^APCMMUCN(APCMRPTC,15,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 X=0
FOR
SET X=$ORDER(^APCM13OB(X))
IF X'=+X
QUIT
IF $PIECE(^APCM13OB(X,0),U,2)="H"
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 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 a 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(^APCM13OB("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(^APCM13OB("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(^APCM13OB("B",APCMX,0))
+18 SET X=0
FOR
SET X=$ORDER(^APCM13OB(APCMY,19,X))
IF X'=+X
QUIT
WRITE !,^APCM13OB(APCMY,19,X,0)
+19 Begin DoDot:2
+20 IF '$PIECE(^APCM13OB(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(^APCM13OB(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 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 !!,"Hospital: ",$PIECE(^DIC(4,APCMFAC,0),U,1)
+7 DO PT^APCM13SL
+8 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^APCM13H"
SET XBRX="XIT^APCM13H"
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 ;----------
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. 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)-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/2013)"
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^APCM13E
+2 QUIT
