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

IBCNBMN.m

Go to the documentation of this file.
  1. IBCNBMN ;ALB/ARH-Ins Buffer: add new insurance file entrys ; 4/22/03 10:00am
  1. ;;2.0;INTEGRATED BILLING;**82,211,519**;21-MAR-94;Build 56
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. NEWINS(IBBUFDA) ; add new insurance carrier entry in Insurance Company (#36) file
  1. ;
  1. N DIC,DA,DIE,DR,X,Y,DLAYGO,IBINSDA,IB20,IBINSNM,IBREIMB S IBINSDA=0,IB20=$G(^IBA(355.33,+$G(IBBUFDA),20))
  1. S IBINSNM=$P(IB20,U,1) I IBINSNM="" G NIQ
  1. ;
  1. S IBREIMB=$P(IB20,U,5) I IBREIMB'="" S DIC("DR")="1///"_IBREIMB ; will reimburse?
  1. K DD,DO S DIC="^DIC(36,",DIC(0)="L",X=IBINSNM,DLAYGO=36 D FILE^DICN I +Y>0 S IBINSDA=+Y
  1. ;
  1. NIQ Q IBINSDA
  1. ;
  1. NEWGRP(IBBUFDA,IBINSDA) ; add a new group/plan to the Group Insurance Plan (#355.3) file, also add standard fields
  1. ;
  1. N DIC,DA,DR,DIE,X,Y,DLAYGO,IBGRPDA,IB40,IBFIELDS,IBERR,IBXIFN S IBGRPDA=0,IB40=$G(^IBA(355.33,+$G(IBBUFDA),40))
  1. I '$D(^DIC(36,+$G(IBINSDA),0)) G NGQ
  1. I $P(IB40,U,1)=0,'$G(^IBA(355.33,+$G(IBBUFDA),60)) G NGQ
  1. ;
  1. K DA,DO S DIC="^IBA(355.3,",DIC(0)="L",X=IBINSDA,DLAYGO=355.3 D FILE^DICN I +Y'>0 G NGQ
  1. S IBGRPDA=+Y,IBXIFN=IBGRPDA_","
  1. ;
  1. S IBFIELDS(355.3,IBXIFN,.02)=$P(IB40,U,1) ; group plan?
  1. I $P(IB40,U,1)=0 S IBFIELDS(355.3,IBXIFN,.1)=+$G(^IBA(355.33,+$G(IBBUFDA),60)) ; individual plan patient
  1. D FILE^DIE("","IBFIELDS","IBERR")
  1. ;
  1. ; IB*2.0*519: If new group added, check to see if we already have a NIF ID for this insurance company.
  1. ; if no NIF and we have not yet requested one, send an HL7
  1. I '$$NIF^IBCNHUT1(+$G(IBINSDA)),'$D(^IBCNH(367.1,"INS",+$G(IBINSDA))) D SEND^IBCNHHLO(+$G(IBINSDA))
  1. ;
  1. NGQ Q IBGRPDA
  1. ;
  1. NEWPOL(IBBUFDA,IBINSDA,IBGRPDA) ; add a new patient policy to the Patient's Insurance Policys (2.312), also add standard fields
  1. ;
  1. N DIC,DA,DR,DIE,X,Y,IBPOLDA,IBFIELDS,IBERR,DFN,IBGRP,IBXIFN S IBPOLDA=0
  1. I '$D(^DIC(36,+$G(IBINSDA),0)) G NPQ
  1. S IBGRP=$G(^IBA(355.3,+$G(IBGRPDA),0)) I +IBGRP'=IBINSDA G NPQ
  1. S DFN=+$G(^IBA(355.33,+$G(IBBUFDA),60)) I 'DFN G NPQ
  1. I $P(IBGRP,U,10)'="",$P(IBGRP,U,10)'=DFN G NPQ
  1. ;
  1. ; IB*2*211
  1. L +^DPT(DFN,.312):5 I '$T D LOCKED^IBTRCD1 G NPQ
  1. I $G(^DPT(DFN,.312,0))="" S ^DPT(DFN,.312,0)="^2.312PAI^^"
  1. ;
  1. K DA,DO S DIC="^DPT("_DFN_",.312,",DIC(0)="L",X=IBINSDA,DA(1)=DFN D FILE^DICN I +Y'>0 G NPQ
  1. S IBPOLDA=+Y,IBXIFN=IBPOLDA_","_DFN_","
  1. ;
  1. S IBFIELDS(2.312,IBXIFN,.18)=IBGRPDA ; policy's group/plan
  1. S IBFIELDS(2.312,IBXIFN,1.09)=$P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,3) ; source
  1. S IBFIELDS(2.312,IBXIFN,1.1)=+$G(^IBA(355.33,+$G(IBBUFDA),0)) ; source date
  1. D FILE^DIE("","IBFIELDS","IBERR")
  1. L -^DPT(DFN,.312)
  1. ;
  1. NPQ Q IBPOLDA