- 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
