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 ---[H[J[2J[HIBCNBAC 7727 printed Sep 23, 2025@19:49:59 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
