| [613] | 1 | IBCNBMN ;ALB/ARH-Ins Buffer: add new insurance file entrys ; 4/22/03 10:00am
 | 
|---|
 | 2 |  ;;2.0;INTEGRATED BILLING;**82,211**;21-MAR-94
 | 
|---|
 | 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 |  ;
 | 
|---|
 | 6 | NEWINS(IBBUFDA) ; add new insurance carrier entry in Insurance Company (#36) file
 | 
|---|
 | 7 |  ;
 | 
|---|
 | 8 |  N DIC,DA,DIE,DR,X,Y,DLAYGO,IBINSDA,IB20,IBINSNM,IBREIMB S IBINSDA=0,IB20=$G(^IBA(355.33,+$G(IBBUFDA),20))
 | 
|---|
 | 9 |  S IBINSNM=$P(IB20,U,1) I IBINSNM="" G NIQ
 | 
|---|
 | 10 |  ;
 | 
|---|
 | 11 |  S IBREIMB=$P(IB20,U,5) I IBREIMB'="" S DIC("DR")="1///"_IBREIMB ;                     will reimburse?
 | 
|---|
 | 12 |  K DD,DO S DIC="^DIC(36,",DIC(0)="L",X=IBINSNM,DLAYGO=36 D FILE^DICN I +Y>0  S IBINSDA=+Y
 | 
|---|
 | 13 |  ;
 | 
|---|
 | 14 | NIQ Q IBINSDA
 | 
|---|
 | 15 |  ;
 | 
|---|
 | 16 | NEWGRP(IBBUFDA,IBINSDA) ; add a new group/plan to the Group Insurance Plan (#355.3) file, also add standard fields
 | 
|---|
 | 17 |  ;
 | 
|---|
 | 18 |  N DIC,DA,DR,DIE,X,Y,DLAYGO,IBGRPDA,IB40,IBFIELDS,IBERR,IBXIFN S IBGRPDA=0,IB40=$G(^IBA(355.33,+$G(IBBUFDA),40))
 | 
|---|
 | 19 |  I '$D(^DIC(36,+$G(IBINSDA),0)) G NGQ
 | 
|---|
 | 20 |  I $P(IB40,U,1)=0,'$G(^IBA(355.33,+$G(IBBUFDA),60)) G NGQ
 | 
|---|
 | 21 |  ;
 | 
|---|
 | 22 |  K DA,DO S DIC="^IBA(355.3,",DIC(0)="L",X=IBINSDA,DLAYGO=355.3 D FILE^DICN I +Y'>0 G NGQ
 | 
|---|
 | 23 |  S IBGRPDA=+Y,IBXIFN=IBGRPDA_","
 | 
|---|
 | 24 |  ;
 | 
|---|
 | 25 |  S IBFIELDS(355.3,IBXIFN,.02)=$P(IB40,U,1) ;                                           group plan?
 | 
|---|
 | 26 |  I $P(IB40,U,1)=0 S IBFIELDS(355.3,IBXIFN,.1)=+$G(^IBA(355.33,+$G(IBBUFDA),60)) ;   individual plan patient
 | 
|---|
 | 27 |  D FILE^DIE("","IBFIELDS","IBERR")
 | 
|---|
 | 28 |  ;
 | 
|---|
 | 29 | NGQ Q IBGRPDA
 | 
|---|
 | 30 |  ;
 | 
|---|
 | 31 | NEWPOL(IBBUFDA,IBINSDA,IBGRPDA) ; add a new patient policy to the Patient's Insurance Policys (2.312), also add standard fields
 | 
|---|
 | 32 |  ;
 | 
|---|
 | 33 |  N DIC,DA,DR,DIE,X,Y,IBPOLDA,IBFIELDS,IBERR,DFN,IBGRP,IBXIFN S IBPOLDA=0
 | 
|---|
 | 34 |  I '$D(^DIC(36,+$G(IBINSDA),0)) G NPQ
 | 
|---|
 | 35 |  S IBGRP=$G(^IBA(355.3,+$G(IBGRPDA),0)) I +IBGRP'=IBINSDA G NPQ
 | 
|---|
 | 36 |  S DFN=+$G(^IBA(355.33,+$G(IBBUFDA),60)) I 'DFN G NPQ
 | 
|---|
 | 37 |  I $P(IBGRP,U,10)'="",$P(IBGRP,U,10)'=DFN G NPQ
 | 
|---|
 | 38 |  ;
 | 
|---|
 | 39 |  ; IB*2*211
 | 
|---|
 | 40 |  L +^DPT(DFN,.312):5 I '$T D LOCKED^IBTRCD1 G NPQ
 | 
|---|
 | 41 |  I $G(^DPT(DFN,.312,0))="" S ^DPT(DFN,.312,0)="^2.312PAI^^"
 | 
|---|
 | 42 |  ;
 | 
|---|
 | 43 |  K DA,DO S DIC="^DPT("_DFN_",.312,",DIC(0)="L",X=IBINSDA,DA(1)=DFN D FILE^DICN I +Y'>0 G NPQ
 | 
|---|
 | 44 |  S IBPOLDA=+Y,IBXIFN=IBPOLDA_","_DFN_","
 | 
|---|
 | 45 |  ;
 | 
|---|
 | 46 |  S IBFIELDS(2.312,IBXIFN,.18)=IBGRPDA ;                                                 policy's group/plan
 | 
|---|
 | 47 |  S IBFIELDS(2.312,IBXIFN,1.09)=$P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,3) ;                source
 | 
|---|
 | 48 |  S IBFIELDS(2.312,IBXIFN,1.1)=+$G(^IBA(355.33,+$G(IBBUFDA),0)) ;                        source date
 | 
|---|
 | 49 |  D FILE^DIE("","IBFIELDS","IBERR")
 | 
|---|
 | 50 |  L -^DPT(DFN,.312)
 | 
|---|
 | 51 |  ;
 | 
|---|
 | 52 | NPQ Q IBPOLDA
 | 
|---|