- 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
