IBCNBAC.m

IBCNBAC ;ALB/ARH/DAOU/WCW/AWC - Ins Buffer: Individually Accept Insurance Buffer Fields ;28-APR-03

 ;;2.0;INTEGRATED BILLING;**184,497,528**;21-MAR-94;Build 163

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

INS(IBBUFDA,IBINSDA,SKPBLANK) ; display a buffer entry's insurance company fields and an existing insurance company fields for comparison

 N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q

 S SKPBLANK=$G(SKPBLANK)

 ;

 S IBEXTDA=$G(IBINSDA)_","

 ;

 I +$P($G(^DIC(36,+IBEXTDA,0)),U,5) W !,?10,"Selected Insurance Company "_$$GET1^DIQ(36,IBEXTDA,.01)_" is Inactive!",!

 ;

 W @IOF

 W ! D WRTFLD("  Insurance Data:  Buffer Data                     Selected Insurance Company   ",0,80,"BU")

 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.01),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(36,IBEXTDA,.01),1:"<none selected>") D WRTLN("Company Name:",IBFLD1,IBFLD2,"","","")

 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.05),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(36,IBEXTDA,1),1:"") D WRTLN("Reimburse?:",IBFLD1,IBFLD2,"","","U")

 ;

 D FIELDS("INS","",SKPBLANK)

 ;

 Q

 ;

GRP(IBBUFDA,IBGRPDA,SKPBLANK) ; display a buffer entrys group insurance fields and an existing group/plan's fields for comparison

 N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q

 S SKPBLANK=$G(SKPBLANK)

 ;

 S IBEXTDA=$G(IBGRPDA)_","

 ;

 I +$P($G(^IBA(355.3,+IBEXTDA,0)),U,11) W !,?23,"Selected Group/Plan is Inactive!",!

 ;

 W @IOF

 W ! D WRTFLD(" Group/Plan Data:  Buffer Data                     Selected Group/Plan          ",0,80,"BU")

 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.01),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(355.3,IBEXTDA,.01),1:"<none selected>") D WRTLN("Company Name:",IBFLD1,IBFLD2,"","","")

 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,40.01),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(355.3,IBEXTDA,.02),1:"") D WRTLN("Is Group Plan?:",IBFLD1,IBFLD2,"","","U")

 ;

 D FIELDS("GRP","",SKPBLANK)

 ;

 Q

 ;

POLICY(IBBUFDA,IBPOLDA,SKPBLANK) ; display a buffer entry's patient policy fields and an existing patient policy's fields for comparison

 N DFN,IBEXTDA,IBFLD1,IBFLD2,X,Y,DIR,DIRUT I '$G(IBBUFDA) Q

 S SKPBLANK=$G(SKPBLANK)

 S DFN=+$G(^IBA(355.33,IBBUFDA,60))

 ;

 S IBEXTDA=$G(IBPOLDA)_","_DFN_","

 ;

 W @IOF

 W ! D WRTFLD("     Policy Data:  Buffer Data                     Selected Policy              ",0,80,"BU")

 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.01),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(2.312,IBEXTDA,.01),1:"<none selected>") D WRTLN("Company Name:",IBFLD1,IBFLD2,"","","")

 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,90.02),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(2.312,IBEXTDA,21),1:"") D WRTLN("Group #:",IBFLD1,IBFLD2,"","","")

 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,60.01),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(2,DFN,.01),1:"") D WRTLN("Patient Name:",IBFLD1,IBFLD2,"","","")

 S IBFLD1=$P($$GET1^DIQ(355.33,IBBUFDA,.1),"@"),IBFLD2=$S(+IBEXTDA:$P($$GET1^DIQ(2.312,IBEXTDA,1.03),"@"),1:"") D WRTLN("Last Verified:",IBFLD1,IBFLD2,"","","U")

 ;

 D FIELDS("POL","",SKPBLANK)

 ;

 I +$G(^IBA(355.33,IBBUFDA,61))!($$GET1^DIQ(2.312,IBEXTDA,2.1)="YES") D ESGHP(SKPBLANK)

 ;

 Q

 ;

