ABME8L10 ; IHS/ASDST/DMJ - Header
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Header Segments
;
; IHS/SD/EFG - V2.5 P8 - IM16385
; Modified to print dental services
; IHS/SD/SDR - v2.5 p8 - IM20395
; Split out lines bundled by rev code
; IHS/SD/SDR - v2.5 p11 - NPI
; IHS/SD/SDR - v2.5 p12 - IM25247
; Added missing REF segment for TIN if NPI ONLY
;
EP ;START HERE
S ABMLXCNT=0
K ABM
D FRATE^ABMDF11
D ^ABMERGRV
S ABMREV=""
F S ABMREV=$O(ABMRV(ABMREV)) Q:ABMREV="" D
.Q:ABMREV=9999
.S ABMCODE=-1
.F S ABMCODE=$O(ABMRV(ABMREV,ABMCODE)) Q:ABMCODE="" D
..S ABMCNTR=0
..F S ABMCNTR=$O(ABMRV(ABMREV,ABMCODE,ABMCNTR)) Q:ABMCNTR="" D
...D LOOP
K ABMREV,ABMCODE,ABMCNTR
Q
;
LOOP ;
S ABMLXCNT=ABMLXCNT+1
D EP^ABME8LX
D WR^ABMUTL8("LX")
D EP^ABME8SV2
D WR^ABMUTL8("SV2")
I $P(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,10) D
.D EP^ABME8DTP("472","D8",$P(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,10))
I '$P(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,10) D
.D EP^ABME8DTP(472,"D8",$P(ABMB7,U))
D WR^ABMUTL8("DTP")
;
; Loop 2420A - Attending Physician
I $P($G(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,15) D
.S ABM("PRV")=$P(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,15)
.Q:ABM("PRV")=$O(ABMP("PRV","A",0))
.D EP^ABME8NM1("71")
.D WR^ABMUTL8("NM1")
.I ABMNPIU="N" D
..D EP^ABME8REF("EI",9999999.06,DUZ(2))
..D WR^ABMUTL8("REF")
.I ABMNPIU'="N" D
..D EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
..D WR^ABMUTL8("REF")
;
; Loop 2420B - Operating Physician Name
I $P($G(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,16) D
.S ABM("PRV")=$P(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,16)
.Q:ABM("PRV")=$O(ABMP("PRV","O",0))
.D EP^ABME8NM1("72")
.D WR^ABMUTL8("NM1")
.I ABMNPIU="N" D
..D EP^ABME8REF("EI",9999999.06,DUZ(2))
..D WR^ABMUTL8("REF")
.I ABMNPIU'="N" D
..D EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
..D WR^ABMUTL8("REF")
;
; Loop 2420C - Other Physician Name
I $P($G(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,18) D
.S ABM("PRV")=$P(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,18)
.Q:ABM("PRV")=$O(ABMP("PRV","T",0))
.D EP^ABME8NM1("73")
.D WR^ABMUTL8("NM1")
.I ABMNPIU="N" D
..D EP^ABME8REF("EI",9999999.06,DUZ(2))
..D WR^ABMUTL8("REF")
.I ABMNPIU'="N" D
..D EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
..D WR^ABMUTL8("REF")
;
; Loop 2420D - Referring Physician Name
I $P($G(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,17) D
.S ABM("PRV")=$P(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,17)
.Q:ABM("PRV")=$O(ABMP("PRV","F",0))
.D EP^ABME8NM1("DN")
.D WR^ABMUTL8("NM1")
.D EP^ABME8PRV("RF",ABM("PRV"))
.D WR^ABMUTL8("PRV")
.I ABMNPIU="N" D
..D EP^ABME8REF("EI",9999999.06,DUZ(2))
..D WR^ABMUTL8("REF")
.I ABMNPIU'="N" D
..D EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
..D WR^ABMUTL8("REF")
Q
ABME8L10 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Header Segments
+3 ;
+4 ; IHS/SD/EFG - V2.5 P8 - IM16385
+5 ; Modified to print dental services
+6 ; IHS/SD/SDR - v2.5 p8 - IM20395
+7 ; Split out lines bundled by rev code
+8 ; IHS/SD/SDR - v2.5 p11 - NPI
+9 ; IHS/SD/SDR - v2.5 p12 - IM25247
+10 ; Added missing REF segment for TIN if NPI ONLY
+11 ;
EP ;START HERE
+1 SET ABMLXCNT=0
+2 KILL ABM
+3 DO FRATE^ABMDF11
+4 DO ^ABMERGRV
+5 SET ABMREV=""
+6 FOR
SET ABMREV=$ORDER(ABMRV(ABMREV))
IF ABMREV=""
QUIT
Begin DoDot:1
+7 IF ABMREV=9999
QUIT
+8 SET ABMCODE=-1
+9 FOR
SET ABMCODE=$ORDER(ABMRV(ABMREV,ABMCODE))
IF ABMCODE=""
QUIT
Begin DoDot:2
+10 SET ABMCNTR=0
+11 FOR
SET ABMCNTR=$ORDER(ABMRV(ABMREV,ABMCODE,ABMCNTR))
IF ABMCNTR=""
QUIT
Begin DoDot:3
+12 DO LOOP
End DoDot:3
End DoDot:2
End DoDot:1
+13 KILL ABMREV,ABMCODE,ABMCNTR
+14 QUIT
+15 ;
LOOP ;
+1 SET ABMLXCNT=ABMLXCNT+1
+2 DO EP^ABME8LX
+3 DO WR^ABMUTL8("LX")
+4 DO EP^ABME8SV2
+5 DO WR^ABMUTL8("SV2")
+6 IF $PIECE(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,10)
Begin DoDot:1
+7 DO EP^ABME8DTP("472","D8",$PIECE(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,10))
End DoDot:1
+8 IF '$PIECE(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,10)
Begin DoDot:1
+9 DO EP^ABME8DTP(472,"D8",$PIECE(ABMB7,U))
End DoDot:1
+10 DO WR^ABMUTL8("DTP")
+11 ;
+12 ; Loop 2420A - Attending Physician
+13 IF $PIECE($GET(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,15)
Begin DoDot:1
+14 SET ABM("PRV")=$PIECE(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,15)
+15 IF ABM("PRV")=$ORDER(ABMP("PRV","A",0))
QUIT
+16 DO EP^ABME8NM1("71")
+17 DO WR^ABMUTL8("NM1")
+18 IF ABMNPIU="N"
Begin DoDot:2
+19 DO EP^ABME8REF("EI",9999999.06,DUZ(2))
+20 DO WR^ABMUTL8("REF")
End DoDot:2
+21 IF ABMNPIU'="N"
Begin DoDot:2
+22 DO EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
+23 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+24 ;
+25 ; Loop 2420B - Operating Physician Name
+26 IF $PIECE($GET(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,16)
Begin DoDot:1
+27 SET ABM("PRV")=$PIECE(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,16)
+28 IF ABM("PRV")=$ORDER(ABMP("PRV","O",0))
QUIT
+29 DO EP^ABME8NM1("72")
+30 DO WR^ABMUTL8("NM1")
+31 IF ABMNPIU="N"
Begin DoDot:2
+32 DO EP^ABME8REF("EI",9999999.06,DUZ(2))
+33 DO WR^ABMUTL8("REF")
End DoDot:2
+34 IF ABMNPIU'="N"
Begin DoDot:2
+35 DO EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
+36 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+37 ;
+38 ; Loop 2420C - Other Physician Name
+39 IF $PIECE($GET(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,18)
Begin DoDot:1
+40 SET ABM("PRV")=$PIECE(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,18)
+41 IF ABM("PRV")=$ORDER(ABMP("PRV","T",0))
QUIT
+42 DO EP^ABME8NM1("73")
+43 DO WR^ABMUTL8("NM1")
+44 IF ABMNPIU="N"
Begin DoDot:2
+45 DO EP^ABME8REF("EI",9999999.06,DUZ(2))
+46 DO WR^ABMUTL8("REF")
End DoDot:2
+47 IF ABMNPIU'="N"
Begin DoDot:2
+48 DO EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
+49 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+50 ;
+51 ; Loop 2420D - Referring Physician Name
+52 IF $PIECE($GET(ABMRV(ABMREV,ABMCODE,ABMCNTR)),U,17)
Begin DoDot:1
+53 SET ABM("PRV")=$PIECE(ABMRV(ABMREV,ABMCODE,ABMCNTR),U,17)
+54 IF ABM("PRV")=$ORDER(ABMP("PRV","F",0))
QUIT
+55 DO EP^ABME8NM1("DN")
+56 DO WR^ABMUTL8("NM1")
+57 DO EP^ABME8PRV("RF",ABM("PRV"))
+58 DO WR^ABMUTL8("PRV")
+59 IF ABMNPIU="N"
Begin DoDot:2
+60 DO EP^ABME8REF("EI",9999999.06,DUZ(2))
+61 DO WR^ABMUTL8("REF")
End DoDot:2
+62 IF ABMNPIU'="N"
Begin DoDot:2
+63 DO EP^ABME8REF(ABMP("RTYPE"),200,ABM("PRV"))
+64 DO WR^ABMUTL8("REF")
End DoDot:2
End DoDot:1
+65 QUIT
