- 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