Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCM2AE

APCM2AE.m

Go to the documentation of this file.
  1. APCM2AE ; IHS/CMI/LAB - IHS MU ; 07 Oct 2015 1:21 PM
  1. ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
  1. ;
  1. ;
  1. W:$D(IOF) @IOF
  1. EP D XIT
  1. INTRO ;
  1. S APCMRPTT=1
  1. W !!!
  1. W $$CTR("***IHS Modified Stage 2 MU Performance Reports for EPS***",80),!
  1. W $$CTR("Alternate Stage 1 Exclusions",80),!
  1. W !,"This report displays the performance measure results for Modified",!
  1. W "Stage 2 Meaningful Use with alternate Stage 1 exclusions/thresholds.",!
  1. W !,"In order to achieve Meaningful Use, an EP must attest to meeting",!
  1. W "all 10 objectives and their associated performance measures.",!
  1. W !,"The report can be run for 90 days, 1 year or a user defined time period.",!
  1. S DIR(0)="Y",DIR("A")="Do you wish to continue to report",DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) D XIT Q
  1. I 'Y D XIT Q
  1. ;
  1. W !! S X=0 F S X=$O(^APCM25OB(X)) Q:X'=+X I $P(^APCM25OB(X,0),U,2)="E" S APCMIND(X)=""
  1. RT ;
  1. S APCMSUM="S"
  1. TP ;
  1. S APCMRPTP=""
  1. W !
  1. MUYEAR ;
  1. K DIR S DIR(0)="D^::EP"
  1. W !,"Enter the Calendar Year for which the EP is demonstrating Meaningful"
  1. S DIR("A")="Use. Use a 4 digit year, e.g. 2015"
  1. S DIR("?")="Enter a valid year."
  1. D ^DIR KILL DIR
  1. I $D(DIRUT) G EP
  1. I $D(DUOUT) G EP
  1. S APCMVDT=Y
  1. I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G MUYEAR
  1. I $E(Y,1,3)'=315,$E(Y,1,3)'=316 W !!,"Calendar year must equal 2015 or 2016.",! G MUYEAR
  1. S APCMPER=APCMVDT
  1. S APCMLD=$E(APCMPER,1,3)_"0101",APCMHD=$E(APCMPER,1,3)_"1231"
  1. ;
  1. YEAR ;
  1. S (APCMVDT,APCMBD,APCMED)=""
  1. S APCMQ=0
  1. D G:APCMQ INTRO
  1. .W !!,"Select one of the following:",!
  1. .W !?10,"1 User Defined 90-Day Report"
  1. .W !?10,"2 Calendar Year"
  1. .W !?10,"3 User Defined Date Range"
  1. .W ! S DIR(0)="N^1:3:",DIR("A")="Select Report Period" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) S APCMQ=1 Q
  1. .S APCMRPTP=Y
  1. .I APCMRPTP=1 D 5 Q
  1. .I APCMRPTP=2 S APCMBD=APCMLD,APCMED=APCMHD W !!,"Date range is: ",$$FMTE^XLFDT(APCMBD)," - ",$$FMTE^XLFDT(APCMED),"." Q
  1. .I APCMRPTP=3 D 6 Q
  1. I APCMBD="" G TP
  1. I APCMED="" G TP
  1. ;
  1. PRV ;
  1. S APCMPLTY=""
  1. 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
  1. I $D(DIRUT) G TP
  1. S APCMPLTY=Y
  1. S APCMQUIT=""
  1. I APCMPLTY="IP" D I $G(APCMQUIT) G PRV
  1. .K APCMPRV
  1. .W !!,"Enter the name of the provider for whom the Meaningful Use Report will be run.",!
  1. .S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER NAME: " D MIX^DIC1 K DIC,D
  1. .I Y<0 S APCMQUIT=1 Q
  1. .S APCMPRV(+Y)=""
  1. I APCMPLTY="SEL" D I $G(APCMQUIT) G PRV
  1. .K APCMPRV
  1. .W !!,"Enter the name of the provider for whom the Meaningful Use Report will be run.",!
  1. SEL1 .S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER NAME: " D MIX^DIC1 K DIC,D
  1. .I Y<0,'$D(APCMPRV) S APCMQUIT=1 Q
  1. .I Y<0 Q
  1. .S APCMPRV(+Y)=""
  1. .G SEL1
  1. I APCMPLTY="TAX" D I $G(APCMQUIT) G PRV
  1. .W !!,"Enter the name of the provider taxonomy"
  1. .S DIC="^ATXAX(",DIC("S")="I $P(^(0),U,15)=200",DIC(0)="AEMQ",DIC("A")="Enter PROVIDER TAXONOMY NAME: " D ^DIC K DIC
  1. .I Y<0 S APCMQUIT=1 Q
  1. .S APCMPRTX=+Y
  1. .W !,"The following providers are members of this taxonomy: "
  1. .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)
  1. DEMO ;
  1. D DEMOCHK^APCLUTL(.APCMDEMO)
  1. I APCMDEMO=-1 G PRV
  1. ASKADD ;
  1. K APCMADDQ
  1. ;
  1. ATTEST ;get answers to attestation
  1. D ATTESTQ
  1. I APCMQ G PRV
  1. SUM ;display summary
  1. W:$D(IOF) @IOF
  1. W !,$$CTR("SUMMARY OF MODIFIED STAGE 2 REPORT TO BE GENERATED")
  1. W !!,"The date ranges for this report are:"
  1. W !?5,"Report Period: ",?31,$$FMTE^XLFDT(APCMBD)," to ",?31,$$FMTE^XLFDT(APCMED)
  1. W !!,"Providers: "
  1. S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X W !?5,$P(^VA(200,X,0),U,1)
  1. D PT^APCM2ASL
  1. I APCMROT="" G DEMO
  1. ZIS ;call to XBDBQUE
  1. D REPORT^APCM2ASL
  1. I $G(APCMQUIT) D XIT Q
  1. I APCMRPT="" D XIT Q
  1. K IOP,%ZIS I APCMROT="D",APCMDELT="F" D NODEV,XIT Q
  1. K IOP,%ZIS W !! S %ZIS=$S(APCMDELT'="S":"PQM",1:"PM") D ^%ZIS
  1. I POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMM25C(" D ^DIK K DIK D XIT Q
  1. I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1. D PROC^APCM2AE1
  1. U IO
  1. D ^APCM2AEP
  1. D ^%ZISC
  1. D XIT
  1. Q
  1. ;
  1. NODEV ;
  1. S XBRP="",XBRC="NODEV1^APCM2AE",XBRX="XIT^APCM2AE",XBNS="APCM"
  1. D ^XBDBQUE
  1. Q
  1. ;
  1. NODEV1 ;
  1. D PROC^APCM2AE1
  1. D ^APCM2AEP
  1. D ^%ZISC
  1. D XIT
  1. Q
  1. TSKMN ;EP ENTRY POINT FROM TASKMAN
  1. S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
  1. I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
  1. I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
  1. K ZTSAVE S ZTSAVE("APCM*")=""
  1. S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCM2AE",ZTDTH="",ZTDESC="MODIFIED STAGE 2 REPORT" D ^%ZTLOAD D XIT Q
  1. Q
  1. ;
  1. XIT ;
  1. D ^%ZISC
  1. D EN^XBVK("APCM")
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. K DIRUT,DUOUT,DIR,DOD
  1. K DIADD,DLAYGO
  1. D KILL^AUPNPAT
  1. K X,X1,X2,X3,X4,X5,X6
  1. 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
  1. K N,N1,N2,N3,N4,N5,N6
  1. K BD,ED
  1. D KILL^AUPNPAT
  1. D ^XBFMK
  1. Q
  1. ;
  1. CTR(X,Y) ;EP - Center X
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. EOP ;EP - End of page.
  1. Q:$E(IOST)'="C"
  1. Q:$D(ZTQUEUED)!$D(IO("S"))
  1. NEW DIR
  1. K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1. S DIR(0)="E" D ^DIR KILL DIR
  1. Q
  1. ;----------
  1. USR() ;EP - Return USER
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------
  1. 6 ;EP
  1. C ;EP
  1. S (APCMVDT,APCMBD,APCMED)=""
  1. K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"
  1. D ^DIR I $D(DIRUT) S APCMQ=1 Q
  1. I Y<0 S APCMQ=1 Q
  1. I Y>DT W !!,"Future dates not allowed." G C
  1. I Y<APCMLD W !!,"The beginning date must be within calendar year entered." G C
  1. I Y>APCMHD W !!,"The beginning date must be within calendar year entered." G C
  1. S APCMBD=Y
  1. K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date"
  1. D ^DIR G:Y<1 C
  1. I Y>APCMHD W !!,"The ending date must be within calendar year entered." G C
  1. S APCMED=Y
  1. ;
  1. I APCMED<APCMBD D G C
  1. . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1. Q
  1. 5 ;EP - TEXT
  1. ;W !!,"Enter the start date of the 90-day report period.",!
  1. S (APCMVDT,APCMBD,APCMED)=""
  1. W ! K DIR,X,Y
  1. S DIR(0)="D^::E"
  1. S DIR("A")="Enter Start Date for the 90-Day Report (e.g. 01/01/2015)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) S APCMQ=1 Q
  1. I Y<APCMLD W !!,"The 90 day start and end dates must be within the calendar year entered." G 5
  1. 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
  1. S APCMBD=Y,APCMED=$$FMADD^XLFDT(APCMBD,89)
  1. Q
  1. ;
  1. CXIT ;
  1. K DIR
  1. Q
  1. EPRES ;EP - ask additional exclusion questions for e-prescribing
  1. S APCMQ=0
  1. S APCMY=$O(^APCM25OB("B","S2.003.EP",0))
  1. ;Q:'$D(APCMIND(APCMY)) ;measure not being run
  1. K APCMADDQ("ANS",APCMY)
  1. ;display exclusion text/narrative
  1. I $O(^APCM25OB(APCMY,26,0)) D ET
  1. I APCMPLTY="SEL"!(APCMPLTY="TAX") D G:APCMIND=1 EIND Q
  1. .S APCMQ=0,APCMIND=0
  1. .W !,"The e-Prescribing onsite pharmacy question below may be addressed as a group or"
  1. .W !,"by individual provider. Do you want to answer for all selected providers as a"
  1. .S DIR(0)="Y",DIR("A")="group Y/N",DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) S APCMQ=1 Q
  1. .I 'Y S APCMIND=1 Q
  1. .W !!,"Do all selected providers included in this report have an onsite"
  1. .S DIR(0)="Y",DIR("A")="pharmacy Y/N",DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) S APCMQ=1 Q
  1. .I 'Y S APCMIND=1 Q
  1. .S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP S APCMADDQ("ANS",APCMY,24,APCMP)="Yes"
  1. EIND ;ask individually
  1. S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ) D
  1. .S APCMZ=0 F S APCMZ=$O(^APCM25OB(APCMY,24,APCMZ)) Q:APCMZ'=+APCMZ W !,^APCM25OB(APCMY,24,APCMZ,0)
  1. .W ! S DIR(0)="Y",DIR("A")=$E($P(^VA(200,APCMP,0),U,1),1,25)_"'s answer",DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) S APCMQ=1 Q
  1. .S APCMADDQ("ANS",APCMY,24,APCMP)=$S(Y:"Yes",1:"No")
  1. .Q:Y
  1. .W ! S X=0 F S X=$O(^APCM25OB(APCMY,25,X)) Q:X'=+X W !,^APCM25OB(APCMY,25,X,0)
  1. .;
  1. .W ! S DIR(0)="Y",DIR("A")=$E($P(^VA(200,APCMP,0),U,1),1,25)_"'s answer",DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) S APCMQ=1 Q
  1. .S APCMADDQ("ANS",APCMY,25,APCMP)=$S(Y:"Yes",1:"No")
  1. Q
  1. ET ;
  1. W ! S APCMZ=0 F S APCMZ=$O(^APCM25OB(APCMY,26,APCMZ)) Q:APCMZ'=+APCMZ W !,^APCM25OB(APCMY,26,APCMZ,0)
  1. W !
  1. Q
  1. ATTESTQ ;EP
  1. K APCMATTE
  1. S APCMQ=0
  1. S Z=0 F S Z=$O(^APCM25OB("ALTA",Z)) Q:Z'=+Z S A=0 F S A=$O(^APCM25OB("ALTA",Z,A)) Q:A'=+A I $D(APCMIND(A)) S X=$P(^APCM25OB(A,0),U,1) D
  1. .S Y=0 F S Y=$O(APCMPRV(Y)) Q:Y'=+Y S APCMATTE(X,Y)="",APCMORA(Z,X)=""
  1. I '$D(APCMATTE) Q ;no measures with attestation being run
  1. S APCMQ=0
  1. I APCMPLTY="SEL"!(APCMPLTY="TAX") D
  1. .W !!,"Each of the questions below may be addressed as a group or individual",!,"attestation.",!
  1. ;PROTECT
  1. I $D(APCMATTE("S2.014.EP")) D
  1. .S APCMQU=19,APCMAP=1,APCMX="S2.014.EP" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.010.EP.1")) D
  1. .S APCMQU=$S($E(APCMPER,1,3)=315:32,$E(APCMPER,1,3)=316:33,1:19),APCMAP=1,APCMX="S2.010.EP.1" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.010.EP.2")) D
  1. .S APCMQU=19,APCMAP=1,APCMX="S2.010.EP.2" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.001.1EP")) D
  1. .W !!,"CPOE Exclusions:"
  1. .W !,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
  1. .W !,"reporting period in 2015 or 2016, the provider may claim the "
  1. .W !,"exclusions below."
  1. .S APCMQU=32,APCMAP=1,APCMX="S2.001.1EP" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.001.2EP")) D
  1. .I '$D(APCMATTE("S2.001.1EP")) D
  1. ..W !,"CPOE Exclusions:"
  1. ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
  1. ..W !,"reporting period in 2015 or 2016, the provider may claim the "
  1. ..W !,"exclusions below."
  1. .S APCMQU=32,APCMAP=1,APCMX="S2.001.2EP" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.003.EP")) D
  1. .S APCMQU=32,APCMAP=1,APCMX="S2.003.EP" D EPRES
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.023.EP")) D
  1. .I $E(APCMPER,1,3)=315 D
  1. ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
  1. ..W !,"reporting period in 2015, the provider may claim one or more of the"
  1. ..W !,"alternate exclusions below."
  1. ..S APCMQU=32,APCMAP=2,APCMX="S2.023.EP" D ASK
  1. .;S APCMQU=19,APCMAP=1,APCMX="S2.023.EP" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.021.EP")),$E(APCMPER,1,3)=315 D
  1. .I '$D(APCMATTE("S2.023.EP")) D
  1. ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
  1. ..W !,"reporting period in 2015, the provider may claim one or more of the"
  1. ..W !,"alternate exclusions below."
  1. .S APCMQU=32,APCMAP=1,APCMX="S2.021.EP" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.022.EP")),$E(APCMPER,1,3)=315 D
  1. .I '$D(APCMATTE("S2.021.EP")) D
  1. ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
  1. ..W !,"reporting period in 2015, the provider may claim one or more of the"
  1. ..W !,"alternate exclusions below."
  1. .S APCMQU=32,APCMAP=1,APCMX="S2.022.EP" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.020.EP")) D
  1. .I $E(APCMPER,1,3)=315 D
  1. ..I '$D(APCMATTE("S2.022.EP")) D
  1. ...W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
  1. ...W !,"reporting period in 2015, the provider may claim one or more of the"
  1. ...W !,"alternate exclusions below."
  1. ..S APCMQU=32,APCMAP=2,APCMX="S2.020.EP.1" D ASK
  1. .Q:APCMQ
  1. .;S APCMQU=19,APCMAP=1,APCMX="S2.020.EP.1" D ASK
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.026.EP")),$E(APCMPER,1,3)=315 D
  1. .I '$D(APCMATTE("S2.020.EP")) D
  1. ..W !!,"If the provider is scheduled to demonstrate Stage 1 for an EHR"
  1. ..W !,"reporting period in 2015, the provider may claim one or more of the"
  1. ..W !,"alternate exclusions below."
  1. .S APCMQU=32,APCMAP=3,APCMX="S2.026.EP" D ASK
  1. .;Q:$D(APCMATTE("S2.020.EP.1")) ;ALREADY ASKED
  1. Q:APCMQ
  1. I $D(APCMATTE("S2.026.EP"))!($D(APCMATTE("S2.020.EP.1"))) D
  1. .S APCMQU=19,APCMAP=1,APCMX="S2.026.EP" D ASK
  1. .I $E(APCMPER,1,3)=315 S APCMQU=31,APCMAP=2,APCMX="S2.026.EP" D ASK
  1. S APCMQU=19
  1. I $D(APCMATTE("S2.024.EP")) S APCMX="S2.024.EP",APCMQU=32 D IMMREG
  1. Q:APCMQ
  1. S APCMQU=19
  1. I $D(APCMATTE("S2.025.EP")) S APCMX="S2.025.EP" D IMMREG
  1. Q:APCMQ
  1. S APCMQU=19
  1. I $D(APCMATTE("S2.030.EP")) S APCMX="S2.030.EP" D IMMREG
  1. Q
  1. ASK ;
  1. D
  1. .S APCMY=$O(^APCM25OB("B",APCMX,0))
  1. .Q:'$O(^APCM25OB(APCMY,APCMQU,0))
  1. .W !
  1. .I APCMX="S2.020.EP.1",APCMAP=1 S Y=$O(^APCM25OB("B","S2.026.EP",0)) Q:$D(APCMIND(Y))
  1. .S X=0 F S X=$O(^APCM25OB(APCMY,APCMQU,X)) Q:X'=+X W !,^APCM25OB(APCMY,APCMQU,X,0)
  1. .I APCMPLTY="SEL"!(APCMPLTY="TAX") D G:APCMIND ATTIND Q
  1. ..S APCMIND=0
  1. ..I '$P(^APCM25OB(APCMY,0),U,13) D
  1. ...W ! S DIR(0)="Y",DIR("A")="Do all selected providers included in this report"_$$T(APCMY,APCMQU)
  1. ...S DIR("B")="YES" I $P(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1",APCMQU'=32 S DIR("B")="NO"
  1. ...I APCMQU=19,$P(^APCM25OB(APCMY,0),U,1)="S2.026.EP" S DIR("B")="NO"
  1. ...KILL DA D ^DIR KILL DIR
  1. ...I $D(DIRUT) S APCMQ=1 Q
  1. ...I 'Y S APCMIND=1 Q
  1. ...S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP I $P(APCMATTE(APCMX,APCMP),U,APCMAP)'="N/A" S $P(APCMATTE(APCMX,APCMP),U,APCMAP)="Yes"
  1. ..I $P(^APCM25OB(APCMY,0),U,13) D
  1. ...W ! S DIR(0)="Y",DIR("A")="Will the following response apply to all EPs included in this report",DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. ...I $D(DIRUT) S APCMQ=1 Q
  1. ...I 'Y S APCMIND=1 Q
  1. ...S DIR(0)="S^Y:YES;N:NO;X:No Registry Available",DIR("A")="All selected providers included in this report attest to (Enter Y, N or X)",DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. ...I $D(DIRUT) S APCMQ=1 Q
  1. ...S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP S $P(APCMATTE(APCMX,APCMP),U,APCMAP)=$S(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
  1. ATTIND .;
  1. .S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ) D
  1. ..W !
  1. ..I '$P(^APCM25OB(APCMY,0),U,13) S DIR(0)="Y",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_$$T(APCMY,APCMQU)
  1. ..S DIR("B")="YES" I $P(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1",APCMQU'=32 S DIR("B")="NO"
  1. ..I APCMQU=19,$P(^APCM25OB(APCMY,0),U,1)="S2.026.EP" S DIR("B")="NO"
  1. ..KILL DA D ^DIR KILL DIR
  1. ..I $P(^APCM25OB(APCMY,0),U,13) S DIR(0)="S^Y:YES;N:NO;X:No Registry Available" D
  1. ...S DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_$$T(APCMY,APCMQU),DIR("B")="YES" KILL DA D ^DIR KILL DIR
  1. ..I $D(DIRUT) S APCMQ=1 Q
  1. ..S $P(APCMATTE(APCMX,APCMP),U,APCMAP)=$S(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
  1. Q
  1. IMMREG ;EP - ask
  1. D IMMREG^APCM2AEA
  1. Q
  1. SPECREG ;
  1. D SPECREG^APCM2AEA
  1. Q
  1. SS D SS^APCM2AEA
  1. Q
  1. T(APCMY,APCMQU) ;
  1. I APCMQU=32,$P(^APCM25OB(APCMY,0),U,1)="S2.020.EP.1" Q " claim this exclusion"
  1. I APCMQU=32,$P(^APCM25OB(APCMY,0),U,1)="S2.026.EP" Q " claim this exclusion"
  1. I APCMQU=31 Q " attest to this"
  1. NEW %
  1. S %=$S($P($G(^APCM25OB(APCMY,11)),U,1)]"":$P(^APCM25OB(APCMY,11),U,1),1:" attest to this")
  1. Q %