ESGHP(SKPBLANK) ; display employee sponsored group health plan

 S SKPBLANK=$G(SKPBLANK)

 W !!

 ;

 D FIELDS("POL",1,SKPBLANK)

 ;

 Q

 ;

SUB(SKPBLANK,IBFNAM,IBHOLD,IBXHOLD) ; display patient registration

 D SUB^IBCNBCD7(SKPBLANK,IBFNAM,.IBHOLD,.IBXHOLD)

 Q

 ;

FIELDS(SET,ESGHP,SKPBLANK) ; accept each field and set into temp array

 N CHGCHK,IBFLDLST,IBFLDVAL,IBUSER,IBLABEL,EXTFILE,IBEXTFLD

 S ESGHP=$G(ESGHP),SKPBLANK=$G(SKPBLANK)

 ;

 K IBFLDS,IBADDS,IBLBLS

 ;

 S EXTFILE=+$P($T(@(SET_"DR")+1^IBCNBMI),";;",2)

 D FIELDS^IBCNBMI(SET_"FLD")

 ;

 S CHGCHK=0 ; Initialize variable to check for any items to accept

 S IBBUFFLD=0 F  S IBBUFFLD=$O(IBFLDS(IBBUFFLD)) Q:'IBBUFFLD  I '$D(IBADDS(IBBUFFLD)) D  Q:$G(IBUSER)<0

 . I '$$ESGHPFLD(ESGHP,IBBUFFLD) Q

 . ;

 . S IBEXTFLD=IBFLDS(IBBUFFLD),IBLABEL=IBLBLS(IBBUFFLD)_":"

 . S IBFLDVAL=$$DISPLAY(IBBUFFLD,EXTFILE,IBEXTFLD,IBLABEL)

 . I $P(IBFLDVAL,U,1)=$P(IBFLDVAL,U,2) Q

 . I SKPBLANK,$P(IBFLDVAL,U,1)="" Q

 . ;

 . S CHGCHK=1

 . S IBUSER=$$ACCEPT($P(IBFLDVAL,U,1),$P(IBFLDVAL,U,2)) Q:IBUSER<0

 . I +IBUSER S ^TMP($J,"IB BUFFER SELECTED",IBBUFFLD)=""

 ;

 S IBFLDLST="" ; allow selection of address data in a group rather than individually

 S IBBUFFLD=0 F  S IBBUFFLD=$O(IBFLDS(IBBUFFLD)) Q:'IBBUFFLD  I $D(IBADDS(IBBUFFLD)) D

 . I '$$ESGHPFLD(ESGHP,IBBUFFLD) Q

 . ;

 . S IBEXTFLD=IBFLDS(IBBUFFLD),IBLABEL=IBLBLS(IBBUFFLD)_":"

 . S IBFLDVAL=$$DISPLAY(IBBUFFLD,EXTFILE,IBEXTFLD,IBLABEL)

 . I $P(IBFLDVAL,U,1)=$P(IBFLDVAL,U,2) Q

 . I SKPBLANK,$P(IBFLDVAL,U,1)="" Q  ; Do not prompt for blanks, if skipping

 . S CHGCHK=1

 . S IBFLDLST=IBFLDLST_IBBUFFLD_U

 ;

 I IBFLDLST'="" S IBUSER=$$ACCEPTG Q:IBUSER<0  D

 . I +IBUSER F IBUSER=1:1 S IBBUFFLD=$P(IBFLDLST,U,IBUSER) Q:'IBBUFFLD  S ^TMP($J,"IB BUFFER SELECTED",IBBUFFLD)=""

 ;

 ; Display message if there were no changes to accept

 I CHGCHK=0 W !!,"There are no changes to be accepted, based on the method of update chosen."

 I CHGCHK=1 W !!,"End of changes for "_$S(SET="INS":"INSURANCE",SET="GRP":"GROUP",(SET="POL"&'ESGHP):"POLICY",1:"EMPLOYEE SPONSORED GROUP HEALTH PLAN")_" related data."

 K DIR

 D PAUSE^VALM1

 ;

 Q

 ;

ESGHPFLD(ESGHP,IBBUFFLD) ; return true if field should be included, if ESGHP then include all 61.* fields, else exclude those fields

 N IBX,IBY

 S IBX=1,IBY=0,ESGHP=$G(ESGHP)

 I IBBUFFLD>61,IBBUFFLD<61.99 S IBY=1

 I +IBY,'ESGHP S IBX=0

 I 'IBY,ESGHP S IBX=0

 Q IBX

 ;

ACCEPT(BUFDATA,EXTDATA) ; ask user if they want to accept the change, returns true if yes

 N IBX S IBX=0

 I $G(BUFDATA)=$G(EXTDATA) Q IBX

 I BUFDATA="" S DIR("A")="Accept Change, Delete",DIR("?")="The Buffer field is null, accepting the change will result in the Insurance Company data ("_EXTDATA_") being deleted"

 I BUFDATA'="" S DIR("A")="Accept Change, Replace",DIR("?")="Accepting the change will result Buffer data ("_BUFDATA_") replacing the Insurance Company data ("_EXTDATA_")"

 S DIR(0)="Y",DIR("B")="No" D ^DIR I Y=1 S IBX=1

 I $D(DIRUT)!$D(DTOUT) S IBX=-1

 W !

 Q IBX

 ;

 ;

ACCEPTG() ; ask user if they want to accept the entire address change, returns true if yes

 N IBX S IBX=0

 S DIR("A")="Accept Address Change",DIR("?")="Accepting the change will result in the entire Buffer Address replacing the Insurance Company Address"

 S DIR(0)="Y",DIR("B")="No" D ^DIR I Y=1 S IBX=1

 I $D(DIRUT)!$D(DTOUT) S IBX=-1

 W !

 Q IBX

 ;

DISPLAY(BFLD,IFILE,IFLD,LABEL) ; extract, compare, write the two corresponding fields; one from buffer, one from ins files

 N BUFDATA,EXTDATA,IBOVER,IBMERG,IBATTR,IBDATA S EXTDATA=""

 S BUFDATA=$$GET1^DIQ(355.33,IBBUFDA,BFLD)

 I +IBEXTDA S EXTDATA=$$GET1^DIQ(IFILE,IBEXTDA,IFLD)

 S IBDATA=BUFDATA_U_EXTDATA

 ;

 S (IBOVER,IBMERG,IBATTR)=""

 I BUFDATA'=EXTDATA S (IBOVER,IBMERG,IBATTR)="B"

 ; When skipping blanks, display skipped items without bold

 I SKPBLANK,BUFDATA="" S (IBOVER,IBMERG,IBATTR)=""

 ;

 D WRTLN(LABEL,BUFDATA,EXTDATA,IBOVER,IBMERG,IBATTR)

 Q IBDATA

 ;

WRTLN(LABEL,FLD1,FLD2,OVER,MERG,ATTR) ; write a line of formatted data with label and two fields

 S ATTR=$G(ATTR),OVER=ATTR_$G(OVER),MERG=ATTR_$G(MERG)

 S LABEL=$J(LABEL,17)_"  ",FLD1=FLD1_$J("",29-$L(FLD1)),FLD2=FLD2_$J("",29-$L(FLD2))

 W !

 D WRTFLD(LABEL,0,19,ATTR),WRTFLD(FLD1,19,29,MERG)

 D WRTFLD(" | ",48,3,ATTR),WRTFLD(FLD2,51,29,OVER)

 Q

 ;

WRTFLD(STRING,COL,WD,ATTR) ; write an individual field with display attributes

 N ATTRB,ATTRE,DX,DY,X,Y

 S ATTRB="",ATTRB=$S(ATTR["B":$G(IOINHI),1:"")_$S(ATTR["U":$G(IOUON),1:"")

 S ATTRE="",ATTRE=$S(ATTR["B":$G(IOINORM),1:"")_$S(ATTR["U":$G(IOUOFF),1:"")

 ;

 S DX=COL,DY=$Y X IOXY

 W ATTRB,$E(STRING,1,WD),ATTRE

 S DX=(COL+WD),DY=$Y X IOXY

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCNBAC   7727     printed  Mar 13, 2025@21:18:34                                                                                                                                                                                                     Page 2

IBCNBAC   ;ALB/ARH/DAOU/WCW/AWC - Ins Buffer: Individually Accept Insurance Buffer Fields ;28-APR-03

 +1       ;;2.0;INTEGRATED BILLING;**184,497,528**;21-MAR-94;Build 163

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

INS(IBBUFDA,IBINSDA,SKPBLANK) ; display a buffer entry's insurance company fields and an existing insurance company fields for comparison

 +1        NEW IBEXTDA,IBFLD1,IBFLD2,X

           IF '$GET(IBBUFDA)

               QUIT 

 +2        SET SKPBLANK=$GET(SKPBLANK)

 +3       ;

 +4        SET IBEXTDA=$GET(IBINSDA)_","

 +5       ;

 +6        IF +$PIECE($GET(^DIC(36,+IBEXTDA,0)),U,5)

               WRITE !,?10,"Selected Insurance Company "_$$GET1^DIQ(36,IBEXTDA,.01)_" is Inactive!",!

 +7       ;

 +8        WRITE @IOF

 +9        WRITE !

           DO WRTFLD("  Insurance Data:  Buffer Data                     Selected Insurance Company   ",0,80,"BU")

 +10       SET IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.01)

           SET IBFLD2=$SELECT(+IBEXTDA:$$GET1^DIQ(36,IBEXTDA,.01),1:"<none selected>")

           DO WRTLN("Company Name:",IBFLD1,IBFLD2,"","","")

 +11       SET IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.05)

           SET IBFLD2=$SELECT(+IBEXTDA:$$GET1^DIQ(36,IBEXTDA,1),1:"")

           DO WRTLN("Reimburse?:",IBFLD1,IBFLD2,"","","U")

 +12      ;

 +13       DO FIELDS("INS","",SKPBLANK)

 +14      ;

 +15       QUIT 

 +16      ;

GRP(IBBUFDA,IBGRPDA,SKPBLANK) ; display a buffer entrys group insurance fields and an existing group/plan's fields for comparison

 +1        NEW IBEXTDA,IBFLD1,IBFLD2,X

           IF '$GET(IBBUFDA)

               QUIT 

 +2        SET SKPBLANK=$GET(SKPBLANK)

 +3       ;

 +4        SET IBEXTDA=$GET(IBGRPDA)_","

 +5       ;

 +6        IF +$PIECE($GET(^IBA(355.3,+IBEXTDA,0)),U,11)

               WRITE !,?23,"Selected Group/Plan is Inactive!",!

 +7       ;

 +8        WRITE @IOF

 +9        WRITE !

           DO WRTFLD(" Group/Plan Data:  Buffer Data                     Selected Group/Plan          ",0,80,"BU")

 +10       SET IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.01)

           SET IBFLD2=$SELECT(+IBEXTDA:$$GET1^DIQ(355.3,IBEXTDA,.01),1:"<none selected>")

           DO WRTLN("Company Name:",IBFLD1,IBFLD2,"","","")

 +11       SET IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,40.01)

           SET IBFLD2=$SELECT(+IBEXTDA:$$GET1^DIQ(355.3,IBEXTDA,.02),1:"")

           DO WRTLN("Is Group Plan?:",IBFLD1,IBFLD2,"","","U")

 +12      ;

 +13       DO FIELDS("GRP","",SKPBLANK)

 +14      ;

 +15       QUIT 

 +16      ;

POLICY(IBBUFDA,IBPOLDA,SKPBLANK) ; display a buffer entry's patient policy fields and an existing patient policy's fields for comparison

 +1        NEW DFN,IBEXTDA,IBFLD1,IBFLD2,X,Y,DIR,DIRUT

           IF '$GET(IBBUFDA)

               QUIT 

 +2        SET SKPBLANK=$GET(SKPBLANK)

 +3        SET DFN=+$GET(^IBA(355.33,IBBUFDA,60))

 +4       ;

 +5        SET IBEXTDA=$GET(IBPOLDA)_","_DFN_","

 +6       ;

 +7        WRITE @IOF

 +8        WRITE !

           DO WRTFLD("     Policy Data:  Buffer Data                     Selected Policy              ",0,80,"BU")

 +9        SET IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.01)

           SET IBFLD2=$SELECT(+IBEXTDA:$$GET1^DIQ(2.312,IBEXTDA,.01),1:"<none selected>")

           DO WRTLN("Company Name:",IBFLD1,IBFLD2,"","","")

 +10       SET IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,90.02)

           SET IBFLD2=$SELECT(+IBEXTDA:$$GET1^DIQ(2.312,IBEXTDA,21),1:"")

           DO WRTLN("Group #:",IBFLD1,IBFLD2,"","","")

 +11       SET IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,60.01)

           SET IBFLD2=$SELECT(+IBEXTDA:$$GET1^DIQ(2,DFN,.01),1:"")

           DO WRTLN("Patient Name:",IBFLD1,IBFLD2,"","","")

 +12       SET IBFLD1=$PIECE($$GET1^DIQ(355.33,IBBUFDA,.1),"@")

           SET IBFLD2=$SELECT(+IBEXTDA:$PIECE($$GET1^DIQ(2.312,IBEXTDA,1.03),"@"),1:"")

           DO WRTLN("Last Verified:",IBFLD1,IBFLD2,"","","U")

 +13      ;

 +14       DO FIELDS("POL","",SKPBLANK)

 +15      ;

 +16       IF +$GET(^IBA(355.33,IBBUFDA,61))!($$GET1^DIQ(2.312,IBEXTDA,2.1)="YES")

               DO ESGHP(SKPBLANK)

 +17      ;

 +18       QUIT 

 +19      ;

