ABMDLCK2 ; IHS/SD/SDR - check visit for elig - PART 2 ; 15 Sep 2016 8:58 AM
;;2.6;IHS Third Party Billing System;**2,21**;NOV 12, 2009;Build 379
;;;IHS/PIMC/JLG 1/16/02
;Original;TMD;
;
; IHS/ASDS/LSL - 03/28/2001 - V2.4 Patch 9 - NOIS XAA-0301-200051
; Allow claims to generate properly for KIDSCARE for AHCCCS. Also allow KIDSCARE plan name on
; Medicaid INS regardless of use of plan name field.
; IHS/ASDS/LSL - 06/27/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
; Modified to expand No Eligibility Found. Reasons 39, 36, 40, and 37 can be found in this routine.
; IHS/ASDS/LSL - 11/26/2001 - V2.4 Patch 10 - NOIS BXX-1101-150084
; Resolve <UNDEF>53+8^ABMDLCK2
;
; IHS/SD/SDR - v2.5 p8 - IM13854 - <UNDEF>43+2^ABMDLCK2 during A/R rollback
;
;IHS/SD/SDR - 2.6*21 - VMBP - Added code for VAMB Eligible file changes.
;
; *********************************************************************
4 ;EP - Medicaid Elig Chk
S ABM("PRI")=4
S ABM("TYP")="D"
D PRIO
S ABM("INS")=$O(^AUTNINS("B","MEDICAID",""))
I '+ABM("INS") S ABME(167)="" Q
S ABM("MDFN")=""
F S ABM("MDFN")=$O(^AUPNMCD("B",DFN,ABM("MDFN"))) Q:'ABM("MDFN") D 43
Q
;
43 ;
Q:$P($G(^AUPNMCD(ABM("MDFN"),0)),U)=""
Q:$P($G(^AUPNMCD(ABM("MDFN"),0)),U,2)=""
Q:$P($G(^AUPNMCD(ABM("MDFN"),0)),U,4)=""
N ABMINS
S ABM("REC")=$G(^AUPNMCD(ABM("MDFN"),0))
S ABMINS=$P(ABM("REC"),U,2)
D Q:'ABM("INS")
.Q:'$P(ABM("REC"),U,4)
.S ABM("STATE")=$P(ABM("REC"),U,4)
.I '$D(^AUTNINS(ABMINS,13,ABM("STATE"),0)) S ABME(101)=$P(^DIC(5,ABM("STATE"),0),U) Q
.S ABM("INS")=$P(^AUTNINS(ABMINS,13,ABM("STATE"),0),U,2)
.Q:'$P(ABM("REC"),"^",10)
.S ABMPLAN=$$GET1^DIQ(9000004,ABM("MDFN"),.11) ; Plan name
.I ABMINS=3,ABM("STATE")=3,ABMPLAN["KIDS" S ABM("INS")=$P(ABM("REC"),U,10)
.I ABMINS=3,ABM("STATE")=3,ABMPLAN["CHIP" S ABM("INS")=$P(ABM("REC"),U,10)
.; Piece 5 in the 3P ins file is USE PLAN NAME? field
.Q:'$P($G(^ABMNINS(DUZ(2),ABM("INS"),0)),"^",5)
.; Piece 10 of Medicaid eligible file is Plan Name
.S ABM("INS")=$P(ABM("REC"),U,10)
;If the insurer has been merged to another insurer use the one merged
;to.
I $P($G(^AUTNINS(ABM("INS"),2)),U,7)]"" S ABM("INS")=$P(^(2),U,7)
K ABM("SUB")
S ABM("NDFN")=""
;If subfile 11 does not exist then no elig start and end date
; 39 ; Medicaid coverage; no eligibility date
I '+$O(^AUPNMCD(ABM("MDFN"),11,0)) D Q
.D CHK^ABMDLCK1
.S ABM("XIT")=1
.S $P(ABML(99,ABM("INS")),U,6)=39
.D UNCHK
.K ABM("XIT")
S ABMELGDT=0
S ABM("NDFN")=0
F S ABM("NDFN")=$O(^AUPNMCD(ABM("MDFN"),11,ABM("NDFN"))) Q:'ABM("NDFN") D
.S ABM("SUB")=^AUPNMCD(ABM("MDFN"),11,ABM("NDFN"),0)
.D 44
I 'ABMELGDT D Q
.I '$D(ABML(ABM("PRI"),ABM("INS"))) D
..I '$D(ABML(99,ABM("INS"))) D
...S $P(ABML(99,ABM("INS")),U)=$G(ABM("MDFN"))
...S $P(ABML(99,ABM("INS")),U,2)=$G(ABM("NDFN"))
...S $P(ABML(99,ABM("INS")),U,3)="D"
..S $P(ABML(99,ABM("INS")),U,6)=36
E I $D(ABML(ABM("PRI"),ABM("INS"))),ABM("PRI")<97 D
.K ABML(99,ABM("INS"))
Q
;
44 ;
;ABM("NDFN") is the start date. 2nd piece of ABM("SUB") is end date
Q:ABM("NDFN")>$P($S(ABMDISDT:ABMDISDT,1:ABMVDT),".",1)
I $P(ABM("SUB"),U,2)]"",$P(ABM("SUB"),U,2)<$P(ABMVDT,".",1) Q
S ABMELGDT=1
S ABM("COV")=$P(ABM("SUB"),U,3)
;This is the coverage type from the 11 multiple from Medicaid elg file
;This must match the plan code in coverage type file.
I ABM("COV")]"" S ABM("COV")=$O(^AUTTPIC("AC",ABM("INS"),ABM("COV"),0))
K ABM("XIT")
D CHK^ABMDLCK1
I $G(ABM("XIT")) D UNCHK
Q
;
5 ; Private Ins chk
S ABM("PRI")=$S(ABM("EMPLOYED")=5:3,ABM("EMPLOYED")=1:1,1:2)
I ABM("VACHK")=1 S ABM("PRI")=5 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
S ABM("TYP")="P" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
;S:(ABM("VACHK")=0) ABM("TYP")="P" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
;S:(ABM("VACHK")=1) ABM("TYP")="V" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
Q:'$D(^AUPNPRVT(DFN))
S ABM("MDFN")=0
F S ABM("MDFN")=$O(^AUPNPRVT(DFN,11,ABM("MDFN"))) Q:'ABM("MDFN") D 53
Q
;
53 ;
K ABM("XIT")
Q:$P($G(^AUPNPRVT(DFN,11,ABM("MDFN"),0)),U)=""
Q:'$D(^AUTNINS($P(^AUPNPRVT(DFN,11,ABM("MDFN"),0),U),0))
; 40 ; POV is accident related; but insurer is not
S ABM("REC")=^AUPNPRVT(DFN,11,ABM("MDFN"),0)
S ABM("INS")=$P(ABM("REC"),U)
I (ABM("VACHK")=0),($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABM("INS"),".211","I"),1,"I")="V") Q ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
I (ABM("VACHK")=1),($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABM("INS"),".211","I"),1,"I")'="V") Q ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
I 'ACCDENT,$$ACCREL^ABMDLCK(ABM("MDFN")) D ;Q:ABMVDFN
.S ABM("XIT")=1
.S $P(ABML(99,ABM("INS")),U,6)=40
D PRIO
I $P(ABM("REC"),U,6)>$P(ABMVDT,".",1) D Q
.S $P(ABML(99,ABM("INS")),U,2)=ABM("MDFN")
.S $P(ABML(99,ABM("INS")),U,3)="P" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
.;S:(ABM("VACHK")=0) $P(ABML(99,ABM("INS")),U,3)="P" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
.;S:(ABM("VACHK")=1) $P(ABML(99,ABM("INS")),U,3)="V" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
.S $P(ABML(99,ABM("INS")),U,6)=37
I $P(ABM("REC"),U,7)]"",$P(ABM("REC"),U,7)<$P(ABMVDT,".",1) D Q
.S $P(ABML(99,ABM("INS")),U,2)=ABM("MDFN")
.S $P(ABML(99,ABM("INS")),U,3)="P"
.S $P(ABML(99,ABM("INS")),U,6)=37
Q:$P(ABM("REC"),U,8)="" ;abm*2.6*2 quit if no policy holder
S ABM("COV")=$P($G(^AUPN3PPH($P(ABM("REC"),U,8),0)),U,5)
;ABM("COV") is the ien of the coverage type file
I ABM("COV"),$P($G(^AUTTPIC(ABM("COV"),0)),U,5) D
.S ABM("MSUP",ABM("INS"))=""
.S ABM("OPRI")=ABM("PRI")
.S ABM("PRI")=4
D CHK^ABMDLCK1
I $D(ABM("OPRI")) D
.S ABM("PRI")=ABM("OPRI")
.K ABM("OPRI")
I $G(ABM("XIT")) D UNCHK
Q
;
6 ; Non-beneficiary Patient
K ABM("XIT")
;S ABM("PRI")=5 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
S ABM("PRI")=6 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
S ABM("TYP")="N"
D PRIO
S ABM("INS")=$O(^AUTNINS("B","NON-BENEFICIARY PATIENT",""))
I '+ABM("INS") S ABME(169)="" Q
;Piece 12 of node 11 is indian eligibility status. I means ineligible
G 7:'$D(^AUPNPAT(DFN,11)),7:($P(^(11),U,12)'="I")
S (ABM("COV"),ABM("MDFN"))=""
D CHK^ABMDLCK1
I $G(ABM("XIT")) D UNCHK
Q
;
7 ; Beneficiary Patient
K ABM("XIT")
;Piece 18 of 0 node is the "bill all pats" field
N ABMBBENP,ABMPRI
S ABMBBENP=$P($G(^ABMDPARM(DUZ(2),1,0)),U,18),ABMBDISP=$P($G(^(0)),"^",10)
Q:'ABMBBENP
S ABMPRI=$O(ABML(0))
Q:ABMPRI>0&(ABMPRI<97)&('ABMBDISP) ;Quit if other insurer found
;Don't put an entry in ABML for bene pat if there another entry
;If bill all inpats check for visit type
Q:ABMBBENP=2&$D(SERVCAT)&("HID"'[$G(SERVCAT))
Q:ABMBBENP=2&$D(ABMP("VTYP"))&($G(ABMP("VTYP"))'=111)
;S ABM("PRI")=6 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
S ABM("PRI")=7 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
S ABM("TYP")="I"
D PRIO
S ABM("INS")=$O(^AUTNINS("B","BENEFICIARY PATIENT (INDIAN)",""))
I '+ABM("INS") Q
S (ABM("COV"),ABM("MDFN"))=""
D CHK^ABMDLCK1
I $G(ABM("XIT")) D UNCHK
Q
;
PRIO ;SET PRIORITY
F D Q:'$D(ABML(ABM("PRI")))
.Q:'$D(ABML(ABM("PRI")))
.S ABM("PRI")=ABM("PRI")+1
Q
;
;ABM("XIT") serves as a flag that the priority needs to be 99
;
UNCHK ;EP-Instead of deleting the coverage for insurer represented by ien
;ABM("INS") the subroutine changes the priority for this insurer to
;99
I ABM("XIT") D Q
.N P
.S P=$S($D(ABM("BEFSD"))=0:99,1:97)
.S REASON=$P($G(ABML(P,ABM("INS"))),U,6)
.M ABML(P,ABM("INS"))=ABML(ABM("PRI"),ABM("INS"))
.S:+REASON $P(ABML(P,ABM("INS")),U,6)=REASON
.K REASON
.K ABML(ABM("PRI"),ABM("INS"))
I $D(ABML(99,ABM("INS"))),ABM("PRI")'=99 D
.S:ABM("CV")]"" ABML(ABM("PRI"),ABM("INS"),"COV",ABM("CV"))=""
.K ABML(99,ABM("INS"))
Q
ABMDLCK2 ; IHS/SD/SDR - check visit for elig - PART 2 ; 15 Sep 2016 8:58 AM
+1 ;;2.6;IHS Third Party Billing System;**2,21**;NOV 12, 2009;Build 379
+2 ;;;IHS/PIMC/JLG 1/16/02
+3 ;Original;TMD;
+4 ;
+5 ; IHS/ASDS/LSL - 03/28/2001 - V2.4 Patch 9 - NOIS XAA-0301-200051
+6 ; Allow claims to generate properly for KIDSCARE for AHCCCS. Also allow KIDSCARE plan name on
+7 ; Medicaid INS regardless of use of plan name field.
+8 ; IHS/ASDS/LSL - 06/27/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
+9 ; Modified to expand No Eligibility Found. Reasons 39, 36, 40, and 37 can be found in this routine.
+10 ; IHS/ASDS/LSL - 11/26/2001 - V2.4 Patch 10 - NOIS BXX-1101-150084
+11 ; Resolve <UNDEF>53+8^ABMDLCK2
+12 ;
+13 ; IHS/SD/SDR - v2.5 p8 - IM13854 - <UNDEF>43+2^ABMDLCK2 during A/R rollback
+14 ;
+15 ;IHS/SD/SDR - 2.6*21 - VMBP - Added code for VAMB Eligible file changes.
+16 ;
+17 ; *********************************************************************
4 ;EP - Medicaid Elig Chk
+1 SET ABM("PRI")=4
+2 SET ABM("TYP")="D"
+3 DO PRIO
+4 SET ABM("INS")=$ORDER(^AUTNINS("B","MEDICAID",""))
+5 IF '+ABM("INS")
SET ABME(167)=""
QUIT
+6 SET ABM("MDFN")=""
+7 FOR
SET ABM("MDFN")=$ORDER(^AUPNMCD("B",DFN,ABM("MDFN")))
IF 'ABM("MDFN")
QUIT
DO 43
+8 QUIT
+9 ;
43 ;
+1 IF $PIECE($GET(^AUPNMCD(ABM("MDFN"),0)),U)=""
QUIT
+2 IF $PIECE($GET(^AUPNMCD(ABM("MDFN"),0)),U,2)=""
QUIT
+3 IF $PIECE($GET(^AUPNMCD(ABM("MDFN"),0)),U,4)=""
QUIT
+4 NEW ABMINS
+5 SET ABM("REC")=$GET(^AUPNMCD(ABM("MDFN"),0))
+6 SET ABMINS=$PIECE(ABM("REC"),U,2)
+7 Begin DoDot:1
+8 IF '$PIECE(ABM("REC"),U,4)
QUIT
+9 SET ABM("STATE")=$PIECE(ABM("REC"),U,4)
+10 IF '$DATA(^AUTNINS(ABMINS,13,ABM("STATE"),0))
SET ABME(101)=$PIECE(^DIC(5,ABM("STATE"),0),U)
QUIT
+11 SET ABM("INS")=$PIECE(^AUTNINS(ABMINS,13,ABM("STATE"),0),U,2)
+12 IF '$PIECE(ABM("REC"),"^",10)
QUIT
+13 ; Plan name
SET ABMPLAN=$$GET1^DIQ(9000004,ABM("MDFN"),.11)
+14 IF ABMINS=3
IF ABM("STATE")=3
IF ABMPLAN["KIDS"
SET ABM("INS")=$PIECE(ABM("REC"),U,10)
+15 IF ABMINS=3
IF ABM("STATE")=3
IF ABMPLAN["CHIP"
SET ABM("INS")=$PIECE(ABM("REC"),U,10)
+16 ; Piece 5 in the 3P ins file is USE PLAN NAME? field
+17 IF '$PIECE($GET(^ABMNINS(DUZ(2),ABM("INS"),0)),"^",5)
QUIT
+18 ; Piece 10 of Medicaid eligible file is Plan Name
+19 SET ABM("INS")=$PIECE(ABM("REC"),U,10)
End DoDot:1
IF 'ABM("INS")
QUIT
+20 ;If the insurer has been merged to another insurer use the one merged
+21 ;to.
+22 IF $PIECE($GET(^AUTNINS(ABM("INS"),2)),U,7)]""
SET ABM("INS")=$PIECE(^(2),U,7)
+23 KILL ABM("SUB")
+24 SET ABM("NDFN")=""
+25 ;If subfile 11 does not exist then no elig start and end date
+26 ; 39 ; Medicaid coverage; no eligibility date
+27 IF '+$ORDER(^AUPNMCD(ABM("MDFN"),11,0))
Begin DoDot:1
+28 DO CHK^ABMDLCK1
+29 SET ABM("XIT")=1
+30 SET $PIECE(ABML(99,ABM("INS")),U,6)=39
+31 DO UNCHK
+32 KILL ABM("XIT")
End DoDot:1
QUIT
+33 SET ABMELGDT=0
+34 SET ABM("NDFN")=0
+35 FOR
SET ABM("NDFN")=$ORDER(^AUPNMCD(ABM("MDFN"),11,ABM("NDFN")))
IF 'ABM("NDFN")
QUIT
Begin DoDot:1
+36 SET ABM("SUB")=^AUPNMCD(ABM("MDFN"),11,ABM("NDFN"),0)
+37 DO 44
End DoDot:1
+38 IF 'ABMELGDT
Begin DoDot:1
+39 IF '$DATA(ABML(ABM("PRI"),ABM("INS")))
Begin DoDot:2
+40 IF '$DATA(ABML(99,ABM("INS")))
Begin DoDot:3
+41 SET $PIECE(ABML(99,ABM("INS")),U)=$GET(ABM("MDFN"))
+42 SET $PIECE(ABML(99,ABM("INS")),U,2)=$GET(ABM("NDFN"))
+43 SET $PIECE(ABML(99,ABM("INS")),U,3)="D"
End DoDot:3
+44 SET $PIECE(ABML(99,ABM("INS")),U,6)=36
End DoDot:2
End DoDot:1
QUIT
+45 IF '$TEST
IF $DATA(ABML(ABM("PRI"),ABM("INS")))
IF ABM("PRI")<97
Begin DoDot:1
+46 KILL ABML(99,ABM("INS"))
End DoDot:1
+47 QUIT
+48 ;
44 ;
+1 ;ABM("NDFN") is the start date. 2nd piece of ABM("SUB") is end date
+2 IF ABM("NDFN")>$PIECE($SELECT(ABMDISDT
QUIT
+3 IF $PIECE(ABM("SUB"),U,2)]""
IF $PIECE(ABM("SUB"),U,2)<$PIECE(ABMVDT,".",1)
QUIT
+4 SET ABMELGDT=1
+5 SET ABM("COV")=$PIECE(ABM("SUB"),U,3)
+6 ;This is the coverage type from the 11 multiple from Medicaid elg file
+7 ;This must match the plan code in coverage type file.
+8 IF ABM("COV")]""
SET ABM("COV")=$ORDER(^AUTTPIC("AC",ABM("INS"),ABM("COV"),0))
+9 KILL ABM("XIT")
+10 DO CHK^ABMDLCK1
+11 IF $GET(ABM("XIT"))
DO UNCHK
+12 QUIT
+13 ;
5 ; Private Ins chk
+1 SET ABM("PRI")=$SELECT(ABM("EMPLOYED")=5:3,ABM("EMPLOYED")=1:1,1:2)
+2 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
IF ABM("VACHK")=1
SET ABM("PRI")=5
+3 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
SET ABM("TYP")="P"
+4 ;S:(ABM("VACHK")=0) ABM("TYP")="P" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+5 ;S:(ABM("VACHK")=1) ABM("TYP")="V" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+6 IF '$DATA(^AUPNPRVT(DFN))
QUIT
+7 SET ABM("MDFN")=0
+8 FOR
SET ABM("MDFN")=$ORDER(^AUPNPRVT(DFN,11,ABM("MDFN")))
IF 'ABM("MDFN")
QUIT
DO 53
+9 QUIT
+10 ;
53 ;
+1 KILL ABM("XIT")
+2 IF $PIECE($GET(^AUPNPRVT(DFN,11,ABM("MDFN"),0)),U)=""
QUIT
+3 IF '$DATA(^AUTNINS($PIECE(^AUPNPRVT(DFN,11,ABM("MDFN"),0),U),0))
QUIT
+4 ; 40 ; POV is accident related; but insurer is not
+5 SET ABM("REC")=^AUPNPRVT(DFN,11,ABM("MDFN"),0)
+6 SET ABM("INS")=$PIECE(ABM("REC"),U)
+7 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
IF (ABM("VACHK")=0)
IF ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABM("INS"),".211","I"),1,"I")="V")
QUIT
+8 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
IF (ABM("VACHK")=1)
IF ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABM("INS"),".211","I"),1,"I")'="V")
QUIT
+9 ;Q:ABMVDFN
IF 'ACCDENT
IF $$ACCREL^ABMDLCK(ABM("MDFN"))
Begin DoDot:1
+10 SET ABM("XIT")=1
+11 SET $PIECE(ABML(99,ABM("INS")),U,6)=40
End DoDot:1
+12 DO PRIO
+13 IF $PIECE(ABM("REC"),U,6)>$PIECE(ABMVDT,".",1)
Begin DoDot:1
+14 SET $PIECE(ABML(99,ABM("INS")),U,2)=ABM("MDFN")
+15 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
SET $PIECE(ABML(99,ABM("INS")),U,3)="P"
+16 ;S:(ABM("VACHK")=0) $P(ABML(99,ABM("INS")),U,3)="P" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+17 ;S:(ABM("VACHK")=1) $P(ABML(99,ABM("INS")),U,3)="V" ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+18 SET $PIECE(ABML(99,ABM("INS")),U,6)=37
End DoDot:1
QUIT
+19 IF $PIECE(ABM("REC"),U,7)]""
IF $PIECE(ABM("REC"),U,7)<$PIECE(ABMVDT,".",1)
Begin DoDot:1
+20 SET $PIECE(ABML(99,ABM("INS")),U,2)=ABM("MDFN")
+21 SET $PIECE(ABML(99,ABM("INS")),U,3)="P"
+22 SET $PIECE(ABML(99,ABM("INS")),U,6)=37
End DoDot:1
QUIT
+23 ;abm*2.6*2 quit if no policy holder
IF $PIECE(ABM("REC"),U,8)=""
QUIT
+24 SET ABM("COV")=$PIECE($GET(^AUPN3PPH($PIECE(ABM("REC"),U,8),0)),U,5)
+25 ;ABM("COV") is the ien of the coverage type file
+26 IF ABM("COV")
IF $PIECE($GET(^AUTTPIC(ABM("COV"),0)),U,5)
Begin DoDot:1
+27 SET ABM("MSUP",ABM("INS"))=""
+28 SET ABM("OPRI")=ABM("PRI")
+29 SET ABM("PRI")=4
End DoDot:1
+30 DO CHK^ABMDLCK1
+31 IF $DATA(ABM("OPRI"))
Begin DoDot:1
+32 SET ABM("PRI")=ABM("OPRI")
+33 KILL ABM("OPRI")
End DoDot:1
+34 IF $GET(ABM("XIT"))
DO UNCHK
+35 QUIT
+36 ;
6 ; Non-beneficiary Patient
+1 KILL ABM("XIT")
+2 ;S ABM("PRI")=5 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+3 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
SET ABM("PRI")=6
+4 SET ABM("TYP")="N"
+5 DO PRIO
+6 SET ABM("INS")=$ORDER(^AUTNINS("B","NON-BENEFICIARY PATIENT",""))
+7 IF '+ABM("INS")
SET ABME(169)=""
QUIT
+8 ;Piece 12 of node 11 is indian eligibility status. I means ineligible
+9 IF '$DATA(^AUPNPAT(DFN,11))
GOTO 7
IF ($PIECE(^(11),U,12)'="I")
GOTO 7
+10 SET (ABM("COV"),ABM("MDFN"))=""
+11 DO CHK^ABMDLCK1
+12 IF $GET(ABM("XIT"))
DO UNCHK
+13 QUIT
+14 ;
7 ; Beneficiary Patient
+1 KILL ABM("XIT")
+2 ;Piece 18 of 0 node is the "bill all pats" field
+3 NEW ABMBBENP,ABMPRI
+4 SET ABMBBENP=$PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,18)
SET ABMBDISP=$PIECE($GET(^(0)),"^",10)
+5 IF 'ABMBBENP
QUIT
+6 SET ABMPRI=$ORDER(ABML(0))
+7 ;Quit if other insurer found
IF ABMPRI>0&(ABMPRI<97)&('ABMBDISP)
QUIT
+8 ;Don't put an entry in ABML for bene pat if there another entry
+9 ;If bill all inpats check for visit type
+10 IF ABMBBENP=2&$DATA(SERVCAT)&("HID"'[$GET(SERVCAT))
QUIT
+11 IF ABMBBENP=2&$DATA(ABMP("VTYP"))&($GET(ABMP("VTYP"))'=111)
QUIT
+12 ;S ABM("PRI")=6 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+13 ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
SET ABM("PRI")=7
+14 SET ABM("TYP")="I"
+15 DO PRIO
+16 SET ABM("INS")=$ORDER(^AUTNINS("B","BENEFICIARY PATIENT (INDIAN)",""))
+17 IF '+ABM("INS")
QUIT
+18 SET (ABM("COV"),ABM("MDFN"))=""
+19 DO CHK^ABMDLCK1
+20 IF $GET(ABM("XIT"))
DO UNCHK
+21 QUIT
+22 ;
PRIO ;SET PRIORITY
+1 FOR
Begin DoDot:1
+2 IF '$DATA(ABML(ABM("PRI")))
QUIT
+3 SET ABM("PRI")=ABM("PRI")+1
End DoDot:1
IF '$DATA(ABML(ABM("PRI")))
QUIT
+4 QUIT
+5 ;
+6 ;ABM("XIT") serves as a flag that the priority needs to be 99
+7 ;
UNCHK ;EP-Instead of deleting the coverage for insurer represented by ien
+1 ;ABM("INS") the subroutine changes the priority for this insurer to
+2 ;99
+3 IF ABM("XIT")
Begin DoDot:1
+4 NEW P
+5 SET P=$SELECT($DATA(ABM("BEFSD"))=0:99,1:97)
+6 SET REASON=$PIECE($GET(ABML(P,ABM("INS"))),U,6)
+7 MERGE ABML(P,ABM("INS"))=ABML(ABM("PRI"),ABM("INS"))
+8 IF +REASON
SET $PIECE(ABML(P,ABM("INS")),U,6)=REASON
+9 KILL REASON
+10 KILL ABML(ABM("PRI"),ABM("INS"))
End DoDot:1
QUIT
+11 IF $DATA(ABML(99,ABM("INS")))
IF ABM("PRI")'=99
Begin DoDot:1
+12 IF ABM("CV")]""
SET ABML(ABM("PRI"),ABM("INS"),"COV",ABM("CV"))=""
+13 KILL ABML(99,ABM("INS"))
End DoDot:1
+14 QUIT
