IBCNBCD ;ALB/ARH-Ins Buffer: display/compare buffer and existing ins ;1 Jun 97 ;;2.0;INTEGRATED BILLING;**82,251,361**;21-MAR-94;Build 9 ;;Per VHA Directive 2004-038, this routine should not be modified. ; INS(IBBUFDA,IBINSDA) ; display a buffer entry's insurance company fields and ; an existing insurance company's fields for comparison N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q ; 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 ! 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:"") 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 DISPLAY(20.02,36,.131,"Phone Number:") D DISPLAY(20.03,36,.132,"Billing Phone:") D DISPLAY(20.04,36,.133,"Pre-Cert Phone:") D DISPLAY(21.01,36,.111,"Street [Line 1]:") D DISPLAY(21.02,36,.112,"Street [Line 2]:") D DISPLAY(21.03,36,.113,"Street [Line 3]:") D DISPLAY(21.04,36,.114,"City:") D DISPLAY(21.05,36,.115,"State:") D DISPLAY(21.06,36,.116,"Zip Code:") ; S IBFLD1="(bold=accepted on Merge)",IBFLD2="(bold=replaced on Overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") Q ; GRP(IBBUFDA,IBGRPDA) ; display a buffer entry's group insurance fields and an existing group/plan's fields for comparison N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q ; S IBEXTDA=$G(IBGRPDA)_"," ; I +$P($G(^IBA(355.3,+IBEXTDA,0)),U,11) W !,?23,"Selected Group/Plan is Inactive!",! ; 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:"") 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 DISPLAY(40.02,355.3,.03,"Group Name:") D DISPLAY(40.03,355.3,.04,"Group Number:") D DISPLAY(40.1,355.3,6.02,"BIN:") ;;Daou/EEN - adding BIN and PCN D DISPLAY(40.11,355.3,6.03,"PCN:") D DISPLAY(40.04,355.3,.05,"Require UR:") D DISPLAY(40.05,355.3,.06,"Require Pre-Cert:") D DISPLAY(40.06,355.3,.12,"Require Amb Cert:") D DISPLAY(40.07,355.3,.07,"Exclude Pre-Cond:") D DISPLAY(40.08,355.3,.08,"Benefits Assign:") D DISPLAY(40.09,355.3,.09,"Type of Plan:") ; S IBFLD1="(bold=accepted on merge)",IBFLD2="(bold=replaced on overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") Q ; POLICY(IBBUFDA,IBPOLDA) ; 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 DFN=+$G(^IBA(355.33,IBBUFDA,60)) ; S IBEXTDA=$G(IBPOLDA)_","_DFN_"," ; 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:"") D WRTLN("Company Name:",IBFLD1,IBFLD2,"","","") S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,40.03),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 DISPLAY(60.02,2.312,8,"Effective Date:") D DISPLAY(60.03,2.312,3,"Expiration Date:") D DISPLAY(60.04,2.312,1,"Subscriber Id:") D DISPLAY(60.05,2.312,6,"Whose Insurance:") D DISPLAY(60.06,2.312,16,"Relationship:") D DISPLAY(60.07,2.312,17,"Name of Insured:") D DISPLAY(60.08,2.312,3.01,"Insured's DOB:") D DISPLAY(60.09,2.312,3.05,"Insured's SSN:") D DISPLAY(60.13,2.312,3.12,"Insured's SEX:") D DISPLAY(60.1,2.312,4.01,"Primary Provider:") D DISPLAY(60.11,2.312,4.02,"Provider Phone:") D DISPLAY(60.12,2.312,.2,"Coor of Benefits:") D DISPLAY(61.01,2.312,2.1,"Emp Sponsored?:") ; I +$G(^IBA(355.33,IBBUFDA,61))!($$GET1^DIQ(2.312,IBEXTDA,2.1)="YES") D ESGHP ; S IBFLD1="(bold=accepted on merge)",IBFLD2="(bold=replaced on overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") ; Q ; ESGHP ; display employee sponsored group health plan W ! S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR W ! Q:$D(DIRUT) ; D DISPLAY(61.02,2.312,2.015,"Employer Name:") D DISPLAY(61.03,2.312,2.11,"Emp Status:") D DISPLAY(61.04,2.312,2.12,"Retirement Date:") D DISPLAY(61.05,2.312,2.01,"Send to Employer:") D DISPLAY(61.06,2.312,2.02,"Emp Street Ln 1:") D DISPLAY(61.07,2.312,2.03,"Emp Street Ln 2:") D DISPLAY(61.08,2.312,2.04,"Emp Street Ln 3:") D DISPLAY(61.09,2.312,2.05,"Emp City:") D DISPLAY(61.1,2.312,2.06,"Emp State:") D DISPLAY(61.11,2.312,2.07,"Emp Zip Code:") D DISPLAY(61.12,2.312,2.08,"Emp Phone:") ; Q ; DISPLAY(BFLD,IFILE,IFLD,LABEL) ; extract, compare, write the two corresponding fields; one from buffer, one from ins files N BUFDATA,EXTDATA,IBOVER,IBMERG S EXTDATA="" S BUFDATA=$$GET1^DIQ(355.33,IBBUFDA,BFLD) I +IBEXTDA S EXTDATA=$$GET1^DIQ(IFILE,IBEXTDA,IFLD) ; S IBOVER=$S(BUFDATA'=""&(BUFDATA'=EXTDATA):"B",1:""),IBMERG=$S(EXTDATA="":"B",1:"") ; D WRTLN(LABEL,BUFDATA,EXTDATA,IBOVER,IBMERG) Q ; 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