ABME5L9 ; IHS/ASDST/DMJ - Header
;;2.6;IHS Third Party Billing System;**6,8,9,10,21**;NOV 12, 2009;Build 379
;Header Segments
;IHS/SD/SDR - 2.6*21 - HEAT70826 - Modified to remove 2310B loop based on SGTM entry
EP ;START HERE
N ABM
K ABMP("PRV") ;reset provider array
D GETPRV^ABMEEPRV ; Build Claim Level Provider array
S ABMPAYER=ABMP("INS")
;
; Loop 2310A - Referring Physician Name
S ABMLOOP="2310A"
I $D(ABMP("PRV","F")) D
.S ABM("PRV")=$O(ABMP("PRV","F",0))
.D EP^ABME5NM1("DN")
.D WR^ABMUTL8("NM1")
.I $P($G(ABMB8),U,18)'="" D
..D EP^ABME5REF($S($P($G(ABMB8),U,18)'="":$P(ABMB8,U,18),1:ABMP("RTYPE")),200,ABM("PRV"))
..D WR^ABMUTL8("REF")
;
; Loop 2310B - Rendering Physician Name
S ABMLOOP="2310B"
I $D(ABMP("PRV","R"))!($D(ABMP("PRV","A"))) D
.Q:$G(ABMP("VTYP"))=831 ;don't write provider info for ASC
.Q:$G(ABMP("CLIN"))="A3"
.;start new abm*2.6*21 IHS/SD/SDR HEAT70826
.S ABMOFLG=0
.I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N"))>0 D
..S ABMO=0
..F S ABMO=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N",ABMO)) Q:'ABMO D
...I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=""!($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=ABMP("VTYP")) S ABMOFLG=1
.Q:ABMOFLG=1
.;end new abm*2.6*21 IHS/SD/SDR HEAT70826
.S ABM("PRV")=$S($D(ABMP("PRV","R")):$O(ABMP("PRV","R",0)),1:$O(ABMP("PRV","A",0)))
.D EP^ABME5NM1("82")
.D WR^ABMUTL8("NM1")
.D EP^ABME5PRV("PE",ABM("PRV"))
.D WR^ABMUTL8("PRV")
.Q:$P($G(^AUTNINS(ABMP("INS"),0)),U)["OKLAHOMA MEDICAID"
.;D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
.K ABMLOOP
;
; Loop 2310C - Service Facility Name
S ABMLOOP="2310C"
;start old code abm*2.6*9 HEAT57746
;S ABMTRUE=(ABMP("LDFN")'=DUZ(2))
;I 'ABMTRUE D
;.Q:$$POS^ABMERUTL<12
;.Q:$$POS^ABMERUTL=12
;.S ABMTRUE=1
;I ABMTRUE D
;end old code start new code HEAT57746
S ABMSLOC=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,17) ;abm*2.6*9 HEAT57746
I ((ABMSLOC="S")!((ABMSLOC="D")!(ABMSLOC="")&($P($G(^DIC(4,DUZ(2),0)),U)'=$P($G(^DIC(4,ABMP("LDFN"),0)),U)))) D ;abm*2.6*8 ;abm*2.6*9 HEAT57746
.;end new code HEAT57746
.D EP^ABME5NM1(77)
.D OVER^ABMUTLP(51)
.D WR^ABMUTL8("NM1")
.S ABMFILE=4,ABMIEN=ABMP("LDFN")
.D EP^ABME5N3(ABMFILE,ABMIEN)
.D OVER^ABMUTLP(52)
.D WR^ABMUTL8("N3")
.S ABMFILE=4,ABMIEN=ABMP("LDFN")
.D EP^ABME5N4(ABMFILE,ABMIEN)
.D OVER^ABMUTLP(53)
.D WR^ABMUTL8("N4")
.;start old code abm*2.6*10 NOHEAT
.;D EP^ABME8REF("LU",9999999.06,ABMP("LDFN"))
.;D WR^ABMUTL8("REF")
.;end old code abm*2.6*10 NO HEAT
;
; Loop 2310D - Supervising Physician Name
S ABMLOOP="2310D"
I $D(ABMP("PRV","S")) D
.S ABM("PRV")=$O(ABMP("PRV","S",0))
.D EP^ABME5NM1("DQ")
.D WR^ABMUTL8("NM1")
;.I ABMNPIU="N" D ;5010 837P
;..;D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
;..D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
;..D WR^ABMUTL8("REF") ;5010 837P
;.I ABMNPIU'="N" D ;5010 837P
;..;D EP^ABME5REF("1G",200,ABM("PRV")) ;5010 837P
;..D EP^ABME5REF("1G",200,ABM("PRV")) ;5010 837P
;..D WR^ABMUTL8("REF") ;5010 837P
;
; LOOP 2310E - Ambulance Pick-Up Location
S ABMLOOP="2310E"
;I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("PCN"),12)),U,2)'="") D ;abm*2.6* HEAT45242
I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("BDFN"),12)),U,2)'="") D ;abm*2.6* HEAT45242
.D EP^ABME5NM1("PW")
.D WR^ABMUTL8("NM1")
.D EP^ABME5N3("AMB","PU")
.D WR^ABMUTL8("N3")
.D EP^ABME5N4("AMB","PU")
.D WR^ABMUTL8("N4")
;
; LOOP 2310F - Ambulance Drop-Off Location
S ABMLOOP="2310F"
;I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("PCN"),12)),U,7)'="") D ;abm*2.6*8 HEAT45242
I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("BDFN"),12)),U,7)'="") D ;abm*2.6*8 HEAT45242
.D EP^ABME5NM1(45)
.D WR^ABMUTL8("NM1")
.D EP^ABME5N3("AMB","DO")
.D WR^ABMUTL8("N3")
.D EP^ABME5N4("AMB","DO")
.D WR^ABMUTL8("N4")
Q
ABME5L9 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS Third Party Billing System;**6,8,9,10,21**;NOV 12, 2009;Build 379
+2 ;Header Segments
+3 ;IHS/SD/SDR - 2.6*21 - HEAT70826 - Modified to remove 2310B loop based on SGTM entry
EP ;START HERE
+1 NEW ABM
+2 ;reset provider array
KILL ABMP("PRV")
+3 ; Build Claim Level Provider array
DO GETPRV^ABMEEPRV
+4 SET ABMPAYER=ABMP("INS")
+5 ;
+6 ; Loop 2310A - Referring Physician Name
+7 SET ABMLOOP="2310A"
+8 IF $DATA(ABMP("PRV","F"))
Begin DoDot:1
+9 SET ABM("PRV")=$ORDER(ABMP("PRV","F",0))
+10 DO EP^ABME5NM1("DN")
+11 DO WR^ABMUTL8("NM1")
+12 IF $PIECE($GET(ABMB8),U,18)'=""
Begin DoDot:2
+13 DO EP^ABME5REF($SELECT($PIECE($GET(ABMB8),U,18)'="":$PIECE(ABMB8,U,18),1:ABMP("RTYPE")),200,ABM("PRV"))
+14 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+15 ;
+16 ; Loop 2310B - Rendering Physician Name
+17 SET ABMLOOP="2310B"
+18 IF $DATA(ABMP("PRV","R"))!($DATA(ABMP("PRV","A")))
Begin DoDot:1
+19 ;don't write provider info for ASC
IF $GET(ABMP("VTYP"))=831
QUIT
+20 IF $GET(ABMP("CLIN"))="A3"
QUIT
+21 ;start new abm*2.6*21 IHS/SD/SDR HEAT70826
+22 SET ABMOFLG=0
+23 IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N"))>0
Begin DoDot:2
+24 SET ABMO=0
+25 FOR
SET ABMO=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,"ASEND",ABMP("EXP"),"2310B","00","0","N",ABMO))
IF 'ABMO
QUIT
Begin DoDot:3
+26 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=""!($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2.5,ABMO,0)),U,6)=ABMP("VTYP"))
SET ABMOFLG=1
End DoDot:3
End DoDot:2
+27 IF ABMOFLG=1
QUIT
+28 ;end new abm*2.6*21 IHS/SD/SDR HEAT70826
+29 SET ABM("PRV")=$SELECT($DATA(ABMP("PRV","R")):$ORDER(ABMP("PRV","R",0)),1:$ORDER(ABMP("PRV","A",0)))
+30 DO EP^ABME5NM1("82")
+31 DO WR^ABMUTL8("NM1")
+32 DO EP^ABME5PRV("PE",ABM("PRV"))
+33 DO WR^ABMUTL8("PRV")
+34 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["OKLAHOMA MEDICAID"
QUIT
+35 ;D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
+36 KILL ABMLOOP
End DoDot:1
+37 ;
+38 ; Loop 2310C - Service Facility Name
+39 SET ABMLOOP="2310C"
+40 ;start old code abm*2.6*9 HEAT57746
+41 ;S ABMTRUE=(ABMP("LDFN")'=DUZ(2))
+42 ;I 'ABMTRUE D
+43 ;.Q:$$POS^ABMERUTL<12
+44 ;.Q:$$POS^ABMERUTL=12
+45 ;.S ABMTRUE=1
+46 ;I ABMTRUE D
+47 ;end old code start new code HEAT57746
+48 ;abm*2.6*9 HEAT57746
SET ABMSLOC=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,17)
+49 ;abm*2.6*8 ;abm*2.6*9 HEAT57746
IF ((ABMSLOC="S")!((ABMSLOC="D")!(ABMSLOC="")&($PIECE($GET(^DIC(4,DUZ(2),0)),U)'=$PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U))))
Begin DoDot:1
+50 ;end new code HEAT57746
+51 DO EP^ABME5NM1(77)
+52 DO OVER^ABMUTLP(51)
+53 DO WR^ABMUTL8("NM1")
+54 SET ABMFILE=4
SET ABMIEN=ABMP("LDFN")
+55 DO EP^ABME5N3(ABMFILE,ABMIEN)
+56 DO OVER^ABMUTLP(52)
+57 DO WR^ABMUTL8("N3")
+58 SET ABMFILE=4
SET ABMIEN=ABMP("LDFN")
+59 DO EP^ABME5N4(ABMFILE,ABMIEN)
+60 DO OVER^ABMUTLP(53)
+61 DO WR^ABMUTL8("N4")
+62 ;start old code abm*2.6*10 NOHEAT
+63 ;D EP^ABME8REF("LU",9999999.06,ABMP("LDFN"))
+64 ;D WR^ABMUTL8("REF")
+65 ;end old code abm*2.6*10 NO HEAT
End DoDot:1
+66 ;
+67 ; Loop 2310D - Supervising Physician Name
+68 SET ABMLOOP="2310D"
+69 IF $DATA(ABMP("PRV","S"))
Begin DoDot:1
+70 SET ABM("PRV")=$ORDER(ABMP("PRV","S",0))
+71 DO EP^ABME5NM1("DQ")
+72 DO WR^ABMUTL8("NM1")
End DoDot:1
+73 ;.I ABMNPIU="N" D ;5010 837P
+74 ;..;D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
+75 ;..D EP^ABME5REF("EI",9999999.06,DUZ(2)) ;5010 837P
+76 ;..D WR^ABMUTL8("REF") ;5010 837P
+77 ;.I ABMNPIU'="N" D ;5010 837P
+78 ;..;D EP^ABME5REF("1G",200,ABM("PRV")) ;5010 837P
+79 ;..D EP^ABME5REF("1G",200,ABM("PRV")) ;5010 837P
+80 ;..D WR^ABMUTL8("REF") ;5010 837P
+81 ;
+82 ; LOOP 2310E - Ambulance Pick-Up Location
+83 SET ABMLOOP="2310E"
+84 ;I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("PCN"),12)),U,2)'="") D ;abm*2.6* HEAT45242
+85 ;abm*2.6* HEAT45242
IF $GET(ABMP("CLIN"))="A3"&($PIECE($GET(^ABMDBILL(DUZ(2),+ABMP("BDFN"),12)),U,2)'="")
Begin DoDot:1
+86 DO EP^ABME5NM1("PW")
+87 DO WR^ABMUTL8("NM1")
+88 DO EP^ABME5N3("AMB","PU")
+89 DO WR^ABMUTL8("N3")
+90 DO EP^ABME5N4("AMB","PU")
+91 DO WR^ABMUTL8("N4")
End DoDot:1
+92 ;
+93 ; LOOP 2310F - Ambulance Drop-Off Location
+94 SET ABMLOOP="2310F"
+95 ;I $G(ABMP("CLIN"))="A3"&($P($G(^ABMDBILL(DUZ(2),+ABMP("PCN"),12)),U,7)'="") D ;abm*2.6*8 HEAT45242
+96 ;abm*2.6*8 HEAT45242
IF $GET(ABMP("CLIN"))="A3"&($PIECE($GET(^ABMDBILL(DUZ(2),+ABMP("BDFN"),12)),U,7)'="")
Begin DoDot:1
+97 DO EP^ABME5NM1(45)
+98 DO WR^ABMUTL8("NM1")
+99 DO EP^ABME5N3("AMB","DO")
+100 DO WR^ABMUTL8("N3")
+101 DO EP^ABME5N4("AMB","DO")
+102 DO WR^ABMUTL8("N4")
End DoDot:1
+103 QUIT
