ABME5N3.m

ABME5N3 ; IHS/ASDST/DMJ - 837 N3 Segment 

 ;;2.6;IHS Third Party Billing System;**6,9**;NOV 12, 2009

 ;Address Information

 ;

EP(X,Y) ;EP - START HERE

 ;x=file number

 ;y=ien

 K ABMREC("N3"),ABMR("N3")

 S:X=3 X=9000003.1

 S ABME("RTYPE")="N3"

 D LOOP

 K ABME

 Q

LOOP ;LOOP HERE

 F I=10:10:30 D

 .D @I

 .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))

 .I $G(ABMREC("N3"))'="" S ABMREC("N3")=ABMREC("N3")_"*"

 .S ABMREC("N3")=$G(ABMREC("N3"))_ABMR("N3",I)

 Q

10 ;segment

 S ABMR("N3",10)="N3"

 Q

20 ;N301 - Address 1

 S ABMR("N3",20)=""

 I X=2 S ABMR("N3",20)=$$TRIM^ABMUTLP($P($G(^DPT(Y,.11)),U),"R"," ")

 I X=4 S ABMR("N3",20)=$P($G(^DIC(4,Y,1)),U)

 I X=9000003.1 S ABMR("N3",20)=$$TRIM^ABMUTLP($P($G(^AUPN3PPH(Y,0)),U,9),"R"," ")

 I X=9999999.06 S ABMR("N3",20)=$P($G(^AUTTLOC(Y,0)),"^",12)

 I X=9999999.18 S ABMR("N3",20)=$P($G(^AUTNINS(Y,1)),"^",2)

 I X=9002274.35 S ABMR("N3",20)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U)

 I X=200 S ABMR("N3",20)=$P($G(^VA(200,Y,.11)),U)

 I X="AMB",(Y="PU") S ABMR("N3",20)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,3)

 I X="AMB",(Y="DO") D

 .S ABMR("F")=$P($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";",2)

 .S ABMR("IEN")=$P($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";")

 .I ABMR("F")["AUTNINS" S ABMR("N3",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,2)

 .I ABMR("F")["AUPNPAT" S ABMR("N3",20)=$P($G(^DPT(ABMR("IEN"),.11)),U)

 .I ABMR("F")["AUTTLOC" S ABMR("N3",20)=$P($G(^DIC(4,ABMR("IEN"),1)),U)

 .I ABMR("F")["AUTTVNDR" S ABMR("N3",20)=$P($G(^AUTTVNDR(ABMR("IEN"),13)),U)  ;abm*2.6*9 NOHEAT IHS/SD/AML 1/17/2012 Adds vendor street address

 Q

30 ;N302 - Address 2

 S ABMR("N3",30)=""

 I X=2 D

 .S ABMR("N3",30)=$P($G(^DPT(Y,.11)),"^",2)

 I X=4 D

 .S ABMR("N3",30)=$P($G(^DIC(4,Y,1)),"^",2)

 Q

ABME5N3   ; IHS/ASDST/DMJ - 837 N3 Segment 

 +1       ;;2.6;IHS Third Party Billing System;**6,9**;NOV 12, 2009

 +2       ;Address Information

 +3       ;

EP(X,Y)   ;EP - START HERE

 +1       ;x=file number

 +2       ;y=ien

 +3        KILL ABMREC("N3"),ABMR("N3")

 +4        IF X=3

               SET X=9000003.1

 +5        SET ABME("RTYPE")="N3"

 +6        DO LOOP

 +7        KILL ABME

 +8        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:30

               Begin DoDot:1

 +2                DO @I

 +3                IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),ABME("RTYPE"),I))

                       DO @(^(I))

 +4                IF $GET(ABMREC("N3"))'=""

                       SET ABMREC("N3")=ABMREC("N3")_"*"

 +5                SET ABMREC("N3")=$GET(ABMREC("N3"))_ABMR("N3",I)

               End DoDot:1

 +6        QUIT 

10        ;segment

 +1        SET ABMR("N3",10)="N3"

 +2        QUIT 

20        ;N301 - Address 1

 +1        SET ABMR("N3",20)=""

 +2        IF X=2

               SET ABMR("N3",20)=$$TRIM^ABMUTLP($PIECE($GET(^DPT(Y,.11)),U),"R"," ")

 +3        IF X=4

               SET ABMR("N3",20)=$PIECE($GET(^DIC(4,Y,1)),U)

 +4        IF X=9000003.1

               SET ABMR("N3",20)=$$TRIM^ABMUTLP($PIECE($GET(^AUPN3PPH(Y,0)),U,9),"R"," ")

 +5        IF X=9999999.06

               SET ABMR("N3",20)=$PIECE($GET(^AUTTLOC(Y,0)),"^",12)

 +6        IF X=9999999.18

               SET ABMR("N3",20)=$PIECE($GET(^AUTNINS(Y,1)),"^",2)

 +7        IF X=9002274.35

               SET ABMR("N3",20)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U)

 +8        IF X=200

               SET ABMR("N3",20)=$PIECE($GET(^VA(200,Y,.11)),U)

 +9        IF X="AMB"

               IF (Y="PU")

                   SET ABMR("N3",20)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,3)

 +10       IF X="AMB"

               IF (Y="DO")

                   Begin DoDot:1

 +11                   SET ABMR("F")=$PIECE($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";",2)

 +12                   SET ABMR("IEN")=$PIECE($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";")

 +13                   IF ABMR("F")["AUTNINS"

                           SET ABMR("N3",20)=$PIECE($GET(^AUTNINS(ABMR("IEN"),0)),U,2)

 +14                   IF ABMR("F")["AUPNPAT"

                           SET ABMR("N3",20)=$PIECE($GET(^DPT(ABMR("IEN"),.11)),U)

 +15                   IF ABMR("F")["AUTTLOC"

                           SET ABMR("N3",20)=$PIECE($GET(^DIC(4,ABMR("IEN"),1)),U)

 +16      ;abm*2.6*9 NOHEAT IHS/SD/AML 1/17/2012 Adds vendor street address

                       IF ABMR("F")["AUTTVNDR"

                           SET ABMR("N3",20)=$PIECE($GET(^AUTTVNDR(ABMR("IEN"),13)),U)

                   End DoDot:1

 +17       QUIT 

30        ;N302 - Address 2

 +1        SET ABMR("N3",30)=""

 +2        IF X=2

               Begin DoDot:1

 +3                SET ABMR("N3",30)=$PIECE($GET(^DPT(Y,.11)),"^",2)

               End DoDot:1

 +4        IF X=4

               Begin DoDot:1

 +5                SET ABMR("N3",30)=$PIECE($GET(^DIC(4,Y,1)),"^",2)

               End DoDot:1

 +6        QUIT