Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDLCK2

ABMDLCK2.m

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