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
