- 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
