| 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 | 
|---|