ABMDF14C ; IHS/ASDST/DMJ - Set HCFA1500 Print Array ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;
;
; IHS/ASDS/LSL -08/01/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
; Don't print unbillable insurers in box 9D
;
; IHS/ASDS/DMJ - 01/09/02 - V2.4 Patch 10 - NOIS NFA-1201-180018
; Modified to correct values that were being reset in nested
; calls.
;
; IHS/SD/SDR - V2.5 P3 - 1/24/03 - NEA-0301-180044
; Modified to display patient info when workers comp
;
; IHS/SD/SDR - v2.5 p8 - IM14272/IM15419
; Used billed amount for flat rate per Adrian; Due to inpt covered
; days, make rate=billed amount/covered days (units)
;
; IHS/SD/SDR - v2.5 p9 - IM15533
; Removed dash from Block 1A
;
; IHS/SD/SDR - v2.5 p9 - IM16155
; Patient ID# not policy holder number
;
; IHS/SD/SDR - v2.5 p10 - IM20068
; Fix Policy number
;
; IHS/SD/SDR - v2.5 p10 - IM20225
; Check for DME group number
;
; IHS/SD/SDR - v2.5 p10 - IM20752
; Add check for new insurer parameter regarding
; dash printing in block 1A
;
; IHS/SD/SDR - v2.5 p12 - IM23734
; Added change for AK Medicaid to remove blocks 9 and 11
;
; *********************************************************************
;
D VAR
D LOOP
D VAR
D XIT
Q
VAR S ABM("CNT")=0
S ABMP("C0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U),$P(ABMP("C0"),U,2)=ABMP("VDT")
S ABMP("VTYP")=$P(ABMP("C0"),U,7)
Q
LOOP S ABM("IN")="" F ABM("I")=41:1:43 S ABM("IN")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("IN"))) Q:'ABM("IN") S ABM("XIEN")=$O(^(ABM("IN"),"")) S ABM("Z")=$S(ABM("I")=41:"A",ABM("I")=42:"B",1:"C") D INS
Q
;
XIT K ABM,ABME,ABMV
Q
;
INS Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0)) S ABM("INSCO")=$P(^(0),"^",1)
Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),U,3)="U"
I ABM("INSCO")=$P(ABMP("B0"),U,8),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),"^",3)="I" D
.D ^ABMDE2X1
.I $D(ABMP("FLAT")) D
..S $P(ABMP("FLAT"),U)=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U) ;bill amt
..S:ABMP("VTYP")=111 $P(ABMP("FLAT"),U)=$P(ABMP("FLAT"),U)/$P(ABMP("FLAT"),U,3)
.S ABMP("EXP")=14
PAYOR S Y=ABM("INSCO") D SEL^ABMDE2X
S ABM("I0")=+ABMV("X1")
I ABM("INSCO")'=$P(ABMP("B0"),U,8),ABM("CNT")=0,"IN"'[$P($G(^AUTNINS(ABM("I0"),2)),U) D
.Q:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0)),U,11)=$P(ABMP("B0"),U,8)
.Q:$P($G(^AUTNINS(ABMP("INS"),0)),U)="ALASKA MEDICAID" ;skip fl9 and 11 if AK Mcd
.S $P(ABMF(19),U,3)="X",$P(ABMF(19),U,4)=""
.S $P(ABMF(19),U)=$P(^AUTNINS(ABM("I0"),0),U)
.S $P(ABMF(11),U)=$P($P(ABMV("X2"),U),";",2)
.S $P(ABMF(15),U)=$P(ABMV("X2"),U,7)
.I $P(ABMV("X2"),U,6)]"" S $P(ABMF(15),U,$S($P(ABMV("X2"),U,6)="F":3,1:2))="X"
.S $P(ABMF(13),U)=$P(ABMV("X1"),U,4)_" "_$P(ABMV("X3"),U,7)
.S $P(ABMF(17),U)=$P(ABMV("X3"),U)
.S ABM("CNT")=ABM("CNT")+1
PRIM ;
I ((ABM("INSCO")=$P(ABMP("B0"),U,8))!($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0)),U,11)=$P(ABMP("B0"),U,8))),($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),"^",3)="I") D
.S ABM("SPOUSE")=0
.I $P(^AUPNPAT(ABMP("PDFN"),0),U,22) S ABM("SPOUSE")=1
.I $P($G(^AUPNPAT(ABMP("PDFN"),28)),U,2),$P($G(^AUTTRLSH($P(^(28),U,2),0)),U,3)="02" S ABM("SPOUSE")=1
.I $P($G(^AUPNPAT(ABMP("PDFN"),31)),U,2),$P($G(^AUTTRLSH($P(^(31),U,2),0)),U,3)="02" S ABM("SPOUSE")=1
.I $P(ABMV("X2"),U,2),$P($G(^AUTTRLSH(+$P(ABMV("X2"),U,2),0)),U,3)="02" S ABM("SPOUSE")=1
.S ABMPIECE=3
.S:ABM("SPOUSE") ABMPIECE=4
.S ABMMSTAT=$P(^DPT(ABMP("PDFN"),0),"^",5)
.I ABMMSTAT D
..S ABMPIECE=5
..S:ABMMSTAT=8 ABMPIECE=3
..S:ABMMSTAT=2 ABMPIECE=4
.S $P(ABMF(7),"^",ABMPIECE)="X"
.S:$P($G(ABMF(19)),U,3)="" $P(ABMF(19),U,4)="X"
.S $P(ABMF(3),U,5)=$P($P(ABMV("X2"),U),";",2)
.I $P(ABMV("X3"),U,1)]"",$P(ABMV("X3"),U,6)]"" S ABMF(1)="",$P(ABMF(1),U,5)="X"
.S $P(ABMF(1),U,8)=$S($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8):$P(^(4),U,8),$P($G(ABMV("X1")),U,12)'="":$P(ABMV("X1"),U,12),1:$P(ABMV("X1"),U,4))
.I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,7)="N" S $P(ABMF(1),U,8)=$TR($P(ABMF(1),U,8),"-","")
.S $P(ABMF(15),U,7)=$P(ABMV("X3"),U,1)
.S $P(ABMF(17),U,4)=$P($P(ABMV("X1"),U),";",2)
.S $P(ABMF(11),U,2)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,3) ;group name/number
.I $P(ABMF(11),U,2)="",($P(ABMV("X3"),U,7)]"") S $P(ABMF(11),U,2)=$P(ABMV("X3"),U,7)_"/"_$P(ABMV("X3"),U,6)
.S $P(ABMF(13),U,4)=$P(ABMV("X2"),U,7)
.I $P(ABMV("X2"),U,6)]"" S $P(ABMF(13),U,$S($P(ABMV("X2"),U,6)="F":6,1:5))="X"
.S $P(ABMF(5),U,6)=$P(ABMV("X2"),U,3)
.S $P(ABMF(7),U,6)=$P($P(ABMV("X2"),U,4),", ")
.S $P(ABMF(7),U,7)=$P($P($P(ABMV("X2"),U,4),", ",2)," ")
.S $P(ABMF(9),U,6)=$P($P($P(ABMV("X2"),U,4),", ",2)," ",2)
.S $P(ABMF(9),U,7)=$S($E($P(ABMV("X2"),U,5))="(":"",1:" ")_$P(ABMV("X2"),U,5)
.S ABM("RLSH")=$S($P(ABMV("X2"),U,2)]"":+$P($G(^AUTTRLSH(+$P(ABMV("X2"),U,2),0)),U,2),1:"")
.I ABM("RLSH")>0&(ABM("RLSH")<4) S ABM("RLSH")=ABM("RLSH")+1
.E S ABM("RLSH")=$S(ABM("RLSH")=5:4,1:5)
.S $P(ABMF(5),U,ABM("RLSH"))="X"
Q
ABMDF14C ; IHS/ASDST/DMJ - Set HCFA1500 Print Array ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;
+3 ;
+4 ; IHS/ASDS/LSL -08/01/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
+5 ; Don't print unbillable insurers in box 9D
+6 ;
+7 ; IHS/ASDS/DMJ - 01/09/02 - V2.4 Patch 10 - NOIS NFA-1201-180018
+8 ; Modified to correct values that were being reset in nested
+9 ; calls.
+10 ;
+11 ; IHS/SD/SDR - V2.5 P3 - 1/24/03 - NEA-0301-180044
+12 ; Modified to display patient info when workers comp
+13 ;
+14 ; IHS/SD/SDR - v2.5 p8 - IM14272/IM15419
+15 ; Used billed amount for flat rate per Adrian; Due to inpt covered
+16 ; days, make rate=billed amount/covered days (units)
+17 ;
+18 ; IHS/SD/SDR - v2.5 p9 - IM15533
+19 ; Removed dash from Block 1A
+20 ;
+21 ; IHS/SD/SDR - v2.5 p9 - IM16155
+22 ; Patient ID# not policy holder number
+23 ;
+24 ; IHS/SD/SDR - v2.5 p10 - IM20068
+25 ; Fix Policy number
+26 ;
+27 ; IHS/SD/SDR - v2.5 p10 - IM20225
+28 ; Check for DME group number
+29 ;
+30 ; IHS/SD/SDR - v2.5 p10 - IM20752
+31 ; Add check for new insurer parameter regarding
+32 ; dash printing in block 1A
+33 ;
+34 ; IHS/SD/SDR - v2.5 p12 - IM23734
+35 ; Added change for AK Medicaid to remove blocks 9 and 11
+36 ;
+37 ; *********************************************************************
+38 ;
+39 DO VAR
+40 DO LOOP
+41 DO VAR
+42 DO XIT
+43 QUIT
VAR SET ABM("CNT")=0
+1 SET ABMP("C0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
+2 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+3 SET ABMP("VDT")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)
SET $PIECE(ABMP("C0"),U,2)=ABMP("VDT")
+4 SET ABMP("VTYP")=$PIECE(ABMP("C0"),U,7)
+5 QUIT
LOOP SET ABM("IN")=""
FOR ABM("I")=41:1:43
SET ABM("IN")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("IN")))
IF 'ABM("IN")
QUIT
SET ABM("XIEN")=$ORDER(^(ABM("IN"),""))
SET ABM("Z")=$SELECT(ABM("I")=41:"A",ABM("I")=42:"B",1:"C")
DO INS
+1 QUIT
+2 ;
XIT KILL ABM,ABME,ABMV
+1 QUIT
+2 ;
INS IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0))
QUIT
SET ABM("INSCO")=$PIECE(^(0),"^",1)
+1 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),U,3)="U"
QUIT
+2 IF ABM("INSCO")=$PIECE(ABMP("B0"),U,8)
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),"^",3)="I"
Begin DoDot:1
+3 DO ^ABMDE2X1
+4 IF $DATA(ABMP("FLAT"))
Begin DoDot:2
+5 ;bill amt
SET $PIECE(ABMP("FLAT"),U)=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)
+6 IF ABMP("VTYP")=111
SET $PIECE(ABMP("FLAT"),U)=$PIECE(ABMP("FLAT"),U)/$PIECE(ABMP("FLAT"),U,3)
End DoDot:2
+7 SET ABMP("EXP")=14
End DoDot:1
PAYOR SET Y=ABM("INSCO")
DO SEL^ABMDE2X
+1 SET ABM("I0")=+ABMV("X1")
+2 IF ABM("INSCO")'=$PIECE(ABMP("B0"),U,8)
IF ABM("CNT")=0
IF "IN"'[$PIECE($GET(^AUTNINS(ABM("I0"),2)),U)
Begin DoDot:1
+3 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0)),U,11)=$PIECE(ABMP("B0"),U,8)
QUIT
+4 ;skip fl9 and 11 if AK Mcd
IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="ALASKA MEDICAID"
QUIT
+5 SET $PIECE(ABMF(19),U,3)="X"
SET $PIECE(ABMF(19),U,4)=""
+6 SET $PIECE(ABMF(19),U)=$PIECE(^AUTNINS(ABM("I0"),0),U)
+7 SET $PIECE(ABMF(11),U)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+8 SET $PIECE(ABMF(15),U)=$PIECE(ABMV("X2"),U,7)
+9 IF $PIECE(ABMV("X2"),U,6)]""
SET $PIECE(ABMF(15),U,$SELECT($PIECE(ABMV("X2"),U,6)="F":3,1:2))="X"
+10 SET $PIECE(ABMF(13),U)=$PIECE(ABMV("X1"),U,4)_" "_$PIECE(ABMV("X3"),U,7)
+11 SET $PIECE(ABMF(17),U)=$PIECE(ABMV("X3"),U)
+12 SET ABM("CNT")=ABM("CNT")+1
End DoDot:1
PRIM ;
+1 IF ((ABM("INSCO")=$PIECE(ABMP("B0"),U,8))!($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0)),U,11)=$PIECE(ABMP("B0"),U,8)))
IF ($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),"^",3)="I")
Begin DoDot:1
+2 SET ABM("SPOUSE")=0
+3 IF $PIECE(^AUPNPAT(ABMP("PDFN"),0),U,22)
SET ABM("SPOUSE")=1
+4 IF $PIECE($GET(^AUPNPAT(ABMP("PDFN"),28)),U,2)
IF $PIECE($GET(^AUTTRLSH($PIECE(^(28),U,2),0)),U,3)="02"
SET ABM("SPOUSE")=1
+5 IF $PIECE($GET(^AUPNPAT(ABMP("PDFN"),31)),U,2)
IF $PIECE($GET(^AUTTRLSH($PIECE(^(31),U,2),0)),U,3)="02"
SET ABM("SPOUSE")=1
+6 IF $PIECE(ABMV("X2"),U,2)
IF $PIECE($GET(^AUTTRLSH(+$PIECE(ABMV("X2"),U,2),0)),U,3)="02"
SET ABM("SPOUSE")=1
+7 SET ABMPIECE=3
+8 IF ABM("SPOUSE")
SET ABMPIECE=4
+9 SET ABMMSTAT=$PIECE(^DPT(ABMP("PDFN"),0),"^",5)
+10 IF ABMMSTAT
Begin DoDot:2
+11 SET ABMPIECE=5
+12 IF ABMMSTAT=8
SET ABMPIECE=3
+13 IF ABMMSTAT=2
SET ABMPIECE=4
End DoDot:2
+14 SET $PIECE(ABMF(7),"^",ABMPIECE)="X"
+15 IF $PIECE($GET(ABMF(19)),U,3)=""
SET $PIECE(ABMF(19),U,4)="X"
+16 SET $PIECE(ABMF(3),U,5)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+17 IF $PIECE(ABMV("X3"),U,1)]""
IF $PIECE(ABMV("X3"),U,6)]""
SET ABMF(1)=""
SET $PIECE(ABMF(1),U,5)="X"
+18 SET $PIECE(ABMF(1),U,8)=$SELECT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8):$PIECE(^(4),U,8),$PIECE($GET(ABMV("X1")),U,12)'="":$PIECE(ABMV("X1"),U,12),1:$PIECE(ABMV("X1"),U,4))
+19 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,7)="N"
SET $PIECE(ABMF(1),U,8)=$TRANSLATE($PIECE(ABMF(1),U,8),"-","")
+20 SET $PIECE(ABMF(15),U,7)=$PIECE(ABMV("X3"),U,1)
+21 SET $PIECE(ABMF(17),U,4)=$PIECE($PIECE(ABMV("X1"),U),";",2)
+22 ;group name/number
SET $PIECE(ABMF(11),U,2)=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,3)
+23 IF $PIECE(ABMF(11),U,2)=""
IF ($PIECE(ABMV("X3"),U,7)]"")
SET $PIECE(ABMF(11),U,2)=$PIECE(ABMV("X3"),U,7)_"/"_$PIECE(ABMV("X3"),U,6)
+24 SET $PIECE(ABMF(13),U,4)=$PIECE(ABMV("X2"),U,7)
+25 IF $PIECE(ABMV("X2"),U,6)]""
SET $PIECE(ABMF(13),U,$SELECT($PIECE(ABMV("X2"),U,6)="F":6,1:5))="X"
+26 SET $PIECE(ABMF(5),U,6)=$PIECE(ABMV("X2"),U,3)
+27 SET $PIECE(ABMF(7),U,6)=$PIECE($PIECE(ABMV("X2"),U,4),", ")
+28 SET $PIECE(ABMF(7),U,7)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2)," ")
+29 SET $PIECE(ABMF(9),U,6)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2)," ",2)
+30 SET $PIECE(ABMF(9),U,7)=$SELECT($EXTRACT($PIECE(ABMV("X2"),U,5))="(":"",1:" ")_$PIECE(ABMV("X2"),U,5)
+31 SET ABM("RLSH")=$SELECT($PIECE(ABMV("X2"),U,2)]"":+$PIECE($GET(^AUTTRLSH(+$PIECE(ABMV("X2"),U,2),0)),U,2),1:"")
+32 IF ABM("RLSH")>0&(ABM("RLSH")<4)
SET ABM("RLSH")=ABM("RLSH")+1
+33 IF '$TEST
SET ABM("RLSH")=$SELECT(ABM("RLSH")=5:4,1:5)
+34 SET $PIECE(ABMF(5),U,ABM("RLSH"))="X"
End DoDot:1
+35 QUIT
