ABME5L16 ; IHS/ASDST/DMJ - Header
;;2.6;IHS Third Party Billing System;**6,9,10,11**;NOV 12, 2009;Build 133
;Header Segments
;
START ;START HERE
S ABMLOOP=2320
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,"^",11)=ABMP("INS")),$P(ABMLINE,"^",3)="I" Q
.D EP^ABME5SBR(ABMI)
.D WR^ABMUTL8("SBR")
.F ABML="OA","PR","CO" D
..Q:'$D(ABMP(+ABMLINE,ABML)) ;quit if no data for insurer in ABMP adj array
..D EP^ABME5CAS
..D WR^ABMUTL8("CAS")
.;start old code abm*2.6*9 NOHEAT
.;printing AMT twice
.;I $G(ABMP("PAYED",+ABMLINE)) D
.;.D EP^ABME5AMT("D")
.;.D WR^ABMUTL8("AMT")
.;end old code
.I ($G(ABMP("PAYED",+ABMLINE))!($P($G(^ABMNINS(ABMP("LDFN"),+ABMLINE,0)),U,11)="Y")) D
..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")
.;
.S ABMLOOP="2330A"
.I $G(ABMSBR(ABMI)) D
..S ABMSFILE=$P(ABMSBR(ABMI),"-",1)
..S ABMSIEN=$P(ABMSBR(ABMI),"-",2)
.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")
.;
.S ABMLOOP="2330B"
.D EP^ABME5NM1("PR",+ABMLINE)
.D WR^ABMUTL8("NM1")
.D EP^ABME5N3(9999999.18,+ABMLINE)
.D WR^ABMUTL8("N3")
.D EP^ABME5N4(9999999.18,+ABMLINE)
.D WR^ABMUTL8("N4")
.I $G(ABMP("PAYED",+ABMLINE))'="" D
..;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*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*10 COB billing
..D EP^ABME5DTP(573,"D8",ABMPDT)
..D WR^ABMUTL8("DTP")
..K ABMPDT
.;D OTHR ;abm*2.6*9 HEAT58542
Q
OTHR ;other payer info
;loops 2330C through 2330G
N J
F J=1:1:4 D
.S ABMPTYP=$E("FRPS",J)
.Q:($G(ABMP("CLIN"))="A3")&(J="R")
.S ABMPROV=$O(ABMP("PRV",ABMPTYP,0))
.I ABMPROV D
..S ABMPNBR=$$NPI^ABMEEPRV(ABMPROV,ABMP("LDFN"),+ABMLINE)
..Q:ABMPNBR=""
..D EP^ABME5NM2($P("DN^82^QB^DQ","^",J))
..D WR^ABMUTL8("NM1")
..S ABMITYP=$P(ABMLINE,"^",2)
..S ABMP("RTYPE")=$S(ABMITYP="R":"1G",ABMITYP="D":"1D",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
..;I ABMP("EXP")=32,ABMP("RTYPE")="1G" S ABMP("RTYPE")="1C"
..;D EP^ABME5RF2(ABMP("RTYPE"))
..;I ABMNPIU="B"!(ABMNPIU="N") D
..;.D EP^ABME5REF("EI",9999999.06,DUZ(2))
..;D WR^ABMUTL8("REF")
Q
ABME5L16 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS Third Party Billing System;**6,9,10,11**;NOV 12, 2009;Build 133
+2 ;Header Segments
+3 ;
START ;START HERE
+1 SET ABMLOOP=2320
+2 DO PAYED^ABMUTLP
+3 NEW ABMI
+4 SET ABMI=0
+5 FOR
SET ABMI=$ORDER(ABMP("INS",ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+6 SET ABMLINE=ABMP("INS",ABMI)
+7 IF $PIECE(ABMLINE,U)=ABMP("INS")!($PIECE(ABMLINE,"^",11)=ABMP("INS"))
IF $PIECE(ABMLINE,"^",3)="I"
QUIT
+8 DO EP^ABME5SBR(ABMI)
+9 DO WR^ABMUTL8("SBR")
+10 FOR ABML="OA","PR","CO"
Begin DoDot:2
+11 ;quit if no data for insurer in ABMP adj array
IF '$DATA(ABMP(+ABMLINE,ABML))
QUIT
+12 DO EP^ABME5CAS
+13 DO WR^ABMUTL8("CAS")
End DoDot:2
+14 ;start old code abm*2.6*9 NOHEAT
+15 ;printing AMT twice
+16 ;I $G(ABMP("PAYED",+ABMLINE)) D
+17 ;.D EP^ABME5AMT("D")
+18 ;.D WR^ABMUTL8("AMT")
+19 ;end old code
+20 IF ($GET(ABMP("PAYED",+ABMLINE))!($PIECE($GET(^ABMNINS(ABMP("LDFN"),+ABMLINE,0)),U,11)="Y"))
Begin DoDot:2
+21 DO EP^ABME5AMT("D")
+22 DO WR^ABMUTL8("AMT")
End DoDot:2
+23 ;start new code abm*2.6*10 COB billing
+24 ;I ABMPSQ'=1,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="R" D
+25 SET ABMAMT=0
+26 DO EP^ABME5AMT("B6")
+27 DO WR^ABMUTL8("AMT")
+28 ;end new code abm*2.6*10 COB billing
+29 DO ^ABME5OI
+30 DO WR^ABMUTL8("OI")
+31 ;
+32 SET ABMLOOP="2330A"
+33 IF $GET(ABMSBR(ABMI))
Begin DoDot:2
+34 SET ABMSFILE=$PIECE(ABMSBR(ABMI),"-",1)
+35 SET ABMSIEN=$PIECE(ABMSBR(ABMI),"-",2)
End DoDot:2
+36 DO EP^ABME5NM1("IL")
+37 DO WR^ABMUTL8("NM1")
+38 DO EP^ABME5N3(ABMSFILE,ABMSIEN)
+39 DO WR^ABMUTL8("N3")
+40 DO EP^ABME5N4(ABMSFILE,ABMSIEN)
+41 DO WR^ABMUTL8("N4")
+42 ;
+43 SET ABMLOOP="2330B"
+44 DO EP^ABME5NM1("PR",+ABMLINE)
+45 DO WR^ABMUTL8("NM1")
+46 DO EP^ABME5N3(9999999.18,+ABMLINE)
+47 DO WR^ABMUTL8("N3")
+48 DO EP^ABME5N4(9999999.18,+ABMLINE)
+49 DO WR^ABMUTL8("N4")
+50 IF $GET(ABMP("PAYED",+ABMLINE))'=""
Begin DoDot:2
+51 ;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*10 COB billing
+52 ;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)
+53 DO EP^ABME5DTP(573,"D8",ABMPDT)
+54 DO WR^ABMUTL8("DTP")
+55 KILL ABMPDT
End DoDot:2
+56 ;D OTHR ;abm*2.6*9 HEAT58542
End DoDot:1
+57 QUIT
OTHR ;other payer info
+1 ;loops 2330C through 2330G
+2 NEW J
+3 FOR J=1:1:4
Begin DoDot:1
+4 SET ABMPTYP=$EXTRACT("FRPS",J)
+5 IF ($GET(ABMP("CLIN"))="A3")&(J="R")
QUIT
+6 SET ABMPROV=$ORDER(ABMP("PRV",ABMPTYP,0))
+7 IF ABMPROV
Begin DoDot:2
+8 SET ABMPNBR=$$NPI^ABMEEPRV(ABMPROV,ABMP("LDFN"),+ABMLINE)
+9 IF ABMPNBR=""
QUIT
+10 DO EP^ABME5NM2($PIECE("DN^82^QB^DQ","^",J))
+11 DO WR^ABMUTL8("NM1")
+12 SET ABMITYP=$PIECE(ABMLINE,"^",2)
+13 SET ABMP("RTYPE")=$SELECT(ABMITYP="R":"1G",ABMITYP="D":"1D",$PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$PIECE($GET(^ABMREFID($PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
+14 ;I ABMP("EXP")=32,ABMP("RTYPE")="1G" S ABMP("RTYPE")="1C"
+15 ;D EP^ABME5RF2(ABMP("RTYPE"))
+16 ;I ABMNPIU="B"!(ABMNPIU="N") D
+17 ;.D EP^ABME5REF("EI",9999999.06,DUZ(2))
+18 ;D WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+19 QUIT
