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

APCM25H.m

Go to the documentation of this file. 
  1. APCM25H ; IHS/CMI/LAB - IHS MU ;
  1.  ;;1.0;MU PERFORMANCE REPORTS;**7,8,9,10**;MAR 26, 2012;Build 31
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1. EP D XIT
  1. INTRO ;
  1.  S APCMRPTT=2  ;CONTROL VARIABLE FOR CAH REPORT
  1.  S APCMRPTC=$O(^APCMMUCN("B","MODIFIED STAGE 2 2015",0))
  1.  W !!!
  1.  S X=0 F  S X=$O(^APCMMUCN(APCMRPTC,15,X)) Q:X'=+X  W ^APCMMUCN(APCMRPTC,15,X,0),!
  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.  ;gather up measures for this report
  1.  S X=0 F  S X=$O(^APCM25OB(X)) Q:X'=+X  I $P(^APCM25OB(X,0),U,2)="H" S APCMIND(X)=""
  1. RT ;
  1.  S APCMSUM="S"
  1. TP ;
  1.  S APCMRPTP=""
  1.  ;W !! S X=0 F  S X=$O(^APCMMUCN(APCMRPTC,18,X)) Q:X'=+X  W ^APCMMUCN(APCMRPTC,18,X,0),!
  1. MUYEAR ;
  1.  K APCMVDT,APCMPER,APCMEDUD
  1.  K DIR S DIR(0)="D^::EP"
  1.  W !!,"Enter the Calendar Year for which the EH is demonstrating Meaningful"
  1.  S DIR("A")="Use.  Use a 4 digit year, e.g. 2018"
  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 Y'="3150000",Y'="3160000",Y'="3170000",Y'="3180000" W !!,"You can only enter 2015, 2016, 2017 or 2018" G MUYEAR
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! 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
  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 Q
  1.  .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
  1.  .I APCMRPTP=3 D 6 Q
  1.  I APCMBD="" G TP
  1.  I APCMED="" G TP
  1.  ;
  1. METHOD ;
  1.  S APCMMETH=""
  1.  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
  1.  I $D(DIRUT) G TP
  1.  S APCMMETH=Y
  1. FAC ;
  1.  S APCMFAC=""
  1.  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
  1.  G:Y<0 METHOD
  1.  S APCMFAC=+Y
  1. PRV ;
  1.  S APCMQUIT=""
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCMDEMO)
  1.  I APCMDEMO=-1 G FAC
  1. ATTEST ;get answers to attestation questions for each provider.
  1.  K APCMATTE
  1.  D ATTESTQ
  1.  I APCMQ G DEMO
  1.  ;
  1. SUM ;display summary of this report
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("SUMMARY OF 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 D    ;IHS/CMI/LAB - PATCH 9 06/06/2017  PATCH 10 06/20/18
  1.  .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),".",!
  1.  W !!,"Hospital: ",$P(^DIC(4,APCMFAC,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="^APCMM14C(" 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^APCM25H",XBRX="XIT^APCM25H",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^APCM25H",ZTDTH="",ZTDESC="2015 MU 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 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. 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)="DO^"_APCMLD_":"_$$FMADD^XLFDT(APCMHD,-89)_":EP"
  1.  S DIR(0)="D^::E"
  1.  S DIR("A")="Enter Start Date for the 90-Day Report" 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. 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 the 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 the 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. ATTESTQ ;EP
  1.  K APCMATTE
  1.  S APCMQ=0
  1.  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
  1.  .S Y=APCMFAC S APCMATTE(X,Y)="",APCMORA(Z,X)=""
  1.  I '$D(APCMATTE) Q  ;no measures with attestation being run
  1.  W !!,"Please answer the following attestation and exclusion questions.",!
  1.  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
  1.  .;WRITE QUESTION 1 THEN QUESTION 2
  1.  .I APCMX="S2.024.H" D IMMREG Q  ;SYNDROMIC
  1.  .I APCMX="S2.022.H" D IMMREG Q  ;IMM REG
  1.  .I APCMX="S2.023.H" D IMMREG Q  ;REPORTABLE LABS
  1.  .F APCMQU=19,31 S APCMAP=$S(APCMQU=19:1,1:2) D ASK
  1.  Q
  1. ASK ;
  1.  D
  1.  .W !
  1.  .S APCMY=$O(^APCM25OB("B",APCMX,0))
  1.  .Q:'$O(^APCM25OB(APCMY,APCMQU,0))
  1.  .S X=0 F  S X=$O(^APCM25OB(APCMY,APCMQU,X)) Q:X'=+X  W !,^APCM25OB(APCMY,APCMQU,X,0)
  1. ATTIND .;
  1.  .D
  1.  ..W !
  1.  ..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")
  1.  ..S DIR("B")="YES"
  1.  ..I $P(^APCM25OB(APCMY,0),U,1)="S2.025.H.1" 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(^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
  1.  ..I $D(DIRUT) S APCMQ=1 Q
  1.  ..S $P(APCMATTE(APCMX,APCMFAC),U,APCMAP)=$S(Y="X":"N/A",Y="Y":"Yes",Y="N":"No",Y:"Yes",1:"No")
  1.  Q
  1. IMMREG ;EP - ask additional exclusion questions for IMM REG
  1.  D IMMREGH^APCM25EA
  1.  Q