- 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
