ABME5L15 ; IHS/ASDST/DMJ - Header
;;2.6;IHS Third Party Billing System;**6,8,11**;NOV 12, 2009;Build 133
;Header Segments
;
EP ;START HERE
S ABMLXCNT=0
K ABM
D ^ABMEHGRV
S ABMI=0
F S ABMI=$O(ABMRV(ABMI)) Q:'+ABMI D
.S ABMJ=-1
.F S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:'+ABMJ D
..S ABMK=0
..F S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:'+ABMK D
...D LOOP
K ABMI,ABMJ,ABMK
Q
;
LOOP ;
Q:$P(ABMRV(ABMI,ABMJ,ABMK),U,2)=""
S ABMLXCNT=ABMLXCNT+1
S ABMLOOP=2400
D EP^ABME5LX
D WR^ABMUTL8("LX")
D EP^ABME5SV3
D WR^ABMUTL8("SV3")
I $P(ABMRV(ABMI,ABMJ,ABMK),U,23)'=""!($P(ABMRV(ABMI,ABMJ,ABMK),U,24)'="") D
.D ^ABME5TOO
.D WR^ABMUTL8("TOO")
I $P(ABMRV(ABMI,ABMJ,ABMK),U,10)'=$P(ABMB7,U) D
.Q:'$P(ABMRV(ABMI,ABMJ,ABMK),U,10)
.D EP^ABME5DTP(472,"D8",$P(ABMRV(ABMI,ABMJ,ABMK),U,10))
.D WR^ABMUTL8("DTP")
;D EP^ABME5REF("6R","") ;line item control number ;abm*2.6*11 HEAT92070
;D WR^ABMUTL8("REF") ;abm*2.6*11 HEAT92070
;start new code abm*2.6*11 HEAT92070
I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,38)'="" D
.D EP^ABME5REF("6R","")
.D WR^ABMUTL8("REF") ;line item control number
;end new code HEAT92070
;
; Loop 2420A - Rendering Physician
I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,13) D
.S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,13)
.Q:ABM("PRV")=$O(ABMP("PRV","R",0))
.Q:$D(ABMP("PRV","A",ABM("PRV")))!($D(ABMP("PRV","R",ABM("PRV")))) ;abm*2.6*8
.D EP^ABME5NM1(82,ABM("PRV"))
.D WR^ABMUTL8("NM1")
.;D EP^ABME5PRV("PE",ABM("PRV"))
.;D WR^ABMUTL8("PRV")
.;I ABMNPIU="N" D
.;.Q:((ABMRCID="99999")!(ABMRCID="AHCCCS866004791")) ;AZ Medicaid
.;.D EP^ABME5REF("EI",9999999.06,DUZ(2))
.;.D WR^ABMUTL8("REF")
.I ABMNPIU'="N" D
..D EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))
..D WR^ABMUTL8("REF")
;
; Loop 2420C - Supervising Provider
I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,21) D
.S ABM("PRV")=$P(ABMRV(ABMI,ABMJ,ABMK),U,21)
.Q:ABM("PRV")=$O(ABMP("PRV","S",0))
.D EP^ABME5NM1("DQ",ABM("PRV"))
.D WR^ABMUTL8("NM1")
.I ABMNPIU'="N" D
..D EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))
..D WR^ABMUTL8("REF")
Q
ABME5L15 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS Third Party Billing System;**6,8,11**;NOV 12, 2009;Build 133
+2 ;Header Segments
+3 ;
EP ;START HERE
+1 SET ABMLXCNT=0
+2 KILL ABM
+3 DO ^ABMEHGRV
+4 SET ABMI=0
+5 FOR
SET ABMI=$ORDER(ABMRV(ABMI))
IF '+ABMI
QUIT
Begin DoDot:1
+6 SET ABMJ=-1
+7 FOR
SET ABMJ=$ORDER(ABMRV(ABMI,ABMJ))
IF '+ABMJ
QUIT
Begin DoDot:2
+8 SET ABMK=0
+9 FOR
SET ABMK=$ORDER(ABMRV(ABMI,ABMJ,ABMK))
IF '+ABMK
QUIT
Begin DoDot:3
+10 DO LOOP
End DoDot:3
End DoDot:2
End DoDot:1
+11 KILL ABMI,ABMJ,ABMK
+12 QUIT
+13 ;
LOOP ;
+1 IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,2)=""
QUIT
+2 SET ABMLXCNT=ABMLXCNT+1
+3 SET ABMLOOP=2400
+4 DO EP^ABME5LX
+5 DO WR^ABMUTL8("LX")
+6 DO EP^ABME5SV3
+7 DO WR^ABMUTL8("SV3")
+8 IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,23)'=""!($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,24)'="")
Begin DoDot:1
+9 DO ^ABME5TOO
+10 DO WR^ABMUTL8("TOO")
End DoDot:1
+11 IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,10)'=$PIECE(ABMB7,U)
Begin DoDot:1
+12 IF '$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,10)
QUIT
+13 DO EP^ABME5DTP(472,"D8",$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,10))
+14 DO WR^ABMUTL8("DTP")
End DoDot:1
+15 ;D EP^ABME5REF("6R","") ;line item control number ;abm*2.6*11 HEAT92070
+16 ;D WR^ABMUTL8("REF") ;abm*2.6*11 HEAT92070
+17 ;start new code abm*2.6*11 HEAT92070
+18 IF $PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,38)'=""
Begin DoDot:1
+19 DO EP^ABME5REF("6R","")
+20 ;line item control number
DO WR^ABMUTL8("REF")
End DoDot:1
+21 ;end new code HEAT92070
+22 ;
+23 ; Loop 2420A - Rendering Physician
+24 IF $PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,13)
Begin DoDot:1
+25 SET ABM("PRV")=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,13)
+26 IF ABM("PRV")=$ORDER(ABMP("PRV","R",0))
QUIT
+27 ;abm*2.6*8
IF $DATA(ABMP("PRV","A",ABM("PRV")))!($DATA(ABMP("PRV","R",ABM("PRV"))))
QUIT
+28 DO EP^ABME5NM1(82,ABM("PRV"))
+29 DO WR^ABMUTL8("NM1")
+30 ;D EP^ABME5PRV("PE",ABM("PRV"))
+31 ;D WR^ABMUTL8("PRV")
+32 ;I ABMNPIU="N" D
+33 ;.Q:((ABMRCID="99999")!(ABMRCID="AHCCCS866004791")) ;AZ Medicaid
+34 ;.D EP^ABME5REF("EI",9999999.06,DUZ(2))
+35 ;.D WR^ABMUTL8("REF")
+36 IF ABMNPIU'="N"
Begin DoDot:2
+37 DO EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))
+38 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+39 ;
+40 ; Loop 2420C - Supervising Provider
+41 IF $PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,21)
Begin DoDot:1
+42 SET ABM("PRV")=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,21)
+43 IF ABM("PRV")=$ORDER(ABMP("PRV","S",0))
QUIT
+44 DO EP^ABME5NM1("DQ",ABM("PRV"))
+45 DO WR^ABMUTL8("NM1")
+46 IF ABMNPIU'="N"
Begin DoDot:2
+47 DO EP^ABME5REF(ABMP("RTYPE"),200,ABM("PRV"))
+48 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+49 QUIT
