APCM25H ; IHS/CMI/LAB - IHS MU ;
;;1.0;MU PERFORMANCE REPORTS;**7,8,9,10**;MAR 26, 2012;Build 31
;
;
W:$D(IOF) @IOF
EP D XIT
INTRO ;
S APCMRPTT=2 ;CONTROL VARIABLE FOR CAH REPORT
S APCMRPTC=$O(^APCMMUCN("B","MODIFIED STAGE 2 2015",0))
W !!!
S X=0 F S X=$O(^APCMMUCN(APCMRPTC,15,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,15,X,0),!
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
;gather up measures for this report
S X=0 F S X=$O(^APCM25OB(X)) Q:X'=+X I $P(^APCM25OB(X,0),U,2)="H" S APCMIND(X)=""
RT ;
S APCMSUM="S"
TP ;
S APCMRPTP=""
;W !! S X=0 F S X=$O(^APCMMUCN(APCMRPTC,18,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,18,X,0),!
MUYEAR ;
K APCMVDT,APCMPER,APCMEDUD
K DIR S DIR(0)="D^::EP"
W !!,"Enter the Calendar Year for which the EH is demonstrating Meaningful"
S DIR("A")="Use. Use a 4 digit year, e.g. 2018"
S DIR("?")="Enter a valid year."
D ^DIR KILL DIR
I $D(DIRUT) G EP
I $D(DUOUT) G EP
S APCMVDT=Y
;I Y'="3150000",Y'="3160000",Y'="3170000",Y'="3180000" W !!,"You can only enter 2015, 2016, 2017 or 2018" G MUYEAR
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G MUYEAR
S APCMPER=APCMVDT
I $E(APCMPER,1,3)>316 S APCMEDUD=$E(APCMPER,1,3)_"1231" ;IHS/CMI/LAB - PATCH 10
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 Q
.I APCMRPTP=2 S APCMBD=$E(APCMPER,1,3)_"0101",APCMED=$E(APCMPER,1,3)_"1231" 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
;
METHOD ;
S APCMMETH=""
S DIR(0)="S^E:All Emergency Department;O:Observation Method",DIR("A")="Run the report using which method",DIR("B")="E" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G TP
S APCMMETH=Y
FAC ;
S APCMFAC=""
W ! 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 METHOD
S APCMFAC=+Y
PRV ;
S APCMQUIT=""
DEMO ;
D DEMOCHK^APCLUTL(.APCMDEMO)
I APCMDEMO=-1 G FAC
ATTEST ;get answers to attestation questions for each provider.
K APCMATTE
D ATTESTQ
I APCMQ G DEMO
;
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF 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 D ;IHS/CMI/LAB - PATCH 9 06/06/2017 PATCH 10 06/20/18
.W !!,"Please note: the date range for Patient Education, Patient Electronic Access",!,"and Summary of Care (HIE) is ",$$FMTE^XLFDT(APCMBD)," to ",$$FMTE^XLFDT(APCMEDUD),".",!
W !!,"Hospital: ",$P(^DIC(4,APCMFAC,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="^APCMM14C(" 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^APCM25H",XBRX="XIT^APCM25H",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^APCM25H",ZTDTH="",ZTDESC="2015 MU 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 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")
;----------
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)="DO^"_APCMLD_":"_$$FMADD^XLFDT(APCMHD,-89)_":EP"
S DIR(0)="D^::E"
S DIR("A")="Enter Start Date for the 90-Day Report" 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
;
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 the 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 the 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
ATTESTQ ;EP
K APCMATTE
S APCMQ=0
S Z=0 F S Z=$O(^APCM25OB("ATT",Z)) Q:Z'=+Z S A=0 F S A=$O(^APCM25OB("ATT",Z,A)) Q:A'=+A I $D(APCMIND(A)),$P(^APCM25OB(A,0),U,17) S X=$P(^APCM25OB(A,0),U,1) D
.S Y=APCMFAC S APCMATTE(X,Y)="",APCMORA(Z,X)=""
I '$D(APCMATTE) Q ;no measures with attestation being run
W !!,"Please answer the following attestation and exclusion questions.",!
S APCMO=0 F S APCMO=$O(APCMORA(APCMO)) Q:APCMO=""!(APCMQ) S APCMX="" F S APCMX=$O(APCMORA(APCMO,APCMX)) Q:APCMX=""!(APCMQ) D
.;WRITE QUESTION 1 THEN QUESTION 2
.I APCMX="S2.024.H" D IMMREG Q ;SYNDROMIC
.I APCMX="S2.022.H" D IMMREG Q ;IMM REG
.I APCMX="S2.023.H" D IMMREG Q ;REPORTABLE LABS
.F APCMQU=19,31 S APCMAP=$S(APCMQU=19:1,1:2) D ASK
Q
ASK ;
D
.W !
.S APCMY=$O(^APCM25OB("B",APCMX,0))
.Q:'$O(^APCM25OB(APCMY,APCMQU,0))
.S X=0 F S X=$O(^APCM25OB(APCMY,APCMQU,X)) Q:X'=+X W !,^APCM25OB(APCMY,APCMQU,X,0)
ATTIND .;
.D
..W !
..I '$P(^APCM25OB(APCMY,0),U,13) S DIR(0)="Y",DIR("A")="Does "_$E($P(^DIC(4,APCMFAC,0),U,1),1,25)_$S($P($G(^APCM25OB(APCMY,11)),U,1)]"":$P(^APCM25OB(APCMY,11),U,1),1:" attest to this")
..S DIR("B")="YES"
..I $P(^APCM25OB(APCMY,0),U,1)="S2.025.H.1" 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(^DIC(4,APCMFAC,0),U,1),1,25)_$S($P($G(^APCM25OB(APCMY,11)),U,1)]"":$P(^APCM25OB(APCMY,11),U,1),1:" attest to this"),DIR("B")="YES" KILL DA D ^DIR KILL DIR
..I $D(DIRUT) S APCMQ=1 Q
..S $P(APCMATTE(APCMX,APCMFAC),U,APCMAP)=$S(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
Q
IMMREG ;EP - ask additional exclusion questions for IMM REG
D IMMREGH^APCM25EA
Q
APCM25H ; IHS/CMI/LAB - IHS MU ;
+1 ;;1.0;MU PERFORMANCE REPORTS;**7,8,9,10**;MAR 26, 2012;Build 31
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
EP DO XIT
INTRO ;
+1 ;CONTROL VARIABLE FOR CAH REPORT
SET APCMRPTT=2
+2 SET APCMRPTC=$ORDER(^APCMMUCN("B","MODIFIED STAGE 2 2015",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 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue to report"
SET DIR("B")="YES"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
DO XIT
QUIT
+7 IF 'Y
DO XIT
QUIT
+8 ;gather up measures for this report
+9 SET X=0
FOR
SET X=$ORDER(^APCM25OB(X))
IF X'=+X
QUIT
IF $PIECE(^APCM25OB(X,0),U,2)="H"
SET APCMIND(X)=""
RT ;
+1 SET APCMSUM="S"
TP ;
+1 SET APCMRPTP=""
+2 ;W !! S X=0 F S X=$O(^APCMMUCN(APCMRPTC,18,X)) Q:X'=+X W ^APCMMUCN(APCMRPTC,18,X,0),!
MUYEAR ;
+1 KILL APCMVDT,APCMPER,APCMEDUD
+2 KILL DIR
SET DIR(0)="D^::EP"
+3 WRITE !!,"Enter the Calendar Year for which the EH is demonstrating Meaningful"
+4 SET DIR("A")="Use. Use a 4 digit year, e.g. 2018"
+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 ;I Y'="3150000",Y'="3160000",Y'="3170000",Y'="3180000" W !!,"You can only enter 2015, 2016, 2017 or 2018" G MUYEAR
+11 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO MUYEAR
+12 SET APCMPER=APCMVDT
+13 ;IHS/CMI/LAB - PATCH 10
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
QUIT
+12 IF APCMRPTP=2
SET APCMBD=$EXTRACT(APCMPER,1,3)_"0101"
SET APCMED=$EXTRACT(APCMPER,1,3)_"1231"
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 ;
METHOD ;
+1 SET APCMMETH=""
+2 SET DIR(0)="S^E:All Emergency Department;O:Observation Method"
SET DIR("A")="Run the report using which method"
SET DIR("B")="E"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO TP
+4 SET APCMMETH=Y
FAC ;
+1 SET APCMFAC=""
+2 WRITE !
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 METHOD
+4 SET APCMFAC=+Y
PRV ;
+1 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 DO ATTESTQ
+3 IF APCMQ
GOTO DEMO
+4 ;
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF 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 PATCH 10 06/20/18
IF $EXTRACT(APCMPER,1,3)>316
Begin DoDot:1
+6 WRITE !!,"Please note: the date range for Patient Education, Patient Electronic Access",!,"and Summary of Care (HIE) is ",$$FMTE^XLFDT(APCMBD)," to ",$$FMTE^XLFDT(APCMEDUD),".",!
End DoDot:1
+7 WRITE !!,"Hospital: ",$PIECE(^DIC(4,APCMFAC,0),U,1)
+8 DO PT^APCM25SL
+9 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="^APCMM14C("
DO ^DIK
KILL DIK
DO XIT
QUIT
+7 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^APCM25H"
SET XBRX="XIT^APCM25H"
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^APCM25H"
SET ZTDTH=""
SET ZTDESC="2015 MU 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 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 ;----------
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 ;S DIR(0)="DO^"_APCMLD_":"_$$FMADD^XLFDT(APCMHD,-89)_":EP"
+5 SET DIR(0)="D^::E"
+6 SET DIR("A")="Enter Start Date for the 90-Day Report"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+7 IF $DATA(DIRUT)
SET APCMQ=1
QUIT
+8 IF Y<APCMLD
WRITE !!,"The 90 day start and end dates must be within the calendar year entered."
GOTO 5
+9 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
+10 SET APCMBD=Y
SET APCMED=$$FMADD^XLFDT(APCMBD,89)
+11 QUIT
+12 ;
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 the calendar year entered."
GOTO C
+7 SET APCMBD=Y
+8 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Date"
+9 DO ^DIR
IF Y<1
GOTO C
+10 IF Y>APCMHD
WRITE !!,"The ending date must be within the calendar year entered."
GOTO C
+11 SET APCMED=Y
+12 ;
+13 IF APCMED<APCMBD
Begin DoDot:1
+14 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO C
+15 QUIT
ATTESTQ ;EP
+1 KILL APCMATTE
+2 SET APCMQ=0
+3 SET Z=0
FOR
SET Z=$ORDER(^APCM25OB("ATT",Z))
IF Z'=+Z
QUIT
SET A=0
FOR
SET A=$ORDER(^APCM25OB("ATT",Z,A))
IF A'=+A
QUIT
IF $DATA(APCMIND(A))
IF $PIECE(^APCM25OB(A,0),U,17)
SET X=$PIECE(^APCM25OB(A,0),U,1)
Begin DoDot:1
+4 SET Y=APCMFAC
SET APCMATTE(X,Y)=""
SET APCMORA(Z,X)=""
End DoDot:1
+5 ;no measures with attestation being run
IF '$DATA(APCMATTE)
QUIT
+6 WRITE !!,"Please answer the following attestation and exclusion questions.",!
+7 SET APCMO=0
FOR
SET APCMO=$ORDER(APCMORA(APCMO))
IF APCMO=""!(APCMQ)
QUIT
SET APCMX=""
FOR
SET APCMX=$ORDER(APCMORA(APCMO,APCMX))
IF APCMX=""!(APCMQ)
QUIT
Begin DoDot:1
+8 ;WRITE QUESTION 1 THEN QUESTION 2
+9 ;SYNDROMIC
IF APCMX="S2.024.H"
DO IMMREG
QUIT
+10 ;IMM REG
IF APCMX="S2.022.H"
DO IMMREG
QUIT
+11 ;REPORTABLE LABS
IF APCMX="S2.023.H"
DO IMMREG
QUIT
+12 FOR APCMQU=19,31
SET APCMAP=$SELECT(APCMQU=19:1,1:2)
DO ASK
End DoDot:1
+13 QUIT
ASK ;
+1 Begin DoDot:1
+2 WRITE !
+3 SET APCMY=$ORDER(^APCM25OB("B",APCMX,0))
+4 IF '$ORDER(^APCM25OB(APCMY,APCMQU,0))
QUIT
+5 SET X=0
FOR
SET X=$ORDER(^APCM25OB(APCMY,APCMQU,X))
IF X'=+X
QUIT
WRITE !,^APCM25OB(APCMY,APCMQU,X,0)
ATTIND ;
+1 Begin DoDot:2
+2 WRITE !
+3 IF '$PIECE(^APCM25OB(APCMY,0),U,13)
SET DIR(0)="Y"
SET DIR("A")="Does "_$EXTRACT($PIECE(^DIC(4,APCMFAC,0),U,1),1,25)_$SELECT($PIECE($GET(^APCM25OB(APCMY,11)),U,1)]"":$PIECE(^APCM25OB(APCMY,11),U,1),1:" attest to this")
+4 SET DIR("B")="YES"
+5 IF $PIECE(^APCM25OB(APCMY,0),U,1)="S2.025.H.1"
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(^DIC(4,APCMFAC,0),U,1),1,25)_$SELECT($PIECE($GET(^APCM25OB(APCMY,11)),U,1)]"":$PIECE(^APCM25OB(APCMY,11),U,1),1:" attest to this")
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,APCMFAC),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 additional exclusion questions for IMM REG
+1 DO IMMREGH^APCM25EA
+2 QUIT
