ABME8N4 ; IHS/ASDST/DMJ - 837 N4 Segment
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;City/State/Zip
;
; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548
; Added code for Service Facility (9002274.35)
;
; IHS/SD/SDR - v2.5 p8 - task 6
; use point of pickup city/st/zip if ambulance
;
; IHS/SD/SDR - v2.5 p9 - task 1
; Added code for ordering provider address
;
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:70 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 D
.S ABMR("N4",20)=$P($G(^DPT(Y,.11)),"^",4)
I X=4 D
.S ABMR("N4",20)=$P($G(^DIC(4,Y,1)),"^",3)
I X=9000003.1 D
.S ABMR("N4",20)=$P($G(^AUPN3PPH(Y,0)),"^",11)
I X=9999999.06 D
.S ABMR("N4",20)=$P($G(^AUTTLOC(Y,0)),"^",13)
I X=9999999.18 D
.S ABMR("N4",20)=$P($G(^AUTNINS(Y,1)),"^",3)
I X=9002274.35 D
.S ABMR("N4",20)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U,2)
I X=9002274.4 D
.S ABMR("N4",20)=$P($G(^ABMDBILL(DUZ(2),Y,12)),U,4)
I X=200 D
.S ABMR("N4",20)=$P($G(^VA(200,Y,.11)),U,4)
Q
30 ;N402 - State or Province
I X=2 D
.S ABMR("N4",30)=$P($G(^DPT(Y,.11)),"^",5)
I X=4 D
.S ABMR("N4",30)=$P($G(^DIC(4,Y,0)),"^",2)
I X=9000003.1 D
.S ABMR("N4",30)=$P($G(^AUPN3PPH(Y,0)),"^",12)
I X=9999999.06 D
.S ABMR("N4",30)=$P($G(^AUTTLOC(Y,0)),"^",14)
I X=9999999.18 D
.S ABMR("N4",30)=$P($G(^AUTNINS(Y,1)),"^",4)
I X=9002274.4 D
.S ABMR("N4",30)=$P($G(^ABMDBILL(DUZ(2),Y,12)),U,5)
I X=9002274.35 D
.S ABMR("N4",30)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U,3)
I X=200 D
.S ABMR("N4",30)=$P($G(^VA(200,Y,.11)),U,5)
S ABMR("N4",30)=$P($G(^DIC(5,+ABMR("N4",30),0)),"^",2)
Q
40 ;N403 - Postal Code
I X=2 D
.S ABMR("N4",40)=$P($G(^DPT(Y,.11)),"^",6)
I X=4 D
.S ABMR("N4",40)=$P($G(^DIC(4,Y,1)),"^",4)
I X=9000003.1 D
.S ABMR("N4",40)=$P($G(^AUPN3PPH(Y,0)),"^",13)
I X=9999999.06 D
.S ABMR("N4",40)=$P($G(^AUTTLOC(Y,0)),"^",15)
I X=9999999.18 D
.S ABMR("N4",40)=$P($G(^AUTNINS(Y,1)),"^",5)
I X=9002274.35 D
.S ABMR("N4",40)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U,4)
I X=9002274.4 D
.S ABMR("N4",40)=$P($G(^ABMDBILL(DUZ(2),Y,12)),U,6)
I X=200 D
.S ABMR("N4",40)=$P($G(^VA(200,Y,.11)),U,6)
S ABMR("N4",40)=$TR(ABMR("N4",40)," -")
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
ABME8N4 ; IHS/ASDST/DMJ - 837 N4 Segment
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;City/State/Zip
+3 ;
+4 ; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548
+5 ; Added code for Service Facility (9002274.35)
+6 ;
+7 ; IHS/SD/SDR - v2.5 p8 - task 6
+8 ; use point of pickup city/st/zip if ambulance
+9 ;
+10 ; IHS/SD/SDR - v2.5 p9 - task 1
+11 ; Added code for ordering provider address
+12 ;
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:70
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
Begin DoDot:1
+2 SET ABMR("N4",20)=$PIECE($GET(^DPT(Y,.11)),"^",4)
End DoDot:1
+3 IF X=4
Begin DoDot:1
+4 SET ABMR("N4",20)=$PIECE($GET(^DIC(4,Y,1)),"^",3)
End DoDot:1
+5 IF X=9000003.1
Begin DoDot:1
+6 SET ABMR("N4",20)=$PIECE($GET(^AUPN3PPH(Y,0)),"^",11)
End DoDot:1
+7 IF X=9999999.06
Begin DoDot:1
+8 SET ABMR("N4",20)=$PIECE($GET(^AUTTLOC(Y,0)),"^",13)
End DoDot:1
+9 IF X=9999999.18
Begin DoDot:1
+10 SET ABMR("N4",20)=$PIECE($GET(^AUTNINS(Y,1)),"^",3)
End DoDot:1
+11 IF X=9002274.35
Begin DoDot:1
+12 SET ABMR("N4",20)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U,2)
End DoDot:1
+13 IF X=9002274.4
Begin DoDot:1
+14 SET ABMR("N4",20)=$PIECE($GET(^ABMDBILL(DUZ(2),Y,12)),U,4)
End DoDot:1
+15 IF X=200
Begin DoDot:1
+16 SET ABMR("N4",20)=$PIECE($GET(^VA(200,Y,.11)),U,4)
End DoDot:1
+17 QUIT
30 ;N402 - State or Province
+1 IF X=2
Begin DoDot:1
+2 SET ABMR("N4",30)=$PIECE($GET(^DPT(Y,.11)),"^",5)
End DoDot:1
+3 IF X=4
Begin DoDot:1
+4 SET ABMR("N4",30)=$PIECE($GET(^DIC(4,Y,0)),"^",2)
End DoDot:1
+5 IF X=9000003.1
Begin DoDot:1
+6 SET ABMR("N4",30)=$PIECE($GET(^AUPN3PPH(Y,0)),"^",12)
End DoDot:1
+7 IF X=9999999.06
Begin DoDot:1
+8 SET ABMR("N4",30)=$PIECE($GET(^AUTTLOC(Y,0)),"^",14)
End DoDot:1
+9 IF X=9999999.18
Begin DoDot:1
+10 SET ABMR("N4",30)=$PIECE($GET(^AUTNINS(Y,1)),"^",4)
End DoDot:1
+11 IF X=9002274.4
Begin DoDot:1
+12 SET ABMR("N4",30)=$PIECE($GET(^ABMDBILL(DUZ(2),Y,12)),U,5)
End DoDot:1
+13 IF X=9002274.35
Begin DoDot:1
+14 SET ABMR("N4",30)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U,3)
End DoDot:1
+15 IF X=200
Begin DoDot:1
+16 SET ABMR("N4",30)=$PIECE($GET(^VA(200,Y,.11)),U,5)
End DoDot:1
+17 SET ABMR("N4",30)=$PIECE($GET(^DIC(5,+ABMR("N4",30),0)),"^",2)
+18 QUIT
40 ;N403 - Postal Code
+1 IF X=2
Begin DoDot:1
+2 SET ABMR("N4",40)=$PIECE($GET(^DPT(Y,.11)),"^",6)
End DoDot:1
+3 IF X=4
Begin DoDot:1
+4 SET ABMR("N4",40)=$PIECE($GET(^DIC(4,Y,1)),"^",4)
End DoDot:1
+5 IF X=9000003.1
Begin DoDot:1
+6 SET ABMR("N4",40)=$PIECE($GET(^AUPN3PPH(Y,0)),"^",13)
End DoDot:1
+7 IF X=9999999.06
Begin DoDot:1
+8 SET ABMR("N4",40)=$PIECE($GET(^AUTTLOC(Y,0)),"^",15)
End DoDot:1
+9 IF X=9999999.18
Begin DoDot:1
+10 SET ABMR("N4",40)=$PIECE($GET(^AUTNINS(Y,1)),"^",5)
End DoDot:1
+11 IF X=9002274.35
Begin DoDot:1
+12 SET ABMR("N4",40)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U,4)
End DoDot:1
+13 IF X=9002274.4
Begin DoDot:1
+14 SET ABMR("N4",40)=$PIECE($GET(^ABMDBILL(DUZ(2),Y,12)),U,6)
End DoDot:1
+15 IF X=200
Begin DoDot:1
+16 SET ABMR("N4",40)=$PIECE($GET(^VA(200,Y,.11)),U,6)
End DoDot:1
+17 SET ABMR("N4",40)=$TRANSLATE(ABMR("N4",40)," -")
+18 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
