- 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
