ABMDLBL1.m

ABMDLBL1 ; IHS/ASDST/DMJ - Print Insurer Labels - PART 2 ; 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;

 ;

BADDR ;EP for setting Mailing Address array

 S ABM("IDFN")=$P(ABM("I"),"-",$L(ABM("I"),"-")) Q:'ABM("IDFN")

 I ABM("I")["NON-BENEFICIARY PATIENT"&($G(ABM("INS",ABM("I"),ABM("J")))) G PADDR

 Q:'$D(^AUTNINS(ABM("IDFN"),0))  S ABM("I",0)=^(0),ABM("I",1)=$G(^(1)),ABM("I",4)=$G(^(4))

 I $P(ABM("I",1),U)]"",$P(ABM("I",1),U,2)]"",$P(ABM("I",1),U,3)]"",$P(ABM("I",1),U,4)]"",$P(ABM("I",1),U,5)]""

 E  G MADDR

 S ABMCSZ=$P(ABM("I",1),"^",3,5)

 S ABM("ADD")=$P(ABM("I",1),U,1,3)_", "

 I $D(^DIC(5,$P(ABM("I",1),U,4),0)) S $P(ABM("ADD"),U,3)=$P(ABM("ADD"),U,3)_$P(^(0),U,2)_"  "_$P(ABM("I",1),U,5) Q

 E  K ABM("ADD")

 ;

MADDR ;mailing address

 S ABM("ADD")=$S($P(ABM("I",4),U)]"":ABM("I",4),1:$P(ABM("I",0),U))

 I $P(ABM("I",0),U,2)]"",$P(ABM("I",0),U,3)]"",$P(ABM("I",0),U,4)]"",$P(ABM("I",0),U,5)]"" S $P(ABM("ADD"),U,2)=$P(ABM("I",0),U,2),$P(ABM("ADD"),U,3)=$P(ABM("I",0),U,3)_", "

 E  G NO

 I $P(ABM("I",0),U,4)]"",$D(^DIC(5,$P(ABM("I",0),U,4),0)) S $P(ABM("ADD"),U,3)=$P(ABM("ADD"),U,3)_$P(^(0),U,2)_"  "_$P(ABM("I",0),U,5)

 E  G NO

 S ABMCSZ=$P(ABM("I",0),"^",3,5)

 Q

 ;

PADDR ;PATIENT ADDRESS

 S ABM("PAT")=ABM("INS",ABM("I"),ABM("J")) Q:'$D(^DPT(+ABM("PAT"),0))

 S ABM("ADD")=$P(^DPT(ABM("PAT"),0),U)

 I $D(^DPT(ABM("PAT"),.11)),$P(^(.11),U)]"",$P(^(.11),U,4)]"",$P(^(.11),U,5)]"",$P(^(.11),U,6)]"" S $P(ABM("ADD"),U,2)=$P(^(.11),U),$P(ABM("ADD"),U,3)=$P(^(.11),U,4)_", "

 E  S ABM("ADD")=ABM("ADD")_U_"*** address info incomplete ***" Q

 S ABMCSZ=$P(^DPT(ABM("PAT"),.11),"^",4,6)

 I $D(^DIC(5,$P(^DPT(ABM("PAT"),.11),U,5),0)) S $P(ABM("ADD"),U,3)=$P(ABM("ADD"),U,3)_$P(^(0),U,2)_"  "_$P(^DPT(ABM("PAT"),.11),U,6)

 E  S ABM("ADD")=ABM("ADD")_U_"*** address info incomplete ***"

 Q

 ;

NO S ABM("ADD")=$P(^AUTNINS(ABM("IDFN"),0),U)_U_"*** address info incomplete ***"

 Q

ABMDLBL1  ; IHS/ASDST/DMJ - Print Insurer Labels - PART 2 ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;TMD;

 +3       ;

