ABMDF3C ; IHS/ASDST/DMJ - Set HCFA1500 Print Array ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;
;
; IHS/ASDS/LSL - 08/01/01 - 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 variable that were being reset in nested
; calls.
;
; IHS/SD/SDR - V2.5 P3 - 1/24/03 - NEA-0301-180044
; Modified to display patient data when workers comp
;
; IHS/SD/SDR - v2.5 p9 - IM15533
; Removed dash from block 1A
;
; IHS/SD/SDR - v2.5 p9 - IM16155
; patient's ID# not policy holder number
;
; IHS/SD/SDR - v2.5 p10 - IM20068
; Fixed check for policy number (didn't allow for letter as first
; character)
;
; *********************************************************************
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),U)
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")=3
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)
.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 $P(ABMF(7),U,$S(ABM("SPOUSE"):4,1:3))="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
ABMDF3C ; 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/01 - 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 variable 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 data when workers comp
+13 ;
+14 ; IHS/SD/SDR - v2.5 p9 - IM15533
+15 ; Removed dash from block 1A
+16 ;
+17 ; IHS/SD/SDR - v2.5 p9 - IM16155
+18 ; patient's ID# not policy holder number
+19 ;
+20 ; IHS/SD/SDR - v2.5 p10 - IM20068
+21 ; Fixed check for policy number (didn't allow for letter as first
+22 ; character)
+23 ;
+24 ; *********************************************************************
+25 DO VAR
+26 DO LOOP
+27 DO VAR
+28 DO XIT
+29 QUIT
+30 ;
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),U)
+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")=3
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 SET $PIECE(ABMF(19),U,3)="X"
SET $PIECE(ABMF(19),U,4)=""
+5 SET $PIECE(ABMF(19),U)=$PIECE(^AUTNINS(ABM("I0"),0),U)
+6 SET $PIECE(ABMF(11),U)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+7 SET $PIECE(ABMF(15),U)=$PIECE(ABMV("X2"),U,7)
+8 IF $PIECE(ABMV("X2"),U,6)]""
SET $PIECE(ABMF(15),U,$SELECT($PIECE(ABMV("X2"),U,6)="F":3,1:2))="X"
+9 SET $PIECE(ABMF(13),U)=$PIECE(ABMV("X1"),U,4)_" "_$PIECE(ABMV("X3"),U,7)
+10 SET $PIECE(ABMF(17),U)=$PIECE(ABMV("X3"),U)
+11 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 $PIECE(ABMF(7),U,$SELECT(ABM("SPOUSE"):4,1:3))="X"
+8 IF $PIECE($GET(ABMF(19)),U,3)=""
SET $PIECE(ABMF(19),U,4)="X"
+9 SET $PIECE(ABMF(3),U,5)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+10 IF $PIECE(ABMV("X3"),U,1)]""
IF $PIECE(ABMV("X3"),U,6)]""
SET ABMF(1)=""
SET $PIECE(ABMF(1),U,5)="X"
+11 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))
+12 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),"-","")
+13 SET $PIECE(ABMF(15),U,7)=$PIECE(ABMV("X3"),U,1)
+14 SET $PIECE(ABMF(17),U,4)=$PIECE($PIECE(ABMV("X1"),U),";",2)
+15 ;group name/number
SET $PIECE(ABMF(11),U,2)=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,3)
+16 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)
+17 SET $PIECE(ABMF(13),U,4)=$PIECE(ABMV("X2"),U,7)
+18 IF $PIECE(ABMV("X2"),U,6)]""
SET $PIECE(ABMF(13),U,$SELECT($PIECE(ABMV("X2"),U,6)="F":6,1:5))="X"
+19 SET $PIECE(ABMF(5),U,6)=$PIECE(ABMV("X2"),U,3)
+20 SET $PIECE(ABMF(7),U,6)=$PIECE($PIECE(ABMV("X2"),U,4),", ")
+21 SET $PIECE(ABMF(7),U,7)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2)," ")
+22 SET $PIECE(ABMF(9),U,6)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2)," ",2)
+23 SET $PIECE(ABMF(9),U,7)=$SELECT($EXTRACT($PIECE(ABMV("X2"),U,5))="(":"",1:" ")_$PIECE(ABMV("X2"),U,5)
+24 SET ABM("RLSH")=$SELECT($PIECE(ABMV("X2"),U,2)]"":+$PIECE($GET(^AUTTRLSH(+$PIECE(ABMV("X2"),U,2),0)),U,2),1:"")
+25 IF ABM("RLSH")>0&(ABM("RLSH")<4)
SET ABM("RLSH")=ABM("RLSH")+1
+26 IF '$TEST
SET ABM("RLSH")=$SELECT(ABM("RLSH")=5:4,1:5)
+27 SET $PIECE(ABMF(5),U,ABM("RLSH"))="X"
End DoDot:1
+28 QUIT
