ABME8N3 ; IHS/ASDST/DMJ - 837 N3 Segment
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Address Information
;
; 01/29/04 V2.5 P5 - 837 Modifications
; Remove trailing spaces from address of Patient and policy holder
; name
; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548
; Added code for Service Facility (9002274.35)
; IHS/SD/SDR - V2.5 P8 - task 6
; point of pickup address if ambulance
; IHS/SD/SDR - v2.5 p9 - task 1
; Added code for ordering provider address
;
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 D
.S ABMR("N3",20)=$$TRIM^ABMUTLP($P($G(^DPT(Y,.11)),U),"R"," ")
I X=4 D
.S ABMR("N3",20)=$P($G(^DIC(4,Y,1)),U)
I X=9000003.1 D
.S ABMR("N3",20)=$$TRIM^ABMUTLP($P($G(^AUPN3PPH(Y,0)),U,9),"R"," ")
I X=9999999.06 D
.S ABMR("N3",20)=$P($G(^AUTTLOC(Y,0)),"^",12)
I X=9999999.18 D
.S ABMR("N3",20)=$P($G(^AUTNINS(Y,1)),"^",2)
I X=9002274.35 D
.S ABMR("N3",20)=$P($G(^AUTTVNDR($P($G(^ABMRLABS(Y,0)),U),13)),U)
I X=9002274.4 D
.S ABMR("N3",20)=$P($G(^ABMDBILL(DUZ(2),Y,12)),U,3)
I X=200 D
.S ABMR("N3",20)=$P($G(^VA(200,Y,.11)),U)
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
ABME8N3 ; IHS/ASDST/DMJ - 837 N3 Segment
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Address Information
+3 ;
+4 ; 01/29/04 V2.5 P5 - 837 Modifications
+5 ; Remove trailing spaces from address of Patient and policy holder
+6 ; name
+7 ; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548
+8 ; Added code for Service Facility (9002274.35)
+9 ; IHS/SD/SDR - V2.5 P8 - task 6
+10 ; point of pickup address if ambulance
+11 ; IHS/SD/SDR - v2.5 p9 - task 1
+12 ; Added code for ordering provider address
+13 ;
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
Begin DoDot:1
+3 SET ABMR("N3",20)=$$TRIM^ABMUTLP($PIECE($GET(^DPT(Y,.11)),U),"R"," ")
End DoDot:1
+4 IF X=4
Begin DoDot:1
+5 SET ABMR("N3",20)=$PIECE($GET(^DIC(4,Y,1)),U)
End DoDot:1
+6 IF X=9000003.1
Begin DoDot:1
+7 SET ABMR("N3",20)=$$TRIM^ABMUTLP($PIECE($GET(^AUPN3PPH(Y,0)),U,9),"R"," ")
End DoDot:1
+8 IF X=9999999.06
Begin DoDot:1
+9 SET ABMR("N3",20)=$PIECE($GET(^AUTTLOC(Y,0)),"^",12)
End DoDot:1
+10 IF X=9999999.18
Begin DoDot:1
+11 SET ABMR("N3",20)=$PIECE($GET(^AUTNINS(Y,1)),"^",2)
End DoDot:1
+12 IF X=9002274.35
Begin DoDot:1
+13 SET ABMR("N3",20)=$PIECE($GET(^AUTTVNDR($PIECE($GET(^ABMRLABS(Y,0)),U),13)),U)
End DoDot:1
+14 IF X=9002274.4
Begin DoDot:1
+15 SET ABMR("N3",20)=$PIECE($GET(^ABMDBILL(DUZ(2),Y,12)),U,3)
End DoDot:1
+16 IF X=200
Begin DoDot:1
+17 SET ABMR("N3",20)=$PIECE($GET(^VA(200,Y,.11)),U)
End DoDot:1
+18 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
