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

ABMMUPVH.m

Go to the documentation of this file. 
  1. ABMMUPVH ;IHS/SD/SDR - MU Patient Volume Hospital Report ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**7,10,11**;NOV 12, 2009;Build 133
  1.  ;
  1. EN ;
  1.  I $P($G(^ABMMUPRM(1,0)),U,2)="" D  Q
  1.  .W !!,"Setup has not been done.  Please do MUP option prior to running any reports",!
  1.  .S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  ;
  1.  K ^XTMP("ABM-PVH",$J)
  1.  S ABMY("RTYP")="HOS"
  1.  D FAC^ABMMUPVP Q:'$D(ABMF)&($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT))
  1.  M ABMFAC=ABMF
  1.  ;
  1.  W !!,"Hospital/ER Participation year for the Meaningful Use EHR incentive program",!!
  1.  W "For Hospitals/ERs, the Participation year is a federal fiscal year, which "
  1.  W !,"begins on October 1, and ends on the following September 30."
  1.  W !!,"Note: The qualification year is the year prior to the participation year."
  1.  W !,"Patient Volume is calculated on encounters that occurred in the qualification"
  1.  W !,"year, which is the year prior to the participation year.  To view volume for "
  1.  W !,"the current year, select next year as the participation year.",!
  1.  ;
  1.  D PARTYR^ABMMUPVP Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)  ;participation year
  1.  ;start new code abm*2.6*11 MU4
  1.  I (ABMY("PYR")>2012) D  Q
  1.  .W !!?5,"**NOTE** For CY 2013+, you should use report options within menu "
  1.  .W !?15,"MUS2 PARTICIPATION CY 2013+ PATIENT VOLUME REPORTS"
  1.  .W ! S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  ;end new code MU4
  1.  D 90DAY^ABMMUPVP Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)  ;select 90-day window
  1.  D RFORMAT^ABMMUPVP Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)  ;summary/abbrev. sum/patient list
  1.  D SUMMARY^ABMMUPVP Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)  ;summary of selections
  1.  D ^XBFMK
  1.  S DIR(0)="S^P:Print Report;R:Return to Selection Criteria -Erases ALL previous selections"
  1.  S DIR("A")="Do you want to print this report?"
  1.  D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1.  I $P(Y,U)="R" K ABMY,ABMPRVDR,ABMF G EN
  1.  S ABMQ("RX")="POUT^ABMDRUTL"
  1.  S ABMQ("NS")="ABM"
  1.  S ABMQ("RP")="COMPUTE^ABMMUPVH"
  1.  D ^ABMDRDBQ
  1.  Q
  1. COMPUTE ;EP - gather data report
  1.  I ABMY("90")="B" D  Q
  1.  .S X1=ABMY("SDT")
  1.  .S X2=89
  1.  .D C^%DTC
  1.  .S ABMY("EDT")=X
  1.  .D VISITS
  1.  .D BILLS
  1.  .D CALC
  1.  .D PRINT
  1.  ;
  1.  I ABMY("90")="C" D VISITS,BILLS,CALC,PRINT Q
  1.  ;
  1.  S ABMY("SDT")=(ABMY("QYR")-1701)_"1001"
  1.  S X1=ABMY("SDT")
  1.  S X2=89
  1.  D C^%DTC
  1.  S ABMY("EDT")=X
  1.  D VISITS
  1.  D BILLS
  1.  D CALC
  1.  S ABM=0
  1.  F  S ABM=$O(ABMF(ABM)) Q:'ABM  D
  1.  .I +$G(^XTMP("ABM-PVH",$J,"LOC TOP",ABM))>9.99 K ABMF(ABM)
  1.  I '$D(ABMF) D PRINT Q
  1.  S ABMQLFLG=0
  1.  F  D  Q:ABMQLFLG=1
  1.  .S X1=ABMY("SDT")
  1.  .S X2=1
  1.  .D C^%DTC
  1.  .S ABMY("SDT")=X
  1.  .S ABMDFLG=1
  1.  .S X1=ABMY("SDT")
  1.  .S X2=89
  1.  .D C^%DTC
  1.  .S ABMY("EDT")=X
  1.  .I ABMY("EDT")>((ABMY("QYR")-1700)_"0930")!(ABMY("EDT")>DT) S ABMQLFLG=1 Q
  1.  .K ^XTMP("ABM-PVH",$J,"VISITS")
  1.  .D VISITS
  1.  .D BILLS
  1.  .D CALC
  1.  .S ABM=0
  1.  .F  S ABM=$O(ABMF(ABM)) Q:'ABM  D
  1.  ..I +$G(^XTMP("ABM-PVH",$J,"LOC TOP",ABM))>9.99 K ABMF(ABM)
  1.  .I '$D(ABMF) S ABMQLFLG=1 Q
  1.  D PRINT
  1.  Q
  1. VISITS ;
  1.  S ABMFILE="AUPNVINP"
  1.  S ABMSDT=ABMY("SDT")
  1.  S ABMEDT=ABMY("EDT")+.999999
  1.  F  S ABMSDT=$O(^AUPNVINP("B",ABMSDT)) Q:'ABMSDT!(ABMSDT>ABMEDT)  D
  1.  .S ABMVIEN=0
  1.  .F  S ABMVIEN=$O(^AUPNVINP("B",ABMSDT,ABMVIEN)) Q:'ABMVIEN  D
  1.  ..S ABMVDFN=$$GET1^DIQ(9000010.02,ABMVIEN,.03,"I")
  1.  ..S ABMSCAT=$$GET1^DIQ(9000010,ABMVDFN,.07,"I")  ;service cat
  1.  ..S ABMCLNC=$$GET1^DIQ(9000010,ABMVDFN,.08,"I")  ;clinic
  1.  ..S ABMPT=$$GET1^DIQ(9000010,ABMVDFN,.05,"I")  ;patient
  1.  ..D VISITCK
  1.  S ABMSDT=ABMY("SDT")
  1.  S ABMEDT=ABMY("EDT")+.999999
  1.  S ABMFILE="AUPNVSIT"
  1.  F  S ABMSDT=$O(^AUPNVSIT("B",ABMSDT)) Q:'ABMSDT!(ABMSDT>ABMEDT)  D
  1.  .S ABMVDFN=0
  1.  .F  S ABMVDFN=$O(^AUPNVSIT("B",ABMSDT,ABMVDFN)) Q:'ABMVDFN  D
  1.  ..S ABMSCAT=$$GET1^DIQ(9000010,ABMVDFN,.07,"I")  ;service cat
  1.  ..S ABMCLNC=$$GET1^DIQ(9000010,ABMVDFN,.08,"I")  ;clinic
  1.  ..S ABMPT=$$GET1^DIQ(9000010,ABMVDFN,.05,"I")  ;patient
  1.  ..D VISITCK
  1.   Q
  1. VISITCK ;EP
  1.  ;service cat MUST be H, or (A w/clinic=30)
  1.  K ABMFLG
  1.  I ABMFILE="AUPNVINP",ABMSCAT="H" S ABMFLG=1
  1.  I (ABMFILE="AUPNVSIT")&((ABMSCAT="A")&(ABMCLNC=30)) S ABMFLG=1
  1.  Q:(+$G(ABMFLG)=0)
  1.  S ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,.06,"I")
  1.  I ($$GET1^DIQ(9000010,ABMVLOC,.12)'="")&(ABMSDT>$$GET1^DIQ(9000010,ABMVLOC,.12,"I")&($$GET1^DIQ(9000010,ABMVLOC,1111,"I")'="R")) Q
  1.  Q:'$D(ABMF(ABMVLOC))  ;not a selected location
  1.  S ^XTMP("ABM-PVH",$J,"LOC-DENOM",ABMY("SDT"))=+$G(^XTMP("ABM-PVH",$J,"LOC-DENOM",ABMY("SDT")))+1
  1.  S ^XTMP("ABM-PVH",$J,"LOC-DENOM",ABMY("SDT"),ABMVLOC)=+$G(^XTMP("ABM-PVH",$J,"LOC-DENOM",ABMY("SDT"),ABMVLOC))+1
  1.  S ^XTMP("ABM-PVH",$J,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)=""  ;list of visits by patient,DOS
  1.  S ^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)=""  ;list of visits to check for pymt
  1.  S ^XTMP("ABM-PVH",$J,"VISIT CNT")=+$G(^XTMP("ABM-PVH",$J,"VISIT CNT"))+1  ;count of visits
  1.  S ^XTMP("ABM-PVH",$J,"ALL VISITS",ABMVDFN)=""  ;list of all visits looked at
  1.  S ^XTMP("ABM-PVH",$J,"ALL VISIT CNT")=+$G(^XTMP("ABM-PVH",$J,"ALL VISIT CNT"))+1  ;count of all visits
  1.  I ^XTMP("ABM-PVH",$J,"ALL VISIT CNT")#1000 U IO(0) W "."
  1.  K ABMITYP
  1.  D PTDATA
  1.  Q
  1. BILLS ;EP
  1.  S ABMCNT=0
  1.  S ABMDUZ2=0
  1.  S ABMFOUND=0
  1.  F  S ABMDUZ2=$O(^ABMDBILL(ABMDUZ2)) Q:'ABMDUZ2  D
  1.  .S ABMVDFN=0
  1.  .F  S ABMVDFN=$O(^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)) Q:'ABMVDFN  D
  1.  ..I (+$G(^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)))=1 Q  ;already counted this visit on report
  1.  ..Q:'$D(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN))  ;visit not under this DUZ(2)
  1.  ..S ABMP("BDFN")=0
  1.  ..F  S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN,ABMP("BDFN"))) Q:'ABMP("BDFN")  D  Q:(+$G(^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)))=1
  1.  ...S (ABMBILLN,ABMSAV)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
  1.  ...I $P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,4)="X" Q
  1.  ...S ABMVLOC=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
  1.  ...S ABMINS=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8)
  1.  ...S ABMPT=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
  1.  ...F  S ABMBILLN=$O(^BARBL(ABMPAR,"B",ABMBILLN)) Q:$G(ABMBILLN)=""!(ABMBILLN'[ABMSAV)  D  Q:(+$G(^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)))=1
  1.  ....S ABMARIEN=0
  1.  ....S ABMHOLD=DUZ(2)
  1.  ....S DUZ(2)=ABMPAR
  1.  ....F  S ABMARIEN=$O(^BARBL(DUZ(2),"B",ABMBILLN,ABMARIEN)) Q:'ABMARIEN  D  Q:(+$G(^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)))=1
  1.  .....S ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"I")     ;A/R BILL, A/R ACCOUNT
  1.  .....S D0=ABMARACT
  1.  .....S ABMITYP=$$VALI^BARVPM(8)   ;GET 'VIP INSURER TYPE' CODE
  1.  .....S ABMGRP=$S(ABMITYP="D":"MCD",ABMITYP="K":"CHIP",1:"OTHR")
  1.  .....S ABMABILN=$P($G(^BARBL(DUZ(2),ABMARIEN,0)),U)
  1.  .....S ABMTRIEN=0,ABMQFLG=0
  1.  .....F  S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN)) Q:'ABMTRIEN  D  Q:ABMQFLG=1
  1.  ......S ABMTRTYP=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U)
  1.  ......I "^40^113^114^121^132^137^138^139^"'[("^"_ABMTRTYP_"^") Q  ;payment or payment credit
  1.  ......I ($$GET1^DIQ(90050.03,ABMTRIEN,3.5))<(.01) Q  ;don't count 0 pymts or reversals
  1.  ......I ABMITYP="D"!((ABMITYP="K")&$D(^ABMMUPRM(1,1,"B",ABMVLOC))) D
  1.  .......S ABMQFLG=1
  1.  .......I (+$G(^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)))=1 Q  ;already counted this visit on report
  1.  .......S ^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT"))=+$G(^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT")))+1
  1.  .......S ^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT"),ABMVLOC)=+$G(^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT"),ABMVLOC))+1
  1.  .......S ^XTMP("ABM-PVH",$J,"LOC-VST",ABMVDFN)=""
  1.  .......S ^XTMP("ABM-PVH",$J,"VISITS",ABMVDFN)=1
  1.  ......S ^XTMP("ABM-PVH",$J,"LOC ENC CNT",ABMY("SDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVH",$J,"LOC ENC CNT",ABMY("SDT"),ABMVLOC,ABMGRP))+1
  1.  ......S ^XTMP("ABM-PVH",$J,"LOC ENC CNT",ABMY("SDT"),ABMGRP)=+$G(^XTMP("ABM-PVH",$J,"LOC ENC CNT",ABMY("SDT"),ABMGRP))+1
  1.  ......;I ABMCNT#1000 U IO(0) W "."  ;abm*2.6*11 HEAT94295
  1.  ......I (ABMCNT#1000&(IOST["C")) U IO(0) W "."  ;abm*2.6*11 HEAT94295
  1.  ......S ABMCNT=+$G(ABMCNT)+1
  1.  ......D PTDATA
  1.  .....S DUZ(2)=ABMHOLD
  1.  ...I +$G(ABMFOUND)=1 D OTHERVST  ;check for other visits on DOS to mark as paid
  1.  Q
  1. OTHERVST ;EP
  1.  S ABMPT=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
  1.  S (ABMDOS,ABMDOSSV)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
  1.  F  S ABMDOS=$O(^XTMP("ABM-PVH",$J,"PT VSTS",ABMPT,ABMDOS)) Q:'ABMDOS!($P(ABMDOS,".")>$P(ABMDOSSV,"."))  D
  1.  .S ABMVCHK=0
  1.  .F  S ABMVCHK=$O(^XTMP("ABM-PVH",$J,"PT VSTS",ABMPT,ABMDOS,ABMVCHK)) Q:'ABMVCHK  D
  1.  ..Q:^XTMP("ABM-PVH",$J,"VISITS",ABMVCHK)=1  ;already counted this visit
  1.  ..S ABMPIEN=0
  1.  ..F  S ABMPIEN=$O(^AUPNVPRV("AD",ABMVCHK,ABMPIEN)) Q:'ABMPIEN  D
  1.  ...S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
  1.  ...Q:$D(^XTMP("ABM-PVH",$J,"LOC-VST",ABMVCHK))
  1.  ...S ^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT"))=+$G(^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT")))+1
  1.  ...S ^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT"),ABMVLOC)=+$G(^XTMP("ABM-PVH",$J,"LOC-NUM",ABMY("SDT"),ABMVLOC))+1
  1.  ...S ^XTMP("ABM-PVH",$J,"VISITS",ABMVCHK)=1
  1.  Q
  1. PTDATA ;EP
  1.  S ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
  1.  S ABMINSO=$S(+$G(ABMINS):$$GET1^DIQ(9999999.18,ABMINS,.01,"E"),1:"NO BILL")
  1.  S:$G(ABMITYP)="" ABMITYP="X"
  1.  S:$G(ABMTRIEN)="" ABMTRIEN="NOT PAID"
  1.  S ABMREC=ABMVDFN_U_ABMPT_U_$P(ABMTRIEN,".")_U_$S(ABMITYP="D"!((ABMITYP="K")&$D(^ABMMUPRM(1,1,"B",ABMVLOC))):"*",1:"")
  1.  ;S ^XTMP("ABM-PVH",$J,"PT LST",ABMY("SDT"),ABMVLOC,ABMITYP,ABMINSO,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U))=ABMREC  ;abm*2.6*11 HEAT94295
  1.  S ^XTMP("ABM-PVH",$J,"PT LST",ABMY("SDT"),ABMVLOC,ABMITYP,ABMINSO,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC  ;abm*2.6*11 HEAT94295
  1.  I ($G(ABMTRIEN)'="NOT PAID"),$D(^XTMP("ABM-PVH",$J,"PT LST",ABMY("SDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U))) D
  1.  .K ^XTMP("ABM-PVH",$J,"PT LST",ABMY("SDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U))
  1.  Q
  1. CALC ;EP
  1.  S ABMSDT=0
  1.  F  S ABMSDT=$O(^XTMP("ABM-PVH",$J,"LOC-DENOM",ABMSDT)) Q:'ABMSDT  D
  1.  .S ABMLOC=0
  1.  .F  S ABMLOC=$O(^XTMP("ABM-PVH",$J,"LOC-DENOM",ABMSDT,ABMLOC)) Q:'ABMLOC  D
  1.  ..S ABMPERCT=$J((+$G(^XTMP("ABM-PVH",$J,"LOC-NUM",ABMSDT,ABMLOC))/(+$G(^XTMP("ABM-PVH",$J,"LOC-DENOM",ABMSDT,ABMLOC))))*100,0,1)
  1.  ..S ^XTMP("ABM-PVH",$J,"LOC PERCENT",ABMSDT,ABMLOC)=ABMPERCT
  1.  ..I '$D(^XTMP("ABM-PVH",$J,"LOC TOP",ABMLOC)) S ^XTMP("ABM-PVH",$J,"LOC TOP",ABMLOC)=ABMPERCT_"^"_ABMSDT
  1.  ..I +$P($G(^XTMP("ABM-PVH",$J,"LOC TOP",ABMLOC)),U)<ABMPERCT S ^XTMP("ABM-PVH",$J,"LOC TOP",ABMLOC)=ABMPERCT_"^"_ABMSDT
  1.  Q
  1. PRINT ;EP
  1.  S ABMVLOC=0
  1.  F  S ABMVLOC=$O(ABMFAC(ABMVLOC)) Q:'ABMVLOC  D  D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  .S ABM("PG")=1
  1.  .S ABMSDT=$P($G(^XTMP("ABM-PVH",$J,"LOC TOP",ABMVLOC)),U,2)
  1.  .I +$G(^XTMP("ABM-PVH",$J,"LOC TOP",ABMVLOC))>9.99 S ABMPMET=1
  1.  .D HDR^ABMMUPV3
  1.  .;W !,"Hospital used in this report: ",$$GET1^DIQ(9999999.06,ABMVLOC,.01,"E"),$S($D(^ABMMUPRM(1,1,"B",ABMVLOC)):" (FQHC/RHC)",1:""),!  ;abm*2.6*10 HEAT61752
  1.  .W !,"Hospital used in this report: ",$$GET1^DIQ(9999999.06,ABMVLOC,.01,"E"),$S($D(^ABMMUPRM(1,1,"B",ABMVLOC)):" (FQHC/RHC/Tribal)",1:""),!  ;abm*2.6*10 HEAT61752
  1.  .S ABMPMET=0
  1.  .I ABMY("RFMT")="P" D PATIENT^ABMMUPH1 Q
  1.  .I +$G(^XTMP("ABM-PVH",$J,"LOC TOP",ABMVLOC))>9.99 D MET^ABMMUPH1 Q
  1.  .D NOTMET^ABMMUPH1
  1.  K ^XTMP("ABM-PVH",$J)
  1.  Q