- 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
