- IBCNBEE ;ALB/ARH - Ins Buffer: add/edit existing entries in buffer ;1 Jun 97
- ;;2.0;INTEGRATED BILLING;**82,184,252,251,356,361,371,377,416,438,452,497,528**;21-MAR-94;Build 163
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ADD(IBSOURCE) ; add a new buffer file entry (#355.33), sets only status (0) node data
- N IBARR,IBERR,IBIFN,IBX I '$G(IBSOURCE) S IBSOURCE=1
- ;
- S IBARR(355.33,"+1,",.01)="NOW",IBARR(355.33,"+1,",.03)=IBSOURCE
- D UPDATE^DIE("E","IBARR","IBIFN","IBERR")
- S IBX=+$G(IBIFN(1)) I $D(IBERR) S $P(IBX,U,2)=$G(IBERR("DIERR",1,"TEXT",1))
- Q IBX
- ;
- STATUS(IBBUFDA,STATUS,NC,NG,NP) ; edit the status node
- ;
- N IBX,IBARR,IBIFN Q:'$G(IBBUFDA) S IBIFN=IBBUFDA_","
- D CHK^DIE(355.33,.04,"",$G(STATUS),.IBX) Q:IBX="^"
- ;
- S IBARR(355.33,IBIFN,.04)=STATUS I STATUS="R" S (NC,NG,NP)=0
- S IBARR(355.33,IBIFN,.07)=+$G(NC),IBARR(355.33,IBIFN,.08)=+$G(NG),IBARR(355.33,IBIFN,.09)=+$G(NP)
- D FILE^DIE("E","IBARR")
- Q
- ;
- INS(IBBUFDA,FLDS) ; edit the insurance company portion of a buffer file entry
- ;
- N DIC,DIE,DA,DR,X,Y,IBCNEXT1
- I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q
- I $G(FLDS)="" S FLDS="MR"
- ;
- ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing
- ; - the insurance company name in the buffer. Also added an
- ; - input transform (see below) to clean up the data coming in.
- ; - fetch the current buffer ins co name
- ;
- I FLDS="MR" S IBCNEXT1=$P($G(^IBA(355.33,IBBUFDA,20)),U,1)
- ;
- S DR=$P($T(@(FLDS_"INS")+1),";;",2,9999) Q:DR=""
- ;
- I FLDS="MR" Q:$$INSNAME(IBBUFDA)<0 S DR=$P($T(@(FLDS_"INS")+1),";;",2,9999),DR=$P(DR,";",2,99999)
- ;
- S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
- Q
- ;
- GRP(IBBUFDA,FLDS) ; edit the group/plan portion of the buffer file entry
- ;
- N DIC,DIE,DA,DR,X,Y I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q
- I $G(FLDS)="" S FLDS="MR"
- ;
- S DR=$P($T(@(FLDS_"GRP")+1),";;",2,9999) Q:DR=""
- S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
- Q
- ;
- POLICY(IBBUFDA,FLDS) ; edit the patient policy portion of the buffer file entry
- ;
- N DIC,DIE,DA,DR,X,Y,IBZZ I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q
- I $G(FLDS)="" S FLDS="MR"
- ;
- S DR=$P($T(@(FLDS_"POL")+1),";;",2,9999)_$P($T(@(FLDS_"POL")+2),";;",2,9999) Q:DR=""
- S DIE="^IBA(355.33,",DA=IBBUFDA
- S DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DA,DR Q:$D(Y)
- ;
- I FLDS="MR" D ESGHP(IBBUFDA)
- Q
- ;
- ESGHP(IBBUFDA) ; sponsoring employer information
- N DIR,DIRUT,DUOUT,DTOUT,VAOA,VAERR,VA,DFN,IB60,IBE,IBEMPST,IBREL
- ;
- ; if insured is patient or spouse, ask if insured's current employer is the plan's sponsoring employer, if yes auto stuff it
- I +$G(^IBA(355.33,IBBUFDA,61)) W ! S IB60=$G(^IBA(355.33,IBBUFDA,60)) D Q:$D(DIRUT)
- . ; sponsoring employer is current employer?
- . S DFN=+IB60,IBREL=$P(IB60,U,6),VAOA("A")=$S(IBREL="01":5,IBREL="02":6,1:"") I 'DFN!(VAOA("A")="") Q
- . D OAD^VADPT I $G(VAOA(9))="" Q
- . S DIR("?")="Enter Yes if this plan is sponsored by the "_$S(IBREL="01":"patient's",1:"spouse's")_" current employer."
- . S DIR("?",1)="Entering Yes will result in the "_$S(IBREL="01":"patient's",1:"spouse's")_" current employer data being",DIR("?",2)="added to the policy as the Sponsoring Employer data.",DIR("?",3)=""
- . S DIR("A")="Current Employer "_VAOA(9)_" Sponsors this Plan",DIR("B")="No",DIR(0)="Y" D ^DIR W ! I Y'=1 Q
- . ;
- . D DELEMP(IBBUFDA) ; delete any data already contained in these fields
- . ;
- . ; if the insured's current employer sponsors the plan then stuff that employer's address into the buffer
- . S IBE=$S(IBREL="01":.311,1:.25),IBEMPST=$P($G(^DPT(DFN,IBE)),U,15)
- . S DR="61.02///"_VAOA(9)_";61.03///"_IBEMPST_";61.06///"_$E(VAOA(1),1,30)_";61.07///"_$E(VAOA(2),1,30)
- . S DR=DR_";61.08///"_$E(VAOA(3),1,30)_";61.09///"_$E(VAOA(4),1,20)_";61.1////"_$P(VAOA(5),U,1)
- . S DR=DR_";61.11////"_$P(VAOA(11),U,1)_";61.12///"_$E(VAOA(8),1,15)
- . S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
- ;
- ; if employer sponsored plan, edit buffer entry's sponsoring employer info
- I +$G(^IBA(355.33,IBBUFDA,61)) S DR="61.02:61.12",DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
- ;
- ; if not employer sponsored plan, delete any existing sponsoring employer data
- I $D(^IBA(355.33,IBBUFDA,61)),'$G(^IBA(355.33,IBBUFDA,61)) D DELEMP(IBBUFDA)
- Q
- ;
- ASKSAVE(NAME) ;asks the user if changes to the Patient Registration File (Subscriber data) should be saved
- ;returns 1 for yes, 0 for no
- K DIR S DIR(0)="Y",DIR("A")="Save changes to the "_NAME_" File",DIR("B")="YES"
- D ^DIR K DIR
- Q $S($D(DIRUT):0,1:Y)
- ;
- DELEMP(IBBUFDA) ; delete sponsoring employer data
- N DIC,DIE,DA,DR,X,Y Q:'$D(^IBA(355.33,+$G(IBBUFDA),61))
- S DR="61.02///@;61.03///@;61.04///@;61.05///@;61.06///@;61.07///@;61.08///@;61.09///@;61.10///@;61.11///@;61.12///@"
- S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR
- Q
- ;
- INSHELP ;
- W !!,"------------------------ INSURANCE COMPANY INFORMATION -------------------------",!
- Q
- GRPHELP ;
- W !!,"---------------------------- GROUP/PLAN INFORMATION ----------------------------"
- W !," The following data defines a specific Group or Plan provided by an Insurance "
- W !," Company. This may be either a group plan with many potential members or an "
- W !," individual plan with a single member.",!
- Q
- POLHELP ;
- W !!,"---------------------- POLICY AND SUBSCRIBER INFORMATION -----------------------"
- W !," The following data defines the subscriber specific policy information for a "
- W !," particular Insurance Plan. The subscriber, the insured, and the policy holder "
- W !," all refer to the person who is a member of the plan and therefore holds the "
- W !," policy. The patient must be covered under the plan but may not be the policy"
- W !," holder.",!
- Q
- ;
- INSNAME(IBBUFDA) ; Reset insurance company name
- N DR,DIE,DA,Y,X,IBX,IBNEW,IBNAME
- S IBX=-1
- S DR=20.01,DIE="^IBA(355.33,",DA=IBBUFDA
- D ^DIE
- I '$D(Y) S IBNEW=$$CHECK(IBBUFDA)
- I +$G(IBNEW)'<0,$G(IBNEW)'=0,$D(IBNEW) S DR=$P(DR,";",1)_"////"_IBNEW S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR I '$D(Y) S IBX=0
- ; BHS - 10/15/03 - If user entered a caret during $$CHECK still set
- ; return value to 0 so the user can edit the other
- ; INS fields
- I $G(IBNEW)=0!($G(IBNEW)=-1) S IBX=0
- Q IBX
- ;
- CHECK(IBBUFDA) ; Select Insurance Company Name and Automatch
- ; Buffer file (#355.33), field# 20.01.
- ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing the
- ; insurance company name. Also, display the insurance company
- ; name lookup/lister and the Auto Match lookup/lister.
- ;
- NEW IBNEW,IBNAME,AMLIST
- ;
- S IBNEW=0,IBNAME=$P($G(^IBA(355.33,$G(IBBUFDA),20)),U,1)
- I IBNAME="" G CHECKQ
- ;
- ; Perform an insurance company lookup/lister
- ; BHS - 10/15/03 - Removed quits when user enters a caret to quit the
- ; the ins lister or Auto Match lister
- S IBNEW=$$DICINS^IBCNBU1(IBNAME,1,10)
- I IBNEW=0!(IBNEW<0) D
- . I '$$AMLOOK^IBCNEUT1(IBNAME,1,.AMLIST) Q
- . S IBNEW=$$AMSEL^IBCNEUT1(.AMLIST)
- ;
- ; user chose a valid insurance company - possible Auto Match add
- I IBNEW'<0,IBNEW'=0 D AMADD^IBCNEUT6(X,IBCNEXT1)
- ;
- CHECKQ Q IBNEW
- ;
- MRINS ; Insurance Company fields asked of MCCR users in the Buffer Process options (all buffer ins fields 20.01-21.06)
- ;;20.01;20.05;20.02:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06
- ;
- MRGRP ; Group/Plan fields asked of MCCR users in the Buffer Process options (all buffer grp fields 40.01,90.01,90.02,40.04-40.09)
- ;;40.01;90.01;90.02;40.1;40.11;40.09;40.04:40.08
- ;
- MRPOL ; Patient Policy fields asked of MCCR users in the Buffer Process options (all buffer policy fields except ESGHP,60.05,60.06 60.02-61.01
- ;;60.02;60.03;60.14PATIENT RELATIONSHIP TO SUBSCRIBER;S IBZZ=X;I IBZZ'="18" S Y="@111";91.01NAME OF SUBSCRIBER///1;90.03T;60.08SUBSCRIBER'S DOB///@;60.09SUBSCRIBER'S SSN///@;62.01///@;S Y="@112";@111;
- ;;91.01NAME OF SUBSCRIBER;90.03T;60.08SUBSCRIBER'S DOB;60.13SUBSCRIBER'S SEX;62.01T;@112;60.1:60.12;.03;60.15;60.16;61.01;62.02:62.06
- ;
- OTINS ; Insurance Company fields asked of non-MCCR users entering buffer data from options outside IB (20.01-20.04,21.01-21.06)
- ;;20.01:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06
- ;
- OTGRP ; Group/Plan fields asked of non-MCCR users entering buffer data from options outside IB (90.01,90.02,40.09) ;;Daou/EEN-adding BIN & PCN (40.1,40.11)
- ;;90.01;90.02;40.1;40.11;40.09
- ;
- OTPOL ; Patient Policy fields asked of non-MCCR users entering buffer data from options outside IB (60.02,60.03,90.03,60.05,60.06,91.01,60.08)
- ;;60.02;60.03;60.14PT. RELATIONSHIP TO INSURED;S IBZZ=X;90.03T;I IBZZ'="18" S Y="@111";91.01///1;60.08///@;60.09///@;62.01///@;S Y="@112";@111;91.01;60.08;60.13;62.01T;@112;60.15;60.16;62.02;62.03;62.04;62.05;62.06
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBEE 8886 printed Jan 18, 2025@03:15:09 Page 2
- IBCNBEE ;ALB/ARH - Ins Buffer: add/edit existing entries in buffer ;1 Jun 97
- +1 ;;2.0;INTEGRATED BILLING;**82,184,252,251,356,361,371,377,416,438,452,497,528**;21-MAR-94;Build 163
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- ADD(IBSOURCE) ; add a new buffer file entry (#355.33), sets only status (0) node data
- +1 NEW IBARR,IBERR,IBIFN,IBX
- IF '$GET(IBSOURCE)
- SET IBSOURCE=1
- +2 ;
- +3 SET IBARR(355.33,"+1,",.01)="NOW"
- SET IBARR(355.33,"+1,",.03)=IBSOURCE
- +4 DO UPDATE^DIE("E","IBARR","IBIFN","IBERR")
- +5 SET IBX=+$GET(IBIFN(1))
- IF $DATA(IBERR)
- SET $PIECE(IBX,U,2)=$GET(IBERR("DIERR",1,"TEXT",1))
- +6 QUIT IBX
- +7 ;
- STATUS(IBBUFDA,STATUS,NC,NG,NP) ; edit the status node
- +1 ;
- +2 NEW IBX,IBARR,IBIFN
- if '$GET(IBBUFDA)
- QUIT
- SET IBIFN=IBBUFDA_","
- +3 DO CHK^DIE(355.33,.04,"",$GET(STATUS),.IBX)
- if IBX="^"
- QUIT
- +4 ;
- +5 SET IBARR(355.33,IBIFN,.04)=STATUS
- IF STATUS="R"
- SET (NC,NG,NP)=0
- +6 SET IBARR(355.33,IBIFN,.07)=+$GET(NC)
- SET IBARR(355.33,IBIFN,.08)=+$GET(NG)
- SET IBARR(355.33,IBIFN,.09)=+$GET(NP)
- +7 DO FILE^DIE("E","IBARR")
- +8 QUIT
- +9 ;
- INS(IBBUFDA,FLDS) ; edit the insurance company portion of a buffer file entry
- +1 ;
- +2 NEW DIC,DIE,DA,DR,X,Y,IBCNEXT1
- +3 IF $PIECE($GET(^IBA(355.33,+$GET(IBBUFDA),0)),U,4)'="E"
- QUIT
- +4 IF $GET(FLDS)=""
- SET FLDS="MR"
- +5 ;
- +6 ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing
- +7 ; - the insurance company name in the buffer. Also added an
- +8 ; - input transform (see below) to clean up the data coming in.
- +9 ; - fetch the current buffer ins co name
- +10 ;
- +11 IF FLDS="MR"
- SET IBCNEXT1=$PIECE($GET(^IBA(355.33,IBBUFDA,20)),U,1)
- +12 ;
- +13 SET DR=$PIECE($TEXT(@(FLDS_"INS")+1),";;",2,9999)
- if DR=""
- QUIT
- +14 ;
- +15 IF FLDS="MR"
- if $$INSNAME(IBBUFDA)<0
- QUIT
- SET DR=$PIECE($TEXT(@(FLDS_"INS")+1),";;",2,9999)
- SET DR=$PIECE(DR,";",2,99999)
- +16 ;
- +17 SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- DO ^DIE
- KILL DIE,DA,DR
- +18 QUIT
- +19 ;
- GRP(IBBUFDA,FLDS) ; edit the group/plan portion of the buffer file entry
- +1 ;
- +2 NEW DIC,DIE,DA,DR,X,Y
- IF $PIECE($GET(^IBA(355.33,+$GET(IBBUFDA),0)),U,4)'="E"
- QUIT
- +3 IF $GET(FLDS)=""
- SET FLDS="MR"
- +4 ;
- +5 SET DR=$PIECE($TEXT(@(FLDS_"GRP")+1),";;",2,9999)
- if DR=""
- QUIT
- +6 SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- DO ^DIE
- KILL DIE,DA,DR
- +7 QUIT
- +8 ;
- POLICY(IBBUFDA,FLDS) ; edit the patient policy portion of the buffer file entry
- +1 ;
- +2 NEW DIC,DIE,DA,DR,X,Y,IBZZ
- IF $PIECE($GET(^IBA(355.33,+$GET(IBBUFDA),0)),U,4)'="E"
- QUIT
- +3 IF $GET(FLDS)=""
- SET FLDS="MR"
- +4 ;
- +5 SET DR=$PIECE($TEXT(@(FLDS_"POL")+1),";;",2,9999)_$PIECE($TEXT(@(FLDS_"POL")+2),";;",2,9999)
- if DR=""
- QUIT
- +6 SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- +7 SET DIE("NO^")="BACKOUTOK"
- DO ^DIE
- KILL DIE,DA,DR
- if $DATA(Y)
- QUIT
- +8 ;
- +9 IF FLDS="MR"
- DO ESGHP(IBBUFDA)
- +10 QUIT
- +11 ;
- ESGHP(IBBUFDA) ; sponsoring employer information
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,VAOA,VAERR,VA,DFN,IB60,IBE,IBEMPST,IBREL
- +2 ;
- +3 ; if insured is patient or spouse, ask if insured's current employer is the plan's sponsoring employer, if yes auto stuff it
- +4 IF +$GET(^IBA(355.33,IBBUFDA,61))
- WRITE !
- SET IB60=$GET(^IBA(355.33,IBBUFDA,60))
- Begin DoDot:1
- +5 ; sponsoring employer is current employer?
- +6 SET DFN=+IB60
- SET IBREL=$PIECE(IB60,U,6)
- SET VAOA("A")=$SELECT(IBREL="01":5,IBREL="02":6,1:"")
- IF 'DFN!(VAOA("A")="")
- QUIT
- +7 DO OAD^VADPT
- IF $GET(VAOA(9))=""
- QUIT
- +8 SET DIR("?")="Enter Yes if this plan is sponsored by the "_$SELECT(IBREL="01":"patient's",1:"spouse's")_" current employer."
- +9 SET DIR("?",1)="Entering Yes will result in the "_$SELECT(IBREL="01":"patient's",1:"spouse's")_" current employer data being"
- SET DIR("?",2)="added to the policy as the Sponsoring Employer data."
- SET DIR("?",3)=""
- +10 SET DIR("A")="Current Employer "_VAOA(9)_" Sponsors this Plan"
- SET DIR("B")="No"
- SET DIR(0)="Y"
- DO ^DIR
- WRITE !
- IF Y'=1
- QUIT
- +11 ;
- +12 ; delete any data already contained in these fields
- DO DELEMP(IBBUFDA)
- +13 ;
- +14 ; if the insured's current employer sponsors the plan then stuff that employer's address into the buffer
- +15 SET IBE=$SELECT(IBREL="01":.311,1:.25)
- SET IBEMPST=$PIECE($GET(^DPT(DFN,IBE)),U,15)
- +16 SET DR="61.02///"_VAOA(9)_";61.03///"_IBEMPST_";61.06///"_$EXTRACT(VAOA(1),1,30)_";61.07///"_$EXTRACT(VAOA(2),1,30)
- +17 SET DR=DR_";61.08///"_$EXTRACT(VAOA(3),1,30)_";61.09///"_$EXTRACT(VAOA(4),1,20)_";61.1////"_$PIECE(VAOA(5),U,1)
- +18 SET DR=DR_";61.11////"_$PIECE(VAOA(11),U,1)_";61.12///"_$EXTRACT(VAOA(8),1,15)
- +19 SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- DO ^DIE
- KILL DIE,DA,DR
- End DoDot:1
- if $DATA(DIRUT)
- QUIT
- +20 ;
- +21 ; if employer sponsored plan, edit buffer entry's sponsoring employer info
- +22 IF +$GET(^IBA(355.33,IBBUFDA,61))
- SET DR="61.02:61.12"
- SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- DO ^DIE
- KILL DIE,DA,DR
- +23 ;
- +24 ; if not employer sponsored plan, delete any existing sponsoring employer data
- +25 IF $DATA(^IBA(355.33,IBBUFDA,61))
- IF '$GET(^IBA(355.33,IBBUFDA,61))
- DO DELEMP(IBBUFDA)
- +26 QUIT
- +27 ;
- ASKSAVE(NAME) ;asks the user if changes to the Patient Registration File (Subscriber data) should be saved
- +1 ;returns 1 for yes, 0 for no
- +2 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Save changes to the "_NAME_" File"
- SET DIR("B")="YES"
- +3 DO ^DIR
- KILL DIR
- +4 QUIT $SELECT($DATA(DIRUT):0,1:Y)
- +5 ;
- DELEMP(IBBUFDA) ; delete sponsoring employer data
- +1 NEW DIC,DIE,DA,DR,X,Y
- if '$DATA(^IBA(355.33,+$GET(IBBUFDA),61))
- QUIT
- +2 SET DR="61.02///@;61.03///@;61.04///@;61.05///@;61.06///@;61.07///@;61.08///@;61.09///@;61.10///@;61.11///@;61.12///@"
- +3 SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- DO ^DIE
- KILL DIE,DA,DR
- +4 QUIT
- +5 ;
- INSHELP ;
- +1 WRITE !!,"------------------------ INSURANCE COMPANY INFORMATION -------------------------",!
- +2 QUIT
- GRPHELP ;
- +1 WRITE !!,"---------------------------- GROUP/PLAN INFORMATION ----------------------------"
- +2 WRITE !," The following data defines a specific Group or Plan provided by an Insurance "
- +3 WRITE !," Company. This may be either a group plan with many potential members or an "
- +4 WRITE !," individual plan with a single member.",!
- +5 QUIT
- POLHELP ;
- +1 WRITE !!,"---------------------- POLICY AND SUBSCRIBER INFORMATION -----------------------"
- +2 WRITE !," The following data defines the subscriber specific policy information for a "
- +3 WRITE !," particular Insurance Plan. The subscriber, the insured, and the policy holder "
- +4 WRITE !," all refer to the person who is a member of the plan and therefore holds the "
- +5 WRITE !," policy. The patient must be covered under the plan but may not be the policy"
- +6 WRITE !," holder.",!
- +7 QUIT
- +8 ;
- INSNAME(IBBUFDA) ; Reset insurance company name
- +1 NEW DR,DIE,DA,Y,X,IBX,IBNEW,IBNAME
- +2 SET IBX=-1
- +3 SET DR=20.01
- SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- +4 DO ^DIE
- +5 IF '$DATA(Y)
- SET IBNEW=$$CHECK(IBBUFDA)
- +6 IF +$GET(IBNEW)'<0
- IF $GET(IBNEW)'=0
- IF $DATA(IBNEW)
- SET DR=$PIECE(DR,";",1)_"////"_IBNEW
- SET DIE="^IBA(355.33,"
- SET DA=IBBUFDA
- DO ^DIE
- KILL DIE,DA,DR
- IF '$DATA(Y)
- SET IBX=0
- +7 ; BHS - 10/15/03 - If user entered a caret during $$CHECK still set
- +8 ; return value to 0 so the user can edit the other
- +9 ; INS fields
- +10 IF $GET(IBNEW)=0!($GET(IBNEW)=-1)
- SET IBX=0
- +11 QUIT IBX
- +12 ;
- CHECK(IBBUFDA) ; Select Insurance Company Name and Automatch
- +1 ; Buffer file (#355.33), field# 20.01.
- +2 ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing the
- +3 ; insurance company name. Also, display the insurance company
- +4 ; name lookup/lister and the Auto Match lookup/lister.
- +5 ;
- +6 NEW IBNEW,IBNAME,AMLIST
- +7 ;
- +8 SET IBNEW=0
- SET IBNAME=$PIECE($GET(^IBA(355.33,$GET(IBBUFDA),20)),U,1)
- +9 IF IBNAME=""
- GOTO CHECKQ
- +10 ;
- +11 ; Perform an insurance company lookup/lister
- +12 ; BHS - 10/15/03 - Removed quits when user enters a caret to quit the
- +13 ; the ins lister or Auto Match lister
- +14 SET IBNEW=$$DICINS^IBCNBU1(IBNAME,1,10)
- +15 IF IBNEW=0!(IBNEW<0)
- Begin DoDot:1
- +16 IF '$$AMLOOK^IBCNEUT1(IBNAME,1,.AMLIST)
- QUIT
- +17 SET IBNEW=$$AMSEL^IBCNEUT1(.AMLIST)
- End DoDot:1
- +18 ;
- +19 ; user chose a valid insurance company - possible Auto Match add
- +20 IF IBNEW'<0
- IF IBNEW'=0
- DO AMADD^IBCNEUT6(X,IBCNEXT1)
- +21 ;
- CHECKQ QUIT IBNEW
- +1 ;
- MRINS ; Insurance Company fields asked of MCCR users in the Buffer Process options (all buffer ins fields 20.01-21.06)
- +1 ;;20.01;20.05;20.02:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06
- +2 ;
- MRGRP ; Group/Plan fields asked of MCCR users in the Buffer Process options (all buffer grp fields 40.01,90.01,90.02,40.04-40.09)
- +1 ;;40.01;90.01;90.02;40.1;40.11;40.09;40.04:40.08
- +2 ;
- MRPOL ; Patient Policy fields asked of MCCR users in the Buffer Process options (all buffer policy fields except ESGHP,60.05,60.06 60.02-61.01
- +1 ;;60.02;60.03;60.14PATIENT RELATIONSHIP TO SUBSCRIBER;S IBZZ=X;I IBZZ'="18" S Y="@111";91.01NAME OF SUBSCRIBER///1;90.03T;60.08SUBSCRIBER'S DOB///@;60.09SUBSCRIBER'S SSN///@;62.01///@;S Y="@112";@111;
- +2 ;;91.01NAME OF SUBSCRIBER;90.03T;60.08SUBSCRIBER'S DOB;60.13SUBSCRIBER'S SEX;62.01T;@112;60.1:60.12;.03;60.15;60.16;61.01;62.02:62.06
- +3 ;
- OTINS ; Insurance Company fields asked of non-MCCR users entering buffer data from options outside IB (20.01-20.04,21.01-21.06)
- +1 ;;20.01:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06
- +2 ;
- OTGRP ; Group/Plan fields asked of non-MCCR users entering buffer data from options outside IB (90.01,90.02,40.09) ;;Daou/EEN-adding BIN & PCN (40.1,40.11)
- +1 ;;90.01;90.02;40.1;40.11;40.09
- +2 ;
- OTPOL ; Patient Policy fields asked of non-MCCR users entering buffer data from options outside IB (60.02,60.03,90.03,60.05,60.06,91.01,60.08)
- +1 ;;60.02;60.03;60.14PT. RELATIONSHIP TO INSURED;S IBZZ=X;90.03T;I IBZZ'="18" S Y="@111";91.01///1;60.08///@;60.09///@;62.01///@;S Y="@112";@111;91.01;60.08;60.13;62.01T;@112;60.15;60.16;62.02;62.03;62.04;62.05;62.06