- 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
