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

ABMDE2X1.m

Go to the documentation of this file. 
  1. ABMDE2X1 ; IHS/SD/SDR - PAGE 2 - Primary Insurer Check ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**10,21**;NOV 12, 2009;Build 379
  1.  ;
  1.  ; IHS/ASDS/LSL - 01/09/02 - V2.4 Patch 10 
  1.  ;     Modified to allow pick option to function properly.  Thanks to Jim Gray for the research.
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT139641 - Changed 3P Insurer reference to use ABMP("LDFN"), not DUZ(2)
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1.  S ABMP("C0")=@(ABMP("GL")_"0)")
  1.  ;
  1. PRIM ;
  1.  S ABMP("INS")=""
  1.  I $P(ABMP("C0"),U,8)="",'$G(ABMP("DERP OPT")) D
  1.  .S ABMYES=0
  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 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")=@(ABMP("GL")_"0)")
  1.  I $P(ABMP("C0"),U,8)="" S ABME(111)="" G XIT
  1.  S ABMP("INS")=$P(ABMP("C0"),U,8)
  1.  K ABMP("FLAT"),ABMP("EXP"),ABMP("PX"),ABMP("FEE")
  1.  D ^ABMDE2X4
  1.  D FRATE
  1.  D EXP^ABMDE2X5
  1.  S:ABMP("BTYP")=121 ABMP("VTYP")=111
  1.  G XIT
  1.  ;
  1.  ; X6=EXPORT MODE^PROCDURE CODING METHOD^BILL TYPE^REVN CD^FLAT RATE
  1.  ;
  1. FRATE ;EP - Entry Point for setting up Flat Rate array if applicable
  1.  S ABMV("X6")=""
  1.  I '$D(ABMP("GL")) S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
  1.  ;I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,11),$P(^(0),U,11)=111!($P(^(0),U,11)=131) D  ;ABM*2.6*21 IHS/SD/AML HEAT139641
  1.  I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,11),$P(^(0),U,11)=111!($P(^(0),U,11)=131) D  ;ABM*2.6*21 IHS/SD/AML HEAT139641
  1.  .S DA(1)=ABMP("INS")
  1.  .S DA=ABMP("VTYP")
  1.  .S DIE="^ABMNINS("_DA(1)_",1,"
  1.  .S DR=".11////"_$S($P(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,11)=111:40,1:42)
  1.  .D ^DIE
  1.  D BTYP^ABMDEVAR
  1.  S $P(ABMV("X6"),"^",3)=ABMP("BTYP")
  1.  S:ABMP("BTYP")=121 ABMP("VTYP")=121
  1.  S ABMX("VDT")=$P($G(@(ABMP("GL")_"7)")),U)
  1.  ;start old abm*2.6*21 IHS/SD/AML HEAT139641
  1.  ;I '$D(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0)) G RT
  1.  ;S $P(ABMV("X6"),U,2)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,2)
  1.  ;S $P(ABMV("X6"),U,4)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,3)
  1.  ;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
  1.  I '$D(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0)) G RT
  1.  S $P(ABMV("X6"),U,2)=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,2)
  1.  S $P(ABMV("X6"),U,4)=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,3)
  1.  ;end new abm*2.6*21 IHS/SD/AML HEAT139641
  1.  I $P(ABMV("X6"),"^",4)="" D
  1.  .I ABMP("VTYP")=111 S $P(ABMV("X6"),"^",4)=100 Q
  1.  .I ABMP("VTYP")=121 S $P(ABMV("X6"),"^",4)=240 Q
  1.  .S $P(ABMV("X6"),"^",4)=510
  1.  I '$D(ABMP("EXP")) D EXP^ABMDEVAR
  1.  ;start old abm*2.6*21 IHS/SD/AML HEAT139641
  1.  ;I $D(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0)) D
  1.  ;.I $P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,4) D
  1.  ;..S $P(ABMV("X6"),U)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,4)
  1.  ;.I $P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,5) D
  1.  ;..S ABMP("FEE")=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,5)
  1.  ;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
  1.  I $D(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0)) D
  1.  .I $P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,4) D
  1.  ..S $P(ABMV("X6"),U)=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,4)
  1.  .I $P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,5) D
  1.  ..S ABMP("FEE")=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,5)
  1.  ;end new abm*2.6*21 IHS/SD/AML HEAT139641
  1.  ;I $D(ABMP("VTYP",999)),$P($G(^AUTNINS(ABMX("INS"),2)),U)="R" D  ;abm*2.6*10 HEAT73780
  1.  I $D(ABMP("VTYP",999)),($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMX("INS"),".211","I"),1,"I")="R") D  ;abm*2.6*10 HEAT73780
  1.  .S ABMX=0 F  S ABMX=$O(@(ABMP("GL")_"13,"_ABMX("INS")_",11,"_ABMX_")")) Q:'ABMX  I $P($G(^AUTTPIC(ABMX,0)),U,3)="B" S ABMX="OK" Q
  1.  .I ABMX'="OK" K ABMP("VTYP",999)
  1.  S ABMX=0
  1.  K ABMX("HIT")
  1.  S $P(ABMV("X6"),"^",5)=$$FLAT^ABMDUTL(ABMX("INS"),ABMP("VTYP"),ABMX("VDT"))
  1.  ;
  1. RT ; ABMP("FLAT")=Flat Rate^Revn^Units^Pro Fee^Pro Coding Method^Revn Desc^Desc Code^Prof Comp Days
  1.  I +$P(ABMV("X6"),U,5) D
  1.  .S ABMP("FLAT")=$P(ABMV("X6"),U,5)_U_$P(ABMV("X6"),U,4)
  1.  .S ABMP("FLAT")=ABMP("FLAT")_U_$S((ABMP("BTYP")=111!(ABMP("BTYP")=121))&($P($G(@(ABMP("GL")_"7)")),U,3)>0):$P($G(^(7)),U,3),ABMP("BTYP")=111:1,$P($G(^(6)),U,9)]"":$P(^(6),U,9),1:1)
  1.  ;I  S $P(ABMP("FLAT"),U,6)=$P($P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,9),"|"),$P(ABMP("FLAT"),U,7)=$P($P(^(0),U,9),"|",2)  ;abm*2.6*21 IHS/SD/AML HEAT139641
  1.  I  S $P(ABMP("FLAT"),U,6)=$P($P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,9),"|"),$P(ABMP("FLAT"),U,7)=$P($P(^(0),U,9),"|",2)  ;abm*2.6*21 IHS/SD/AML HEAT139641
  1.  Q:'$D(ABMP("FLAT"))
  1.  I $P($G(@(ABMP("GL")_"5)")),U,10)>0 S ABMP("FLAT",170)=$P(^(5),U,10)
  1.  I $D(ABMP("VTYP",999)) D
  1.  .S $P(ABMP("FLAT"),U,8)=$P($G(@(ABMP("GL")_"5)")),U,7)
  1.  .S:'$P(ABMP("FLAT"),U,8) $P(ABMP("FLAT"),U,8)=$P(ABMP("FLAT"),U,3)+3
  1.  .;S $P(ABMP("FLAT"),U,5)=$P($G(^ABMNINS(DUZ(2),ABMX("INS"),1,999,0)),U,2)  ;abm*2.6*21 IHS/SD/AML HEAT139641
  1.  .S $P(ABMP("FLAT"),U,5)=$P($G(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,999,0)),U,2)  ;abm*2.6*21 IHS/SD/AML HEAT139641
  1.  .S $P(ABMP("FLAT"),U,4)=$$FLAT^ABMDUTL(ABMX("INS"),999,ABMX("VDT"))
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. XIT ;
  1.  K ABMX
  1.  Q