ABMDES3 ; IHS/ASDST/DMJ - Display Summarized HCFA-1500B charges ;
;;2.6;IHS 3P BILLING SYSTEM;**6,10,19**;NOV 12, 2009;Build 300
;
; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS on line item
; IHS/SD/SDR - v2.5 p6 - 7/12/04 - IM14097 - Added fix for FL Override for POS
; IHS/SD/SDR - v2.5 p6 - 7/14/04 - IM14187 - Modified to get around bad X-refs if there are any
; IHS/SD/SDR - v2.5 p8 - IM15905 - <UNDEF>HCFA+27^ABMDES3
; IHS/SD/SDR - v2.5 p10 - IM21581 - Added active insurer print to summary
;
;IHS/SD/SDR - 2.6*19 - HEAT235246 - Updated summary so T1015 will be first line to print.
;
HCFA ;EP for displaying charge summary for HCFA-1500
;
D HD
;I ABMP("EXP")=22 S ABMEXP=14 ;abm*2.6*6 5010
I ABMP("EXP")=22!(ABMP("EXP")=32) S ABMEXP=14 ;abm*2.6*6 5010
E S ABMEXP=ABMP("EXP")
S ABMS=0 F S ABMS=$O(ABMS(ABMS)) Q:'ABMS D Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
.I $Y>(IOSL-5) S DIR(0)="EO" D ^DIR W $$EN^ABMVDF("IOF") Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) D HD
.;start new abm*2.6*19 IHS/SD/SDR HEAT235246
.I ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"!($P($G(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN")) D
..S ABMIL=0
..F S ABMIL=$O(ABMS(ABMIL)) Q:'ABMIL D
...I $P($G(ABMS(ABMIL)),U,4)'="T1015" Q
...S ABMTMP("TMP")=$G(ABMS(1))
...S ABMS(1)=$G(ABMS(ABMIL))
...S ABMS(ABMIL)=$G(ABMTMP("TMP"))
.K ABMIL,ABMTMP
.;end new abm*2.6*19 IHS/SD/SDR HEAT235246
.S ABMS("I")=1,ABMLN=0 D PROC^ABMDF3E
.W !,$$HDT^ABMDUTL($P(ABMR(ABMS,0),U))
.W ?11,$$HDT^ABMDUTL($P(ABMR(ABMS,0),U,2))
.;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3))!($D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4))) D ;abm*2.6*10 HEAT53137
.I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3))!($D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4))) D ;abm*2.6*10 HEAT53137
..S ABMFL=0,ABMFLE=0
..F ABMLN=3,4 D
...;F S ABMFL=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,ABMLN,ABMFL)) Q:ABMFL="" I ^(ABMFL)'="^" S ABMFLE=1 ;abm*2.6*10 HEAT53137
...F S ABMFL=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,ABMLN,ABMFL)) Q:ABMFL="" I ^(ABMFL)'="^" S ABMFLE=1 ;abm*2.6*10 HEAT53137
.I $G(ABMFLE)=1 D
..S ABMFLMSG="Form Locator Override edits exist for POS/TOS"
..;
..S ABMVTYP=""
..;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3)) D ;abm*2.6*10 HEAT53137
..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3)) D ;abm*2.6*10 HEAT53137
...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,0)) S ABMVTYP=0 ;abm*2.6*10 HEAT53137
...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,0)) S ABMVTYP=0 ;abm*2.6*10 HEAT53137
...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP") ;abm*2.6*10 HEAT53137
...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP") ;abm*2.6*10 HEAT53137
...Q:+$G(ABMVTYP)=0
...;S $P(ABMR(ABMS,0),U,3)=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMVTYP) ;abm*2.6*10 HEAT53137
...S $P(ABMR(ABMS,0),U,3)=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMVTYP) ;abm*2.6*10 HEAT53137
..;
..S ABMVTYP=""
..;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4)) D ;abm*2.6*10 HEAT53137
..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4)) D ;abm*2.6*10 HEAT53137
...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,0)) S ABMVTYP=0 ;abm*2.6*10 HEAT53137
...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,0)) S ABMVTYP=0 ;abm*2.6*10 HEAT53137
...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP") ;abm*2.6*10 HEAT53137
...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP") ;abm*2.6*10 HEAT53137
...Q:+$G(ABMVTYP)=0
...;S $P(ABMR(ABMS,0),U,4)=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMVTYP) ;abm*2.6*10 HEAT53137
...S $P(ABMR(ABMS,0),U,4)=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMVTYP) ;abm*2.6*10 HEAT53137
.W ?22,$J($P(ABMR(ABMS,0),U,3),2),?23,$J($P(ABMR(ABMS,0),U,4),2),?30,$S($P($G(ABMR(ABMS,(-1))),U)'="":$P(ABMR(ABMS,(-1)),U),1:$P(ABMR(ABMS,0),U,5))
.W ?49,$J($P(ABMR(ABMS,0),U,6),5),?56,$J($FN($P(ABMR(ABMS,0),U,7),",",2),10)
.W ?72,$J($P(ABMR(ABMS,0),U,8),3)
W !?58,"----------"
W !,?10,"TOTAL CHARGE",?56,$J($FN(ABMS("TOT"),",",2),10)
S ABMP("TOT")=ABMP("TOT")+ABMS("TOT")
I $G(ABMFLMSG)'="" W !!!!,ABMFLMSG
F W ! Q:$Y+4>IOSL
S DIR(0)="E" D ^DIR K DIR
Q
;
HD ;SCREEN HEADER
W $$EN^ABMVDF("IOF")
W !,?20,"***** "
W $P(^ABMDEXP(ABMP("EXP"),0),U)
W " CHARGE SUMMARY *****"
W !!,"Active Insurer: ",$P($G(^AUTNINS(ABMP("INS"),0)),U),!
W !,?51,"Corr"
W !?1,"Charge Date ",?21,"POS",?25,"TOS",?30," Description",?51,"Diag",?60,"Charge",?72,"Qty"
S ABMS("I")="",$P(ABMS("I"),"-",80)="" W !,ABMS("I")
Q
ABMDES3 ; IHS/ASDST/DMJ - Display Summarized HCFA-1500B charges ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,10,19**;NOV 12, 2009;Build 300
+2 ;
+3 ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS on line item
+4 ; IHS/SD/SDR - v2.5 p6 - 7/12/04 - IM14097 - Added fix for FL Override for POS
+5 ; IHS/SD/SDR - v2.5 p6 - 7/14/04 - IM14187 - Modified to get around bad X-refs if there are any
+6 ; IHS/SD/SDR - v2.5 p8 - IM15905 - <UNDEF>HCFA+27^ABMDES3
+7 ; IHS/SD/SDR - v2.5 p10 - IM21581 - Added active insurer print to summary
+8 ;
+9 ;IHS/SD/SDR - 2.6*19 - HEAT235246 - Updated summary so T1015 will be first line to print.
+10 ;
HCFA ;EP for displaying charge summary for HCFA-1500
+1 ;
+2 DO HD
+3 ;I ABMP("EXP")=22 S ABMEXP=14 ;abm*2.6*6 5010
+4 ;abm*2.6*6 5010
IF ABMP("EXP")=22!(ABMP("EXP")=32)
SET ABMEXP=14
+5 IF '$TEST
SET ABMEXP=ABMP("EXP")
+6 SET ABMS=0
FOR
SET ABMS=$ORDER(ABMS(ABMS))
IF 'ABMS
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-5)
SET DIR(0)="EO"
DO ^DIR
WRITE $$EN^ABMVDF("IOF")
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
DO HD
+8 ;start new abm*2.6*19 IHS/SD/SDR HEAT235246
+9 IF ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN"))
Begin DoDot:2
+10 SET ABMIL=0
+11 FOR
SET ABMIL=$ORDER(ABMS(ABMIL))
IF 'ABMIL
QUIT
Begin DoDot:3
+12 IF $PIECE($GET(ABMS(ABMIL)),U,4)'="T1015"
QUIT
+13 SET ABMTMP("TMP")=$GET(ABMS(1))
+14 SET ABMS(1)=$GET(ABMS(ABMIL))
+15 SET ABMS(ABMIL)=$GET(ABMTMP("TMP"))
End DoDot:3
End DoDot:2
+16 KILL ABMIL,ABMTMP
+17 ;end new abm*2.6*19 IHS/SD/SDR HEAT235246
+18 SET ABMS("I")=1
SET ABMLN=0
DO PROC^ABMDF3E
+19 WRITE !,$$HDT^ABMDUTL($PIECE(ABMR(ABMS,0),U))
+20 WRITE ?11,$$HDT^ABMDUTL($PIECE(ABMR(ABMS,0),U,2))
+21 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3))!($D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4))) D ;abm*2.6*10 HEAT53137
+22 ;abm*2.6*10 HEAT53137
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3))!($DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4)))
Begin DoDot:2
+23 SET ABMFL=0
SET ABMFLE=0
+24 FOR ABMLN=3,4
Begin DoDot:3
+25 ;F S ABMFL=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,ABMLN,ABMFL)) Q:ABMFL="" I ^(ABMFL)'="^" S ABMFLE=1 ;abm*2.6*10 HEAT53137
+26 ;abm*2.6*10 HEAT53137
FOR
SET ABMFL=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,ABMLN,ABMFL))
IF ABMFL=""
QUIT
IF ^(ABMFL)'="^"
SET ABMFLE=1
End DoDot:3
End DoDot:2
+27 IF $GET(ABMFLE)=1
Begin DoDot:2
+28 SET ABMFLMSG="Form Locator Override edits exist for POS/TOS"
+29 ;
+30 SET ABMVTYP=""
+31 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3)) D ;abm*2.6*10 HEAT53137
+32 ;abm*2.6*10 HEAT53137
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3))
Begin DoDot:3
+33 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,0)) S ABMVTYP=0 ;abm*2.6*10 HEAT53137
+34 ;abm*2.6*10 HEAT53137
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,0))
SET ABMVTYP=0
+35 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP") ;abm*2.6*10 HEAT53137
+36 ;abm*2.6*10 HEAT53137
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMP("VTYP")))
SET ABMVTYP=ABMP("VTYP")
+37 IF +$GET(ABMVTYP)=0
QUIT
+38 ;S $P(ABMR(ABMS,0),U,3)=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMVTYP) ;abm*2.6*10 HEAT53137
+39 ;abm*2.6*10 HEAT53137
SET $PIECE(ABMR(ABMS,0),U,3)=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMVTYP)
End DoDot:3
+40 ;
+41 SET ABMVTYP=""
+42 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4)) D ;abm*2.6*10 HEAT53137
+43 ;abm*2.6*10 HEAT53137
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4))
Begin DoDot:3
+44 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,0)) S ABMVTYP=0 ;abm*2.6*10 HEAT53137
+45 ;abm*2.6*10 HEAT53137
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,0))
SET ABMVTYP=0
+46 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP") ;abm*2.6*10 HEAT53137
+47 ;abm*2.6*10 HEAT53137
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMP("VTYP")))
SET ABMVTYP=ABMP("VTYP")
+48 IF +$GET(ABMVTYP)=0
QUIT
+49 ;S $P(ABMR(ABMS,0),U,4)=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMVTYP) ;abm*2.6*10 HEAT53137
+50 ;abm*2.6*10 HEAT53137
SET $PIECE(ABMR(ABMS,0),U,4)=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMVTYP)
End DoDot:3
End DoDot:2
+51 WRITE ?22,$JUSTIFY($PIECE(ABMR(ABMS,0),U,3),2),?23,$JUSTIFY($PIECE(ABMR(ABMS,0),U,4),2),?30,$SELECT($PIECE($GET(ABMR(ABMS,(-1))),U)'="":$PIECE(ABMR(ABMS,(-1)),U),1:$PIECE(ABMR(ABMS,0),U,5))
+52 WRITE ?49,$JUSTIFY($PIECE(ABMR(ABMS,0),U,6),5),?56,$JUSTIFY($FNUMBER($PIECE(ABMR(ABMS,0),U,7),",",2),10)
+53 WRITE ?72,$JUSTIFY($PIECE(ABMR(ABMS,0),U,8),3)
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+54 WRITE !?58,"----------"
+55 WRITE !,?10,"TOTAL CHARGE",?56,$JUSTIFY($FNUMBER(ABMS("TOT"),",",2),10)
+56 SET ABMP("TOT")=ABMP("TOT")+ABMS("TOT")
+57 IF $GET(ABMFLMSG)'=""
WRITE !!!!,ABMFLMSG
+58 FOR
WRITE !
IF $Y+4>IOSL
QUIT
+59 SET DIR(0)="E"
DO ^DIR
KILL DIR
+60 QUIT
+61 ;
HD ;SCREEN HEADER
+1 WRITE $$EN^ABMVDF("IOF")
+2 WRITE !,?20,"***** "
+3 WRITE $PIECE(^ABMDEXP(ABMP("EXP"),0),U)
+4 WRITE " CHARGE SUMMARY *****"
+5 WRITE !!,"Active Insurer: ",$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U),!
+6 WRITE !,?51,"Corr"
+7 WRITE !?1,"Charge Date ",?21,"POS",?25,"TOS",?30," Description",?51,"Diag",?60,"Charge",?72,"Qty"
+8 SET ABMS("I")=""
SET $PIECE(ABMS("I"),"-",80)=""
WRITE !,ABMS("I")
+9 QUIT
