ABME8L3.m

ABME8L3 ; IHS/SD/SDR - Header 

 ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379

 ;Header Segments

 ;

 ; IHS/SD/SDR - v2.5 p8 - IM15585 - Check for new patient, not just new subscriber

 ; IHS/SD/SDR - v2.5 p8 - IM13177/IM13285 - Change so DOB comes from page 4 of Reg

 ; IHS/SD/SDR - v2.5 p10 - IM19923 - Don't write address if RCID=610442

 ;

 ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'

 ;

START ;START HERE

 S ABMI=1

 D EP^ABME8HL(22,+$G(ABMCHILD))

 D WR^ABMUTL8("HL")

 D EP^ABME8SBR(ABMPSQ)

 D WR^ABMUTL8("SBR")

 D EP^ABME8NM1("IL")

 D WR^ABMUTL8("NM1")

 D EP^ABME8N3(ABMSFILE,ABMSIEN)

 D WR^ABMUTL8("N3")

 D EP^ABME8N4(ABMSFILE,ABMSIEN)

 D WR^ABMUTL8("N4")

 D EP^ABME8DMG(ABMSFILE,ABMSIEN)

 D WR^ABMUTL8("DMG")

 S ABMLOOP="2010BB"

 D EP^ABME8NM1("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^ABME8N3(9999999.18,ABMP("INS"))

 .D WR^ABMUTL8("N3")

 .D EP^ABME8N4(9999999.18,ABMP("INS"))

 .D WR^ABMUTL8("N4")

 Q:'ABMCHILD

PTCHG ;EP

 S ABMI=1

 D EP^ABME8HL(23,0)

 D WR^ABMUTL8("HL")

 D ^ABME8PAT

 D WR^ABMUTL8("PAT")

 D EP^ABME8NM1("QC")

 D WR^ABMUTL8("NM1")

 D EP^ABME8N3(2,ABMP("PDFN"))

 D WR^ABMUTL8("N3")

 D EP^ABME8N4(2,ABMP("PDFN"))

 D WR^ABMUTL8("N4")

 D EP^ABME8DMG(2,ABMP("PDFN"))

 D WR^ABMUTL8("DMG")

 Q

ABME8L3   ; IHS/SD/SDR - Header 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379

 +2       ;Header Segments

 +3       ;

 +4       ; IHS/SD/SDR - v2.5 p8 - IM15585 - Check for new patient, not just new subscriber

 +5       ; IHS/SD/SDR - v2.5 p8 - IM13177/IM13285 - Change so DOB comes from page 4 of Reg

 +6       ; IHS/SD/SDR - v2.5 p10 - IM19923 - Don't write address if RCID=610442

 +7       ;

 +8       ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'

 +9       ;

START     ;START HERE

 +1        SET ABMI=1

 +2        DO EP^ABME8HL(22,+$GET(ABMCHILD))

 +3        DO WR^ABMUTL8("HL")

 +4        DO EP^ABME8SBR(ABMPSQ)

 +5        DO WR^ABMUTL8("SBR")

 +6        DO EP^ABME8NM1("IL")

 +7        DO WR^ABMUTL8("NM1")

 +8        DO EP^ABME8N3(ABMSFILE,ABMSIEN)

 +9        DO WR^ABMUTL8("N3")

 +10       DO EP^ABME8N4(ABMSFILE,ABMSIEN)

 +11       DO WR^ABMUTL8("N4")

 +12       DO EP^ABME8DMG(ABMSFILE,ABMSIEN)

 +13       DO WR^ABMUTL8("DMG")

 +14       SET ABMLOOP="2010BB"

 +15       DO EP^ABME8NM1("PR",ABMP("INS"))

 +16       DO WR^ABMUTL8("NM1")

 +17      ;I $$RCID^ABMUTLP(ABMP("INS"))'=610442 D  ;abm*2.6*21 IHS/SD/SDR HEAT123457

 +18      ;abm*2.6*21 IHS/SD/SDR HEAT123457

           IF $$RCID^ABMUTLP(ABMP("INS"))'["61044"

               Begin DoDot:1

 +19               DO EP^ABME8N3(9999999.18,ABMP("INS"))

 +20               DO WR^ABMUTL8("N3")

 +21               DO EP^ABME8N4(9999999.18,ABMP("INS"))

 +22               DO WR^ABMUTL8("N4")

               End DoDot:1

 +23       IF 'ABMCHILD

               QUIT 

PTCHG     ;EP

 +1        SET ABMI=1

 +2        DO EP^ABME8HL(23,0)

 +3        DO WR^ABMUTL8("HL")

 +4        DO ^ABME8PAT

 +5        DO WR^ABMUTL8("PAT")

 +6        DO EP^ABME8NM1("QC")

 +7        DO WR^ABMUTL8("NM1")

 +8        DO EP^ABME8N3(2,ABMP("PDFN"))

 +9        DO WR^ABMUTL8("N3")

 +10       DO EP^ABME8N4(2,ABMP("PDFN"))

 +11       DO WR^ABMUTL8("N4")

 +12       DO EP^ABME8DMG(2,ABMP("PDFN"))

 +13       DO WR^ABMUTL8("DMG")

 +14       QUIT