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

ABMDE2E.m

Go to the documentation of this file.
  1. ABMDE2E ; IHS/SD/SDR - DSD/DMJ - Check visit for elig ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;**8,10,21**;NOV 12, 2009;Build 379
  1. ;
  1. ; IHS/ASDS/SDH - 06/08/01 - V2.4 Patch 9 - NOIS QDA-0399-130023
  1. ; Modified to update Mode of Export in Insurer has changed.
  1. ; IHS/ASDS/LSL - 07/25/01 - V2.4 Patch 9 - NOIS HQW-0798-100082
  1. ; Loop through all of ABML to update claim with unbillable
  1. ; insurers. Currently only loops if at least one good insurer.
  1. ; Only create new entry in Insurer multiple if billable insurer.
  1. ; Loop all eligibility occurances for PI (08/29/01)
  1. ; IHS/ASDS/SDH - 9/27/01 - V2.4 Patch 9 - NOIS XAA-0901-200095
  1. ; After moving Kidscare to Page 5 from Page 7 found that there are
  1. ; checks that are done for Medicaid that should also be done for
  1. ; Kidscare.
  1. ; IHS/ASDS/DMJ - 12/10/01 - V2.4 Patch 10 - NOIS HQW-1201-100014
  1. ; Loop PCC visit multiple (11) ignoring those that have been
  1. ; merged/deleted.
  1. ;
  1. ; IHS/SD/SDR - v2.5 p3 - 2/28/03 - QEA-0702-130030
  1. ; Modified to check for manually entered insurer
  1. ; IHS/SD/SDR V2.5 P5 - 3/10/2004
  1. ; Jim Gray provided code change to fix problem with with array not
  1. ; being killed before use.
  1. ; IHS/SD/SDR - v2.5 p8 - task 8
  1. ; Added code to check for replacment insurer
  1. ; IHS/SD/SDR - v2.5 p9 - IM17864
  1. ; Check if insurer is merged
  1. ; IHS/SD/SDR - v2.5 p10 - IM20320
  1. ; Added check to MERGECK to see if manually added insurer; if so,
  1. ; don't delete
  1. ;
  1. ;IHS/SD/SDR - 2.6*21 - HEAT137034 - Fixed code for DISPLAY UNBILLABLE INSURER site parameter. The check wasn't being
  1. ; done correctly so unbillable insurers were displaying all the time instead of when specified by parameter.
  1. ;IHS/SD/SDR - 2.6*21 - VMBP - RQMT_90 - Added code for 'V' insurer type.
  1. ;
  1. ; *********************************************************************
  1. ;
  1. S ABMP("VDT")=$P(ABMP("C0"),U,2)
  1. S ABMP("CLN")=$P(ABMP("C0"),U,6)
  1. S DFN=ABMP("PDFN")
  1. S ABMVDT=ABMP("VDT")
  1. S I=0
  1. F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,"AC","P",I)) Q:'I D
  1. .Q:$P($G(^AUPNVSIT(I,0)),"^",11)
  1. .S ABMVDFN=I
  1. S:'$G(ABMVDFN) ABMVDFN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,0))
  1. D ELG^ABMDLCK(ABMVDFN,.ABML,DFN,ABMVDT)
  1. D MERGECK
  1. ;
  1. ENT ;EP - Entry Point to update Elig Info
  1. S ABM("PRI")=""
  1. F S ABM("PRI")=$O(ABML(ABM("PRI"))) Q:'ABM("PRI") D INS
  1. ;
  1. HITCHK ;HIT CHECK
  1. N I
  1. ;start old code abm*2.6*8
  1. ;S I=0
  1. ;F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I)) Q:'I D
  1. ;.I '$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U) D Q
  1. ;..K ^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)
  1. ;.S ABM("INS")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U)
  1. ;.S ABM("ITYPE")=$P($G(^AUTNINS(ABM("INS"),2)),U)
  1. ;.I ABM("ITYPE")="D"!(ABM("ITYPE")="K") D DCFX^ABMDEFIP(ABMP("CDFN"),I)
  1. ;.D HITCHK2
  1. ;end old code start new code
  1. N K
  1. S K=0
  1. F S K=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",K)) Q:'K D
  1. .S I=0
  1. .F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",K,I)) Q:'I D
  1. ..I '$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U) D Q
  1. ...K ^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)
  1. ..S ABM("INS")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U)
  1. ..;S ABM("ITYPE")=$P($G(^AUTNINS(ABM("INS"),2)),U) ;abm*2.6*10 HEAT73780
  1. ..S ABM("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
  1. ..I ABM("ITYPE")="D"!(ABM("ITYPE")="K") D DCFX^ABMDEFIP(ABMP("CDFN"),I)
  1. ..D HITCHK2
  1. ;end new code
  1. G PRIM
  1. ;
  1. ; *********************************************************************
  1. HITCHK2 ;
  1. K ABM("HIT")
  1. S ABM("PRI")=""
  1. F S ABM("PRI")=$O(ABML(ABM("PRI"))) Q:'ABM("PRI") D HITCHK3
  1. I $D(ABM("HIT")) Q
  1. I $G(ABMP("DERP OPT")) Q ;No editing from inq
  1. I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U)'="Y" D
  1. .I '$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3) D
  1. ..I "FPUI"[$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U,3),$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0)),U,9)!($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="F") D
  1. ...S DA=I
  1. ...D KILL
  1. ..;I ABM("INS")'=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8) D ;abm*2.6*8
  1. ..I ABM("INS")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8),($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U,3)="U") D ;abm*2.6*8
  1. ...S DA=ABMP("CDFN")
  1. ...S DIE="^ABMDCLM(DUZ(2),"
  1. ...S DR=".08///@"
  1. ...D ^DIE
  1. ...K DR
  1. Q
  1. ;
  1. ; *********************************************************************
  1. HITCHK3 ;
  1. S ABM("FINS")=""
  1. F S ABM("FINS")=$O(ABML(ABM("PRI"),ABM("FINS"))) Q:'ABM("FINS") D
  1. . I ABM("FINS")=ABM("INS") S ABM("HIT")=""
  1. Q
  1. ;
  1. ; *********************************************************************
  1. INS ;
  1. S ABM("INS")=""
  1. F S ABM("INS")=$O(ABML(ABM("PRI"),ABM("INS"))) Q:'ABM("INS") D ADDCHK
  1. Q
  1. ;
  1. MERGECK ;mark entries unbillable that aren't in eligibility array
  1. Q:("CU"[$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)) ;quit if billed/complete
  1. S ABMIIEN=0
  1. F S ABMIIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMIIEN)) Q:+ABMIIEN=0 D
  1. .S ABMPRI=0,ABMMATCH=0
  1. .F S ABMPRI=$O(ABML(ABMPRI)) Q:+ABMPRI=0 D
  1. ..I $O(ABML(ABMPRI,0))=ABMIIEN S ABMMATCH=1
  1. .I ABMMATCH'=1 D
  1. ..;start old code abm*2.6*8 HEAT37612
  1. ..;S DA(1)=ABMP("CDFN")
  1. ..;S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMIIEN,0))
  1. ..;Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,DA,0)),U,9)="Y"
  1. ..;S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1. ..;D ^DIK
  1. ..;end old code start new code HEAT37612
  1. ..S DA(1)=ABMP("CDFN")
  1. ..S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMIIEN,0))
  1. ..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,DA,0)),U,9)="Y"
  1. ..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,DA,0)),U,3)="C"
  1. ..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1. ..S DR=".03////U" ;set status to unbillable if not returned in elig array
  1. ..D ^DIE
  1. ..;end new code HEAT37612
  1. Q
  1. ; *********************************************************************
  1. ADDCHK ; EP
  1. I (ABM("PRI")>96)&'$D(^ABMDPARM(DUZ(2),1,6,ABM("INS")))&(+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABM("INS"),0))=0) Q ;abm*2.6*21 IHS/SD/SDR HEAT137034
  1. I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABM("INS"))) D Q
  1. .;I ABM("PRI")>96,'$D(^ABMDPARM(DUZ(2),1,6,ABM("INS"))) Q ;abm*2.6*21 IHS/SD/SDR HEAT137034
  1. .D ADD
  1. .D COVCHK
  1. I $P(ABML(ABM("PRI"),ABM("INS")),"^",3)="P" D
  1. .N I
  1. .S I=0
  1. .S ABM("ADD")=1
  1. .F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I)) Q:'I D
  1. ..Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),U)'=ABM("INS")
  1. ..I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,I,0),"^",8)=$P(ABML(ABM("PRI"),ABM("INS")),"^",2) K ABM("ADD")
  1. ;I $G(ABM("ADD")),ABM("PRI")<97 D Q ;abm*2.6*21 IHS/SD/SDR HEAT137034
  1. I $G(ABM("ADD"))&((ABM("PRI")<97)!((ABM("PRI")>96)&($D(^ABMDPARM(DUZ(2),1,6,ABM("INS")))))) D Q ;if priority is <97 or if priority is greater than 96 and display unbillable insurer ;abm*2.6*21 IHS/SD/SDR HEAT137034
  1. .D ADD
  1. .D COVCHK
  1. S DA(1)=ABMP("CDFN")
  1. S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1. I '$G(ADD),$P(ABML(ABM("PRI"),ABM("INS")),U,3)="P" D Q
  1. .S DA=0
  1. .F S DA=$O(^ABMDCLM(DUZ(2),DA(1),13,"B",ABM("INS"),DA)) Q:'+DA D
  1. ..Q:$P(^ABMDCLM(DUZ(2),DA(1),13,DA,0),U,8)'=$P(ABML(ABM("PRI"),ABM("INS")),U,2)
  1. ..D UPDATE
  1. S DA=$O(^ABMDCLM(DUZ(2),DA(1),13,"B",ABM("INS"),0))
  1. Q:'+DA
  1. D UPDATE
  1. Q
  1. ;
  1. ; *********************************************************************
  1. UPDATE ;
  1. K ^ABMDCLM(DUZ(2),DA(1),13,DA,11)
  1. I $P(^ABMDCLM(DUZ(2),DA(1),13,DA,0),U,3)="U",ABM("PRI")<97 D G COVCHK
  1. .S DR=".03////P"
  1. .D ^DIE
  1. I "IP"[$P(^ABMDCLM(DUZ(2),DA(1),13,DA,0),U,3),ABM("PRI")>96 D
  1. .S DR=".03////U"
  1. .D ^DIE
  1. ;
  1. COVCHK ;
  1. S ABM("C")=""
  1. F S ABM("C")=$O(ABML(ABM("PRI"),ABM("INS"),"COV",ABM("C"))) Q:'ABM("C") D
  1. .I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,DA,11,ABM("C"),0)) D ADDCOV
  1. Q
  1. ;
  1. ; *********************************************************************
  1. ADD ;EP - Entry Pont for adding Elig Info to Claim
  1. K DIC
  1. S (ABM("L"),ABML("I"))=0
  1. F S ABML("I")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABML("I"))) Q:'ABML("I") S:$P(^(ABML("I"),0),U,2)>ABM("L") ABM("L")=$P(^(0),U,2)
  1. K ABML("I")
  1. S ABM("L")=ABM("L")+1
  1. S DA(1)=ABMP("CDFN")
  1. S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1. S DIC(0)="LE"
  1. S DIC("P")=$P(^DD(9002274.3,13,0),U,2)
  1. I ABM("L")=1,'$D(ABML(97)) S ABM("STATUS")="I"
  1. E S ABM("STATUS")="P"
  1. S:ABM("PRI")>96 ABM("STATUS")="U"
  1. S X=ABM("INS")
  1. S DIC("DR")=".02///"_ABM("L")_";.03///"_ABM("STATUS")
  1. I $P(ABML(ABM("PRI"),ABM("INS")),U,3)?1(1"P",1"A",1"W") D
  1. .S DIC("DR")=DIC("DR")_";.08////"_$P(ABML(ABM("PRI"),ABM("INS")),U,2)
  1. I $P(ABML(ABM("PRI"),ABM("INS")),U,3)="M" D
  1. .S DIC("DR")=DIC("DR")_";.04////"_$P(ABML(ABM("PRI"),ABM("INS")),U,2)
  1. I $P(ABML(ABM("PRI"),ABM("INS")),U,3)="R" D
  1. .S DIC("DR")=DIC("DR")_";.05////"_$P(ABML(ABM("PRI"),ABM("INS")),U,2)
  1. I $P(ABML(ABM("PRI"),ABM("INS")),U,3)="D" D
  1. .S DIC("DR")=DIC("DR")_";.06////"_$P(ABML(ABM("PRI"),ABM("INS")),U,1)
  1. .S DIC("DR")=DIC("DR")_";.07////"_$P(ABML(ABM("PRI"),ABM("INS")),U,2)
  1. I $P(ABML(ABM("PRI"),ABM("INS")),U,7)="M" D
  1. .S DIC("DR")=DIC("DR")_";.09////Y"
  1. ;start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
  1. I $P(ABML(ABM("PRI"),ABM("INS")),U,3)="V" D
  1. .S DIC("DR")=DIC("DR")_";.013////"_$P(ABML(ABM("PRI"),ABM("INS")),U,2)
  1. ;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
  1. K DD,DO
  1. D FILE^DICN
  1. S (DA,ABM("XIEN"))=+Y
  1. K DIC
  1. Q
  1. ;
  1. ; *********************************************************************
  1. ADDCOV ; EP for adding Coverage Types
  1. I ABM("C")]"",$D(^AUTTPIC(ABM("C"),0)),$P(^(0),U,2)=ABM("INS")
  1. E Q
  1. K DIC
  1. S DA(1)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABM("INS"),0))
  1. S DA(2)=ABMP("CDFN")
  1. S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",13,"_DA(1)_",11,"
  1. S DIC(0)="LE"
  1. S DIC("P")=$P(^DD(9002274.3013,11,0),U,2)
  1. K DD,DO,DR,DIC("DR")
  1. S (X,DINUM)=ABM("C")
  1. K DD,DO
  1. D FILE^DICN
  1. K DIC
  1. Q
  1. ;
  1. ; *********************************************************************
  1. KILL ;
  1. S DA(1)=ABMP("CDFN")
  1. S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1. D ^DIK
  1. I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)=ABM("INS") D
  1. .S DA=ABMP("CDFN")
  1. .S DIE="^ABMDCLM(DUZ(2),"
  1. .S DR=".08///@"
  1. .D ^DIE
  1. .K DR
  1. Q
  1. ;
  1. ; *********************************************************************
  1. PRIM ; Changed code under this line tag for readability in addition to those
  1. ; changes documented.
  1. ;
  1. S ABMYES=0
  1. S ABMP("INS")=""
  1. S ABM("DR")=""
  1. F S ABM("DR")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM("DR"))) Q:'ABM("DR") D Q:'ABM("DR")
  1. .S ABM("DA")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM("DR"),""))
  1. .Q:ABM("DA")=""
  1. .Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0))
  1. .K ABM("DRI")
  1. .S ABM("I0")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0))
  1. .I "UCB"[$P(ABM("I0"),U,3) Q
  1. .S ABM("INSCO")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0),U)
  1. .I +ABMYES,$P(ABM("I0"),U,3)="I" S ABM("DRI")=".03////P"
  1. .I '+ABMYES D
  1. ..I $P(ABM("I0"),U,3)'="I" D
  1. ...S ABM("DRI")=".03////I"
  1. ..S ABMYES=1
  1. ..I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)'=ABM("INSCO") D
  1. ...S ABMINSCK=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABM("INSCO"),0))
  1. ...;replacement insurer?
  1. ...Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSCK,0)),U,11)
  1. ...S DIE="^ABMDCLM(DUZ(2),"
  1. ...S DA=ABMP("CDFN")
  1. ...S DR=".08////^S X=ABM(""INSCO"")"
  1. ...D ^DIE
  1. ...K DR
  1. .I $D(ABM("DRI")) D
  1. ..S DA(1)=ABMP("CDFN")
  1. ..S DA=ABM("DA")
  1. ..S DR=ABM("DRI")
  1. ..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1. ..D ^DIE
  1. ..K DR
  1. S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
  1. I $P(ABMP("C0"),U,8)="" S ABME(111)="" G XIT
  1. S ABMP("INS")=$P(ABMP("C0"),U,8)
  1. S ABMTEXP=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,4)
  1. Q:ABMTEXP=""
  1. S ABMP("EXP")=ABMTEXP
  1. S DIE="^ABMDCLM(DUZ(2),"
  1. S DA=ABMP("CDFN")
  1. S DR=".14////"_ABMP("EXP")
  1. D ^DIE
  1. K DR
  1. ;
  1. XIT ;
  1. K ABML
  1. Q