ABME5L8 ; IHS/ASDST/DMJ - Header
;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,11**;NOV 12, 2009;Build 133
;Header Segments
START ;START HERE
D PAYED^ABMUTLP
N ABMI
S ABMI=0
F S ABMI=$O(ABMP("INS",ABMI)) Q:'ABMI D
.S ABMLINE=ABMP("INS",ABMI)
.;I $P(ABMLINE,U)=ABMP("INS"),$P(ABMLINE,"^",3)="I" Q ;abm*2.6*10 HEAT58915
.I $S($P(ABMLINE,U,11):$P(ABMLINE,U,11),1:$P(ABMLINE,U))=ABMP("INS"),$P(ABMLINE,"^",3)="I" Q ;abm*2.6*10 HEAT58915
.; Loop 2320 - Other Subscriber Information
.S ABMLOOP=2320
.;abm*2.6*8 start new code
.I $G(ABMSBR(ABMI)) D
..S ABMSFILE=$P(ABMSBR(ABMI),"-",1)
..S ABMSIEN=$P(ABMSBR(ABMI),"-",2)
.;abm*2.6*8 end new code
.D EP^ABME5SBR(ABMI)
.D WR^ABMUTL8("SBR")
.F ABML="OA","PR" D
..Q:'$D(ABMP(+ABMLINE,ABML)) ;quit if no data for insurer in ABMP adj array
..D EP^ABME5CAS
..D WR^ABMUTL8("CAS")
.;I $G(ABMP("PAYED",+ABMLINE)) D ;abm*2.6*9 tribal self-insured
.I $G(ABMP("PAYED",+ABMLINE))!($P($G(^ABMNINS(ABMP("LDFN"),+ABMLINE,0)),U,11)="Y") D ;abm*2.6*9 tribal self-insured
..D EP^ABME5AMT("D")
..D WR^ABMUTL8("AMT")
.;start new code abm*2.6*10 COB billing
.;I ABMPSQ'=1,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="R" D
..S ABMAMT=0
..D EP^ABME5AMT("B6")
..D WR^ABMUTL8("AMT")
..;end new code abm*2.6*10 COB billing
.D ^ABME5OI
.D WR^ABMUTL8("OI")
.; Loop 2330A - Other Subscriber Name
.S ABMLOOP="2330A"
.D EP^ABME5NM1("IL")
.D WR^ABMUTL8("NM1")
.D EP^ABME5N3(ABMSFILE,ABMSIEN)
.D WR^ABMUTL8("N3")
.D EP^ABME5N4(ABMSFILE,ABMSIEN)
.D WR^ABMUTL8("N4")
.; Loop 2330B - Other Payer Name
.S ABMLOOP="2330B"
.D EP^ABME5NM1("PR",+ABMLINE)
.D WR^ABMUTL8("NM1")
.;I $G(ABMP("PAYED",+ABMLINE)) D ;abm*2.6*9 tribal self-insured
.I $G(ABMP("PAYED",+ABMLINE))'="" D ;abm*2.6*9 tribal self-insured
..;S ABMPDT=$G(ABMP("PDT",+ABMLINE)) ;abm*2.6*9 tribal self-insured
..;S ABMPDT=$S($P($G(ABMP("PAYED",+ABMLINE)),U,2)'="":$P(ABMP("PAYED",+ABMLINE),U,2),$G(ABMP("PDT",+ABMLINE))'="":ABMP("PDT",+ABMLINE),1:"") ;abm*2.6*9 tribal self-insured ;abm*2.6*10 COB billing
..S ABMPDT=$S($P($G(ABMP("PAYED",+ABMLINE)),U,2)'="":$P(ABMP("PAYED",+ABMLINE),U,2),$G(ABMP("PDT",+ABMLINE))'="":ABMP("PDT",+ABMLINE),1:DT) ;abm*2.6*9 tribal self-insured ;abm*2.6*10 COB billing
..D EP^ABME5DTP(573,"D8",ABMPDT)
..D WR^ABMUTL8("DTP")
..K ABMPDT
.I $G(ABMP("PNUM",ABMI))'="" D
..;D EP^ABME5NM2("QC",ABMI)
..;D WR^ABMUTL8("NM1")
.;D OTHR
Q
OTHR ;other payer info
; Loops 2330C - 2330I 0 Other Payer Info
N J
F J=1:1:4 D
.S ABMPTYP=$E("AOTR",J)
.S ABMPROV=$O(ABMP("PRV",ABMPTYP,0))
.I ABMPROV D
..S ABMPNBR=$$NPI^ABMEEPRV(ABMPROV,ABMP("LDFN"),+ABMLINE)
..Q:ABMPNBR=""
..D EP^ABME5NM2($P("71^72^ZZ^DN","^",J))
..D WR^ABMUTL8("NM1")
..S ABMITYP=$P(ABMLINE,"^",2)
..S ABMITYP=$S(ABMITYP="R":"1C",ABMITYP="D":"1D",1:"G2")
..I ABMITYP="G2",$$BCBS1^ABMERUTL(+ABMLINE) S ABMITYP="1A"
..D EP^ABME5RF2(ABMITYP)
..D WR^ABMUTL8("REF")
Q
ABME5L8 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,9,10,11**;NOV 12, 2009;Build 133
+2 ;Header Segments
START ;START HERE
+1 DO PAYED^ABMUTLP
+2 NEW ABMI
+3 SET ABMI=0
+4 FOR
SET ABMI=$ORDER(ABMP("INS",ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+5 SET ABMLINE=ABMP("INS",ABMI)
+6 ;I $P(ABMLINE,U)=ABMP("INS"),$P(ABMLINE,"^",3)="I" Q ;abm*2.6*10 HEAT58915
+7 ;abm*2.6*10 HEAT58915
IF $SELECT($PIECE(ABMLINE,U,11):$PIECE(ABMLINE,U,11),1:$PIECE(ABMLINE,U))=ABMP("INS")
IF $PIECE(ABMLINE,"^",3)="I"
QUIT
+8 ; Loop 2320 - Other Subscriber Information
+9 SET ABMLOOP=2320
+10 ;abm*2.6*8 start new code
+11 IF $GET(ABMSBR(ABMI))
Begin DoDot:2
+12 SET ABMSFILE=$PIECE(ABMSBR(ABMI),"-",1)
+13 SET ABMSIEN=$PIECE(ABMSBR(ABMI),"-",2)
End DoDot:2
+14 ;abm*2.6*8 end new code
+15 DO EP^ABME5SBR(ABMI)
+16 DO WR^ABMUTL8("SBR")
+17 FOR ABML="OA","PR"
Begin DoDot:2
+18 ;quit if no data for insurer in ABMP adj array
IF '$DATA(ABMP(+ABMLINE,ABML))
QUIT
+19 DO EP^ABME5CAS
+20 DO WR^ABMUTL8("CAS")
End DoDot:2
+21 ;I $G(ABMP("PAYED",+ABMLINE)) D ;abm*2.6*9 tribal self-insured
+22 ;abm*2.6*9 tribal self-insured
IF $GET(ABMP("PAYED",+ABMLINE))!($PIECE($GET(^ABMNINS(ABMP("LDFN"),+ABMLINE,0)),U,11)="Y")
Begin DoDot:2
+23 DO EP^ABME5AMT("D")
+24 DO WR^ABMUTL8("AMT")
End DoDot:2
+25 ;start new code abm*2.6*10 COB billing
+26 ;I ABMPSQ'=1,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="R" D
+27 SET ABMAMT=0
+28 DO EP^ABME5AMT("B6")
+29 DO WR^ABMUTL8("AMT")
+30 ;end new code abm*2.6*10 COB billing
+31 DO ^ABME5OI
+32 DO WR^ABMUTL8("OI")
+33 ; Loop 2330A - Other Subscriber Name
+34 SET ABMLOOP="2330A"
+35 DO EP^ABME5NM1("IL")
+36 DO WR^ABMUTL8("NM1")
+37 DO EP^ABME5N3(ABMSFILE,ABMSIEN)
+38 DO WR^ABMUTL8("N3")
+39 DO EP^ABME5N4(ABMSFILE,ABMSIEN)
+40 DO WR^ABMUTL8("N4")
+41 ; Loop 2330B - Other Payer Name
+42 SET ABMLOOP="2330B"
+43 DO EP^ABME5NM1("PR",+ABMLINE)
+44 DO WR^ABMUTL8("NM1")
+45 ;I $G(ABMP("PAYED",+ABMLINE)) D ;abm*2.6*9 tribal self-insured
+46 ;abm*2.6*9 tribal self-insured
IF $GET(ABMP("PAYED",+ABMLINE))'=""
Begin DoDot:2
+47 ;S ABMPDT=$G(ABMP("PDT",+ABMLINE)) ;abm*2.6*9 tribal self-insured
+48 ;S ABMPDT=$S($P($G(ABMP("PAYED",+ABMLINE)),U,2)'="":$P(ABMP("PAYED",+ABMLINE),U,2),$G(ABMP("PDT",+ABMLINE))'="":ABMP("PDT",+ABMLINE),1:"") ;abm*2.6*9 tribal self-insured ;abm*2.6*10 COB billing
+49 ;abm*2.6*9 tribal self-insured ;abm*2.6*10 COB billing
SET ABMPDT=$SELECT($PIECE($GET(ABMP("PAYED",+ABMLINE)),U,2)'="":$PIECE(ABMP("PAYED",+ABMLINE),U,2),$GET(ABMP("PDT",+ABMLINE))'="":ABMP("PDT",+ABMLINE),1:DT)
+50 DO EP^ABME5DTP(573,"D8",ABMPDT)
+51 DO WR^ABMUTL8("DTP")
+52 KILL ABMPDT
End DoDot:2
+53 IF $GET(ABMP("PNUM",ABMI))'=""
Begin DoDot:2
+54 ;D EP^ABME5NM2("QC",ABMI)
+55 ;D WR^ABMUTL8("NM1")
End DoDot:2
+56 ;D OTHR
End DoDot:1
+57 QUIT
OTHR ;other payer info
+1 ; Loops 2330C - 2330I 0 Other Payer Info
+2 NEW J
+3 FOR J=1:1:4
Begin DoDot:1
+4 SET ABMPTYP=$EXTRACT("AOTR",J)
+5 SET ABMPROV=$ORDER(ABMP("PRV",ABMPTYP,0))
+6 IF ABMPROV
Begin DoDot:2
+7 SET ABMPNBR=$$NPI^ABMEEPRV(ABMPROV,ABMP("LDFN"),+ABMLINE)
+8 IF ABMPNBR=""
QUIT
+9 DO EP^ABME5NM2($PIECE("71^72^ZZ^DN","^",J))
+10 DO WR^ABMUTL8("NM1")
+11 SET ABMITYP=$PIECE(ABMLINE,"^",2)
+12 SET ABMITYP=$SELECT(ABMITYP="R":"1C",ABMITYP="D":"1D",1:"G2")
+13 IF ABMITYP="G2"
IF $$BCBS1^ABMERUTL(+ABMLINE)
SET ABMITYP="1A"
+14 DO EP^ABME5RF2(ABMITYP)
+15 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+16 QUIT
