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