ABMDESM ; IHS/ASDST/DMJ - Display Summarized Claim Info ; 17 Oct 2013 9:59 AM
;;2.6;IHS 3P BILLING SYSTEM;**6,8,13**;NOV 12, 2009;Build 213
;
; IHS/ASDS/DMJ - 04/18/00 - V2.4 Patch 1 - NOIS XAA-0400-200044
; Modified mode of export loop to include 16 and 17
; IHS/ASDS/LSL - 05/15/00 - V2.4 Patch 1 - NOIS NDA-0500-180042
; Modified to populate total by export mode properly.
; IHS/ASDS/DMJ - 07/24/01 - v2.4 Patch 7 - NOIS HQW-0701-100066
; Modified mode of export loop to include 20
; IHS/ASDS/SDH - 08/14/01 - V2.4 Patch 9 - NOIS NDA-1199-180065
; Modified to include groupler allowance, non-covered, and
; penalties in the writeoff category.
;
; IHS/SD/SDR - v2.5 p10 - IM21581 - Added active insurer print to summary
; IHS/SD/SDR - v2.5 p11 - NPI; Added checks for new export modes (27/28/29)
; IHS/SD/SDR - v2.5 p13 - IM25002 - Change for Medi-Cal when Medi/Medi
; IHS/SD/SDR - abm*2.6*6 - 5010 - added export mode 32
;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35
;
; *********************************************************************
;
S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_",",ABMP("TOT")=0,ABMP("NC")=0
I '$G(ABMQUIET) W $$EN^ABMVDF("IOF")
S ABMP("TMP-EXP")=ABMP("EXP")
;F ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,23,24,27,28,51 I $D(ABMP("EXP",ABMP("EXP"))) D ;abm*2.6*6 5010
;F ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,23,24,27,28,32,51 I $D(ABMP("EXP",ABMP("EXP"))) D ;abm*2.6*6 5010 ;abm*2.6*8 5010
;F ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,24,27,28,31,32,51 I $D(ABMP("EXP",ABMP("EXP"))) D ;abm*2.6*6 5010 ;abm*2.6*8 5010 ;abm*2.6*13 export mode 35
F ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,24,27,28,31,32,35,51 I $D(ABMP("EXP",ABMP("EXP"))) D ;abm*2.6*13 export mode 35
.D ^ABMDESM1
.S ABMP("EXP",ABMP("EXP"))=+ABMS("TOT")
.I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" D Q
..S ABMP("NC")=$S($P($G(ABMP("FLAT")),U,2):$P(ABMS($P(ABMP("FLAT"),U,2)),U,5),1:0)
..I ABMS("TOT"),'$G(ABMQUIET) D ^ABMDES1,^ABMPPADJ
.Q:'ABMS("TOT")
.Q:$G(ABMQUIET)
.I $P($G(^ABMDEXP(ABMP("EXP"),1)),U)]"" D @("^"_$P(^(1),U)),^ABMPPADJ Q
.D @("^ABMDES"_ABMP("EXP")),^ABMPPADJ
Q:($G(ABMSFLG)=1)
S ABMP("EXP")=ABMP("TMP-EXP") K ABMP("TMP-EXP")
I $G(ABMTFLAG)=1 S (ABMP("TOT"),ABMP("EXP",ABMEXPMS))=+$G(ABMP("CBAMT")) Q ;don't do summary below if 2NDARY with one export mode
;
VTYP S ABMP=3 F S ABMP=$O(ABMP("EXP",ABMP)) Q:'ABMP D
.Q:ABMP=10
.Q:ABMP=11
.Q:ABMP=13
.Q:ABMP=14
.Q:ABMP=15
.Q:ABMP=16
.Q:ABMP=17
.Q:ABMP=19
.Q:ABMP=20
.Q:ABMP=21
.Q:ABMP=22
.;Q:ABMP=23 ;abm*2.6*8
.Q:ABMP=24
.Q:ABMP=27
.Q:ABMP=28
.Q:ABMP=31 ;abm*2.6*8 5010
.Q:ABMP=32 ;abm*2.6*6 5010
.Q:ABMP=35 ;abm*2.6*13 export mode 35
.Q:ABMP=51
.I $P($G(^ABMDEXP(ABMP,1)),U)]"" D @("^"_$P(^(1),U)) I 1
.E D @("^ABMDES"_ABMP)
.S:$G(ABMP("EXP",ABMP)) ABMP("TOT")=ABMP("TOT")+ABMP("EXP",ABMP)
;
Q:$G(ABMQUIET)
D PREV^ABMDFUTL
S ABMP("RATIO")=1/$S((ABMP("TOT")-ABMP("NC"))>0:(ABMP("TOT")-ABMP("NC")),1:1)
;
W $$EN^ABMVDF("IOF")
S $P(ABM("="),"=",80)=""
W !,?35,"SUMMARY",!,ABM("=")
W !!,"Active Insurer: ",$P($G(^AUTNINS(ABMP("INS"),0)),U),!
W !!,?30,"Previous",?68,"Bill"
W !,?8,"Form",?18,"Charges",?30,"Payments",?41,"Write-offs",?54,"Non-cvd",?67,"Amount"
W !?5,"---------- ---------- ---------- ---------- ---------- ----------"
S ABM("NT")=ABMP("NC")
F ABM=0:0 S ABM=$O(ABMP("EXP",ABM)) Q:'ABM D
.W !?1,$P(^ABMDEXP(ABM,0),U) ;form name
.W ?17,$J($FN(ABMP("EXP",ABM),",",2),10) ;charges
.S ABM("P")=+$FN(ABMP("PD")*ABMP("RATIO")*(ABMP("EXP",ABM)-ABM("NT")),"",3)
.W ?29,$J($FN(ABM("P"),",",2),10) ;payments
.S ABMP("WO")=ABMP("WO")+($G(ABMP("GRP")))+$G(ABMP("NONC"))
.S ABMP("WO")=ABMP("WO")+$G(ABMP("PENS"))
.S ABM("W")=+$FN(ABMP("WO")*ABMP("RATIO")*(ABMP("EXP",ABM)-ABM("NT")),"",3)
.W ?41,$J($FN(ABM("W"),",",2),10) ;writeoffs
.D MEDICHK ;check for Medicare/Medi-Cal
.I $G(ABMMFLG)'=1 S ABMP("EXP",ABM)=ABMP("EXP",ABM)-ABM("P")-ABM("W")-ABM("NT")
.S:ABMP("EXP",ABM)<0 ABMP("EXP",ABM)=0
.W ?53,$J($FN(ABM("NT"),",",2),10) ;non-covered
.I ABMP("NC") S ABM("NT")=0
.W ?65,$J($FN(ABMP("EXP",ABM),",",2),10) ;amount
W !?17,"========== ========== ========== ========== =========="
W !?17,$J($FN(ABMP("TOT"),",",2),10)
W ?29,$J($FN(ABMP("PD"),",",2),10)
W ?41,$J($FN(ABMP("WO"),",",2),10)
W ?53,$J($FN(ABMP("NC"),",",2),10)
S ABMP("TOT")=ABMP("TOT")-ABMP("NC")
S ABMP("TOT")=+$FN($S(ABMP("TOT")<1:0,1:ABMP("TOT")),"",3)
W ?65,$J($FN(ABMP("TOT"),",",2),10)
;
XIT K ABMS
Q
;
MEDICHK ;EP
S ABMI=0
K ABMMCRC,ABMMCDI
F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI)) Q:+ABMI=0 D
.S ABMIREC=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0))
.I $P(ABMIREC,U,3)="C"&($P(ABMIREC,U)=2) S ABMMCRC=1
.I $P(ABMIREC,U,3)="I"&($$RCID^ABMUTLP($P(ABMIREC,U))["61044") S ABMMCDI=1
I $G(ABMMCRC)=1&($G(ABMMCDI)=1) S ABMMFLG=1
Q
ABMDESM ; IHS/ASDST/DMJ - Display Summarized Claim Info ; 17 Oct 2013 9:59 AM
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,13**;NOV 12, 2009;Build 213
+2 ;
+3 ; IHS/ASDS/DMJ - 04/18/00 - V2.4 Patch 1 - NOIS XAA-0400-200044
+4 ; Modified mode of export loop to include 16 and 17
+5 ; IHS/ASDS/LSL - 05/15/00 - V2.4 Patch 1 - NOIS NDA-0500-180042
+6 ; Modified to populate total by export mode properly.
+7 ; IHS/ASDS/DMJ - 07/24/01 - v2.4 Patch 7 - NOIS HQW-0701-100066
+8 ; Modified mode of export loop to include 20
+9 ; IHS/ASDS/SDH - 08/14/01 - V2.4 Patch 9 - NOIS NDA-1199-180065
+10 ; Modified to include groupler allowance, non-covered, and
+11 ; penalties in the writeoff category.
+12 ;
+13 ; IHS/SD/SDR - v2.5 p10 - IM21581 - Added active insurer print to summary
+14 ; IHS/SD/SDR - v2.5 p11 - NPI; Added checks for new export modes (27/28/29)
+15 ; IHS/SD/SDR - v2.5 p13 - IM25002 - Change for Medi-Cal when Medi/Medi
+16 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added export mode 32
+17 ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35
+18 ;
+19 ; *********************************************************************
+20 ;
+21 SET ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
SET ABMP("TOT")=0
SET ABMP("NC")=0
+22 IF '$GET(ABMQUIET)
WRITE $$EN^ABMVDF("IOF")
+23 SET ABMP("TMP-EXP")=ABMP("EXP")
+24 ;F ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,23,24,27,28,51 I $D(ABMP("EXP",ABMP("EXP"))) D ;abm*2.6*6 5010
+25 ;F ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,23,24,27,28,32,51 I $D(ABMP("EXP",ABMP("EXP"))) D ;abm*2.6*6 5010 ;abm*2.6*8 5010
+26 ;F ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,24,27,28,31,32,51 I $D(ABMP("EXP",ABMP("EXP"))) D ;abm*2.6*6 5010 ;abm*2.6*8 5010 ;abm*2.6*13 export mode 35
+27 ;abm*2.6*13 export mode 35
FOR ABMP("EXP")=1,10,11,2,3,13,14,15,16,17,19,20,21,22,24,27,28,31,32,35,51
IF $DATA(ABMP("EXP",ABMP("EXP")))
Begin DoDot:1
+28 DO ^ABMDESM1
+29 SET ABMP("EXP",ABMP("EXP"))=+ABMS("TOT")
+30 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"
Begin DoDot:2
+31 SET ABMP("NC")=$SELECT($PIECE($GET(ABMP("FLAT")),U,2):$PIECE(ABMS($PIECE(ABMP("FLAT"),U,2)),U,5),1:0)
+32 IF ABMS("TOT")
IF '$GET(ABMQUIET)
DO ^ABMDES1
DO ^ABMPPADJ
End DoDot:2
QUIT
+33 IF 'ABMS("TOT")
QUIT
+34 IF $GET(ABMQUIET)
QUIT
+35 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),U)]""
DO @("^"_$PIECE(^(1),U))
DO ^ABMPPADJ
QUIT
+36 DO @("^ABMDES"_ABMP("EXP"))
DO ^ABMPPADJ
End DoDot:1
+37 IF ($GET(ABMSFLG)=1)
QUIT
+38 SET ABMP("EXP")=ABMP("TMP-EXP")
KILL ABMP("TMP-EXP")
+39 ;don't do summary below if 2NDARY with one export mode
IF $GET(ABMTFLAG)=1
SET (ABMP("TOT"),ABMP("EXP",ABMEXPMS))=+$GET(ABMP("CBAMT"))
QUIT
+40 ;
VTYP SET ABMP=3
FOR
SET ABMP=$ORDER(ABMP("EXP",ABMP))
IF 'ABMP
QUIT
Begin DoDot:1
+1 IF ABMP=10
QUIT
+2 IF ABMP=11
QUIT
+3 IF ABMP=13
QUIT
+4 IF ABMP=14
QUIT
+5 IF ABMP=15
QUIT
+6 IF ABMP=16
QUIT
+7 IF ABMP=17
QUIT
+8 IF ABMP=19
QUIT
+9 IF ABMP=20
QUIT
+10 IF ABMP=21
QUIT
+11 IF ABMP=22
QUIT
+12 ;Q:ABMP=23 ;abm*2.6*8
+13 IF ABMP=24
QUIT
+14 IF ABMP=27
QUIT
+15 IF ABMP=28
QUIT
+16 ;abm*2.6*8 5010
IF ABMP=31
QUIT
+17 ;abm*2.6*6 5010
IF ABMP=32
QUIT
+18 ;abm*2.6*13 export mode 35
IF ABMP=35
QUIT
+19 IF ABMP=51
QUIT
+20 IF $PIECE($GET(^ABMDEXP(ABMP,1)),U)]""
DO @("^"_$PIECE(^(1),U))
IF 1
+21 IF '$TEST
DO @("^ABMDES"_ABMP)
+22 IF $GET(ABMP("EXP",ABMP))
SET ABMP("TOT")=ABMP("TOT")+ABMP("EXP",ABMP)
End DoDot:1
+23 ;
+24 IF $GET(ABMQUIET)
QUIT
+25 DO PREV^ABMDFUTL
+26 SET ABMP("RATIO")=1/$SELECT((ABMP("TOT")-ABMP("NC"))>0:(ABMP("TOT")-ABMP("NC")),1:1)
+27 ;
+28 WRITE $$EN^ABMVDF("IOF")
+29 SET $PIECE(ABM("="),"=",80)=""
+30 WRITE !,?35,"SUMMARY",!,ABM("=")
+31 WRITE !!,"Active Insurer: ",$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U),!
+32 WRITE !!,?30,"Previous",?68,"Bill"
+33 WRITE !,?8,"Form",?18,"Charges",?30,"Payments",?41,"Write-offs",?54,"Non-cvd",?67,"Amount"
+34 WRITE !?5,"---------- ---------- ---------- ---------- ---------- ----------"
+35 SET ABM("NT")=ABMP("NC")
+36 FOR ABM=0:0
SET ABM=$ORDER(ABMP("EXP",ABM))
IF 'ABM
QUIT
Begin DoDot:1
+37 ;form name
WRITE !?1,$PIECE(^ABMDEXP(ABM,0),U)
+38 ;charges
WRITE ?17,$JUSTIFY($FNUMBER(ABMP("EXP",ABM),",",2),10)
+39 SET ABM("P")=+$FNUMBER(ABMP("PD")*ABMP("RATIO")*(ABMP("EXP",ABM)-ABM("NT")),"",3)
+40 ;payments
WRITE ?29,$JUSTIFY($FNUMBER(ABM("P"),",",2),10)
+41 SET ABMP("WO")=ABMP("WO")+($GET(ABMP("GRP")))+$GET(ABMP("NONC"))
+42 SET ABMP("WO")=ABMP("WO")+$GET(ABMP("PENS"))
+43 SET ABM("W")=+$FNUMBER(ABMP("WO")*ABMP("RATIO")*(ABMP("EXP",ABM)-ABM("NT")),"",3)
+44 ;writeoffs
WRITE ?41,$JUSTIFY($FNUMBER(ABM("W"),",",2),10)
+45 ;check for Medicare/Medi-Cal
DO MEDICHK
+46 IF $GET(ABMMFLG)'=1
SET ABMP("EXP",ABM)=ABMP("EXP",ABM)-ABM("P")-ABM("W")-ABM("NT")
+47 IF ABMP("EXP",ABM)<0
SET ABMP("EXP",ABM)=0
+48 ;non-covered
WRITE ?53,$JUSTIFY($FNUMBER(ABM("NT"),",",2),10)
+49 IF ABMP("NC")
SET ABM("NT")=0
+50 ;amount
WRITE ?65,$JUSTIFY($FNUMBER(ABMP("EXP",ABM),",",2),10)
End DoDot:1
+51 WRITE !?17,"========== ========== ========== ========== =========="
+52 WRITE !?17,$JUSTIFY($FNUMBER(ABMP("TOT"),",",2),10)
+53 WRITE ?29,$JUSTIFY($FNUMBER(ABMP("PD"),",",2),10)
+54 WRITE ?41,$JUSTIFY($FNUMBER(ABMP("WO"),",",2),10)
+55 WRITE ?53,$JUSTIFY($FNUMBER(ABMP("NC"),",",2),10)
+56 SET ABMP("TOT")=ABMP("TOT")-ABMP("NC")
+57 SET ABMP("TOT")=+$FNUMBER($SELECT(ABMP("TOT")<1:0,1:ABMP("TOT")),"",3)
+58 WRITE ?65,$JUSTIFY($FNUMBER(ABMP("TOT"),",",2),10)
+59 ;
XIT KILL ABMS
+1 QUIT
+2 ;
MEDICHK ;EP
+1 SET ABMI=0
+2 KILL ABMMCRC,ABMMCDI
+3 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI))
IF +ABMI=0
QUIT
Begin DoDot:1
+4 SET ABMIREC=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0))
+5 IF $PIECE(ABMIREC,U,3)="C"&($PIECE(ABMIREC,U)=2)
SET ABMMCRC=1
+6 IF $PIECE(ABMIREC,U,3)="I"&($$RCID^ABMUTLP($PIECE(ABMIREC,U))["61044")
SET ABMMCDI=1
End DoDot:1
+7 IF $GET(ABMMCRC)=1&($GET(ABMMCDI)=1)
SET ABMMFLG=1
+8 QUIT
