ABME5L5 ; IHS/ASDST/DMJ - Header
;;2.6;IHS Third Party Billing;**6,8,9,14,21**;NOV 12, 2009;Build 379
;Header Segments
;IHS/SD/SDR - 2.6*21 - HEAT135923 - Print DTP*435 if date and bill type is 181
;
START ;START HERE
S ABMLOOP=2300
D ^ABME5CLM
D WR^ABMUTL8("CLM")
I $P(ABMB6,U,4)'="",($E(ABMP("BTYP"),1,2)=11) D
.D EP^ABME5DTP("096","TM",$P(ABMB6,U,4))
.D WR^ABMUTL8("DTP")
D EP^ABME5DTP(434,"RD8",$P(ABMB7,U),$P(ABMB7,U,2))
D WR^ABMUTL8("DTP")
;I $P(ABMB6,U),($E(ABMP("BTYP"),1,2)=11) D ;abm*2.6*21 IHS/SD/SDR HEAT135923
I $P(ABMB6,U),(($E(ABMP("BTYP"),1,2)=11)!(ABMP("BTYP")=181)) D ;abm*2.6*21 IHS/SD/SDR HEAT135923
.D EP^ABME5DTP(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 ^ABME5CN1
.D WR^ABMUTL8("CN1")
S ABMB5TR=$P(ABMB5,U,1,3)
S ABMB5TR=$TR(ABMB5TR,U)
I +ABMB5TR D
.D ^ABME5CL1
.D WR^ABMUTL8("CL1")
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 ^ABME5PWK,WR^ABMUTL8("PWK")
..S ABM71CNT=+$G(ABM71CNT)+1
I $P(ABMB9,U,9) D
.D EP^ABME5AMT("F5")
.D WR^ABMUTL8("AMT")
I $P(ABMB4,U,9)'="" D
.D EP^ABME5REF("F8")
.D WR^ABMUTL8("REF")
I $P(ABMB5,U,8)'="" D
.D EP^ABME5REF("G4")
.D WR^ABMUTL8("REF")
I $P(ABMB5,U,11)'="" D
.D EP^ABME5REF("9F")
.D WR^ABMUTL8("REF")
I $P(ABMB5,U,12)'="" D
.D EP^ABME5REF("G1")
.D WR^ABMUTL8("REF")
;auto accident state
I $P(ABMB8,U,16)'="" D
.D EP^ABME5REF("LU")
.D WR^ABMUTL8("REF")
D EP^ABME5REF("EA")
D WR^ABMUTL8("REF")
;start old code abm*2.6*9 HEAT57041
;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^ABME5K3
;.D WR^ABMUTL8("K3")
;end old code abm*2.6*9
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61)) D
.D EP^ABME5NTE("ADD")
.Q:$TR($G(ABMR("NTE",30))," ")=""
.D WR^ABMUTL8("NTE")
;EPSDT Referral
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0)) D
.S ABMSPIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))
.Q:+ABMSPIEN=0
.Q:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABMSPIEN,0)),U,2)=""
.D EP^ABME5CRC("EPSDT")
.D WR^ABMUTL8("CRC")
Q
ABME5L5 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS Third Party Billing;**6,8,9,14,21**;NOV 12, 2009;Build 379
+2 ;Header Segments
+3 ;IHS/SD/SDR - 2.6*21 - HEAT135923 - Print DTP*435 if date and bill type is 181
+4 ;
START ;START HERE
+1 SET ABMLOOP=2300
+2 DO ^ABME5CLM
+3 DO WR^ABMUTL8("CLM")
+4 IF $PIECE(ABMB6,U,4)'=""
IF ($EXTRACT(ABMP("BTYP"),1,2)=11)
Begin DoDot:1
+5 DO EP^ABME5DTP("096","TM",$PIECE(ABMB6,U,4))
+6 DO WR^ABMUTL8("DTP")
End DoDot:1
+7 DO EP^ABME5DTP(434,"RD8",$PIECE(ABMB7,U),$PIECE(ABMB7,U,2))
+8 DO WR^ABMUTL8("DTP")
+9 ;I $P(ABMB6,U),($E(ABMP("BTYP"),1,2)=11) D ;abm*2.6*21 IHS/SD/SDR HEAT135923
+10 ;abm*2.6*21 IHS/SD/SDR HEAT135923
IF $PIECE(ABMB6,U)
IF (($EXTRACT(ABMP("BTYP"),1,2)=11)!(ABMP("BTYP")=181))
Begin DoDot:1
+11 DO EP^ABME5DTP(435,"DT",$TRANSLATE($PIECE(ABMB6,U,1,2),U,"."))
+12 DO WR^ABMUTL8("DTP")
End DoDot:1
+13 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,11)'=""
Begin DoDot:1
+14 DO ^ABME5CN1
+15 DO WR^ABMUTL8("CN1")
End DoDot:1
+16 SET ABMB5TR=$PIECE(ABMB5,U,1,3)
+17 SET ABMB5TR=$TRANSLATE(ABMB5TR,U)
+18 IF +ABMB5TR
Begin DoDot:1
+19 DO ^ABME5CL1
+20 DO WR^ABMUTL8("CL1")
End DoDot:1
+21 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),71))
Begin DoDot:1
+22 KILL ABM71CNT
+23 SET ABM71IEN=0
+24 FOR
SET ABM71IEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN))
IF +ABM71IEN=0
QUIT
Begin DoDot:2
+25 DO ^ABME5PWK
DO WR^ABMUTL8("PWK")
+26 SET ABM71CNT=+$GET(ABM71CNT)+1
End DoDot:2
IF $GET(ABM71CNT)=10
QUIT
End DoDot:1
+27 IF $PIECE(ABMB9,U,9)
Begin DoDot:1
+28 DO EP^ABME5AMT("F5")
+29 DO WR^ABMUTL8("AMT")
End DoDot:1
+30 IF $PIECE(ABMB4,U,9)'=""
Begin DoDot:1
+31 DO EP^ABME5REF("F8")
+32 DO WR^ABMUTL8("REF")
End DoDot:1
+33 IF $PIECE(ABMB5,U,8)'=""
Begin DoDot:1
+34 DO EP^ABME5REF("G4")
+35 DO WR^ABMUTL8("REF")
End DoDot:1
+36 IF $PIECE(ABMB5,U,11)'=""
Begin DoDot:1
+37 DO EP^ABME5REF("9F")
+38 DO WR^ABMUTL8("REF")
End DoDot:1
+39 IF $PIECE(ABMB5,U,12)'=""
Begin DoDot:1
+40 DO EP^ABME5REF("G1")
+41 DO WR^ABMUTL8("REF")
End DoDot:1
+42 ;auto accident state
+43 IF $PIECE(ABMB8,U,16)'=""
Begin DoDot:1
+44 DO EP^ABME5REF("LU")
+45 DO WR^ABMUTL8("REF")
End DoDot:1
+46 DO EP^ABME5REF("EA")
+47 DO WR^ABMUTL8("REF")
+48 ;start old code abm*2.6*9 HEAT57041
+49 ;I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) D
+50 ;.D EP^ABME5K3
+51 ;.D WR^ABMUTL8("K3")
+52 ;end old code abm*2.6*9
+53 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),61))
Begin DoDot:1
+54 DO EP^ABME5NTE("ADD")
+55 IF $TRANSLATE($GET(ABMR("NTE",30))," ")=""
QUIT
+56 DO WR^ABMUTL8("NTE")
End DoDot:1
+57 ;EPSDT Referral
+58 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))
Begin DoDot:1
+59 SET ABMSPIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))
+60 IF +ABMSPIEN=0
QUIT
+61 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABMSPIEN,0)),U,2)=""
QUIT
+62 DO EP^ABME5CRC("EPSDT")
+63 DO WR^ABMUTL8("CRC")
End DoDot:1
+64 QUIT
