ABMDE2X2 ; IHS/ASDST/DMJ - PAGE 2 - INSURER DATA CK PART 2 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - 10/30/02 - V2.5 P2 - QXX-0402-130120
; Modified to make error codes 11 and 105 more specific when
; checking for data
;
; IHS/SD/SDR/ - v2.5 p10 - IM20128
; Put PH not patient in 11a/11b
;
; IHS/SD/SDR - v2.5 p11 - IM22893
; Enhanced check for employer info just in case entry is incomplete
;
; *********************************************************************
;
; X2=PHDFN;NAME^RDFN;RELATIONSHIP^ADDR1^ADDR2^PHONE^SEX^DOB
; X3=EMPLOYER^ADDR1^ADDR2^PHONE^STATUS;DESC^GROUP^GROUP #^EMPL #
;
I +ABMV("X2")="" G XIT
I '$D(^AUPN3PPH(+ABMV("X2"),0)) S ABME(65)="" G XIT
I $P($G(ABMV("X1")),U,5)]"" S $P(ABMV("X2"),";",2)=$P(ABMV("X1"),U,5)
I $P($G(ABMV("X1")),U,6)]"" S $P(ABMV("X2"),U,7)=$P(ABMV("X1"),U,6)
;
GRP ;
S ABMX("GRP")=$P(^AUPN3PPH(+ABMV("X2"),0),U,6)
I ABMX("GRP")]"" D
. I $D(^AUTNEGRP(ABMX("GRP"),0)) D
.. S $P(ABMV("X3"),U,6)=$P(^AUTNEGRP(ABMX("GRP"),0),U)
.. S $P(ABMV("X3"),U,7)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2))
;
REG ;
I $P(^AUPN3PPH(+ABMV("X2"),0),U,2)]"",($G(ABMP("PDFN"))'=$P(^AUPN3PPH(+ABMV("X2"),0),U,2)) S ABMX("HDFN")=$P(^AUPN3PPH(+ABMV("X2"),0),U,2)
E G PHINFO
S $P(ABMV("X2"),U,6)=$P(^DPT(ABMX("HDFN"),0),U,2)
S $P(ABMV("X2"),U,7)=$P(^DPT(ABMX("HDFN"),0),U,3)
I '+$D(^DPT(ABMX("HDFN"),.11)) S ABME(105)="" Q
I +$D(^DPT(ABMX("HDFN"),.11)) D
. I '($P(^DPT(ABMX("HDFN"),.11),U)]"") S ABME(105)="" Q
. I '($P(^DPT(ABMX("HDFN"),.11),U,4)]"") S ABME(105)="" Q
. I '($P(^DPT(ABMX("HDFN"),.11),U,5)]"") S ABME(105)="" Q
. I '($P(^DPT(ABMX("HDFN"),.11),U,6)]"") S ABME(105)="" Q
. S $P(ABMV("X2"),U,3)=$P(^DPT(ABMX("HDFN"),.11),U)
. S $P(ABMV("X2"),U,4)=$P(^DPT(ABMX("HDFN"),.11),U,4)_", "
I $D(ABME(105)) G REMPL
I $P(^DPT(ABMX("HDFN"),.11),U,5)]"" D
. I $D(^DIC(5,$P(^DPT(ABMX("HDFN"),.11),U,5),0)) D
.. S $P(ABMV("X2"),U,4)=$P(ABMV("X2"),U,4)_$P(^DIC(5,$P(^DPT(ABMX("HDFN"),.11),U,5),0),U,2)_" "_$P(^DPT(ABMX("HDFN"),.11),U,6)
.. S:$D(^DPT(ABMX("HDFN"),.13)) $P(ABMV("X2"),U,5)=$P(^DPT(ABMX("HDFN"),.13),U)
E S ABME(105)=""
;
REMPL ;
I $P(^AUPNPAT(ABMX("HDFN"),0),U,19)]"" D
.I $D(^AUTNEMPL($P(^AUPNPAT(ABMX("HDFN"),0),U,19),0)) D
..S $P(ABMV("X3"),U)=$P(^AUTNEMPL($P(^AUPNPAT(ABMX("HDFN"),0),U,19),0),U)
..S ABMX("E0")=$G(^AUTNEMPL($P(^AUPNPAT(ABMX("HDFN"),0),U,19),0))
E S ABME(73)="" G XIT
I $G(ABMX("E0"))="" S ABME(73)=""
I '($P($G(ABMX("E0")),U,2)]"") S ABME(75)=""
I '($P($G(ABMX("E0")),U,3)]"") S ABME(75)=""
I '($P($G(ABMX("E0")),U,4)]"") S ABME(75)=""
I '($P($G(ABMX("E0")),U,5)]"") S ABME(75)=""
I $D(ABME(75)) G REMST
S $P(ABMV("X3"),U,2)=$P(ABMX("E0"),U,2)
S $P(ABMV("X3"),U,3)=$P(ABMX("E0"),U,3)_", "
I $D(^DIC(5,$P(ABMX("E0"),U,4),0)) S $P(ABMV("X3"),U,3)=$P(ABMV("X3"),U,3)_$P(^(0),U,2)_" "_$P(ABMX("E0"),U,5)
E S ABME(75)=""
S $P(ABMV("X3"),U,4)=$P(ABMX("E0"),U,6)
;
REMST ;
S ABMX("Y")=$P(^AUPNPAT(ABMX("HDFN"),0),U,21)
I ABMX("Y")="" D
. S ABME(72)=""
. S ABMX("Y")=9
S ABMX("Y0")=$P(^DD(9000001,.21,0),U,3)
S ABMX("Y0")=$P($P(ABMX("Y0"),ABMX("Y")_":",2),";",1)
S $P(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
S $P(ABMV("X3"),U,8)=$S($P(^DPT(ABMX("HDFN"),0),U,9)]""&($P(^(0),U,9)'["-"):$E($P(^(0),U,9),1,3)_"-"_$E($P(^(0),U,9),4,5)_"-"_$E($P(^(0),U,9),6,9),1:$P(^(0),U,9))
G XIT
;
; *********************************************************************
PHINFO ; INSURER INFO FROM POLICY HOLDER FILE
S $P(ABMV("X2"),U,6)=$P(^AUPN3PPH(+ABMV("X2"),0),U,8)
S $P(ABMV("X2"),U,7)=$P(^AUPN3PPH(+ABMV("X2"),0),U,19)
S ABMX("Y")=$P(^AUPN3PPH(+ABMV("X2"),0),U,15)
I ABMX("Y")="" S ABME(72)="" G PHADD
S ABMX("Y0")=$P(^DD(9000003.1,.15,0),U,3)
S ABMX("Y0")=$P($P(ABMX("Y0"),ABMX("Y")_":",2),";",1)
S $P(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
;
PHADD ;
I $D(^AUPN3PPH(+ABMV("X2"),0)) D
. I '($P(^AUPN3PPH(+ABMV("X2"),0),U,9)]"") S ABME(105)="" Q
. I '($P(^AUPN3PPH(+ABMV("X2"),0),U,11)]"") S ABME(105)="" Q
. I '($P(^AUPN3PPH(+ABMV("X2"),0),U,12)]"") S ABME(105)="" Q
. I '($P(^AUPN3PPH(+ABMV("X2"),0),U,13)]"") S ABME(105)="" Q
. S $P(ABMV("X2"),U,3)=$P(^AUPN3PPH(+ABMV("X2"),0),U,9)
. S $P(ABMV("X2"),U,4)=$P(^AUPN3PPH(+ABMV("X2"),0),U,11)_", "
I $D(ABME(105)) G PEMPL
I $D(^DIC(5,$P(^AUPN3PPH(+ABMV("X2"),0),U,12),0)) D
. S $P(ABMV("X2"),U,4)=$P(ABMV("X2"),U,4)_$P(^DIC(5,$P(^AUPN3PPH(+ABMV("X2"),0),U,12),0),U,2)_" "_$P(^AUPN3PPH(+ABMV("X2"),0),U,13)
. S $P(ABMV("X2"),U,5)=$P(^AUPN3PPH(+ABMV("X2"),0),U,14)
E S ABME(105)=""
;
PEMPL ;
I $P(^AUPN3PPH(+ABMV("X2"),0),U,16)]"" D
. I '$D(^AUTNEMPL($P(^AUPN3PPH(+ABMV("X2"),0),U,16),0)) S ABME(73)="" Q
. S $P(ABMV("X3"),U)=$P(^AUTNEMPL($P(^AUPN3PPH(+ABMV("X2"),0),U,16),0),U)
. S ABMX("E0")=^AUTNEMPL($P(^AUPN3PPH(+ABMV("X2"),0),U,16),0)
E S ABME(73)=""
I $D(ABME(73)) G XIT
I $P(ABMX("E0"),U,2)]"",$P(ABMX("E0"),U,3)]"",$P(ABMX("E0"),U,4)]"",$P(ABMX("E0"),U,5)]""
E S ABME(75)="" G XIT
S $P(ABMV("X3"),U,2)=$P(ABMX("E0"),U,2)
S $P(ABMV("X3"),U,3)=$P(ABMX("E0"),U,3)_", "
I $D(^DIC(5,$P(ABMX("E0"),U,4),0)) S $P(ABMV("X3"),U,3)=$P(ABMV("X3"),U,3)_$P(^(0),U,2)_" "_$P(ABMX("E0"),U,5)
E S ABME(75)=""
S $P(ABMV("X3"),U,4)=$P(ABMX("E0"),U,6)
;
XIT ;
K ABMX
Q
ABMDE2X2 ; IHS/ASDST/DMJ - PAGE 2 - INSURER DATA CK PART 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - 10/30/02 - V2.5 P2 - QXX-0402-130120
+4 ; Modified to make error codes 11 and 105 more specific when
+5 ; checking for data
+6 ;
+7 ; IHS/SD/SDR/ - v2.5 p10 - IM20128
+8 ; Put PH not patient in 11a/11b
+9 ;
+10 ; IHS/SD/SDR - v2.5 p11 - IM22893
+11 ; Enhanced check for employer info just in case entry is incomplete
+12 ;
+13 ; *********************************************************************
+14 ;
+15 ; X2=PHDFN;NAME^RDFN;RELATIONSHIP^ADDR1^ADDR2^PHONE^SEX^DOB
+16 ; X3=EMPLOYER^ADDR1^ADDR2^PHONE^STATUS;DESC^GROUP^GROUP #^EMPL #
+17 ;
+18 IF +ABMV("X2")=""
GOTO XIT
+19 IF '$DATA(^AUPN3PPH(+ABMV("X2"),0))
SET ABME(65)=""
GOTO XIT
+20 IF $PIECE($GET(ABMV("X1")),U,5)]""
SET $PIECE(ABMV("X2"),";",2)=$PIECE(ABMV("X1"),U,5)
+21 IF $PIECE($GET(ABMV("X1")),U,6)]""
SET $PIECE(ABMV("X2"),U,7)=$PIECE(ABMV("X1"),U,6)
+22 ;
GRP ;
+1 SET ABMX("GRP")=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,6)
+2 IF ABMX("GRP")]""
Begin DoDot:1
+3 IF $DATA(^AUTNEGRP(ABMX("GRP"),0))
Begin DoDot:2
+4 SET $PIECE(ABMV("X3"),U,6)=$PIECE(^AUTNEGRP(ABMX("GRP"),0),U)
+5 SET $PIECE(ABMV("X3"),U,7)=$SELECT($DATA(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$PIECE(^(0),U,2),1:$PIECE(^AUTNEGRP(ABMX("GRP"),0),U,2))
End DoDot:2
End DoDot:1
+6 ;
REG ;
+1 IF $PIECE(^AUPN3PPH(+ABMV("X2"),0),U,2)]""
IF ($GET(ABMP("PDFN"))'=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,2))
SET ABMX("HDFN")=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,2)
+2 IF '$TEST
GOTO PHINFO
+3 SET $PIECE(ABMV("X2"),U,6)=$PIECE(^DPT(ABMX("HDFN"),0),U,2)
+4 SET $PIECE(ABMV("X2"),U,7)=$PIECE(^DPT(ABMX("HDFN"),0),U,3)
+5 IF '+$DATA(^DPT(ABMX("HDFN"),.11))
SET ABME(105)=""
QUIT
+6 IF +$DATA(^DPT(ABMX("HDFN"),.11))
Begin DoDot:1
+7 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U)]"")
SET ABME(105)=""
QUIT
+8 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U,4)]"")
SET ABME(105)=""
QUIT
+9 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U,5)]"")
SET ABME(105)=""
QUIT
+10 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U,6)]"")
SET ABME(105)=""
QUIT
+11 SET $PIECE(ABMV("X2"),U,3)=$PIECE(^DPT(ABMX("HDFN"),.11),U)
+12 SET $PIECE(ABMV("X2"),U,4)=$PIECE(^DPT(ABMX("HDFN"),.11),U,4)_", "
End DoDot:1
+13 IF $DATA(ABME(105))
GOTO REMPL
+14 IF $PIECE(^DPT(ABMX("HDFN"),.11),U,5)]""
Begin DoDot:1
+15 IF $DATA(^DIC(5,$PIECE(^DPT(ABMX("HDFN"),.11),U,5),0))
Begin DoDot:2
+16 SET $PIECE(ABMV("X2"),U,4)=$PIECE(ABMV("X2"),U,4)_$PIECE(^DIC(5,$PIECE(^DPT(ABMX("HDFN"),.11),U,5),0),U,2)_" "_$PIECE(^DPT(ABMX("HDFN"),.11),U,6)
+17 IF $DATA(^DPT(ABMX("HDFN"),.13))
SET $PIECE(ABMV("X2"),U,5)=$PIECE(^DPT(ABMX("HDFN"),.13),U)
End DoDot:2
End DoDot:1
+18 IF '$TEST
SET ABME(105)=""
+19 ;
REMPL ;
+1 IF $PIECE(^AUPNPAT(ABMX("HDFN"),0),U,19)]""
Begin DoDot:1
+2 IF $DATA(^AUTNEMPL($PIECE(^AUPNPAT(ABMX("HDFN"),0),U,19),0))
Begin DoDot:2
+3 SET $PIECE(ABMV("X3"),U)=$PIECE(^AUTNEMPL($PIECE(^AUPNPAT(ABMX("HDFN"),0),U,19),0),U)
+4 SET ABMX("E0")=$GET(^AUTNEMPL($PIECE(^AUPNPAT(ABMX("HDFN"),0),U,19),0))
End DoDot:2
End DoDot:1
+5 IF '$TEST
SET ABME(73)=""
GOTO XIT
+6 IF $GET(ABMX("E0"))=""
SET ABME(73)=""
+7 IF '($PIECE($GET(ABMX("E0")),U,2)]"")
SET ABME(75)=""
+8 IF '($PIECE($GET(ABMX("E0")),U,3)]"")
SET ABME(75)=""
+9 IF '($PIECE($GET(ABMX("E0")),U,4)]"")
SET ABME(75)=""
+10 IF '($PIECE($GET(ABMX("E0")),U,5)]"")
SET ABME(75)=""
+11 IF $DATA(ABME(75))
GOTO REMST
+12 SET $PIECE(ABMV("X3"),U,2)=$PIECE(ABMX("E0"),U,2)
+13 SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMX("E0"),U,3)_", "
+14 IF $DATA(^DIC(5,$PIECE(ABMX("E0"),U,4),0))
SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMV("X3"),U,3)_$PIECE(^(0),U,2)_" "_$PIECE(ABMX("E0"),U,5)
+15 IF '$TEST
SET ABME(75)=""
+16 SET $PIECE(ABMV("X3"),U,4)=$PIECE(ABMX("E0"),U,6)
+17 ;
REMST ;
+1 SET ABMX("Y")=$PIECE(^AUPNPAT(ABMX("HDFN"),0),U,21)
+2 IF ABMX("Y")=""
Begin DoDot:1
+3 SET ABME(72)=""
+4 SET ABMX("Y")=9
End DoDot:1
+5 SET ABMX("Y0")=$PIECE(^DD(9000001,.21,0),U,3)
+6 SET ABMX("Y0")=$PIECE($PIECE(ABMX("Y0"),ABMX("Y")_":",2),";",1)
+7 SET $PIECE(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
+8 SET $PIECE(ABMV("X3"),U,8)=$SELECT($PIECE(^DPT(ABMX("HDFN"),0),U,9)]""&($PIECE(^(0),U,9)'["-"):$EXTRACT($PIECE(^(0),U,9),1,3)_"-"_$EXTRACT($PIECE(^(0),U,9),4,5)_"-"_$EXTRACT($PIECE(^(0),U,9),6,9),1:$PIECE(^(0),U,9))
+9 GOTO XIT
+10 ;
+11 ; *********************************************************************
PHINFO ; INSURER INFO FROM POLICY HOLDER FILE
+1 SET $PIECE(ABMV("X2"),U,6)=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,8)
+2 SET $PIECE(ABMV("X2"),U,7)=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,19)
+3 SET ABMX("Y")=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,15)
+4 IF ABMX("Y")=""
SET ABME(72)=""
GOTO PHADD
+5 SET ABMX("Y0")=$PIECE(^DD(9000003.1,.15,0),U,3)
+6 SET ABMX("Y0")=$PIECE($PIECE(ABMX("Y0"),ABMX("Y")_":",2),";",1)
+7 SET $PIECE(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
+8 ;
PHADD ;
+1 IF $DATA(^AUPN3PPH(+ABMV("X2"),0))
Begin DoDot:1
+2 IF '($PIECE(^AUPN3PPH(+ABMV("X2"),0),U,9)]"")
SET ABME(105)=""
QUIT
+3 IF '($PIECE(^AUPN3PPH(+ABMV("X2"),0),U,11)]"")
SET ABME(105)=""
QUIT
+4 IF '($PIECE(^AUPN3PPH(+ABMV("X2"),0),U,12)]"")
SET ABME(105)=""
QUIT
+5 IF '($PIECE(^AUPN3PPH(+ABMV("X2"),0),U,13)]"")
SET ABME(105)=""
QUIT
+6 SET $PIECE(ABMV("X2"),U,3)=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,9)
+7 SET $PIECE(ABMV("X2"),U,4)=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,11)_", "
End DoDot:1
+8 IF $DATA(ABME(105))
GOTO PEMPL
+9 IF $DATA(^DIC(5,$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,12),0))
Begin DoDot:1
+10 SET $PIECE(ABMV("X2"),U,4)=$PIECE(ABMV("X2"),U,4)_$PIECE(^DIC(5,$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,12),0),U,2)_" "_$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,13)
+11 SET $PIECE(ABMV("X2"),U,5)=$PIECE(^AUPN3PPH(+ABMV("X2"),0),U,14)
End DoDot:1
+12 IF '$TEST
SET ABME(105)=""
+13 ;
PEMPL ;
+1 IF $PIECE(^AUPN3PPH(+ABMV("X2"),0),U,16)]""
Begin DoDot:1
+2 IF '$DATA(^AUTNEMPL($PIECE(^AUPN3PPH(+ABMV("X2"),0),U,16),0))
SET ABME(73)=""
QUIT
+3 SET $PIECE(ABMV("X3"),U)=$PIECE(^AUTNEMPL($PIECE(^AUPN3PPH(+ABMV("X2"),0),U,16),0),U)
+4 SET ABMX("E0")=^AUTNEMPL($PIECE(^AUPN3PPH(+ABMV("X2"),0),U,16),0)
End DoDot:1
+5 IF '$TEST
SET ABME(73)=""
+6 IF $DATA(ABME(73))
GOTO XIT
+7 IF $PIECE(ABMX("E0"),U,2)]""
IF $PIECE(ABMX("E0"),U,3)]""
IF $PIECE(ABMX("E0"),U,4)]""
IF $PIECE(ABMX("E0"),U,5)]""
+8 IF '$TEST
SET ABME(75)=""
GOTO XIT
+9 SET $PIECE(ABMV("X3"),U,2)=$PIECE(ABMX("E0"),U,2)
+10 SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMX("E0"),U,3)_", "
+11 IF $DATA(^DIC(5,$PIECE(ABMX("E0"),U,4),0))
SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMV("X3"),U,3)_$PIECE(^(0),U,2)_" "_$PIECE(ABMX("E0"),U,5)
+12 IF '$TEST
SET ABME(75)=""
+13 SET $PIECE(ABMV("X3"),U,4)=$PIECE(ABMX("E0"),U,6)
+14 ;
XIT ;
+1 KILL ABMX
+2 QUIT
