- ABME5N4 ; IHS/ASDST/DMJ - 837 N4 Segment
- ;;2.6;IHS Third Party Billing System;**6,8,9**;NOV 12, 2009;Build 379
- ;City/State/Zip
- ;
- EP(X,Y) ;EP - START HERE
- ;x=file
- ;y=internal entry number
- K ABMREC("N4"),ABMR("N4")
- S:X=3 X=9000003.1
- S ABME("RTYPE")="N4"
- D LOOP
- K ABME
- Q
- LOOP ;LOOP HERE
- F I=10:10:80 D
- .D @I
- .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))
- .I $G(ABMREC("N4"))'="" S ABMREC("N4")=ABMREC("N4")_"*"
- .S ABMREC("N4")=$G(ABMREC("N4"))_ABMR("N4",I)
- Q
- 10 ;segment
- S ABMR("N4",10)="N4"
- Q
- 20 ;N401 - City Name
- I X=2 S ABMR("N4",20)=$P($G(^DPT(Y,.11)),"^",4)
- I X=4 S ABMR("N4",20)=$P($G(^DIC(4,Y,1)),"^",3)
- I X=9000003.1 S ABMR("N4",20)=$P($G(^AUPN3PPH(Y,0)),"^",11)
- I X=9999999.06 S ABMR("N4",20)=$P($G(^AUTTLOC(Y,0)),"^",13)
- I X=9999999.18 S ABMR("N4",20)=$P($G(^AUTNINS(Y,1)),"^",3)
- I X=9002274.35 S ABMR("N4",20)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U,2)
- I X=200 S ABMR("N4",20)=$P($G(^VA(200,Y,.11)),U,4)
- I X="AMB",(Y="PU") S ABMR("N4",20)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,4)
- 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),";")
- .;start old code abm*2.6*8 HEAT45242
- .;I ABMR("F")["AUTNINS" S ABMR("N3",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,3)
- .;I ABMR("F")["AUPNPAT" S ABMR("N3",20)=$P($G(^DPT(ABMR("IEN"),.11)),U,4)
- .;I ABMR("F")["AUTTLOC" S ABMR("N3",20)=$P($G(^DIC(4,ABMR("IEN"),1)),U,3)
- .;end old code start new code HEAT45242
- .;I ABMR("F")["AUTNINS" S ABMR("N4",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,3)
- .I ABMR("F")["AUPNPAT" S ABMR("N4",20)=$P($G(^DPT(ABMR("IEN"),.11)),U,4)
- .I ABMR("F")["AUTTLOC" S ABMR("N4",20)=$P($G(^DIC(4,ABMR("IEN"),1)),U,3)
- .I ABMR("F")["AUTTVNDR" S ABMR("N4",20)=$P($G(^AUTTVNDR(ABMR("IEN"),13)),U,2)
- .;end new code HEAT45242
- Q
- 30 ;N402 - State or Province
- I X=2 S ABMR("N4",30)=$P($G(^DPT(Y,.11)),"^",5)
- I X=4 S ABMR("N4",30)=$P($G(^DIC(4,Y,0)),"^",2)
- I X=9000003.1 S ABMR("N4",30)=$P($G(^AUPN3PPH(Y,0)),"^",12)
- I X=9999999.06 S ABMR("N4",30)=$P($G(^AUTTLOC(Y,0)),"^",14)
- I X=9999999.18 S ABMR("N4",30)=$P($G(^AUTNINS(Y,1)),"^",4)
- I X=9002274.35 S ABMR("N4",30)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U,3)
- I X=200 S ABMR("N4",30)=$P($G(^VA(200,Y,.11)),U,5)
- I X="AMB",(Y="PU") S ABMR("N4",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,5)
- 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),";")
- .;start old code abm*2.6*8 HEAT45242
- .;I ABMR("F")["AUTNINS" S ABMR("N3",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,4)
- .;I ABMR("F")["AUPNPAT" S ABMR("N3",20)=$P($G(^DPT(ABMR("IEN"),.11)),U,5)
- .;I ABMR("F")["AUTTLOC" S ABMR("N3",20)=$P($G(^DIC(4,ABMR("IEN"),0)),U,2)
- .;end old code start new code HEAT45242
- .;I ABMR("F")["AUTNINS" S ABMR("N4",30)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,4)
- .I ABMR("F")["AUPNPAT" S ABMR("N4",30)=$P($G(^DPT(ABMR("IEN"),.11)),U,5)
- .I ABMR("F")["AUTTLOC" S ABMR("N4",30)=$P($G(^DIC(4,ABMR("IEN"),0)),U,2)
- .I ABMR("F")["AUTTVNDR" S ABMR("N4",30)=$P($G(^AUTTVNDR(ABMR("IEN"),13)),U,3)
- .;end new codes HEAT45242
- S ABMR("N4",30)=$P($G(^DIC(5,+ABMR("N4",30),0)),"^",2)
- Q
- 40 ;N403 - Postal Code
- I X=2 S ABMR("N4",40)=$P($G(^DPT(Y,.11)),"^",6)
- I X=4 S ABMR("N4",40)=$P($G(^DIC(4,Y,1)),"^",4)
- I X=9000003.1 S ABMR("N4",40)=$P($G(^AUPN3PPH(Y,0)),"^",13)
- I X=9999999.06 S ABMR("N4",40)=$P($G(^AUTTLOC(Y,0)),"^",15)
- I X=9999999.18 S ABMR("N4",40)=$P($G(^AUTNINS(Y,1)),"^",5)
- I X=9002274.35 S ABMR("N4",40)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U,4)
- I X=200 S ABMR("N4",40)=$P($G(^VA(200,Y,.11)),U,6)
- ;I X="AMB",(Y="PU") S ABMR("N4",40)=$P($G(^ABMDBILL(DUZ(2),Y,12)),U,6) ;abm*2.6*9 NOHEAT IHS/SD/AML 1/17/2012 - Fix delimiter
- I X="AMB",(Y="PU") S ABMR("N4",40)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,6) ;ABM*2.6*9 NOHEAT IHS/SD/AML 1/17/2012 - Fix delimiter
- 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),";")
- .;start old code abm*2.6*8 HEAT 45242
- .;I ABMR("F")["AUTNINS" S ABMR("N3",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,5)
- .;I ABMR("F")["AUPNPAT" S ABMR("N3",20)=$P($G(^DPT(ABMR("IEN"),.11)),U,6)
- .;I ABMR("F")["AUTTLOC" S ABMR("N3",20)=$P($G(^DIC(4,ABMR("IEN"),1)),U,4)
- .;end old code start new code HEAT45242
- .I ABMR("F")["AUTNINS" S ABMR("N4",40)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,5)
- .I ABMR("F")["AUPNPAT" S ABMR("N4",40)=$P($G(^DPT(ABMR("IEN"),.11)),U,6)
- .I ABMR("F")["AUTTLOC" S ABMR("N4",40)=$P($G(^DIC(4,ABMR("IEN"),1)),U,4)
- .I ABMR("F")["AUTTVNDR" S ABMR("N4",40)=$P($G(^AUTTVNDR(ABMR("IEN"),13)),U,4) ;abm*2.6*9 NOHEAT IHS/SD/AML 1/17/2012
- .;end new code HEAT45242
- ;S:(+ABMR("N4",40)'=0) ABMR("N4",40)=$$FMT^ABMERUTL($TR(ABMR("N4",40)," -"),"9N") ;abm*2.6*9 NOHEAT IHS/SD/AML 12/23/2011
- S ABMR("N4",40)=$TR(ABMR("N4",40)," -") ;abm*2.6*9 NOHEAT - IHS/SD/AML 12/23/2011 - Pt address only needs to be 5 characters
- Q
- 50 ;N404 - Country Code
- S ABMR("N4",50)=""
- Q
- 60 ;N405 - Location Qualifier
- S ABMR("N4",60)=""
- Q
- 70 ;N406 - Location Identifier
- S ABMR("N4",70)=""
- Q
- 80 ;N407 - Country Subdivision Code
- S ABMR("N4",80)=""
- Q
- ABME5N4 ; IHS/ASDST/DMJ - 837 N4 Segment
- +1 ;;2.6;IHS Third Party Billing System;**6,8,9**;NOV 12, 2009;Build 379
- +2 ;City/State/Zip
- +3 ;
- EP(X,Y) ;EP - START HERE
- +1 ;x=file
- +2 ;y=internal entry number
- +3 KILL ABMREC("N4"),ABMR("N4")
- +4 IF X=3
- SET X=9000003.1
- +5 SET ABME("RTYPE")="N4"
- +6 DO LOOP
- +7 KILL ABME
- +8 QUIT
- LOOP ;LOOP HERE
- +1 FOR I=10:10:80
- 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("N4"))'=""
- SET ABMREC("N4")=ABMREC("N4")_"*"
- +5 SET ABMREC("N4")=$GET(ABMREC("N4"))_ABMR("N4",I)
- End DoDot:1
- +6 QUIT
- 10 ;segment
- +1 SET ABMR("N4",10)="N4"
- +2 QUIT
- 20 ;N401 - City Name
- +1 IF X=2
- SET ABMR("N4",20)=$PIECE($GET(^DPT(Y,.11)),"^",4)
- +2 IF X=4
- SET ABMR("N4",20)=$PIECE($GET(^DIC(4,Y,1)),"^",3)
- +3 IF X=9000003.1
- SET ABMR("N4",20)=$PIECE($GET(^AUPN3PPH(Y,0)),"^",11)
- +4 IF X=9999999.06
- SET ABMR("N4",20)=$PIECE($GET(^AUTTLOC(Y,0)),"^",13)
- +5 IF X=9999999.18
- SET ABMR("N4",20)=$PIECE($GET(^AUTNINS(Y,1)),"^",3)
- +6 IF X=9002274.35
- SET ABMR("N4",20)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U,2)
- +7 IF X=200
- SET ABMR("N4",20)=$PIECE($GET(^VA(200,Y,.11)),U,4)
- +8 IF X="AMB"
- IF (Y="PU")
- SET ABMR("N4",20)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,4)
- +9 IF X="AMB"
- IF (Y="DO")
- Begin DoDot:1
- +10 SET ABMR("F")=$PIECE($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";",2)
- +11 SET ABMR("IEN")=$PIECE($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";")
- +12 ;start old code abm*2.6*8 HEAT45242
- +13 ;I ABMR("F")["AUTNINS" S ABMR("N3",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,3)
- +14 ;I ABMR("F")["AUPNPAT" S ABMR("N3",20)=$P($G(^DPT(ABMR("IEN"),.11)),U,4)
- +15 ;I ABMR("F")["AUTTLOC" S ABMR("N3",20)=$P($G(^DIC(4,ABMR("IEN"),1)),U,3)
- +16 ;end old code start new code HEAT45242
- +17 ;I ABMR("F")["AUTNINS" S ABMR("N4",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,3)
- +18 IF ABMR("F")["AUPNPAT"
- SET ABMR("N4",20)=$PIECE($GET(^DPT(ABMR("IEN"),.11)),U,4)
- +19 IF ABMR("F")["AUTTLOC"
- SET ABMR("N4",20)=$PIECE($GET(^DIC(4,ABMR("IEN"),1)),U,3)
- +20 IF ABMR("F")["AUTTVNDR"
- SET ABMR("N4",20)=$PIECE($GET(^AUTTVNDR(ABMR("IEN"),13)),U,2)
- +21 ;end new code HEAT45242
- End DoDot:1
- +22 QUIT
- 30 ;N402 - State or Province
- +1 IF X=2
- SET ABMR("N4",30)=$PIECE($GET(^DPT(Y,.11)),"^",5)
- +2 IF X=4
- SET ABMR("N4",30)=$PIECE($GET(^DIC(4,Y,0)),"^",2)
- +3 IF X=9000003.1
- SET ABMR("N4",30)=$PIECE($GET(^AUPN3PPH(Y,0)),"^",12)
- +4 IF X=9999999.06
- SET ABMR("N4",30)=$PIECE($GET(^AUTTLOC(Y,0)),"^",14)
- +5 IF X=9999999.18
- SET ABMR("N4",30)=$PIECE($GET(^AUTNINS(Y,1)),"^",4)
- +6 IF X=9002274.35
- SET ABMR("N4",30)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U,3)
- +7 IF X=200
- SET ABMR("N4",30)=$PIECE($GET(^VA(200,Y,.11)),U,5)
- +8 IF X="AMB"
- IF (Y="PU")
- SET ABMR("N4",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,5)
- +9 IF X="AMB"
- IF (Y="DO")
- Begin DoDot:1
- +10 SET ABMR("F")=$PIECE($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";",2)
- +11 SET ABMR("IEN")=$PIECE($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7),";")
- +12 ;start old code abm*2.6*8 HEAT45242
- +13 ;I ABMR("F")["AUTNINS" S ABMR("N3",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,4)
- +14 ;I ABMR("F")["AUPNPAT" S ABMR("N3",20)=$P($G(^DPT(ABMR("IEN"),.11)),U,5)
- +15 ;I ABMR("F")["AUTTLOC" S ABMR("N3",20)=$P($G(^DIC(4,ABMR("IEN"),0)),U,2)
- +16 ;end old code start new code HEAT45242
- +17 ;I ABMR("F")["AUTNINS" S ABMR("N4",30)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,4)
- +18 IF ABMR("F")["AUPNPAT"
- SET ABMR("N4",30)=$PIECE($GET(^DPT(ABMR("IEN"),.11)),U,5)
- +19 IF ABMR("F")["AUTTLOC"
- SET ABMR("N4",30)=$PIECE($GET(^DIC(4,ABMR("IEN"),0)),U,2)
- +20 IF ABMR("F")["AUTTVNDR"
- SET ABMR("N4",30)=$PIECE($GET(^AUTTVNDR(ABMR("IEN"),13)),U,3)
- +21 ;end new codes HEAT45242
- End DoDot:1
- +22 SET ABMR("N4",30)=$PIECE($GET(^DIC(5,+ABMR("N4",30),0)),"^",2)
- +23 QUIT
- 40 ;N403 - Postal Code
- +1 IF X=2
- SET ABMR("N4",40)=$PIECE($GET(^DPT(Y,.11)),"^",6)
- +2 IF X=4
- SET ABMR("N4",40)=$PIECE($GET(^DIC(4,Y,1)),"^",4)
- +3 IF X=9000003.1
- SET ABMR("N4",40)=$PIECE($GET(^AUPN3PPH(Y,0)),"^",13)
- +4 IF X=9999999.06
- SET ABMR("N4",40)=$PIECE($GET(^AUTTLOC(Y,0)),"^",15)
- +5 IF X=9999999.18
- SET ABMR("N4",40)=$PIECE($GET(^AUTNINS(Y,1)),"^",5)
- +6 IF X=9002274.35
- SET ABMR("N4",40)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U,4)
- +7 IF X=200
- SET ABMR("N4",40)=$PIECE($GET(^VA(200,Y,.11)),U,6)
- +8 ;I X="AMB",(Y="PU") S ABMR("N4",40)=$P($G(^ABMDBILL(DUZ(2),Y,12)),U,6) ;abm*2.6*9 NOHEAT IHS/SD/AML 1/17/2012 - Fix delimiter
- +9 ;ABM*2.6*9 NOHEAT IHS/SD/AML 1/17/2012 - Fix delimiter
- IF X="AMB"
- IF (Y="PU")
- SET ABMR("N4",40)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,6)
- +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 ;start old code abm*2.6*8 HEAT 45242
- +14 ;I ABMR("F")["AUTNINS" S ABMR("N3",20)=$P($G(^AUTNINS(ABMR("IEN"),0)),U,5)
- +15 ;I ABMR("F")["AUPNPAT" S ABMR("N3",20)=$P($G(^DPT(ABMR("IEN"),.11)),U,6)
- +16 ;I ABMR("F")["AUTTLOC" S ABMR("N3",20)=$P($G(^DIC(4,ABMR("IEN"),1)),U,4)
- +17 ;end old code start new code HEAT45242
- +18 IF ABMR("F")["AUTNINS"
- SET ABMR("N4",40)=$PIECE($GET(^AUTNINS(ABMR("IEN"),0)),U,5)
- +19 IF ABMR("F")["AUPNPAT"
- SET ABMR("N4",40)=$PIECE($GET(^DPT(ABMR("IEN"),.11)),U,6)
- +20 IF ABMR("F")["AUTTLOC"
- SET ABMR("N4",40)=$PIECE($GET(^DIC(4,ABMR("IEN"),1)),U,4)
- +21 ;abm*2.6*9 NOHEAT IHS/SD/AML 1/17/2012
- IF ABMR("F")["AUTTVNDR"
- SET ABMR("N4",40)=$PIECE($GET(^AUTTVNDR(ABMR("IEN"),13)),U,4)
- +22 ;end new code HEAT45242
- End DoDot:1
- +23 ;S:(+ABMR("N4",40)'=0) ABMR("N4",40)=$$FMT^ABMERUTL($TR(ABMR("N4",40)," -"),"9N") ;abm*2.6*9 NOHEAT IHS/SD/AML 12/23/2011
- +24 ;abm*2.6*9 NOHEAT - IHS/SD/AML 12/23/2011 - Pt address only needs to be 5 characters
- SET ABMR("N4",40)=$TRANSLATE(ABMR("N4",40)," -")
- +25 QUIT
- 50 ;N404 - Country Code
- +1 SET ABMR("N4",50)=""
- +2 QUIT
- 60 ;N405 - Location Qualifier
- +1 SET ABMR("N4",60)=""
- +2 QUIT
- 70 ;N406 - Location Identifier
- +1 SET ABMR("N4",70)=""
- +2 QUIT
- 80 ;N407 - Country Subdivision Code
- +1 SET ABMR("N4",80)=""
- +2 QUIT