- ABME5REF ; IHS/ASDST/DMJ - 837 REF Segment
- ;;2.6;IHS Third Party Billing;**6,8,9,10,11,21**;NOV 12, 2009;Build 379
- ;other payer provider info
- ;IHS/SD/SDR - 2.6*21 - HEAT119570 - Made change so either Property/Casualty Claim number or Case number will print in file
- ;
- EP(X,Y,Z) ;EP
- ;x=entity identifier code from nm1
- ;y=file number
- ;z=internal entry number
- K ABMREC("REF"),ABMR("REF")
- S ABMEIC=X
- S ABMFILE=+$G(Y)
- S ABMIEN=+$G(Z)
- ;S ABMSIEN=$G(Z) ;abm*2.6*8
- S ABME("RTYPE")="REF"
- D LOOP
- K ABME,ABM
- Q
- LOOP ;LOOP HERE
- F I=10:10:50 D
- .D @I
- .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))
- .I $G(ABMREC("REF"))'="" S ABMREC("REF")=ABMREC("REF")_"*"
- .S ABMREC("REF")=$G(ABMREC("REF"))_ABMR("REF",I)
- I '$D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D 837^ABMUTL8
- Q
- 10 ;segment
- S ABMR("REF",10)="REF"
- Q
- 20 ;REF01 - Reference Identification Qualifier
- S ABMR("REF",20)=ABMEIC
- I $G(ABMCLIA)="SV" D
- .I $G(ABMI)=37,(ABMEIC="X4"),($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=""),($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)=($P($G(ABMB9),U,2))) S ABMR("REF",20)=""
- .I $G(ABMI)=37,($G(ABMEIC)="F4"),($P($G(ABMRV(ABMI,ABMJ,ABMK)),U,3)'=90),($P($G(ABMRV(ABMI,ABMJ,ABMK)),U,4)'=90)&($P($G(ABMRV(ABMI,ABMJ,ABMK)),U,12)'=90) S ABMR("REF",20)=""
- I $G(ABMR("REF",20))="",ABMIEN=0,($G(ABMFILE)=200),$D(ABMP("PRV","F")) S ABMR("REF",20)="1G"
- I +$G(Z)'=0,$D(ABMP("PRV","S",Z)) S ABMR("REF",20)="1D" ;supervising
- Q
- 30 ;REF02 - Reference Secondary Identification
- ;I ABMEIC="EI" S ABMR("REF",30)=$P($G(^AUTTLOC(DUZ(2),0)),U,18) ;abm*2.6*9
- ;start old code abm*2.6*10 HEAT72888
- ;note - moved this change to ABMUTLF where it should be
- ;I ABMEIC="EI" D ;abm*2.6*9
- ;.I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="" S ABMR("REF",30)=$P($G(^AUTTLOC($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12),0)),U,18) ;abm*2.6*9 ;abm*2.6*10 HEAT72888
- ;.I $G(ABMR("REF",30))="" S ABMR("REF",30)=$P($G(^AUTTLOC(DUZ(2),0)),U,18) ;abm*2.6*9
- ;end old code HEAT72888
- I ABMEIC="G4" S ABMR("REF",30)=$P(ABMB5,"^",8)
- I ABMEIC="9F" S ABMR("REF",30)=$P(ABMB5,"^",11)
- I ABMEIC="G1" S ABMR("REF",30)=$P(ABMB5,"^",12)
- ;I ABMEIC="Y4" S ABMR("REF",30)=$P(ABMB7,U,13) ;abm*2.6*21 IHS/SD/SDR HEAT119570
- I ABMEIC="Y4" D ;abm*2.6*21 IHS/SD/SDR HEAT119570
- .S ABMR("REF",30)=$P(ABMB7,U,13) ;abm*2.6*21 IHS/SD/SDR HEAT119570
- .S:ABMR("REF",30)="" ABMR("REF",30)=$P(ABMB4,U,8) ;abm*2.6*21 IHS/SD/SDR HEAT119570
- ;I ABMEIC="XZ" S ABMR("REF",30)=$P(ABMRV(ABMI,ABMJ,ABMK),U,2) ;abm*2.6*9 HEAT63888
- ;I ABMEIC="XZ" S ABMR("REF",30)=$P(ABMRV(ABMI,ABMJ,ABMK),U,13) ;abm*2.6*9 HEAT63888 ;abm*2.6*10 HEAT78446
- I ABMEIC="XZ" S ABMR("REF",30)=$P(ABMRV(ABMI,ABMJ,ABMK),U,28) ;abm*2.6*10 HEAT78446
- I ABMEIC="SY"!(ABMEIC="1W") S ABMR("REF",30)=$P(ABMB7,U,26)
- I ABMEIC="BT" S ABMR("REF",30)=$P(ABMRV(ABMI,ABMJ,ABMK),U,37) ;immun. batch#
- I ABMEIC="6R" S ABMR("REF",30)=$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,38) ;line item control number
- ;mammography cert#
- I ABMEIC="EW" S ABMR("REF",30)=$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)
- I ABMEIC="F4" D
- .S ABMR("REF",30)=""
- .I ABMCLIA="SV" D ;service lines
- ..; if outside lab (determined by use of 90 modifier)
- ..; ABMOUTLB will be used later to determine whether other segments should be written
- ..I $P(ABMRV(ABMI,ABMJ,ABMK),U,3)=90!($P(ABMRV(ABMI,ABMJ,ABMK),U,4)=90)!($P(ABMRV(ABMI,ABMJ,ABMK),U,12)=90) D
- ...I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14)'="" S ABMR("REF",30)=$P(^ABMRLABS($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14),0),"^",2) Q
- ...I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23)'="" S ABMR("REF",30)=$P(^ABMRLABS($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23),0),"^",2)
- ..; if in-house lab (lack of 90 modifier)
- I ABMEIC="X4" D
- .S ABMR("REF",30)=""
- .I ABMCLIA="CLM" S ABMR("REF",30)=$P(ABMB9,U,22) Q ;in-house CLIA from claim header
- .I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'="",($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=($P($G(ABMB9),U,22))) S ABMR("REF",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)
- .E S ABMR("REF",30)=$P($G(ABMB9),U,22)
- I ABMEIC="EA" D
- .S ABMR("REF",30)=$$HRN^ABMUTL8(ABMP("PDFN"))
- I ABMEIC="1C" D
- .I ABMFILE=9999999.06 D
- ..S ABMR("REF",30)=$$MCR^ABMUTLF(ABMIEN)
- .I ABMFILE=200 D
- ..S ABMR("REF",30)=$$MCR^ABMEEPRV(ABMIEN)
- ..Q:$$RCID^ABMUTLP(ABMP("INS"))'="C00900"
- ..;Q:$$RCID^ABMUTLP(ABMP("INS"))'="04402" ;abm*2.6*10 HEAT74059
- ..Q:("^04312^04212^04112^04412^04402^")[("^"_$$RCID^ABMUTLP(ABMP("INS"))_"^") ;abm*2.6*10 HEAT74059
- ..S ABMR("REF",30)=$$NPI^ABMEEPRV(ABMIEN,ABMP("LDFN"),ABMP("INS"))
- I ABMEIC="1D" D
- .I ABMFILE=9999999.06 D
- ..S ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
- .I ABMFILE=200 D
- ..S ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$G(ABMPAYER))
- I ABMEIC="0B" D
- .;S ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN) ;abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/2012
- .;start new code abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/2012
- .I ABMFILE=9999999.06 D
- ..S ABMR("REF",30)=$P($G(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
- .E S ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN)
- .;end new code HEAT46645 IHS/SD/AML 6/1/2012
- I ABMEIC="1G" D
- .S ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
- .S:ABMR("REF",30)="" ABMR("REF",30)=$$UPIN^ABMEEPRV(ABMIEN)
- I "^BQ^G2^1A^1B^B3^1H^1J^EI^FH^G5^LU^SY^U3^X5^"[("^"_ABMEIC_"^") D
- .I ABMFILE=9999999.06 D
- ..I ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU") D
- ...S ABMR("REF",30)=$P($G(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
- ..E S ABMR("REF",30)=$$PI^ABMUTLF(ABMIEN)
- .I ABMFILE=200 D
- ..I ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU") D
- ...S ABMR("REF",30)=$P($G(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
- ..I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NORTH DAKOTA MEDICAID") D ;abm*2.6*11 IHS/SD/AML HEAT78969
- ...S ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$G(ABMPAYER)) ;abm*2.6*11 IHS/SD/AML HEAT78969
- ..E S ABMR("REF",30)=$$PI^ABMUTLF(ABMP("LDFN"))
- .I ABMFILE=0,ABMEIC="LU" S ABMR("REF",30)=$$GET1^DIQ(5,$P(ABMB8,U,16),1,"E") ;abm*2.6*8 5010
- I ABMEIC="F8" D
- .S ABMR("REF",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)
- I +ABMIEN=0,$D(ABMP("PRV","F")),($G(Z)'="") S ABMR("REF",30)=$P($G(ABMP("PRV","F",Z)),"^")
- ;I +$G(Z)=0,($G(ABMSIEN)'=""),(ABMR("REF",30)="") S ABMR("REF",30)=$P($G(ABMP("PRV","S",Z)),U) ;abm*2.6*8
- Q:($G(ABMR("REF",30))'="") ;abm*2.6*8
- I +$G(Z)=0,($G(ABMIEN)'=""),(ABMR("REF",30)="") S ABMR("REF",30)=$P($G(ABMP("PRV","S",Z)),U) ;abm*2.6*8
- Q
- 40 ;REF03 - Description-not used
- S ABMR("REF",40)=""
- Q
- 50 ;REF04 - Reference Identifier-not used
- S ABMR("REF",50)=""
- Q
- ABME5REF ; IHS/ASDST/DMJ - 837 REF Segment
- +1 ;;2.6;IHS Third Party Billing;**6,8,9,10,11,21**;NOV 12, 2009;Build 379
- +2 ;other payer provider info
- +3 ;IHS/SD/SDR - 2.6*21 - HEAT119570 - Made change so either Property/Casualty Claim number or Case number will print in file
- +4 ;
- EP(X,Y,Z) ;EP
- +1 ;x=entity identifier code from nm1
- +2 ;y=file number
- +3 ;z=internal entry number
- +4 KILL ABMREC("REF"),ABMR("REF")
- +5 SET ABMEIC=X
- +6 SET ABMFILE=+$GET(Y)
- +7 SET ABMIEN=+$GET(Z)
- +8 ;S ABMSIEN=$G(Z) ;abm*2.6*8
- +9 SET ABME("RTYPE")="REF"
- +10 DO LOOP
- +11 KILL ABME,ABM
- +12 QUIT
- LOOP ;LOOP HERE
- +1 FOR I=10:10:50
- 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("REF"))'=""
- SET ABMREC("REF")=ABMREC("REF")_"*"
- +5 SET ABMREC("REF")=$GET(ABMREC("REF"))_ABMR("REF",I)
- End DoDot:1
- +6 IF '$DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),ABME("RTYPE"),I))
- DO 837^ABMUTL8
- +7 QUIT
- 10 ;segment
- +1 SET ABMR("REF",10)="REF"
- +2 QUIT
- 20 ;REF01 - Reference Identification Qualifier
- +1 SET ABMR("REF",20)=ABMEIC
- +2 IF $GET(ABMCLIA)="SV"
- Begin DoDot:1
- +3 IF $GET(ABMI)=37
- IF (ABMEIC="X4")
- IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'="")
- IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)=($PIECE($GET(ABMB9),U,2)))
- SET ABMR("REF",20)=""
- +4 IF $GET(ABMI)=37
- IF ($GET(ABMEIC)="F4")
- IF ($PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,3)'=90)
- IF ($PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,4)'=90)&($PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,12)'=90)
- SET ABMR("REF",20)=""
- End DoDot:1
- +5 IF $GET(ABMR("REF",20))=""
- IF ABMIEN=0
- IF ($GET(ABMFILE)=200)
- IF $DATA(ABMP("PRV","F"))
- SET ABMR("REF",20)="1G"
- +6 ;supervising
- IF +$GET(Z)'=0
- IF $DATA(ABMP("PRV","S",Z))
- SET ABMR("REF",20)="1D"
- +7 QUIT
- 30 ;REF02 - Reference Secondary Identification
- +1 ;I ABMEIC="EI" S ABMR("REF",30)=$P($G(^AUTTLOC(DUZ(2),0)),U,18) ;abm*2.6*9
- +2 ;start old code abm*2.6*10 HEAT72888
- +3 ;note - moved this change to ABMUTLF where it should be
- +4 ;I ABMEIC="EI" D ;abm*2.6*9
- +5 ;.I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="" S ABMR("REF",30)=$P($G(^AUTTLOC($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12),0)),U,18) ;abm*2.6*9 ;abm*2.6*10 HEAT72888
- +6 ;.I $G(ABMR("REF",30))="" S ABMR("REF",30)=$P($G(^AUTTLOC(DUZ(2),0)),U,18) ;abm*2.6*9
- +7 ;end old code HEAT72888
- +8 IF ABMEIC="G4"
- SET ABMR("REF",30)=$PIECE(ABMB5,"^",8)
- +9 IF ABMEIC="9F"
- SET ABMR("REF",30)=$PIECE(ABMB5,"^",11)
- +10 IF ABMEIC="G1"
- SET ABMR("REF",30)=$PIECE(ABMB5,"^",12)
- +11 ;I ABMEIC="Y4" S ABMR("REF",30)=$P(ABMB7,U,13) ;abm*2.6*21 IHS/SD/SDR HEAT119570
- +12 ;abm*2.6*21 IHS/SD/SDR HEAT119570
- IF ABMEIC="Y4"
- Begin DoDot:1
- +13 ;abm*2.6*21 IHS/SD/SDR HEAT119570
- SET ABMR("REF",30)=$PIECE(ABMB7,U,13)
- +14 ;abm*2.6*21 IHS/SD/SDR HEAT119570
- IF ABMR("REF",30)=""
- SET ABMR("REF",30)=$PIECE(ABMB4,U,8)
- End DoDot:1
- +15 ;I ABMEIC="XZ" S ABMR("REF",30)=$P(ABMRV(ABMI,ABMJ,ABMK),U,2) ;abm*2.6*9 HEAT63888
- +16 ;I ABMEIC="XZ" S ABMR("REF",30)=$P(ABMRV(ABMI,ABMJ,ABMK),U,13) ;abm*2.6*9 HEAT63888 ;abm*2.6*10 HEAT78446
- +17 ;abm*2.6*10 HEAT78446
- IF ABMEIC="XZ"
- SET ABMR("REF",30)=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,28)
- +18 IF ABMEIC="SY"!(ABMEIC="1W")
- SET ABMR("REF",30)=$PIECE(ABMB7,U,26)
- +19 ;immun. batch#
- IF ABMEIC="BT"
- SET ABMR("REF",30)=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,37)
- +20 ;line item control number
- IF ABMEIC="6R"
- SET ABMR("REF",30)=$PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,38)
- +21 ;mammography cert#
- +22 IF ABMEIC="EW"
- SET ABMR("REF",30)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)
- +23 IF ABMEIC="F4"
- Begin DoDot:1
- +24 SET ABMR("REF",30)=""
- +25 ;service lines
- IF ABMCLIA="SV"
- Begin DoDot:2
- +26 ; if outside lab (determined by use of 90 modifier)
- +27 ; ABMOUTLB will be used later to determine whether other segments should be written
- +28 IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,3)=90!($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,4)=90)!($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,12)=90)
- Begin DoDot:3
- +29 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14)'=""
- SET ABMR("REF",30)=$PIECE(^ABMRLABS($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0),"^",14),0),"^",2)
- QUIT
- +30 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23)'=""
- SET ABMR("REF",30)=$PIECE(^ABMRLABS($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",23),0),"^",2)
- End DoDot:3
- +31 ; if in-house lab (lack of 90 modifier)
- End DoDot:2
- End DoDot:1
- +32 IF ABMEIC="X4"
- Begin DoDot:1
- +33 SET ABMR("REF",30)=""
- +34 ;in-house CLIA from claim header
- IF ABMCLIA="CLM"
- SET ABMR("REF",30)=$PIECE(ABMB9,U,22)
- QUIT
- +35 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=""
- IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)'=($PIECE($GET(ABMB9),U,22)))
- SET ABMR("REF",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMJ,0)),U,13)
- +36 IF '$TEST
- SET ABMR("REF",30)=$PIECE($GET(ABMB9),U,22)
- End DoDot:1
- +37 IF ABMEIC="EA"
- Begin DoDot:1
- +38 SET ABMR("REF",30)=$$HRN^ABMUTL8(ABMP("PDFN"))
- End DoDot:1
- +39 IF ABMEIC="1C"
- Begin DoDot:1
- +40 IF ABMFILE=9999999.06
- Begin DoDot:2
- +41 SET ABMR("REF",30)=$$MCR^ABMUTLF(ABMIEN)
- End DoDot:2
- +42 IF ABMFILE=200
- Begin DoDot:2
- +43 SET ABMR("REF",30)=$$MCR^ABMEEPRV(ABMIEN)
- +44 IF $$RCID^ABMUTLP(ABMP("INS"))'="C00900"
- QUIT
- +45 ;Q:$$RCID^ABMUTLP(ABMP("INS"))'="04402" ;abm*2.6*10 HEAT74059
- +46 ;abm*2.6*10 HEAT74059
- IF ("^04312^04212^04112^04412^04402^")[("^"_$$RCID^ABMUTLP(ABMP("INS"))_"^")
- QUIT
- +47 SET ABMR("REF",30)=$$NPI^ABMEEPRV(ABMIEN,ABMP("LDFN"),ABMP("INS"))
- End DoDot:2
- End DoDot:1
- +48 IF ABMEIC="1D"
- Begin DoDot:1
- +49 IF ABMFILE=9999999.06
- Begin DoDot:2
- +50 SET ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
- End DoDot:2
- +51 IF ABMFILE=200
- Begin DoDot:2
- +52 SET ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$GET(ABMPAYER))
- End DoDot:2
- End DoDot:1
- +53 IF ABMEIC="0B"
- Begin DoDot:1
- +54 ;S ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN) ;abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/2012
- +55 ;start new code abm*2.6*10 HEAT46645 IHS/SD/AML 6/1/2012
- +56 IF ABMFILE=9999999.06
- Begin DoDot:2
- +57 SET ABMR("REF",30)=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
- End DoDot:2
- +58 IF '$TEST
- SET ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN)
- +59 ;end new code HEAT46645 IHS/SD/AML 6/1/2012
- End DoDot:1
- +60 IF ABMEIC="1G"
- Begin DoDot:1
- +61 SET ABMR("REF",30)=$$MCD^ABMUTLF(ABMIEN)
- +62 IF ABMR("REF",30)=""
- SET ABMR("REF",30)=$$UPIN^ABMEEPRV(ABMIEN)
- End DoDot:1
- +63 IF "^BQ^G2^1A^1B^B3^1H^1J^EI^FH^G5^LU^SY^U3^X5^"[("^"_ABMEIC_"^")
- Begin DoDot:1
- +64 IF ABMFILE=9999999.06
- Begin DoDot:2
- +65 IF ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU")
- Begin DoDot:3
- +66 SET ABMR("REF",30)=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
- End DoDot:3
- +67 IF '$TEST
- SET ABMR("REF",30)=$$PI^ABMUTLF(ABMIEN)
- End DoDot:2
- +68 IF ABMFILE=200
- Begin DoDot:2
- +69 IF ABMRCID="FHC&AFFILIATES"&(ABMEIC="LU")
- Begin DoDot:3
- +70 SET ABMR("REF",30)=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMIEN,0)),U,2)
- End DoDot:3
- +71 ;abm*2.6*11 IHS/SD/AML HEAT78969
- IF ($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NORTH DAKOTA MEDICAID")
- Begin DoDot:3
- +72 ;abm*2.6*11 IHS/SD/AML HEAT78969
- SET ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$GET(ABMPAYER))
- End DoDot:3
- +73 IF '$TEST
- SET ABMR("REF",30)=$$PI^ABMUTLF(ABMP("LDFN"))
- End DoDot:2
- +74 ;abm*2.6*8 5010
- IF ABMFILE=0
- IF ABMEIC="LU"
- SET ABMR("REF",30)=$$GET1^DIQ(5,$PIECE(ABMB8,U,16),1,"E")
- End DoDot:1
- +75 IF ABMEIC="F8"
- Begin DoDot:1
- +76 SET ABMR("REF",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)
- End DoDot:1
- +77 IF +ABMIEN=0
- IF $DATA(ABMP("PRV","F"))
- IF ($GET(Z)'="")
- SET ABMR("REF",30)=$PIECE($GET(ABMP("PRV","F",Z)),"^")
- +78 ;I +$G(Z)=0,($G(ABMSIEN)'=""),(ABMR("REF",30)="") S ABMR("REF",30)=$P($G(ABMP("PRV","S",Z)),U) ;abm*2.6*8
- +79 ;abm*2.6*8
- IF ($GET(ABMR("REF",30))'="")
- QUIT
- +80 ;abm*2.6*8
- IF +$GET(Z)=0
- IF ($GET(ABMIEN)'="")
- IF (ABMR("REF",30)="")
- SET ABMR("REF",30)=$PIECE($GET(ABMP("PRV","S",Z)),U)
- +81 QUIT
- 40 ;REF03 - Description-not used
- +1 SET ABMR("REF",40)=""
- +2 QUIT
- 50 ;REF04 - Reference Identifier-not used
- +1 SET ABMR("REF",50)=""
- +2 QUIT
