ABMM2PH3 ;IHS/SD/SDR - MU Patient Volume Hospital Report ;
;;2.6;IHS 3P BILLING SYSTEM;**15**;NOV 12, 2009;Build 251
;IHS/SD/SDR - 2.6*15 - HEAT161159 - Changed PT LST to sort differently so there won't be duplicate vsts on pt lst.
;IHS/SD/SDR - 2.6*15 - HEAT156874 - Change for <SUBSCR>PTDATA+16^ABMM2PV7. Occurs when patient is missing from visit.
;
TRANS ;EP
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)
.S ABMADJT=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U,3)
.I (ABMTRTYP'=40)&("^113^114^121^132^137^138^139^"'[("^"_ABMADJT_"^")) D ZEROPD 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 cnt 0 pymts or reversals
.D CALCDTS^ABMM2PV1
.S ABMDTFLG=0
.S ABMP("BDT")=ABMP("BSDT")
.F D Q:ABMDTFLG=1
..I ABMITYP="D"!($D(ABMI("INS",ABMINS))) D
...S ABMQFLG=1
...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"))=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT")))+1
...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC))+1
...S ^XTMP("ABM-PVH2",$J,"LOC-NUM PD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
...S ^XTMP("ABM-PVH2",$J,"LOC-NUM PD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
...S ^XTMP("ABM-PVH2",$J,"LOC-VST",ABMVDFN)=""
...I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ABMBILLF=1,^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN)=1
..S ^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP))+1
..S ^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMGRP))+1
..I (ABMCNT#1000&(IOST["C")) U IO(0) W "."
..S ABMCNT=+$G(ABMCNT)+1
..D PTDATA
..S X1=ABMP("BDT")
..S X2=1
..D C^%DTC
..I X>ABMP("BEDT") S ABMDTFLG=1 Q
..S ABMP("BDT")=X
Q
ZEROPD ;EP
D CALCDTS^ABMM2PV1
S ABMDTFLG=0
S ABMP("BDT")=ABMP("BSDT")
F D Q:ABMDTFLG=1
.I ABMITYP="D"!($D(ABMI("INS",ABMINS))) D
..S ^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
..S ^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
.S ^XTMP("ABM-PVH2",$J,"LOC-VST",ABMP("BDT"),ABMVDFN)=""
.I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN)=1
.D PTDATA
.S X1=ABMP("BDT")
.S X2=1
.D C^%DTC
.I X>ABMP("BEDT") S ABMDTFLG=1 Q
.S ABMP("BDT")=X
;
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-PVH2",$J,"PT VSTS",ABMPT,ABMDOS)) Q:'ABMDOS!($P(ABMDOS,".")>$P(ABMDOSSV,".")) D
.S ABMVCHK=0
.F S ABMVCHK=$O(^XTMP("ABM-PVH2",$J,"PT VSTS",ABMPT,ABMDOS,ABMVCHK)) Q:'ABMVCHK D
..Q:^XTMP("ABM-PVH2",$J,"VISITS",ABMVCHK)=1 ;already cnted vst
..Q:$D(^XTMP("ABM-PVH2",$J,"LOC-VST",ABMVCHK))
..D CALCDTS^ABMM2PV1
..S ABMDTFLG=0
..S ABMP("BDT")=ABMP("BSDT")
..F D Q:ABMDTFLG=1
...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"))=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT")))+1
...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC))+1
...S ^XTMP("ABM-PVH2",$J,"VISITS",ABMVCHK)=1
...S X1=ABMP("BDT")
...S X2=1
...D C^%DTC
...I X>ABMDOS S ABMDTFLG=1 Q
...S ABMP("BDT")=X
Q
PTDATA ;EP
S ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
I '$D(^DPT(ABMPT))!(ABMPNM="") Q ;abm*2.6*15 HEAT156874
S ABMINSO=$S(+$G(ABMINS):$$GET1^DIQ(9999999.18,ABMINS,.01,"E"),1:"NO BILL")
S:+$G(ABMBILLN)=0 ABMITYP="X"
S:$G(ABMTRIEN)="" ABMTRIEN="NOT PAID"
I +$G(ABMTRIEN)'=0 D
.S ABMRECPD=""
.I (+$G(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$G(ABMADJT)_"^")) S ABMRECPD="" Q
.;I (ABMITYP="D")!($D(ABMI("INS",ABMINSO))) S ABMRECPD="*" ;abm*2.6*15
.I (ABMITYP="D")!($D(ABMI("INS",ABMINS))) S ABMRECPD="*" ;abm*2.6*15 HEAT161159
I +$G(ABMTRIEN)=0 S ABMTRIEN="NOT PAID",ABMRECPD=""
S ABMREC=ABMVDFN_U_ABMPT_U_$S($G(ABMRECPD)'="":$P($G(ABMTRIEN),"."),1:"")_U_ABMRECPD
S ABMREC=ABMREC_U_$G(ABMBILLN)_U_$S($G(ABMBILLN):+$G(ABMTRAMT),1:$G(ABMTRAMT))_U_$G(ABMDX)
S ABMREC=ABMREC_U_ABMITYP_U_ABMINSO_U_$P(ABMPNM,",")_U_$P(ABMPNM,",",2)_U_$P($G(^AUPNVSIT(ABMVDFN,0)),U) ;abm*2.6*15 HEAT161159
;S ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,ABMITYP,ABMINSO,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*15 HEAT161159
S ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*15 HEAT161159
;start old abm*2.6*15 HEAT161159
;I (+$G(ABMBILLN)'=0)&$D(^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U))) D
;.K ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
;end old abm*2.6*15 HEAT161159
Q
ABMM2PH3 ;IHS/SD/SDR - MU Patient Volume Hospital Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**15**;NOV 12, 2009;Build 251
+2 ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Changed PT LST to sort differently so there won't be duplicate vsts on pt lst.
+3 ;IHS/SD/SDR - 2.6*15 - HEAT156874 - Change for <SUBSCR>PTDATA+16^ABMM2PV7. Occurs when patient is missing from visit.
+4 ;
TRANS ;EP
+1 SET ABMTRIEN=0
SET ABMQFLG=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
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 cnt 0 pymts or reversals
IF ABMTRAMT<(.01)
QUIT
+10 DO CALCDTS^ABMM2PV1
+11 SET ABMDTFLG=0
+12 SET ABMP("BDT")=ABMP("BSDT")
+13 FOR
Begin DoDot:2
+14 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
Begin DoDot:3
+15 SET ABMQFLG=1
+16 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT"))=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT")))+1
+17 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT"),ABMVLOC))+1
+18 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM PD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+19 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM PD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+20 SET ^XTMP("ABM-PVH2",$JOB,"LOC-VST",ABMVDFN)=""
+21 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
SET ABMBILLF=1
SET ^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVDFN)=1
End DoDot:3
+22 SET ^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP))+1
+23 SET ^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMGRP))+1
+24 IF (ABMCNT#1000&(IOST["C"))
USE IO(0)
WRITE "."
+25 SET ABMCNT=+$GET(ABMCNT)+1
+26 DO PTDATA
+27 SET X1=ABMP("BDT")
+28 SET X2=1
+29 DO C^%DTC
+30 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+31 SET ABMP("BDT")=X
End DoDot:2
IF ABMDTFLG=1
QUIT
End DoDot:1
IF ABMQFLG=1
QUIT
+32 QUIT
ZEROPD ;EP
+1 DO CALCDTS^ABMM2PV1
+2 SET ABMDTFLG=0
+3 SET ABMP("BDT")=ABMP("BSDT")
+4 FOR
Begin DoDot:1
+5 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
Begin DoDot:2
+6 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+7 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM ZEROPD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
End DoDot:2
+8 SET ^XTMP("ABM-PVH2",$JOB,"LOC-VST",ABMP("BDT"),ABMVDFN)=""
+9 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
SET ^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVDFN)=1
+10 DO PTDATA
+11 SET X1=ABMP("BDT")
+12 SET X2=1
+13 DO C^%DTC
+14 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+15 SET ABMP("BDT")=X
End DoDot:1
IF ABMDTFLG=1
QUIT
+16 ;
+17 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-PVH2",$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-PVH2",$JOB,"PT VSTS",ABMPT,ABMDOS,ABMVCHK))
IF 'ABMVCHK
QUIT
Begin DoDot:2
+6 ;already cnted vst
IF ^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVCHK)=1
QUIT
+7 IF $DATA(^XTMP("ABM-PVH2",$JOB,"LOC-VST",ABMVCHK))
QUIT
+8 DO CALCDTS^ABMM2PV1
+9 SET ABMDTFLG=0
+10 SET ABMP("BDT")=ABMP("BSDT")
+11 FOR
Begin DoDot:3
+12 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT"))=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT")))+1
+13 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMP("BDT"),ABMVLOC))+1
+14 SET ^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVCHK)=1
+15 SET X1=ABMP("BDT")
+16 SET X2=1
+17 DO C^%DTC
+18 IF X>ABMDOS
SET ABMDTFLG=1
QUIT
+19 SET ABMP("BDT")=X
End DoDot:3
IF ABMDTFLG=1
QUIT
End DoDot:2
End DoDot:1
+20 QUIT
PTDATA ;EP
+1 SET ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
+2 ;abm*2.6*15 HEAT156874
IF '$DATA(^DPT(ABMPT))!(ABMPNM="")
QUIT
+3 SET ABMINSO=$SELECT(+$GET(ABMINS):$$GET1^DIQ(9999999.18,ABMINS,.01,"E"),1:"NO BILL")
+4 IF +$GET(ABMBILLN)=0
SET ABMITYP="X"
+5 IF $GET(ABMTRIEN)=""
SET ABMTRIEN="NOT PAID"
+6 IF +$GET(ABMTRIEN)'=0
Begin DoDot:1
+7 SET ABMRECPD=""
+8 IF (+$GET(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$GET(ABMADJT)_"^"))
SET ABMRECPD=""
QUIT
+9 ;I (ABMITYP="D")!($D(ABMI("INS",ABMINSO))) S ABMRECPD="*" ;abm*2.6*15
+10 ;abm*2.6*15 HEAT161159
IF (ABMITYP="D")!($DATA(ABMI("INS",ABMINS)))
SET ABMRECPD="*"
End DoDot:1
+11 IF +$GET(ABMTRIEN)=0
SET ABMTRIEN="NOT PAID"
SET ABMRECPD=""
+12 SET ABMREC=ABMVDFN_U_ABMPT_U_$SELECT($GET(ABMRECPD)'="":$PIECE($GET(ABMTRIEN),"."),1:"")_U_ABMRECPD
+13 SET ABMREC=ABMREC_U_$GET(ABMBILLN)_U_$SELECT($GET(ABMBILLN):+$GET(ABMTRAMT),1:$GET(ABMTRAMT))_U_$GET(ABMDX)
+14 ;abm*2.6*15 HEAT161159
SET ABMREC=ABMREC_U_ABMITYP_U_ABMINSO_U_$PIECE(ABMPNM,",")_U_$PIECE(ABMPNM,",",2)_U_$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U)
+15 ;S ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,ABMITYP,ABMINSO,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*15 HEAT161159
+16 ;abm*2.6*15 HEAT161159
SET ^XTMP("ABM-PVH2",$JOB,"PT LST",ABMP("BDT"),ABMVLOC,$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC
+17 ;start old abm*2.6*15 HEAT161159
+18 ;I (+$G(ABMBILLN)'=0)&$D(^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U))) D
+19 ;.K ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
+20 ;end old abm*2.6*15 HEAT161159
+21 QUIT
