ABME5L13 ; IHS/ASDST/DMJ - Header
;;2.6;IHS Third Party Billing System;**6,8,11**;NOV 12, 2009;Build 133
;Header Segments
;
START ;START HERE
S ABMLOOP=2300
D ^ABME5CLM ;5010 837P
D WR^ABMUTL8("CLM")
I $P(ABMB8,U,2) D ;accident
.D EP^ABME8DTP(439,"D8",$P(ABMB8,U,2))
.D WR^ABMUTL8("DTP")
;start new code abm*2.6*11 HEAT78400
I $P(ABMB4,U,5)'="" D
.D EP^ABME8DTP(452,"D8",$P(ABMB4,U,5))
.D WR^ABMUTL8("DTP")
;end new code HEAT78400
I $P(ABMB7,U)'=$P(ABMB7,"^",2) D
.D EP^ABME5DTP(472,"RD8",$P(ABMB7,U),$P(ABMB7,"^",2))
.D WR^ABMUTL8("DTP")
I $P(ABMB7,U)=$P(ABMB7,"^",2) D
.D EP^ABME5DTP(472,"D8",$P(ABMB7,U))
.D WR^ABMUTL8("DTP")
;start new code abm*2.6*11 HEAT78400
I $P(ABMB4,U,13)'="" D
.D EP^ABME5DN1
.D WR^ABMUTL8("DN1")
;end new code HEAT78400
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,"^",9) D
.D EP^ABME5AMT("F5")
.D WR^ABMUTL8("AMT")
I $P(ABMB5,U,11)'="" D ;Referral Number
.D EP^ABME5REF("9F")
.D WR^ABMUTL8("REF")
I $P(ABMB5,U,12)'="" D ;Prior Authorization
.D EP^ABME5REF("G1")
.D WR^ABMUTL8("REF")
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61)) D
.D EP^ABME5NTE("ADD")
.D WR^ABMUTL8("NTE")
D DXSET^ABMUTL8(ABMP("BDFN"))
;principal DX (BK)
D EP^ABME5HI("BK")
D WR^ABMUTL8("HI")
Q
ABME5L13 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS Third Party Billing System;**6,8,11**;NOV 12, 2009;Build 133
+2 ;Header Segments
+3 ;
START ;START HERE
+1 SET ABMLOOP=2300
+2 ;5010 837P
DO ^ABME5CLM
+3 DO WR^ABMUTL8("CLM")
+4 ;accident
IF $PIECE(ABMB8,U,2)
Begin DoDot:1
+5 DO EP^ABME8DTP(439,"D8",$PIECE(ABMB8,U,2))
+6 DO WR^ABMUTL8("DTP")
End DoDot:1
+7 ;start new code abm*2.6*11 HEAT78400
+8 IF $PIECE(ABMB4,U,5)'=""
Begin DoDot:1
+9 DO EP^ABME8DTP(452,"D8",$PIECE(ABMB4,U,5))
+10 DO WR^ABMUTL8("DTP")
End DoDot:1
+11 ;end new code HEAT78400
+12 IF $PIECE(ABMB7,U)'=$PIECE(ABMB7,"^",2)
Begin DoDot:1
+13 DO EP^ABME5DTP(472,"RD8",$PIECE(ABMB7,U),$PIECE(ABMB7,"^",2))
+14 DO WR^ABMUTL8("DTP")
End DoDot:1
+15 IF $PIECE(ABMB7,U)=$PIECE(ABMB7,"^",2)
Begin DoDot:1
+16 DO EP^ABME5DTP(472,"D8",$PIECE(ABMB7,U))
+17 DO WR^ABMUTL8("DTP")
End DoDot:1
+18 ;start new code abm*2.6*11 HEAT78400
+19 IF $PIECE(ABMB4,U,13)'=""
Begin DoDot:1
+20 DO EP^ABME5DN1
+21 DO WR^ABMUTL8("DN1")
End DoDot:1
+22 ;end new code HEAT78400
+23 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),71))
Begin DoDot:1
+24 KILL ABM71CNT
+25 SET ABM71IEN=0
+26 FOR
SET ABM71IEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN))
IF +ABM71IEN=0
QUIT
Begin DoDot:2
+27 DO ^ABME5PWK
DO WR^ABMUTL8("PWK")
+28 SET ABM71CNT=+$GET(ABM71CNT)+1
End DoDot:2
IF $GET(ABM71CNT)=10
QUIT
End DoDot:1
+29 IF $PIECE(ABMB9,"^",9)
Begin DoDot:1
+30 DO EP^ABME5AMT("F5")
+31 DO WR^ABMUTL8("AMT")
End DoDot:1
+32 ;Referral Number
IF $PIECE(ABMB5,U,11)'=""
Begin DoDot:1
+33 DO EP^ABME5REF("9F")
+34 DO WR^ABMUTL8("REF")
End DoDot:1
+35 ;Prior Authorization
IF $PIECE(ABMB5,U,12)'=""
Begin DoDot:1
+36 DO EP^ABME5REF("G1")
+37 DO WR^ABMUTL8("REF")
End DoDot:1
+38 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),61))
Begin DoDot:1
+39 DO EP^ABME5NTE("ADD")
+40 DO WR^ABMUTL8("NTE")
End DoDot:1
+41 DO DXSET^ABMUTL8(ABMP("BDFN"))
+42 ;principal DX (BK)
+43 DO EP^ABME5HI("BK")
+44 DO WR^ABMUTL8("HI")
+45 QUIT
