ABME8L5 ; IHS/ASDST/DMJ - Header
;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
;Header Segments
;
; IHS/SD/SDR - v2.5 p9 - IM18032
; Put Medicaid Resubmission Number as REF*F8
;
; IHS/SD/SDR - v2.5 p13 - POA changes
; Added call to new routine ABME8K3
; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added code for PWK claim attachments
;
START ;START HERE
D ^ABME8CLM
D WR^ABMUTL8("CLM")
I $P(ABMB6,U,4)'="" D
.D EP^ABME8DTP("096","TM",$P(ABMB6,U,4))
.D WR^ABMUTL8("DTP")
D EP^ABME8DTP(434,"RD8",$P(ABMB7,U),$P(ABMB7,U,2))
D WR^ABMUTL8("DTP")
I $P(ABMB6,U) D
.D EP^ABME8DTP(435,"DT",$TR($P(ABMB6,U,1,2),U,"."))
.D WR^ABMUTL8("DTP")
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,11)'="" D
.D ^ABME8CN1
.D WR^ABMUTL8("CN1")
S ABMB5TR=$P(ABMB5,U,1,3)
S ABMB5TR=$TR(ABMB5TR,U)
I +ABMB5TR D
.D ^ABME8CL1
.D WR^ABMUTL8("CL1")
;start new code abm*2.6*1 HEAT6439
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),71)) D
.K ABM71CNT
.S ABM71IEN=0
.F S ABM71IEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN)) Q:+ABM71IEN=0 D Q:$G(ABM71CNT)=10
..D ^ABME8PWK,WR^ABMUTL8("PWK")
..S ABM71CNT=+$G(ABM71CNT)+1
;end new code HEAT6439
D EP^ABME8AMT("C5")
D WR^ABMUTL8("AMT")
I $P(ABMB9,U,9) D
.D EP^ABME8AMT("F5")
.D WR^ABMUTL8("AMT")
I $P(ABMB4,U,9)'="" D
.D EP^ABME8REF("F8")
.D WR^ABMUTL8("REF")
I $P(ABMB5,U,8)'="" D
.D EP^ABME8REF("G4")
.D WR^ABMUTL8("REF")
I $P(ABMB5,U,11)'="" D
.D EP^ABME8REF("9F")
.D WR^ABMUTL8("REF")
I $P(ABMB5,U,12)'="" D
.D EP^ABME8REF("G1")
.D WR^ABMUTL8("REF")
D EP^ABME8REF("EA")
D WR^ABMUTL8("REF")
I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) D
.D EP^ABME8K3
.D WR^ABMUTL8("K3")
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61)) D
.D EP^ABME8NTE("ADD")
.Q:$TR($G(ABMR("NTE",30))," ")=""
.D WR^ABMUTL8("NTE")
Q
ABME8L5 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
+2 ;Header Segments
+3 ;
+4 ; IHS/SD/SDR - v2.5 p9 - IM18032
+5 ; Put Medicaid Resubmission Number as REF*F8
+6 ;
+7 ; IHS/SD/SDR - v2.5 p13 - POA changes
+8 ; Added call to new routine ABME8K3
+9 ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added code for PWK claim attachments
+10 ;
START ;START HERE
+1 DO ^ABME8CLM
+2 DO WR^ABMUTL8("CLM")
+3 IF $PIECE(ABMB6,U,4)'=""
Begin DoDot:1
+4 DO EP^ABME8DTP("096","TM",$PIECE(ABMB6,U,4))
+5 DO WR^ABMUTL8("DTP")
End DoDot:1
+6 DO EP^ABME8DTP(434,"RD8",$PIECE(ABMB7,U),$PIECE(ABMB7,U,2))
+7 DO WR^ABMUTL8("DTP")
+8 IF $PIECE(ABMB6,U)
Begin DoDot:1
+9 DO EP^ABME8DTP(435,"DT",$TRANSLATE($PIECE(ABMB6,U,1,2),U,"."))
+10 DO WR^ABMUTL8("DTP")
End DoDot:1
+11 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,11)'=""
Begin DoDot:1
+12 DO ^ABME8CN1
+13 DO WR^ABMUTL8("CN1")
End DoDot:1
+14 SET ABMB5TR=$PIECE(ABMB5,U,1,3)
+15 SET ABMB5TR=$TRANSLATE(ABMB5TR,U)
+16 IF +ABMB5TR
Begin DoDot:1
+17 DO ^ABME8CL1
+18 DO WR^ABMUTL8("CL1")
End DoDot:1
+19 ;start new code abm*2.6*1 HEAT6439
+20 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),71))
Begin DoDot:1
+21 KILL ABM71CNT
+22 SET ABM71IEN=0
+23 FOR
SET ABM71IEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN))
IF +ABM71IEN=0
QUIT
Begin DoDot:2
+24 DO ^ABME8PWK
DO WR^ABMUTL8("PWK")
+25 SET ABM71CNT=+$GET(ABM71CNT)+1
End DoDot:2
IF $GET(ABM71CNT)=10
QUIT
End DoDot:1
+26 ;end new code HEAT6439
+27 DO EP^ABME8AMT("C5")
+28 DO WR^ABMUTL8("AMT")
+29 IF $PIECE(ABMB9,U,9)
Begin DoDot:1
+30 DO EP^ABME8AMT("F5")
+31 DO WR^ABMUTL8("AMT")
End DoDot:1
+32 IF $PIECE(ABMB4,U,9)'=""
Begin DoDot:1
+33 DO EP^ABME8REF("F8")
+34 DO WR^ABMUTL8("REF")
End DoDot:1
+35 IF $PIECE(ABMB5,U,8)'=""
Begin DoDot:1
+36 DO EP^ABME8REF("G4")
+37 DO WR^ABMUTL8("REF")
End DoDot:1
+38 IF $PIECE(ABMB5,U,11)'=""
Begin DoDot:1
+39 DO EP^ABME8REF("9F")
+40 DO WR^ABMUTL8("REF")
End DoDot:1
+41 IF $PIECE(ABMB5,U,12)'=""
Begin DoDot:1
+42 DO EP^ABME8REF("G1")
+43 DO WR^ABMUTL8("REF")
End DoDot:1
+44 DO EP^ABME8REF("EA")
+45 DO WR^ABMUTL8("REF")
+46 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($EXTRACT(ABMP("BTYP"),1,2)=11)!($EXTRACT(ABMP("BTYP"),1,2)="12"))
Begin DoDot:1
+47 DO EP^ABME8K3
+48 DO WR^ABMUTL8("K3")
End DoDot:1
+49 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),61))
Begin DoDot:1
+50 DO EP^ABME8NTE("ADD")
+51 IF $TRANSLATE($GET(ABMR("NTE",30))," ")=""
QUIT
+52 DO WR^ABMUTL8("NTE")
End DoDot:1
+53 QUIT
