ABME5L3 ; IHS/ASDST/DMJ - Header
;;2.6;IHS Third Party Billing System;**6,9,14,21**;NOV 12, 2009;Build 379
;Header Segments
;IHS/SD/SDR - 2.6*21 - HEAT119570 - Added code to look in secondary place for Case Number
;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check to be 'contains' not 'equals'
;
START ;START HERE
S ABMI=1
S ABMLOOP="2000B"
D EP^ABME5HL(22,+$G(ABMCHILD))
D WR^ABMUTL8("HL")
D EP^ABME5SBR(ABMPSQ)
D WR^ABMUTL8("SBR")
S ABMLOOP="2010BA"
D EP^ABME5NM1("IL")
D WR^ABMUTL8("NM1")
;abm*2.6*9 IHS/SD/AML 12/22/2011 - HEAT51571 BEGIN OLD CODE
;D EP^ABME5N3(ABMSFILE,ABMSIEN)
;D WR^ABMUTL8("N3")
;D EP^ABME5N4(ABMSFILE,ABMSIEN)
;D WR^ABMUTL8("N4")
;D EP^ABME5DMG(ABMSFILE,ABMSIEN)
;D WR^ABMUTL8("DMG")
;IHS/SD/AML 12/22/2011 - HEAT51571 END OLD CODE, BEGIN NEW CODE
I +$G(ABMCHILD)=0 D ;if patient is subscriber, send address
.D EP^ABME5N3(ABMSFILE,ABMSIEN)
.D WR^ABMUTL8("N3")
.D EP^ABME5N4(ABMSFILE,ABMSIEN)
.D WR^ABMUTL8("N4")
.D EP^ABME5DMG(ABMSFILE,ABMSIEN)
.D WR^ABMUTL8("DMG")
;IHS/SD/AML 12/22/2011 - HEAT51571 END NEW CODE
;I $P(ABMB7,U,13)'="",(+$G(ABMCHILD)=0) D ;if patient is subscriber ;abm*2.6*21 IHS/SD/SDR HEAT119570
I ($P(ABMB7,U,13)'=""!($P(ABMB4,U,8)'="")) D ;if patient is subscriber ;abm*2.6*21 IHS/SD/SDR HEAT119570
.D EP^ABME5REF("Y4","","")
.D WR^ABMUTL8("REF")
S ABMLOOP="2010BB"
D EP^ABME5NM1("PR",ABMP("INS"))
D WR^ABMUTL8("NM1")
;I $$RCID^ABMUTLP(ABMP("INS"))'=610442 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMUTLP(ABMP("INS"))'["61044" D ;abm*2.6*21 IHS/SD/SDR HEAT123457
.D EP^ABME5N3(9999999.18,ABMP("INS"))
.D WR^ABMUTL8("N3")
.D EP^ABME5N4(9999999.18,ABMP("INS"))
.D WR^ABMUTL8("N4")
Q:'ABMCHILD
PTCHG ;EP
S ABMI=1
S ABMLOOP="2000C"
D EP^ABME5HL(23,0)
D WR^ABMUTL8("HL")
D ^ABME5PAT
D WR^ABMUTL8("PAT")
S ABMLOOP="2010CA"
D EP^ABME5NM1("QC")
D WR^ABMUTL8("NM1")
D EP^ABME5N3(2,ABMP("PDFN"))
D WR^ABMUTL8("N3")
D EP^ABME5N4(2,ABMP("PDFN"))
D WR^ABMUTL8("N4")
D EP^ABME5DMG(2,ABMP("PDFN"))
D WR^ABMUTL8("DMG")
I $P(ABMB7,U,13)'="",(+$G(ABMCHILD)=1) D ;if patient is not subscriber
.D EP^ABME5REF("Y4","","")
.D WR^ABMUTL8("REF")
I $P(ABMB7,U,26)'="" D
.D EP^ABME5REF($P(ABMB7,U,25),"","")
.D WR^ABMUTL8("REF")
Q
ABME5L3 ; IHS/ASDST/DMJ - Header
+1 ;;2.6;IHS Third Party Billing System;**6,9,14,21**;NOV 12, 2009;Build 379
+2 ;Header Segments
+3 ;IHS/SD/SDR - 2.6*21 - HEAT119570 - Added code to look in secondary place for Case Number
+4 ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check to be 'contains' not 'equals'
+5 ;
START ;START HERE
+1 SET ABMI=1
+2 SET ABMLOOP="2000B"
+3 DO EP^ABME5HL(22,+$GET(ABMCHILD))
+4 DO WR^ABMUTL8("HL")
+5 DO EP^ABME5SBR(ABMPSQ)
+6 DO WR^ABMUTL8("SBR")
+7 SET ABMLOOP="2010BA"
+8 DO EP^ABME5NM1("IL")
+9 DO WR^ABMUTL8("NM1")
+10 ;abm*2.6*9 IHS/SD/AML 12/22/2011 - HEAT51571 BEGIN OLD CODE
+11 ;D EP^ABME5N3(ABMSFILE,ABMSIEN)
+12 ;D WR^ABMUTL8("N3")
+13 ;D EP^ABME5N4(ABMSFILE,ABMSIEN)
+14 ;D WR^ABMUTL8("N4")
+15 ;D EP^ABME5DMG(ABMSFILE,ABMSIEN)
+16 ;D WR^ABMUTL8("DMG")
+17 ;IHS/SD/AML 12/22/2011 - HEAT51571 END OLD CODE, BEGIN NEW CODE
+18 ;if patient is subscriber, send address
IF +$GET(ABMCHILD)=0
Begin DoDot:1
+19 DO EP^ABME5N3(ABMSFILE,ABMSIEN)
+20 DO WR^ABMUTL8("N3")
+21 DO EP^ABME5N4(ABMSFILE,ABMSIEN)
+22 DO WR^ABMUTL8("N4")
+23 DO EP^ABME5DMG(ABMSFILE,ABMSIEN)
+24 DO WR^ABMUTL8("DMG")
End DoDot:1
+25 ;IHS/SD/AML 12/22/2011 - HEAT51571 END NEW CODE
+26 ;I $P(ABMB7,U,13)'="",(+$G(ABMCHILD)=0) D ;if patient is subscriber ;abm*2.6*21 IHS/SD/SDR HEAT119570
+27 ;if patient is subscriber ;abm*2.6*21 IHS/SD/SDR HEAT119570
IF ($PIECE(ABMB7,U,13)'=""!($PIECE(ABMB4,U,8)'=""))
Begin DoDot:1
+28 DO EP^ABME5REF("Y4","","")
+29 DO WR^ABMUTL8("REF")
End DoDot:1
+30 SET ABMLOOP="2010BB"
+31 DO EP^ABME5NM1("PR",ABMP("INS"))
+32 DO WR^ABMUTL8("NM1")
+33 ;I $$RCID^ABMUTLP(ABMP("INS"))'=610442 D ;abm*2.6*21 IHS/SD/SDR HEAT123457
+34 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMUTLP(ABMP("INS"))'["61044"
Begin DoDot:1
+35 DO EP^ABME5N3(9999999.18,ABMP("INS"))
+36 DO WR^ABMUTL8("N3")
+37 DO EP^ABME5N4(9999999.18,ABMP("INS"))
+38 DO WR^ABMUTL8("N4")
End DoDot:1
+39 IF 'ABMCHILD
QUIT
PTCHG ;EP
+1 SET ABMI=1
+2 SET ABMLOOP="2000C"
+3 DO EP^ABME5HL(23,0)
+4 DO WR^ABMUTL8("HL")
+5 DO ^ABME5PAT
+6 DO WR^ABMUTL8("PAT")
+7 SET ABMLOOP="2010CA"
+8 DO EP^ABME5NM1("QC")
+9 DO WR^ABMUTL8("NM1")
+10 DO EP^ABME5N3(2,ABMP("PDFN"))
+11 DO WR^ABMUTL8("N3")
+12 DO EP^ABME5N4(2,ABMP("PDFN"))
+13 DO WR^ABMUTL8("N4")
+14 DO EP^ABME5DMG(2,ABMP("PDFN"))
+15 DO WR^ABMUTL8("DMG")
+16 ;if patient is not subscriber
IF $PIECE(ABMB7,U,13)'=""
IF (+$GET(ABMCHILD)=1)
Begin DoDot:1
+17 DO EP^ABME5REF("Y4","","")
+18 DO WR^ABMUTL8("REF")
End DoDot:1
+19 IF $PIECE(ABMB7,U,26)'=""
Begin DoDot:1
+20 DO EP^ABME5REF($PIECE(ABMB7,U,25),"","")
+21 DO WR^ABMUTL8("REF")
End DoDot:1
+22 QUIT
