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

ABMDE2X3.m

Go to the documentation of this file. 
  1. ABMDE2X3 ; IHS/SD/SDR - PAGE 2 - INSURER DATA CK PART 3 ;    
  1.  ;;2.6;IHS Third Party Billing System;**3,8,10,11,13**;NOV 12, 2009;Build 213
  1.  ;
  1.  ; IHS/ASDS/DMJ - 10/04/00 - V2.4 P3 - NOIS HQW-1000-100062 - Modified code to be CACHE compliant
  1.  ;
  1.  ; IHS/SD/SDR - 10/30/02 - V2.5 P2 - QXX-0402-130120 - Updated error codes 11 and 105 so they would
  1.  ;  be a little more specific and come on if none of the data was there instead of just checking the pieces
  1.  ; IHS/SD/SDR - v2.5 p11 - IM22822 - Fixed <UNDEF>REMPL+16^ABMDE2X3
  1.  ;
  1.  ;IHS/SD/SDR - abm*2.6*3 - HEAT8996 - made group number/name print for Medicaid
  1.  ;IHS/SD/SDR - 2.6*13 - new export mode 35 - added code for worker's compensation group name
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1.  ; X2=PHDFN;NAME^RDFN;RELATIONSHIP^ADDR1^ADDR2^PHONE^SEX^DOB
  1.  ; X3=EMPLOYER^ADDR1^ADDR2^PHONE^STATUS^GROUP^GROUP #^EMPL #
  1.  ;
  1.  S ABMVREL=$P(ABMV("X2"),"^",2)
  1.  I $P(ABMVREL,";",2)="SELF"&($P(ABMV("X1"),U,5)]"") D  G XIT
  1.  .S $P(ABMVREL,";",2)=$P(ABMV("X1"),"^",5)
  1.  .S $P(ABMV("X2"),"^",2)=ABMVREL
  1.  I $P(ABMV("X2"),U)]"" G XIT
  1.  ;
  1.  ;start new code abm*2.6*3 HEAT8996
  1. GRP ;
  1.  ;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="D" D  ;abm*2.6*8 HEAT37612
  1.  ;I +$G(ABMP("INS"))'=0,$P($G(^AUTNINS(ABMP("INS"),2)),U)="D" D  ;abm*2.6*8 HEAT37612  ;abm*2.6*10 HEAT73780
  1.  I +$G(ABMP("INS"))'=0,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D" D  ;abm*2.6*8 HEAT37612  ;abm*2.6*10 HEAT73780
  1.  .S:(+$G(ABMX("2"))'=0) ABMX("GRP")=$P($G(^AUPNMCD(+ABMX("2"),0)),U,17)
  1.  .I $G(ABMX("GRP"))]"" D
  1.  ..I $D(^AUTNEGRP(ABMX("GRP"),0)) D
  1.  ...S $P(ABMV("X3"),U,6)=$P(^AUTNEGRP(ABMX("GRP"),0),U)
  1.  ...S $P(ABMV("X3"),U,7)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2))
  1.  ;end new code abm*2.6*3 HEAT8996
  1.  ;
  1. REG ;
  1.  S ABMX("HDFN")=ABMP("PDFN")
  1.  S ABMV("X2")=ABMP("PDFN")_";"_$S($P(ABMV("X1"),U,5)]"":$P(ABMV("X1"),U,5),1:$P(^DPT(ABMP("PDFN"),0),U))
  1.  I $P(^DPT(ABMP("PDFN"),0),U,2)]"" S $P(ABMV("X2"),U,6)=$P(^(0),U,2)
  1.  ;E  S ABME(13)=""  ;abm*2.6*11 MU2 gender
  1.  I $P(^DPT(ABMP("PDFN"),0),U,2)=""!($P(^DPT(ABMP("PDFN"),0),U,2)="U") S ABME(13)=""  ;abm*2.6*11 MU2 gender
  1.  S $P(ABMV("X2"),U,7)=$P(^DPT(ABMP("PDFN"),0),U,3)
  1.  S $P(ABMV("X2"),U,2)=$O(^AUTTRLSH("B","SELF",""))_";SELF"
  1.  I '+$D(^DPT(ABMX("HDFN"),.11)) S ABME(11)="" Q
  1.  I +$D(^DPT(ABMX("HDFN"),.11)) D
  1.  .I '($P(^DPT(ABMX("HDFN"),.11),U)]"") S ABME(11)="" Q
  1.  .I '($P(^DPT(ABMX("HDFN"),.11),U,4)]"") S ABME(11)="" Q
  1.  .I '($P(^DPT(ABMX("HDFN"),.11),U,5)]"") S ABME(11)="" Q
  1.  .I '($P(^DPT(ABMX("HDFN"),.11),U,6)]"") S ABME(11)="" Q
  1.  .S $P(ABMV("X2"),U,3)=$P(^DPT(ABMX("HDFN"),.11),U)
  1.  .S $P(ABMV("X2"),U,4)=$P(^DPT(ABMX("HDFN"),.11),U,4)_", "
  1.  I $D(ABME(11)) G REMPL
  1.  I $P(^DPT(ABMX("HDFN"),.11),U,5)]"" D
  1.  .I $D(^DIC(5,$P(^DPT(ABMX("HDFN"),.11),U,5),0)) D
  1.  ..S $P(ABMV("X2"),U,4)=$P(ABMV("X2"),U,4)_$P(^DIC(5,$P(^DPT(ABMX("HDFN"),.11),U,5),0),U,2)_"  "_$P(^DPT(ABMX("HDFN"),.11),U,6)
  1.  ..S:$D(^DPT(ABMX("HDFN"),.13)) $P(ABMV("X2"),U,5)=$P(^DPT(ABMX("HDFN"),.13),U)
  1.  E  S ABME(11)=""
  1.  ;
  1. REMPL ; X3=EMPLOYER;ADDR 1^ADDR 2^PHONE^STATUS
  1.  ;
  1.  I $P(^AUPNPAT(ABMX("HDFN"),0),U,19)]"" D
  1.  .I $D(^AUTNEMPL($P(^AUPNPAT(ABMX("HDFN"),0),U,19),0)) D
  1.  ..S ABMX("Y")=^AUTNEMPL($P(^AUPNPAT(ABMX("HDFN"),0),U,19),0)
  1.  ..S $P(ABMV("X3"),U)=$P(ABMX("Y"),U)
  1.  E  S ABME(73)="" G XIT
  1.  I $D(ABMX("Y")) D
  1.  .I '($P(ABMX("Y"),U,2)]"") S ABME(75)="" Q
  1.  .I '($P(ABMX("Y"),U,3)]"") S ABME(75)="" Q
  1.  .I '($P(ABMX("Y"),U,4)]"") S ABME(75)="" Q
  1.  .I '($P(ABMX("Y"),U,5)]"") S ABME(75)="" Q
  1.  .S $P(ABMV("X3"),U,2)=$P(ABMX("Y"),U,2)
  1.  .S $P(ABMV("X3"),U,3)=$P(ABMX("Y"),U,3)_", "
  1.  .I $D(^DIC(5,$P(ABMX("Y"),U,4),0)) D
  1.  ..S $P(ABMV("X3"),U,3)=$P(ABMV("X3"),U,3)_$P(^DIC(5,$P(ABMX("Y"),U,4),0),U,2)_"  "_$P(ABMX("Y"),U,5)
  1.  .S $P(ABMV("X3"),U,4)=$P(ABMX("Y"),U,6)
  1.  S ABMX("Y")=$P(^AUPNPAT(ABMX("HDFN"),0),U,21)
  1.  I ABMX("Y")="" S ABME(72)="" G XIT
  1.  S ABMX("Y0")=$P(^DD(9000001,.21,0),U,3)
  1.  S ABMX("Y0")=$P(ABMX("Y0"),ABMX("Y")_":",2)
  1.  S ABMX("Y0")=$P(ABMX("Y0"),";",1)
  1.  S $P(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
  1.  ;start new abm*2.6*13 exp mode 35
  1.  I ABMITYP="W" D
  1.  .I $G(^AUPNWC(ABMP("PDFN"),0))'="" D  ;entry in 9000042-Workman's Comp
  1.  ..S ABMWCIEN=0
  1.  ..F  S ABMWCIEN=$O(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN)) Q:+ABMWCIEN=0  D  Q:$D(ABMLW)
  1.  ...S ABMWEFDT=$P($G(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,12)
  1.  ...S ABMWEXDT=$P($G(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,13)
  1.  ...I ABMWEFDT>$P($S($G(ABMDISDT):ABMDISDT,1:ABMP("VDT")),".",1) Q
  1.  ...I ABMWEXDT'="",ABMWEXDT<$P(ABMP("VDT"),".",1) Q
  1.  ...S $P(ABMV("X3"),U,6)=$$GET1^DIQ(9999999.77,$P($G(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,11),".01","E")
  1.  ;end new exp mode 35
  1.  ;
  1. XIT ;
  1.  Q