ESGHP(SKPBLANK) ; display employee sponsored group health plan

 +1        SET SKPBLANK=$GET(SKPBLANK)

 +2        WRITE !!

 +3       ;

 +4        DO FIELDS("POL",1,SKPBLANK)

 +5       ;

 +6        QUIT 

 +7       ;

SUB(SKPBLANK,IBFNAM,IBHOLD,IBXHOLD) ; display patient registration

 +1        DO SUB^IBCNBCD7(SKPBLANK,IBFNAM,.IBHOLD,.IBXHOLD)

 +2        QUIT 

 +3       ;

FIELDS(SET,ESGHP,SKPBLANK) ; accept each field and set into temp array

 +1        NEW CHGCHK,IBFLDLST,IBFLDVAL,IBUSER,IBLABEL,EXTFILE,IBEXTFLD

 +2        SET ESGHP=$GET(ESGHP)

           SET SKPBLANK=$GET(SKPBLANK)

 +3       ;

 +4        KILL IBFLDS,IBADDS,IBLBLS

 +5       ;

 +6        SET EXTFILE=+$PIECE($TEXT(@(SET_"DR")+1^IBCNBMI),";;",2)

 +7        DO FIELDS^IBCNBMI(SET_"FLD")

 +8       ;

 +9       ; Initialize variable to check for any items to accept

           SET CHGCHK=0

 +10       SET IBBUFFLD=0

           FOR 

               SET IBBUFFLD=$ORDER(IBFLDS(IBBUFFLD))

               if 'IBBUFFLD

                   QUIT 

               IF '$DATA(IBADDS(IBBUFFLD))

                   Begin DoDot:1

 +11                   IF '$$ESGHPFLD(ESGHP,IBBUFFLD)

                           QUIT 

 +12      ;

 +13                   SET IBEXTFLD=IBFLDS(IBBUFFLD)

                       SET IBLABEL=IBLBLS(IBBUFFLD)_":"

 +14                   SET IBFLDVAL=$$DISPLAY(IBBUFFLD,EXTFILE,IBEXTFLD,IBLABEL)

 +15                   IF $PIECE(IBFLDVAL,U,1)=$PIECE(IBFLDVAL,U,2)

                           QUIT 

 +16                   IF SKPBLANK

                           IF $PIECE(IBFLDVAL,U,1)=""

                               QUIT 

 +17      ;

 +18                   SET CHGCHK=1

 +19                   SET IBUSER=$$ACCEPT($PIECE(IBFLDVAL,U,1),$PIECE(IBFLDVAL,U,2))

                       if IBUSER<0

                           QUIT 

 +20                   IF +IBUSER

                           SET ^TMP($JOB,"IB BUFFER SELECTED",IBBUFFLD)=""

                   End DoDot:1

                   if $GET(IBUSER)<0

                       QUIT 

 +21      ;

 +22      ; allow selection of address data in a group rather than individually

           SET IBFLDLST=""

 +23       SET IBBUFFLD=0

           FOR 

               SET IBBUFFLD=$ORDER(IBFLDS(IBBUFFLD))

               if 'IBBUFFLD

                   QUIT 

               IF $DATA(IBADDS(IBBUFFLD))

                   Begin DoDot:1

 +24                   IF '$$ESGHPFLD(ESGHP,IBBUFFLD)

                           QUIT 

 +25      ;

 +26                   SET IBEXTFLD=IBFLDS(IBBUFFLD)

                       SET IBLABEL=IBLBLS(IBBUFFLD)_":"

 +27                   SET IBFLDVAL=$$DISPLAY(IBBUFFLD,EXTFILE,IBEXTFLD,IBLABEL)

 +28                   IF $PIECE(IBFLDVAL,U,1)=$PIECE(IBFLDVAL,U,2)

                           QUIT 

 +29      ; Do not prompt for blanks, if skipping

                       IF SKPBLANK

                           IF $PIECE(IBFLDVAL,U,1)=""

                               QUIT 

 +30                   SET CHGCHK=1

 +31                   SET IBFLDLST=IBFLDLST_IBBUFFLD_U

                   End DoDot:1

 +32      ;

 +33       IF IBFLDLST'=""

               SET IBUSER=$$ACCEPTG

               if IBUSER<0

                   QUIT 

               Begin DoDot:1

 +34               IF +IBUSER

                       FOR IBUSER=1:1

                           SET IBBUFFLD=$PIECE(IBFLDLST,U,IBUSER)

                           if 'IBBUFFLD

                               QUIT 

                           SET ^TMP($JOB,"IB BUFFER SELECTED",IBBUFFLD)=""

               End DoDot:1

 +35      ;

 +36      ; Display message if there were no changes to accept

 +37       IF CHGCHK=0

               WRITE !!,"There are no changes to be accepted, based on the method of update chosen."

 +38       IF CHGCHK=1

               WRITE !!,"End of changes for "_$SELECT(SET="INS":"INSURANCE",SET="GRP":"GROUP",(SET="POL"&'ESGHP):"POLICY",1:"EMPLOYEE SPONSORED GROUP HEALTH PLAN")_" related data."

 +39       KILL DIR

 +40       DO PAUSE^VALM1

 +41      ;

 +42       QUIT 

 +43      ;

ESGHPFLD(ESGHP,IBBUFFLD) ; return true if field should be included, if ESGHP then include all 61.* fields, else exclude those fields

 +1        NEW IBX,IBY

 +2        SET IBX=1

           SET IBY=0

           SET ESGHP=$GET(ESGHP)

 +3        IF IBBUFFLD>61

               IF IBBUFFLD<61.99

                   SET IBY=1

 +4        IF +IBY

               IF 'ESGHP

                   SET IBX=0

 +5        IF 'IBY

               IF ESGHP

                   SET IBX=0

 +6        QUIT IBX

 +7       ;

ACCEPT(BUFDATA,EXTDATA) ; ask user if they want to accept the change, returns true if yes

 +1        NEW IBX

           SET IBX=0

 +2        IF $GET(BUFDATA)=$GET(EXTDATA)

               QUIT IBX

 +3        IF BUFDATA=""

               SET DIR("A")="Accept Change, Delete"

               SET DIR("?")="The Buffer field is null, accepting the change will result in the Insurance Company data ("_EXTDATA_") being deleted"

 +4        IF BUFDATA'=""

               SET DIR("A")="Accept Change, Replace"

               SET DIR("?")="Accepting the change will result Buffer data ("_BUFDATA_") replacing the Insurance Company data ("_EXTDATA_")"

 +5        SET DIR(0)="Y"

           SET DIR("B")="No"

           DO ^DIR

           IF Y=1

               SET IBX=1

 +6        IF $DATA(DIRUT)!$DATA(DTOUT)

               SET IBX=-1

 +7        WRITE !

 +8        QUIT IBX

 +9       ;

 +10      ;

ACCEPTG() ; ask user if they want to accept the entire address change, returns true if yes

 +1        NEW IBX

           SET IBX=0

 +2        SET DIR("A")="Accept Address Change"

           SET DIR("?")="Accepting the change will result in the entire Buffer Address replacing the Insurance Company Address"

 +3        SET DIR(0)="Y"

           SET DIR("B")="No"

           DO ^DIR

           IF Y=1

               SET IBX=1

 +4        IF $DATA(DIRUT)!$DATA(DTOUT)

               SET IBX=-1

 +5        WRITE !

 +6        QUIT IBX

 +7       ;

DISPLAY(BFLD,IFILE,IFLD,LABEL) ; extract, compare, write the two corresponding fields; one from buffer, one from ins files

 +1        NEW BUFDATA,EXTDATA,IBOVER,IBMERG,IBATTR,IBDATA

           SET EXTDATA=""

 +2        SET BUFDATA=$$GET1^DIQ(355.33,IBBUFDA,BFLD)

 +3        IF +IBEXTDA

               SET EXTDATA=$$GET1^DIQ(IFILE,IBEXTDA,IFLD)

 +4        SET IBDATA=BUFDATA_U_EXTDATA

 +5       ;

 +6        SET (IBOVER,IBMERG,IBATTR)=""

 +7        IF BUFDATA'=EXTDATA

               SET (IBOVER,IBMERG,IBATTR)="B"

 +8       ; When skipping blanks, display skipped items without bold

 +9        IF SKPBLANK

               IF BUFDATA=""

                   SET (IBOVER,IBMERG,IBATTR)=""

 +10      ;

 +11       DO WRTLN(LABEL,BUFDATA,EXTDATA,IBOVER,IBMERG,IBATTR)

 +12       QUIT IBDATA

 +13      ;

WRTLN(LABEL,FLD1,FLD2,OVER,MERG,ATTR) ; write a line of formatted data with label and two fields

 +1        SET ATTR=$GET(ATTR)

           SET OVER=ATTR_$GET(OVER)

           SET MERG=ATTR_$GET(MERG)

 +2        SET LABEL=$JUSTIFY(LABEL,17)_"  "

           SET FLD1=FLD1_$JUSTIFY("",29-$LENGTH(FLD1))

           SET FLD2=FLD2_$JUSTIFY("",29-$LENGTH(FLD2))

 +3        WRITE !

 +4        DO WRTFLD(LABEL,0,19,ATTR)

           DO WRTFLD(FLD1,19,29,MERG)

 +5        DO WRTFLD(" | ",48,3,ATTR)

           DO WRTFLD(FLD2,51,29,OVER)

 +6        QUIT 

 +7       ;

WRTFLD(STRING,COL,WD,ATTR) ; write an individual field with display attributes

 +1        NEW ATTRB,ATTRE,DX,DY,X,Y

 +2        SET ATTRB=""

           SET ATTRB=$SELECT(ATTR["B":$GET(IOINHI),1:"")_$SELECT(ATTR["U":$GET(IOUON),1:"")

 +3        SET ATTRE=""

           SET ATTRE=$SELECT(ATTR["B":$GET(IOINORM),1:"")_$SELECT(ATTR["U":$GET(IOUOFF),1:"")

 +4       ;

 +5        SET DX=COL

           SET DY=$Y

           XECUTE IOXY

 +6        WRITE ATTRB,$EXTRACT(STRING,1,WD),ATTRE

 +7        SET DX=(COL+WD)

           SET DY=$Y

           XECUTE IOXY

 +8        QUIT