ABMDE2X4 ; IHS/ASDST/DMJ - PAGE 2 - INSURER ADDRESS ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - V2.5 P3 - 1/24/03 - NEA-0301-180044
; Modified to display patient info when workers comp
;
; *********************************************************************
;
; X5=BILLING OFFICE^ADDR1^ADDR2^PHONE
;
BADDR ;
S ABMX("INS")=$P(ABMP("C0"),U,8)
Q:'$D(^AUTNINS(ABMX("INS"),0))
S $P(ABMV("X5"),U)=$S($P($G(^AUTNINS(ABMX("INS"),1)),U)]"":$P(^(1),U),1:$P(^(0),U))
I $D(^AUTNINS(ABMX("INS"),1)) D
. I '($P(^AUTNINS(ABMX("INS"),1),U,2)]"") S ABMFLAG=1 Q
. I '($P(^AUTNINS(ABMX("INS"),1),U,3)]"") S ABMFLAG=1 Q
. I '($P(^AUTNINS(ABMX("INS"),1),U,4)]"") S ABMFLAG=1 Q
. I '($P(^AUTNINS(ABMX("INS"),1),U,5)]"") S ABMFLAG=1 Q
. S $P(ABMV("X5"),U,2)=$P(^AUTNINS(ABMX("INS"),1),U,2)
. S $P(ABMV("X5"),U,3)=$P(^AUTNINS(ABMX("INS"),1),U,3)_", "
I $G(ABMFLAG) K ABMFLAG G MADDR
I $P(^AUTNINS(ABMX("INS"),1),U,4)]"" D
. I $D(^DIC(5,$P(^AUTNINS(ABMX("INS"),1),U,4),0)) D
.. S $P(ABMV("X5"),U,3)=$P(ABMV("X5"),U,3)_$P(^DIC(5,$P(^AUTNINS(ABMX("INS"),1),U,4),0),U,2)_" "_$P(^AUTNINS(ABMX("INS"),1),U,5)
E K ABMV("X5")
;
MADDR ;
I $D(^AUTNINS(ABMX("INS"),0)) D
. I '($P(^AUTNINS(ABMX("INS"),0),U,2)]"") S ABMFLAG=1 Q
. I '($P(^AUTNINS(ABMX("INS"),0),U,3)]"") S ABMFLAG=1 Q
. I '($P(^AUTNINS(ABMX("INS"),0),U,4)]"") S ABMFLAG=1 Q
. I '($P(^AUTNINS(ABMX("INS"),0),U,5)]"") S ABMFLAG=1 Q
. S $P(ABMV("X5"),U,4)=$P(^AUTNINS(ABMX("INS"),0),U,6)
. S $P(ABMV("X5"),U,2)=$P(^AUTNINS(ABMX("INS"),0),U,2)
. S $P(ABMV("X5"),U,3)=$P(^AUTNINS(ABMX("INS"),0),U,3)_", "
I $G(ABMFLAG) K ABMFLAG G NO
I $P(^AUTNINS(ABMX("INS"),0),U,4)]"" D Q
. I $D(^DIC(5,$P(^AUTNINS(ABMX("INS"),0),U,4),0)) D
.. S $P(ABMV("X5"),U,3)=$P(ABMV("X5"),U,3)_$P(^DIC(5,$P(^AUTNINS(ABMX("INS"),0),U,4),0),U,2)_" "_$P(^AUTNINS(ABMX("INS"),0),U,5)
;
NO ;
S ABME(112)=""
S ABMV("X5")=$P(^AUTNINS(ABMX("INS"),0),U)
;
XIT ;
Q
;
; *********************************************************************
NONBEN ;
S ABMV("X5")=$P(^DPT(ABMP("PDFN"),0),U)
S $P(ABMV("X5"),U,4)=$P($G(^DPT(ABMP("PDFN"),.13)),U)
I '$D(^DPT(ABMP("PDFN"),.11)) S ABME(112)=""
I $D(^DPT(ABMP("PDFN"),.11)) D
. I '($P(^DPT(ABMP("PDFN"),.11),U)]"") S ABME(112)="" Q
. I '($P(^DPT(ABMP("PDFN"),.11),U,4)]"") S ABME(112)="" Q
. I '($P(^DPT(ABMP("PDFN"),.11),U,5)]"") S ABME(112)="" Q
. I '($P(^DPT(ABMP("PDFN"),.11),U,6)]"") S ABME(112)="" Q
. S $P(ABMV("X5"),U,2)=$P(^DPT(ABMP("PDFN"),.11),U)
. S $P(ABMV("X5"),U,3)=$P(^DPT(ABMP("PDFN"),.11),U,4)_", "
I $D(ABME(112)) G XIT
I $D(^DIC(5,$P(^DPT(ABMP("PDFN"),.11),U,5),0)) D
. S $P(ABMV("X5"),U,3)=$P(ABMV("X5"),U,3)_$P(^DIC(5,$P(^DPT(ABMP("PDFN"),.11),U,5),0),U,2)_" "_$P(^DPT(ABMP("PDFN"),.11),U,6)
E S ABME(112)=""
G XIT
ABMDE2X4 ; IHS/ASDST/DMJ - PAGE 2 - INSURER ADDRESS ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - V2.5 P3 - 1/24/03 - NEA-0301-180044
+4 ; Modified to display patient info when workers comp
+5 ;
+6 ; *********************************************************************
+7 ;
+8 ; X5=BILLING OFFICE^ADDR1^ADDR2^PHONE
+9 ;
BADDR ;
+1 SET ABMX("INS")=$PIECE(ABMP("C0"),U,8)
+2 IF '$DATA(^AUTNINS(ABMX("INS"),0))
QUIT
+3 SET $PIECE(ABMV("X5"),U)=$SELECT($PIECE($GET(^AUTNINS(ABMX("INS"),1)),U)]"":$PIECE(^(1),U),1:$PIECE(^(0),U))
+4 IF $DATA(^AUTNINS(ABMX("INS"),1))
Begin DoDot:1
+5 IF '($PIECE(^AUTNINS(ABMX("INS"),1),U,2)]"")
SET ABMFLAG=1
QUIT
+6 IF '($PIECE(^AUTNINS(ABMX("INS"),1),U,3)]"")
SET ABMFLAG=1
QUIT
+7 IF '($PIECE(^AUTNINS(ABMX("INS"),1),U,4)]"")
SET ABMFLAG=1
QUIT
+8 IF '($PIECE(^AUTNINS(ABMX("INS"),1),U,5)]"")
SET ABMFLAG=1
QUIT
+9 SET $PIECE(ABMV("X5"),U,2)=$PIECE(^AUTNINS(ABMX("INS"),1),U,2)
+10 SET $PIECE(ABMV("X5"),U,3)=$PIECE(^AUTNINS(ABMX("INS"),1),U,3)_", "
End DoDot:1
+11 IF $GET(ABMFLAG)
KILL ABMFLAG
GOTO MADDR
+12 IF $PIECE(^AUTNINS(ABMX("INS"),1),U,4)]""
Begin DoDot:1
+13 IF $DATA(^DIC(5,$PIECE(^AUTNINS(ABMX("INS"),1),U,4),0))
Begin DoDot:2
+14 SET $PIECE(ABMV("X5"),U,3)=$PIECE(ABMV("X5"),U,3)_$PIECE(^DIC(5,$PIECE(^AUTNINS(ABMX("INS"),1),U,4),0),U,2)_" "_$PIECE(^AUTNINS(ABMX("INS"),1),U,5)
End DoDot:2
End DoDot:1
+15 IF '$TEST
KILL ABMV("X5")
+16 ;
MADDR ;
+1 IF $DATA(^AUTNINS(ABMX("INS"),0))
Begin DoDot:1
+2 IF '($PIECE(^AUTNINS(ABMX("INS"),0),U,2)]"")
SET ABMFLAG=1
QUIT
+3 IF '($PIECE(^AUTNINS(ABMX("INS"),0),U,3)]"")
SET ABMFLAG=1
QUIT
+4 IF '($PIECE(^AUTNINS(ABMX("INS"),0),U,4)]"")
SET ABMFLAG=1
QUIT
+5 IF '($PIECE(^AUTNINS(ABMX("INS"),0),U,5)]"")
SET ABMFLAG=1
QUIT
+6 SET $PIECE(ABMV("X5"),U,4)=$PIECE(^AUTNINS(ABMX("INS"),0),U,6)
+7 SET $PIECE(ABMV("X5"),U,2)=$PIECE(^AUTNINS(ABMX("INS"),0),U,2)
+8 SET $PIECE(ABMV("X5"),U,3)=$PIECE(^AUTNINS(ABMX("INS"),0),U,3)_", "
End DoDot:1
+9 IF $GET(ABMFLAG)
KILL ABMFLAG
GOTO NO
+10 IF $PIECE(^AUTNINS(ABMX("INS"),0),U,4)]""
Begin DoDot:1
+11 IF $DATA(^DIC(5,$PIECE(^AUTNINS(ABMX("INS"),0),U,4),0))
Begin DoDot:2
+12 SET $PIECE(ABMV("X5"),U,3)=$PIECE(ABMV("X5"),U,3)_$PIECE(^DIC(5,$PIECE(^AUTNINS(ABMX("INS"),0),U,4),0),U,2)_" "_$PIECE(^AUTNINS(ABMX("INS"),0),U,5)
End DoDot:2
End DoDot:1
QUIT
+13 ;
NO ;
+1 SET ABME(112)=""
+2 SET ABMV("X5")=$PIECE(^AUTNINS(ABMX("INS"),0),U)
+3 ;
XIT ;
+1 QUIT
+2 ;
+3 ; *********************************************************************
NONBEN ;
+1 SET ABMV("X5")=$PIECE(^DPT(ABMP("PDFN"),0),U)
+2 SET $PIECE(ABMV("X5"),U,4)=$PIECE($GET(^DPT(ABMP("PDFN"),.13)),U)
+3 IF '$DATA(^DPT(ABMP("PDFN"),.11))
SET ABME(112)=""
+4 IF $DATA(^DPT(ABMP("PDFN"),.11))
Begin DoDot:1
+5 IF '($PIECE(^DPT(ABMP("PDFN"),.11),U)]"")
SET ABME(112)=""
QUIT
+6 IF '($PIECE(^DPT(ABMP("PDFN"),.11),U,4)]"")
SET ABME(112)=""
QUIT
+7 IF '($PIECE(^DPT(ABMP("PDFN"),.11),U,5)]"")
SET ABME(112)=""
QUIT
+8 IF '($PIECE(^DPT(ABMP("PDFN"),.11),U,6)]"")
SET ABME(112)=""
QUIT
+9 SET $PIECE(ABMV("X5"),U,2)=$PIECE(^DPT(ABMP("PDFN"),.11),U)
+10 SET $PIECE(ABMV("X5"),U,3)=$PIECE(^DPT(ABMP("PDFN"),.11),U,4)_", "
End DoDot:1
+11 IF $DATA(ABME(112))
GOTO XIT
+12 IF $DATA(^DIC(5,$PIECE(^DPT(ABMP("PDFN"),.11),U,5),0))
Begin DoDot:1
+13 SET $PIECE(ABMV("X5"),U,3)=$PIECE(ABMV("X5"),U,3)_$PIECE(^DIC(5,$PIECE(^DPT(ABMP("PDFN"),.11),U,5),0),U,2)_" "_$PIECE(^DPT(ABMP("PDFN"),.11),U,6)
End DoDot:1
+14 IF '$TEST
SET ABME(112)=""
+15 GOTO XIT
