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

ABMDE1X.m

Go to the documentation of this file. 
  1. ABMDE1X ; IHS/ASDST/DMJ - SCRN 1 - CLaim Iden Data Ck ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**10,11**;NOV 12, 2009;Build 133
  1.  ;
  1.  ;IHS/DSD/DMJ  - 03/23/98 - Modified to clear an undef error.
  1.  ;add $G around expression
  1.  ;
  1.  ; IHS/SD/SDR - 10/30/02 - V2.5 P2 - QXX-0402-130120
  1.  ;     Modified to make error codes 11 and 105 more specific when
  1.  ;     checking for data
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1.  K ABME
  1.  S ABME("CTR")=0
  1.  S (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
  1.  I '$D(ABMP("DERP OPT")) D
  1.  .I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,6)="" D
  1.  ..S DIE="^ABMDCLM(DUZ(2),"
  1.  ..S DA=ABMP("CDFN")
  1.  ..S DR=".06////1"
  1.  ..D ^DIE
  1.  .I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",14)="" D
  1.  ..S DIE="^ABMDCLM(DUZ(2),"
  1.  ..S DA=ABMP("CDFN")
  1.  ..S DR=".14////"_$G(ABMP("EXP"))
  1.  ..D ^DIE
  1.  ;
  1. D ;EP
  1.  S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
  1.  N I
  1.  F I=1:1:14 S ABM(I)=$P(ABMP("C0"),"^",I)
  1.  S ABMP("VTYP")=ABM(7)
  1.  S:ABMP("VTYP")]"" ABM(7)=$P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)
  1.  S ABMP("LDFN")=ABM(3)
  1.  S ABM(71)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U)
  1.  S ABM(72)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)
  1.  I $E(ABM(71),6,7)="00"!($E(ABM(72),6,7)="00") S ABME(242)=""  ;abm*2.6*10 HEAT65628
  1.  S ABMP("VDT")=ABM(71)
  1.  I ABM(6)]"",$D(^DIC(40.7,ABM(6),0)) S ABM(6)=$P(^(0),U,1)
  1.  E  S ABME(106)=""
  1.  S ABM("PN")=$P(^DPT(ABMP("PDFN"),0),U)
  1.  S ABMP("DOB")=$P(^DPT(ABMP("PDFN"),0),U,3)
  1.  I $G(^DPT(ABMP("PDFN"),.35)) S ABMP("DOD")=$P(^DPT(ABMP("PDFN"),.35),U)
  1.  ;
  1. EMODE ;
  1.  S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
  1.  I ABMP("EXP")<21,(ABMNPIUS="B"!(ABMNPIUS="N")) S ABME(222)=""
  1. DOB ;
  1.  S X2=ABMP("DOB")
  1.  S X1=DT
  1.  D ^%DTC
  1.  K DIC
  1.  ;I (X\365)>100,'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,38,0)) D
  1.  ;.S (DINUM,X)=38
  1.  ;.S DA(1)=ABMP("CDFN")
  1.  ;.S DIC="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_",53,"
  1.  ;.S DIC(0)="LE"
  1.  ;.S DIC("P")=$P(^DD(9002274.3,53,0),U,2)
  1.  ;.K DD,DO
  1.  ;.D FILE^DICN
  1.  I ABM(71)]"" S ABM(71)=$$SDT^ABMDUTL(ABM(71))
  1.  I ABM(72)]"" S ABM(72)=$$SDT^ABMDUTL(ABM(72))
  1.  E  S ABME(107)=""
  1.  S ABMP("VISTDT")=ABM(71)
  1.  D PAT
  1.  D REMPL^ABMDE1X1
  1.  D LOC^ABMDE1X1
  1.  G XIT
  1.  ;
  1.  ; X2=PDFN;NAME (HRN)^SEX^ADDR 1^ADDR 2^PHONE^DOB^MARTIAL STATUS
  1.  ;
  1. PAT ;EP - Entry Point for setting X2 array for Registered Patient
  1.  I '$D(^DPT(ABMP("PDFN"),0)) S ABME(10)="" Q
  1.  ;
  1. HRN ;
  1.  S ABMV("X2")=ABMP("PDFN")_";"_$P(^DPT(ABMP("PDFN"),0),U,1)
  1.  I ABMP("LDFN")]"" S ABMV("X2")=ABMV("X2")_$S($D(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)):" ("_$P(^(0),U,2)_")",1:" (no HRN)")
  1.  S $P(ABMV("X2"),U,2)=$P(^DPT(ABMP("PDFN"),0),U,2)
  1.  S $P(ABMV("X2"),U,6)=$$HDT^ABMDUTL($P(^DPT(ABMP("PDFN"),0),U,3))
  1.  S $P(ABMV("X2"),U,7)=$S($P($G(^AUPNPAT(ABMP("PDFN"),2)),U,2):"M;MARRIED",1:"U;UNKNOWN")
  1.  ;I $P(ABMV("X2"),U,2)="" S ABME(13)=""  ;abm*2.6*11 MU2 gender
  1.  I $P(ABMV("X2"),U,2)=""!($P(ABMV("X2"),U,2)="U") S ABME(13)=""  ;abm*2.6*11 MU2 gender
  1.  I $P(ABMV("X2"),U,6)="" S ABME(12)=""
  1.  I ABMP("VDT")]"" D
  1.  .I $G(^DPT(ABMP("PDFN"),.35)) D
  1.  ..I ABMP("VDT")>$P(^DPT(ABMP("PDFN"),.35),U) D
  1.  ...S ABME(102)=""
  1.  I '+$D(^DPT(ABMP("PDFN"),.11)) S ABME(11)="" Q
  1.  I +$D(^DPT(ABMP("PDFN"),.11)) D
  1.  .I '($P(^DPT(ABMP("PDFN"),.11),U)]"") S ABME(11)="" Q
  1.  .I '($P(^DPT(ABMP("PDFN"),.11),U,4)]"") S ABME(11)="" Q
  1.  .I '($P(^DPT(ABMP("PDFN"),.11),U,5)]"") S ABME(11)="" Q
  1.  .I '($P(^DPT(ABMP("PDFN"),.11),U,6)]"") S ABME(11)="" Q
  1.  .S $P(ABMV("X2"),U,3)=$P(^DPT(ABMP("PDFN"),.11),U)
  1.  .S $P(ABMV("X2"),U,4)=$P(^DPT(ABMP("PDFN"),.11),U,4)_", "
  1.  Q:$D(ABME(11))
  1.  I $P(^DPT(ABMP("PDFN"),.11),U,5)]"" D
  1.  . I $D(^DIC(5,$P(^DPT(ABMP("PDFN"),.11),U,5),0)) D  Q
  1.  ..S $P(ABMV("X2"),U,4)=$P(ABMV("X2"),U,4)_$P(^DIC(5,$P(^DPT(ABMP("PDFN"),.11),U,5),0),U,2)_"  "_$P(^DPT(ABMP("PDFN"),.11),U,6)
  1.  ..S:$D(^DPT(ABMP("PDFN"),.13)) $P(ABMV("X2"),U,5)=$P(^DPT(ABMP("PDFN"),.13),U)
  1.  .S ABME(11)=""
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. XIT ;
  1.  K ABMX
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. ERR ;
  1.  D ABMDE1X
  1.  S ABME("TITL")="PAGE 1 - CLAIM IDENTIFIERS"
  1.  K ABMV,ABMX,ABM
  1.  Q