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

APCM25ET.m

Go to the documentation of this file. 
  1. APCM25ET ;IHS/CMI/LAB - IHS MU PATIENT LIST;
  1.  ;;1.0;MU PERFORMANCE REPORTS;**7,9,10**;MAR 26, 2012;Build 31
  1.  ;
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1. EP D XIT
  1. INTRO ;
  1.  S APCMRPTT=1  ;CONTROL VARIABLE FOR EP REPORT
  1.  S APCMRPTC=$O(^APCMMUCN("B","MODIFIED STAGE 2 2015",0))
  1.  W !!!
  1.  ;S X=0 F  S X=$O(^APCMMUCN(APCMRPTC,11,X)) Q:X'=+X  W ^APCMMUCN(APCMRPTC,11,X,0),!
  1.  W "*IHS Modified Stage 2 MU Performance Reports for EPS*",!
  1.  W !,"This report displays the performance measure results for Modified",!
  1.  W "Stage 2 Meaningful Use.  In order to achieve Meaningful Use, an EP must",!
  1.  W "attest to meeting 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.  W !,"This report allows a user to review the patients that populate the",!
  1.  W "numerator and denominator of each Performance Measure."
  1.  W !!
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue to report",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D XIT Q
  1.  I 'Y D XIT Q
  1.  ;gather up measures for this report
  1.  S DIR(0)="S^S:One or More Performance Measures;A:All MU Performance Measures",DIR("A")="Run the report on",DIR("B")="S" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D XIT Q
  1.  S APCMINDZ=Y
  1.  I APCMINDZ="S" D EN^APCM25SI S Q=0 D  I Q G INTRO
  1.  .I '$D(APCMIND) W !!,"No measures selected" H 2 S Q=1 Q
  1.  .S X=0 F  S X=$O(APCMIND(X)) Q:X'=+X  D
  1.  ..;GET ALL WITH SAME SUMMARY ORDER # AND ADD IN
  1.  ..S O=0 F  S O=$O(^APCM25OB(X,29,O)) Q:O'=+O  S Y=$P(^APCM25OB(X,29,O,0),U,1),Y=$O(^APCM25OB("B",Y,0)) I Y S APCMIND(Y)=""
  1.  I APCMINDZ="A" S X=0 F  S X=$O(^APCM25OB(X)) Q:X'=+X  I $P(^APCM25OB(X,0),U,2)="E" S APCMIND(X)=""
  1. SI D LISTS
  1. SI1 ;NOW SELECT ONE OR MORE W/IN THE TOPIC
  1.  K APCMX,APCMY,APCMINDL S APCMQ=0
  1.  D TERM^VALM0
  1.  ;REORDER IN AOI FORMAT
  1.  K APCMINDO
  1.  S APCMIND=0 F  S APCMIND=$O(APCMLIST(APCMIND)) Q:APCMIND'=+APCMIND  S APCMINDO($P(^APCM25OB(APCMIND,0),U,4),APCMIND)=""
  1.  S APCMORD=0 F  S APCMORD=$O(APCMINDO(APCMORD)) Q:APCMORD'=+APCMORD!(APCMQ)!($D(DIRUT))  D
  1.  .S APCMIND=$O(APCMINDO(APCMORD,0))
  1.  .S APCMCR="AEP"
  1.  .K APCMX S APCMO=0,X=0,APCMC=0 F  S APCMO=$O(^APCMM25L(APCMCR,APCMIND,APCMO)) Q:APCMO'=+APCMO!($D(DIRUT))  D
  1.  ..S X=$O(^APCMM25L(APCMCR,APCMIND,APCMO,0))
  1.  ..S APCMX(APCMO,X)="",APCMC=APCMC+1
  1.  .;display the choices
  1.  .W !!!,"Please select one or more of these report choices within the",!,IORVON,$P(^APCM25OB(APCMIND,0),U,5),IORVOFF," objective.",!
  1.  .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(^APCMM25L(X,0),U,3) S APCMY(APCMC)=X
  1.  .S DIR(0)="L^1:"_APCMC,DIR("A")="Which item(s)"
  1.  .D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  .I Y="" W !,"No REPORTS selected for this objective." Q
  1.  .I $D(DIRUT) W !,"No REPORTs selected for this objective." Q
  1.  .S APCMANS=Y,APCMC="" F APCMI=1:1 S APCMC=$P(APCMANS,",",APCMI) Q:APCMC=""  S APCMINDL(APCMIND,APCMY(APCMC))=""
  1.  ;get report type
  1.  I $D(DIRUT) G SI
  1.  K APCMQUIT ;D RT^APCM25SL I '$D(APCMLIST)!($D(APCMQUIT)) G SI
  1. RT ;
  1.  S APCMSUM="S"
  1. TP ;
  1.  S APCMRPTP=""
  1.  ;
  1.  W !
  1. MUYEAR ;
  1.  K APCMPER,APCMVDT,APCMEDUD  ;IHS/CMI/LAB - PATCH 9 06/06/2017
  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 W !!,"Year entered cannot be prior to 2015.",! G MUYEAR
  1.  S APCMPER=APCMVDT
  1.  I $E(APCMPER,1,3)>316 S APCMEDUD=$E(APCMPER,1,3)_"1231"  ;IHS/CMI/LAB - PATCH 10 06/20/2018
  1.  S APCMLD=$E(APCMPER,1,3)_"0101",APCMHD=$E(APCMPER,1,3)_"1231"   ;LOW AND HIGH DATES ALLOWED BELOW
  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^APCM25E 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^APCM25E Q
  1.  I APCMBD="" G TP
  1.  I APCMED="" G TP
  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 Patient List 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 Patient List 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.  ;S A=$O(^APCM25OB("B","S2.008.EP",0))
  1.  S B=$O(^APCM25OB("B","S2.003.EP",0))
  1.  I '$D(APCMIND(B)) G ATTEST
  1.  W !!,"Please answer the following exclusion questions for each provider."
  1.  D EPRES^APCM25E ;ASK ADDITIONAL QUESTIONS FOR E-PRESCRIBING
  1.  I APCMQ G DEMO
  1. ATTEST ;get answers to attestation questions for each provider.
  1.  D ATTESTQ^APCM25E
  1.  I APCMQ G DEMO
  1. SUM ;display summary of this report
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("SUMMARY OF IHS MODIFIED STAGE 2 MEANINGFUL USE 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.  I $E(APCMPER,1,3)>316,($$HAS("S2.021.EP")!($$HAS("S2.020.EP"))!($$HAS("S2.023.EP"))) D    ;IHS/CMI/LAB - PATCH 9 06/06/2017
  1.  .S C=0
  1.  .W !!,"Please note: the date range is ",$$FMTE^XLFDT(APCMBD)," to ",$$FMTE^XLFDT(APCMEDUD)," for ",!
  1.  .I $$HAS("S2.021.EP") W ?5,"Patient Education",!
  1.  .I $$HAS("S2.020.EP") W ?5,"Patient Electronic Access",!
  1.  .I $$HAS("S2.023.EP") W ?5,"Summary of Care (HIE)",!
  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^APCM25SL
  1.  I APCMROT="" G DEMO
  1. ZIS ;call to XBDBQUE
  1.  D REPORT^APCM25SL
  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 POP W !,"Report Aborted" S DA=APCMRPT,DIK="^APCMM14P(" D ^DIK K DIK D XIT Q
  1.  I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1.  D PROC^APCM25E1
  1.  U IO
  1.  D ^APCM25EP
  1.  D ^%ZISC
  1.  D XIT
  1.  Q
  1.  ;
  1. NODEV ;
  1.  S XBRP="",XBRC="NODEV1^APCM25ET",XBRX="XIT^APCM25ET",XBNS="APCM"
  1.  D ^XBDBQUE
  1.  Q
  1.  ;
  1. NODEV1 ;
  1.  D PROC^APCM25E1
  1.  D ^APCM25EP
  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^APCM25E",ZTDTH="",ZTDESC="2014 MU STAGE 2 REPORT" D ^%ZTLOAD D XIT Q
  1.  Q
  1.  ;
  1. XIT ;
  1.  L -^APCMM25C
  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 in a field Y wide.
  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 name of current user from ^VA(200.
  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. LISTS ;any lists with measures?
  1.  K APCMLIST,APCMQUIT
  1.  W !!,"PATIENT LISTS"
  1.  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
  1.  .K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
  1.  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
  1.  I $D(DIRUT)!(Y="") Q
  1.  I Y=0 Q
  1.  K APCMLIST
  1.  D EN^APCM25SL
  1.  I '$D(APCMLIST) W !!,"No lists selected.",!
  1.  I $D(APCMLIST) S APCMLIST="A" ;I '$D(APCMLIST)!($D(APCMQUIT)) G LISTS ;get report type for each list
  1.  Q
  1. HAS(I) ;EP
  1.  NEW X,Y
  1.  S Y=0
  1.  S X=0 F  S X=$O(APCMIND(X)) Q:X'=+X  I $P(^APCM25OB(X,0),U,1)=I S Y=1
  1.  Q Y