ABMM2P12 ;IHS/SD/SDR - MU Patient Volume EP Report ; 20 Feb 2014 6:04 AM
;;2.6;IHS 3P BILLING SYSTEM;**15**;NOV 12, 2009;Build 251
;IHS/SD/SDR - 2.6*15 - HEAT161159 - Removed DEMO,PATIENT from report. Also added record indicator.
;IHS/SD/SDR - 2.6*15 - HEAT156874 - fix for programming error <SUBSCR>OTHERVST+23^ABMM2PV7. Flag wasn't getting reset from previous visit where it was looking for
; other visits on the same DOS.
;IHS/SD/SDR - 2.6*15 - HEAT171490 - Added code to put visit location NPI and TIN on patient list. Also added record indicator to label visits on pt list
; as to what grouping they were counted in.
;IHS/SD/SDR - 2.6*15 - HEAT174501 - Added primary provider NPI to group report.
;
ARBILLS ;
K ABMTRIEN
S ABMBILLN=+ABMBILLN_" "
S ABMSAV=+ABMSAV
F S ABMBILLN=$O(^BARBL(ABMPAR,"B",ABMBILLN)) Q:$G(ABMBILLN)=""!(ABMBILLN'[ABMSAV) D Q:ABMBILLF
.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:ABMBILLF
..S ABMCBAMT=$$GET1^DIQ(90050.01,ABMARIEN_",",15,"I") ;Current Bill Amount
..S ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"I") ;A/R BILL, A/R ACCOUNT
..I +$$GET1^DIQ(90050.02,ABMARACT,".01","I")'=ABMINS Q ;abm*2.6*15 Only look at A/R bills with 3P Bill insurer
..S D0=ABMARACT
..S ABMITYP=$$VALI^BARVPM(8) ;GET 'VIP INSURER TYPE' CODE
..I ABMITYP="FPL" S ABMITYP="P" ;change FPL to P abm*2.6*15 HEAT161159
..I "^I^N^"[("^"_ABMITYP_"^") Q
..;S ABMTSI=$P($G(^ABMNINS(DUZ(2),ABMINS,0)),U,11) ;abm*2.6*15 HEAT183289
..S ABMGRP=$S(ABMITYP="D":"MCD",($D(ABMI("INS",ABMINS))):"CHIP",1:"OTHR")
..;I ABMTSI="Y"&($G(ABMFQHC)=1) S ABMGRP="TRIBSI" ;abm*2.6*15 HEAT183289
..S ABMABILN=$P($G(^BARBL(DUZ(2),ABMARIEN,0)),U)
..;I "^MCD^CHIP^"'[("^"_ABMGRP_"^") Q
..;S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
..I "^MCD^CHIP^"[("^"_ABMGRP_"^") S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
..I "^MCD^CHIP^"'[("^"_ABMGRP_"^") S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=2
..;
..D CALCDTS^ABMM2PV1
..S ABMDTFLG=0
..S ABMP("BDT")=ABMP("BSDT")
..F D Q:ABMDTFLG=1
...I (ABMCNT#1000&(IOST["C")) W "."
...S ABMCNT=+$G(ABMCNT)+1
...I ABMY("RTYP")="SEL" D
....S ABMPIEN=0
....K ABMPRVC
....F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D
.....S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
.....Q:'$D(ABMPRVDR(ABMPRV))
.....;skip prv if on vst >1
.....Q:$D(ABMPRVC(ABMPRV))
.....S ABMPRVC(ABMPRV)=1
.....D CALCDTS^ABMM2PV1
.....S ABMDTFLG=0
.....S ABMP("BDT")=ABMP("BSDT")
.....F D Q:ABMDTFLG=1
......I ABMP("VDT")<ABMP("BSDT") S ABMDTFLG=1 Q ;vst is before 90-day ;abm*2.6*12 HEAT141419
......D PTDATA^ABMM2PV1
......S X1=ABMP("BDT")
......S X2=1
......D C^%DTC
......I X>ABMP("BEDT") S ABMDTFLG=1 Q
......S ABMP("BDT")=X
...I ABMY("RTYP")="GRP" D GPTDATA^ABMM2PV1
...S X1=ABMP("BDT")
...S X2=1
...D C^%DTC
...I X>ABMP("BEDT") S ABMDTFLG=1 Q
...S ABMP("BDT")=X
..;I "^I^N^"[($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMINS,".211","I"),1,"I")) Q
..D TRANS
.S DUZ(2)=ABMHOLD
Q
TRANS ;
S ABMTRIEN=0
F S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN)) Q:'ABMTRIEN D Q:ABMBILLF
.S ABMTRTYP=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U)
.S ABMADJT=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U,3)
.I (ABMTRTYP'=40)&("^113^114^121^132^137^138^139^"'[("^"_ABMADJT_"^")) D ZEROPD^ABMM2PV1 Q ;pymt or pymt credit
.I ABMTRTYP=49 Q ;skip BILL NEW
.I $P($G(^BARTR(DUZ(2),ABMTRIEN,0)),U,7)=1 Q ;msg trans
.S ABMTRAMT=$$GET1^DIQ(90050.03,ABMTRIEN,3.5) ;debit-credit field
.I ABMTRAMT<(.01) Q ;don't count 0 pymts or reversals
.I ABMY("RTYP")="GRP" D GRPBILL^ABMM2PV1 Q
.S ABMPIEN=0
.K ABMPRVC
.F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D Q:ABMBILLF
..S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,".01","I")
..Q:'$D(ABMPRVDR(ABMPRV))
..;skip prv if on vst >1
..Q:$D(ABMPRVC(ABMPRV))
..S ABMPRVC(ABMPRV)=1
..D CALCDTS^ABMM2PV1
..S ABMDTFLG=0
..S ABMP("BDT")=ABMP("BSDT")
..F D Q:ABMDTFLG=1
...S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=""
...S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD DET",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=ABMTRAMT
...S ^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
...S ^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP))+1
...S ^XTMP("ABM-PVP2",$J,"PRV-VST",ABMP("BDT"),ABMVDFN,ABMPRV)=""
...I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ABMBILLF=1,^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
...I (ABMCNT#1000&(IOST["C")) W "."
...S ABMCNT=+$G(ABMCNT)+1
...D PTDATA^ABMM2PV1
...S X1=ABMP("BDT")
...S X2=1
...D C^%DTC
...I X>ABMP("BEDT") S ABMDTFLG=1 Q
...S ABMP("BDT")=X
Q
ABMM2P12 ;IHS/SD/SDR - MU Patient Volume EP Report ; 20 Feb 2014 6:04 AM
+1 ;;2.6;IHS 3P BILLING SYSTEM;**15**;NOV 12, 2009;Build 251
+2 ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Removed DEMO,PATIENT from report. Also added record indicator.
+3 ;IHS/SD/SDR - 2.6*15 - HEAT156874 - fix for programming error <SUBSCR>OTHERVST+23^ABMM2PV7. Flag wasn't getting reset from previous visit where it was looking for
+4 ; other visits on the same DOS.
+5 ;IHS/SD/SDR - 2.6*15 - HEAT171490 - Added code to put visit location NPI and TIN on patient list. Also added record indicator to label visits on pt list
+6 ; as to what grouping they were counted in.
+7 ;IHS/SD/SDR - 2.6*15 - HEAT174501 - Added primary provider NPI to group report.
+8 ;
ARBILLS ;
+1 KILL ABMTRIEN
+2 SET ABMBILLN=+ABMBILLN_" "
+3 SET ABMSAV=+ABMSAV
+4 FOR
SET ABMBILLN=$ORDER(^BARBL(ABMPAR,"B",ABMBILLN))
IF $GET(ABMBILLN)=""!(ABMBILLN'[ABMSAV)
QUIT
Begin DoDot:1
+5 SET ABMARIEN=0
+6 SET ABMHOLD=DUZ(2)
+7 SET DUZ(2)=ABMPAR
+8 FOR
SET ABMARIEN=$ORDER(^BARBL(DUZ(2),"B",ABMBILLN,ABMARIEN))
IF 'ABMARIEN
QUIT
Begin DoDot:2
+9 ;Current Bill Amount
SET ABMCBAMT=$$GET1^DIQ(90050.01,ABMARIEN_",",15,"I")
+10 ;A/R BILL, A/R ACCOUNT
SET ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"I")
+11 ;abm*2.6*15 Only look at A/R bills with 3P Bill insurer
IF +$$GET1^DIQ(90050.02,ABMARACT,".01","I")'=ABMINS
QUIT
+12 SET D0=ABMARACT
+13 ;GET 'VIP INSURER TYPE' CODE
SET ABMITYP=$$VALI^BARVPM(8)
+14 ;change FPL to P abm*2.6*15 HEAT161159
IF ABMITYP="FPL"
SET ABMITYP="P"
+15 IF "^I^N^"[("^"_ABMITYP_"^")
QUIT
+16 ;S ABMTSI=$P($G(^ABMNINS(DUZ(2),ABMINS,0)),U,11) ;abm*2.6*15 HEAT183289
+17 SET ABMGRP=$SELECT(ABMITYP="D":"MCD",($DATA(ABMI("INS",ABMINS))):"CHIP",1:"OTHR")
+18 ;I ABMTSI="Y"&($G(ABMFQHC)=1) S ABMGRP="TRIBSI" ;abm*2.6*15 HEAT183289
+19 SET ABMABILN=$PIECE($GET(^BARBL(DUZ(2),ABMARIEN,0)),U)
+20 ;I "^MCD^CHIP^"'[("^"_ABMGRP_"^") Q
+21 ;S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
+22 IF "^MCD^CHIP^"[("^"_ABMGRP_"^")
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=1
+23 IF "^MCD^CHIP^"'[("^"_ABMGRP_"^")
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=2
+24 ;
+25 DO CALCDTS^ABMM2PV1
+26 SET ABMDTFLG=0
+27 SET ABMP("BDT")=ABMP("BSDT")
+28 FOR
Begin DoDot:3
+29 IF (ABMCNT#1000&(IOST["C"))
WRITE "."
+30 SET ABMCNT=+$GET(ABMCNT)+1
+31 IF ABMY("RTYP")="SEL"
Begin DoDot:4
+32 SET ABMPIEN=0
+33 KILL ABMPRVC
+34 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:5
+35 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+36 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+37 ;skip prv if on vst >1
+38 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+39 SET ABMPRVC(ABMPRV)=1
+40 DO CALCDTS^ABMM2PV1
+41 SET ABMDTFLG=0
+42 SET ABMP("BDT")=ABMP("BSDT")
+43 FOR
Begin DoDot:6
+44 ;vst is before 90-day ;abm*2.6*12 HEAT141419
IF ABMP("VDT")<ABMP("BSDT")
SET ABMDTFLG=1
QUIT
+45 DO PTDATA^ABMM2PV1
+46 SET X1=ABMP("BDT")
+47 SET X2=1
+48 DO C^%DTC
+49 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+50 SET ABMP("BDT")=X
End DoDot:6
IF ABMDTFLG=1
QUIT
End DoDot:5
End DoDot:4
+51 IF ABMY("RTYP")="GRP"
DO GPTDATA^ABMM2PV1
+52 SET X1=ABMP("BDT")
+53 SET X2=1
+54 DO C^%DTC
+55 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+56 SET ABMP("BDT")=X
End DoDot:3
IF ABMDTFLG=1
QUIT
+57 ;I "^I^N^"[($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMINS,".211","I"),1,"I")) Q
+58 DO TRANS
End DoDot:2
IF ABMBILLF
QUIT
+59 SET DUZ(2)=ABMHOLD
End DoDot:1
IF ABMBILLF
QUIT
+60 QUIT
TRANS ;
+1 SET ABMTRIEN=0
+2 FOR
SET ABMTRIEN=$ORDER(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN))
IF 'ABMTRIEN
QUIT
Begin DoDot:1
+3 SET ABMTRTYP=$PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,1)),U)
+4 SET ABMADJT=$PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,1)),U,3)
+5 ;pymt or pymt credit
IF (ABMTRTYP'=40)&("^113^114^121^132^137^138^139^"'[("^"_ABMADJT_"^"))
DO ZEROPD^ABMM2PV1
QUIT
+6 ;skip BILL NEW
IF ABMTRTYP=49
QUIT
+7 ;msg trans
IF $PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,0)),U,7)=1
QUIT
+8 ;debit-credit field
SET ABMTRAMT=$$GET1^DIQ(90050.03,ABMTRIEN,3.5)
+9 ;don't count 0 pymts or reversals
IF ABMTRAMT<(.01)
QUIT
+10 IF ABMY("RTYP")="GRP"
DO GRPBILL^ABMM2PV1
QUIT
+11 SET ABMPIEN=0
+12 KILL ABMPRVC
+13 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:2
+14 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,".01","I")
+15 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+16 ;skip prv if on vst >1
+17 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+18 SET ABMPRVC(ABMPRV)=1
+19 DO CALCDTS^ABMM2PV1
+20 SET ABMDTFLG=0
+21 SET ABMP("BDT")=ABMP("BSDT")
+22 FOR
Begin DoDot:3
+23 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+24 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD DET",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=ABMTRAMT
+25 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
+26 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP))+1
+27 SET ^XTMP("ABM-PVP2",$JOB,"PRV-VST",ABMP("BDT"),ABMVDFN,ABMPRV)=""
+28 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
SET ABMBILLF=1
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=1
+29 IF (ABMCNT#1000&(IOST["C"))
WRITE "."
+30 SET ABMCNT=+$GET(ABMCNT)+1
+31 DO PTDATA^ABMM2PV1
+32 SET X1=ABMP("BDT")
+33 SET X2=1
+34 DO C^%DTC
+35 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+36 SET ABMP("BDT")=X
End DoDot:3
IF ABMDTFLG=1
QUIT
End DoDot:2
IF ABMBILLF
QUIT
End DoDot:1
IF ABMBILLF
QUIT
+37 QUIT
