- IBCNBMN ;ALB/ARH-Ins Buffer: add new insurance file entrys ; 4/22/03 10:00am
- ;;2.0;INTEGRATED BILLING;**82,211,519**;21-MAR-94;Build 56
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;
- NEWINS(IBBUFDA) ; add new insurance carrier entry in Insurance Company (#36) file
- ;
- N DIC,DA,DIE,DR,X,Y,DLAYGO,IBINSDA,IB20,IBINSNM,IBREIMB S IBINSDA=0,IB20=$G(^IBA(355.33,+$G(IBBUFDA),20))
- S IBINSNM=$P(IB20,U,1) I IBINSNM="" G NIQ
- ;
- S IBREIMB=$P(IB20,U,5) I IBREIMB'="" S DIC("DR")="1///"_IBREIMB ; will reimburse?
- K DD,DO S DIC="^DIC(36,",DIC(0)="L",X=IBINSNM,DLAYGO=36 D FILE^DICN I +Y>0 S IBINSDA=+Y
- ;
- NIQ Q IBINSDA
- ;
- NEWGRP(IBBUFDA,IBINSDA) ; add a new group/plan to the Group Insurance Plan (#355.3) file, also add standard fields
- ;
- N DIC,DA,DR,DIE,X,Y,DLAYGO,IBGRPDA,IB40,IBFIELDS,IBERR,IBXIFN S IBGRPDA=0,IB40=$G(^IBA(355.33,+$G(IBBUFDA),40))
- I '$D(^DIC(36,+$G(IBINSDA),0)) G NGQ
- I $P(IB40,U,1)=0,'$G(^IBA(355.33,+$G(IBBUFDA),60)) G NGQ
- ;
- K DA,DO S DIC="^IBA(355.3,",DIC(0)="L",X=IBINSDA,DLAYGO=355.3 D FILE^DICN I +Y'>0 G NGQ
- S IBGRPDA=+Y,IBXIFN=IBGRPDA_","
- ;
- S IBFIELDS(355.3,IBXIFN,.02)=$P(IB40,U,1) ; group plan?
- I $P(IB40,U,1)=0 S IBFIELDS(355.3,IBXIFN,.1)=+$G(^IBA(355.33,+$G(IBBUFDA),60)) ; individual plan patient
- D FILE^DIE("","IBFIELDS","IBERR")
- ;
- ; IB*2.0*519: If new group added, check to see if we already have a NIF ID for this insurance company.
- ; if no NIF and we have not yet requested one, send an HL7
- I '$$NIF^IBCNHUT1(+$G(IBINSDA)),'$D(^IBCNH(367.1,"INS",+$G(IBINSDA))) D SEND^IBCNHHLO(+$G(IBINSDA))
- ;
- NGQ Q IBGRPDA
- ;
- NEWPOL(IBBUFDA,IBINSDA,IBGRPDA) ; add a new patient policy to the Patient's Insurance Policys (2.312), also add standard fields
- ;
- N DIC,DA,DR,DIE,X,Y,IBPOLDA,IBFIELDS,IBERR,DFN,IBGRP,IBXIFN S IBPOLDA=0
- I '$D(^DIC(36,+$G(IBINSDA),0)) G NPQ
- S IBGRP=$G(^IBA(355.3,+$G(IBGRPDA),0)) I +IBGRP'=IBINSDA G NPQ
- S DFN=+$G(^IBA(355.33,+$G(IBBUFDA),60)) I 'DFN G NPQ
- I $P(IBGRP,U,10)'="",$P(IBGRP,U,10)'=DFN G NPQ
- ;
- ; IB*2*211
- L +^DPT(DFN,.312):5 I '$T D LOCKED^IBTRCD1 G NPQ
- I $G(^DPT(DFN,.312,0))="" S ^DPT(DFN,.312,0)="^2.312PAI^^"
- ;
- K DA,DO S DIC="^DPT("_DFN_",.312,",DIC(0)="L",X=IBINSDA,DA(1)=DFN D FILE^DICN I +Y'>0 G NPQ
- S IBPOLDA=+Y,IBXIFN=IBPOLDA_","_DFN_","
- ;
- S IBFIELDS(2.312,IBXIFN,.18)=IBGRPDA ; policy's group/plan
- S IBFIELDS(2.312,IBXIFN,1.09)=$P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,3) ; source
- S IBFIELDS(2.312,IBXIFN,1.1)=+$G(^IBA(355.33,+$G(IBBUFDA),0)) ; source date
- D FILE^DIE("","IBFIELDS","IBERR")
- L -^DPT(DFN,.312)
- ;
- NPQ Q IBPOLDA
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBMN 2745 printed Feb 18, 2025@23:40:34 Page 2
- 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
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;
- NEWINS(IBBUFDA) ; add new insurance carrier entry in Insurance Company (#36) file
- +1 ;
- +2 NEW DIC,DA,DIE,DR,X,Y,DLAYGO,IBINSDA,IB20,IBINSNM,IBREIMB
- SET IBINSDA=0
- SET IB20=$GET(^IBA(355.33,+$GET(IBBUFDA),20))
- +3 SET IBINSNM=$PIECE(IB20,U,1)
- IF IBINSNM=""
- GOTO NIQ
- +4 ;
- +5 ; will reimburse?
- SET IBREIMB=$PIECE(IB20,U,5)
- IF IBREIMB'=""
- SET DIC("DR")="1///"_IBREIMB
- +6 KILL DD,DO
- SET DIC="^DIC(36,"
- SET DIC(0)="L"
- SET X=IBINSNM
- SET DLAYGO=36
- DO FILE^DICN
- IF +Y>0
- SET IBINSDA=+Y
- +7 ;
- NIQ QUIT IBINSDA
- +1 ;
- NEWGRP(IBBUFDA,IBINSDA) ; add a new group/plan to the Group Insurance Plan (#355.3) file, also add standard fields
- +1 ;
- +2 NEW DIC,DA,DR,DIE,X,Y,DLAYGO,IBGRPDA,IB40,IBFIELDS,IBERR,IBXIFN
- SET IBGRPDA=0
- SET IB40=$GET(^IBA(355.33,+$GET(IBBUFDA),40))
- +3 IF '$DATA(^DIC(36,+$GET(IBINSDA),0))
- GOTO NGQ
- +4 IF $PIECE(IB40,U,1)=0
- IF '$GET(^IBA(355.33,+$GET(IBBUFDA),60))
- GOTO NGQ
- +5 ;
- +6 KILL DA,DO
- SET DIC="^IBA(355.3,"
- SET DIC(0)="L"
- SET X=IBINSDA
- SET DLAYGO=355.3
- DO FILE^DICN
- IF +Y'>0
- GOTO NGQ
- +7 SET IBGRPDA=+Y
- SET IBXIFN=IBGRPDA_","
- +8 ;
- +9 ; group plan?
- SET IBFIELDS(355.3,IBXIFN,.02)=$PIECE(IB40,U,1)
- +10 ; individual plan patient
- IF $PIECE(IB40,U,1)=0
- SET IBFIELDS(355.3,IBXIFN,.1)=+$GET(^IBA(355.33,+$GET(IBBUFDA),60))
- +11 DO FILE^DIE("","IBFIELDS","IBERR")
- +12 ;
- +13 ; IB*2.0*519: If new group added, check to see if we already have a NIF ID for this insurance company.
- +14 ; if no NIF and we have not yet requested one, send an HL7
- +15 IF '$$NIF^IBCNHUT1(+$GET(IBINSDA))
- IF '$DATA(^IBCNH(367.1,"INS",+$GET(IBINSDA)))
- DO SEND^IBCNHHLO(+$GET(IBINSDA))
- +16 ;
- NGQ QUIT IBGRPDA
- +1 ;
- NEWPOL(IBBUFDA,IBINSDA,IBGRPDA) ; add a new patient policy to the Patient's Insurance Policys (2.312), also add standard fields
- +1 ;
- +2 NEW DIC,DA,DR,DIE,X,Y,IBPOLDA,IBFIELDS,IBERR,DFN,IBGRP,IBXIFN
- SET IBPOLDA=0
- +3 IF '$DATA(^DIC(36,+$GET(IBINSDA),0))
- GOTO NPQ
- +4 SET IBGRP=$GET(^IBA(355.3,+$GET(IBGRPDA),0))
- IF +IBGRP'=IBINSDA
- GOTO NPQ
- +5 SET DFN=+$GET(^IBA(355.33,+$GET(IBBUFDA),60))
- IF 'DFN
- GOTO NPQ
- +6 IF $PIECE(IBGRP,U,10)'=""
- IF $PIECE(IBGRP,U,10)'=DFN
- GOTO NPQ
- +7 ;
- +8 ; IB*2*211
- +9 LOCK +^DPT(DFN,.312):5
- IF '$TEST
- DO LOCKED^IBTRCD1
- GOTO NPQ
- +10 IF $GET(^DPT(DFN,.312,0))=""
- SET ^DPT(DFN,.312,0)="^2.312PAI^^"
- +11 ;
- +12 KILL DA,DO
- SET DIC="^DPT("_DFN_",.312,"
- SET DIC(0)="L"
- SET X=IBINSDA
- SET DA(1)=DFN
- DO FILE^DICN
- IF +Y'>0
- GOTO NPQ
- +13 SET IBPOLDA=+Y
- SET IBXIFN=IBPOLDA_","_DFN_","
- +14 ;
- +15 ; policy's group/plan
- SET IBFIELDS(2.312,IBXIFN,.18)=IBGRPDA
- +16 ; source
- SET IBFIELDS(2.312,IBXIFN,1.09)=$PIECE($GET(^IBA(355.33,+$GET(IBBUFDA),0)),U,3)
- +17 ; source date
- SET IBFIELDS(2.312,IBXIFN,1.1)=+$GET(^IBA(355.33,+$GET(IBBUFDA),0))
- +18 DO FILE^DIE("","IBFIELDS","IBERR")
- +19 LOCK -^DPT(DFN,.312)
- +20 ;
- NPQ QUIT IBPOLDA