- 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