BADDR     ;EP for setting Mailing Address array

 +1        SET ABM("IDFN")=$PIECE(ABM("I"),"-",$LENGTH(ABM("I"),"-"))

           IF 'ABM("IDFN")

               QUIT 

 +2        IF ABM("I")["NON-BENEFICIARY PATIENT"&($GET(ABM("INS",ABM("I"),ABM("J"))))

               GOTO PADDR

 +3        IF '$DATA(^AUTNINS(ABM("IDFN"),0))

               QUIT 

           SET ABM("I",0)=^(0)

           SET ABM("I",1)=$GET(^(1))

           SET ABM("I",4)=$GET(^(4))

 +4        IF $PIECE(ABM("I",1),U)]""

               IF $PIECE(ABM("I",1),U,2)]""

                   IF $PIECE(ABM("I",1),U,3)]""

                       IF $PIECE(ABM("I",1),U,4)]""

                           IF $PIECE(ABM("I",1),U,5)]""

 +5       IF '$TEST

               GOTO MADDR

 +6        SET ABMCSZ=$PIECE(ABM("I",1),"^",3,5)

 +7        SET ABM("ADD")=$PIECE(ABM("I",1),U,1,3)_", "

 +8        IF $DATA(^DIC(5,$PIECE(ABM("I",1),U,4),0))

               SET $PIECE(ABM("ADD"),U,3)=$PIECE(ABM("ADD"),U,3)_$PIECE(^(0),U,2)_"  "_$PIECE(ABM("I",1),U,5)

               QUIT 

 +9       IF '$TEST

               KILL ABM("ADD")

 +10      ;

MADDR     ;mailing address

 +1        SET ABM("ADD")=$SELECT($PIECE(ABM("I",4),U)]"":ABM("I",4),1:$PIECE(ABM("I",0),U))

 +2        IF $PIECE(ABM("I",0),U,2)]""

               IF $PIECE(ABM("I",0),U,3)]""

                   IF $PIECE(ABM("I",0),U,4)]""

                       IF $PIECE(ABM("I",0),U,5)]""

                           SET $PIECE(ABM("ADD"),U,2)=$PIECE(ABM("I",0),U,2)

                           SET $PIECE(ABM("ADD"),U,3)=$PIECE(ABM("I",0),U,3)_", "

 +3       IF '$TEST

               GOTO NO

 +4        IF $PIECE(ABM("I",0),U,4)]""

               IF $DATA(^DIC(5,$PIECE(ABM("I",0),U,4),0))

                   SET $PIECE(ABM("ADD"),U,3)=$PIECE(ABM("ADD"),U,3)_$PIECE(^(0),U,2)_"  "_$PIECE(ABM("I",0),U,5)

 +5       IF '$TEST

               GOTO NO

 +6        SET ABMCSZ=$PIECE(ABM("I",0),"^",3,5)

 +7        QUIT 

 +8       ;

PADDR     ;PATIENT ADDRESS

 +1        SET ABM("PAT")=ABM("INS",ABM("I"),ABM("J"))

           IF '$DATA(^DPT(+ABM("PAT"),0))

               QUIT 

 +2        SET ABM("ADD")=$PIECE(^DPT(ABM("PAT"),0),U)

 +3        IF $DATA(^DPT(ABM("PAT"),.11))

               IF $PIECE(^(.11),U)]""

                   IF $PIECE(^(.11),U,4)]""

                       IF $PIECE(^(.11),U,5)]""

                           IF $PIECE(^(.11),U,6)]""

                               SET $PIECE(ABM("ADD"),U,2)=$PIECE(^(.11),U)

                               SET $PIECE(ABM("ADD"),U,3)=$PIECE(^(.11),U,4)_", "

 +4       IF '$TEST

               SET ABM("ADD")=ABM("ADD")_U_"*** address info incomplete ***"

               QUIT 

 +5        SET ABMCSZ=$PIECE(^DPT(ABM("PAT"),.11),"^",4,6)

 +6        IF $DATA(^DIC(5,$PIECE(^DPT(ABM("PAT"),.11),U,5),0))

               SET $PIECE(ABM("ADD"),U,3)=$PIECE(ABM("ADD"),U,3)_$PIECE(^(0),U,2)_"  "_$PIECE(^DPT(ABM("PAT"),.11),U,6)

 +7       IF '$TEST

               SET ABM("ADD")=ABM("ADD")_U_"*** address info incomplete ***"

 +8        QUIT 

 +9       ;

NO         SET ABM("ADD")=$PIECE(^AUTNINS(ABM("IDFN"),0),U)_U_"*** address info incomplete ***"

 +1        QUIT