- 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
