- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNBCD.m
r613 r623 1 IBCNBCD ;ALB/ARH-Ins Buffer: display/compare buffer and existing ins ;1 Jun 97 2 ;;2.0;INTEGRATED BILLING;**82,251,361,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 INS(IBBUFDA,IBINSDA) ; display a buffer entry's insurance company fields and 6 ; an existing insurance company's fields for comparison 7 N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q 8 ; 9 S IBEXTDA=$G(IBINSDA)_"," 10 ; 11 I +$P($G(^DIC(36,+IBEXTDA,0)),U,5) W !,?10,"Selected Insurance Company "_$$GET1^DIQ(36,IBEXTDA,.01)_" is Inactive!",! 12 ; 13 W ! D WRTFLD(" Insurance Data: Buffer Data Selected Insurance Company ",0,80,"BU") 14 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,"","","") 15 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.05),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(36,IBEXTDA,1),1:"") D WRTLN("Reimburse?:",IBFLD1,IBFLD2,"","","U") 16 ; 17 D DISPLAY(20.02,36,.131,"Phone Number:") 18 D DISPLAY(20.03,36,.132,"Billing Phone:") 19 D DISPLAY(20.04,36,.133,"Pre-Cert Phone:") 20 D DISPLAY(21.01,36,.111,"Street [Line 1]:") 21 D DISPLAY(21.02,36,.112,"Street [Line 2]:") 22 D DISPLAY(21.03,36,.113,"Street [Line 3]:") 23 D DISPLAY(21.04,36,.114,"City:") 24 D DISPLAY(21.05,36,.115,"State:") 25 D DISPLAY(21.06,36,.116,"Zip Code:") 26 ; 27 S IBFLD1="(bold=accepted on Merge)",IBFLD2="(bold=replaced on Overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") 28 Q 29 ; 30 GRP(IBBUFDA,IBGRPDA) ; display a buffer entry's group insurance fields and an existing group/plan's fields for comparison 31 N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q 32 ; 33 S IBEXTDA=$G(IBGRPDA)_"," 34 ; 35 I +$P($G(^IBA(355.3,+IBEXTDA,0)),U,11) W !,?23,"Selected Group/Plan is Inactive!",! 36 ; 37 W ! D WRTFLD(" Group/Plan Data: Buffer Data Selected Group/Plan ",0,80,"BU") 38 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,"","","") 39 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") 40 ; 41 D DISPLAY(40.02,355.3,.03,"Group Name:") 42 D DISPLAY(40.03,355.3,.04,"Group Number:") 43 D DISPLAY(40.1,355.3,6.02,"BIN:") ;;Daou/EEN - adding BIN and PCN 44 D DISPLAY(40.11,355.3,6.03,"PCN:") 45 D DISPLAY(40.04,355.3,.05,"Require UR:") 46 D DISPLAY(40.05,355.3,.06,"Require Pre-Cert:") 47 D DISPLAY(40.06,355.3,.12,"Require Amb Cert:") 48 D DISPLAY(40.07,355.3,.07,"Exclude Pre-Cond:") 49 D DISPLAY(40.08,355.3,.08,"Benefits Assign:") 50 D DISPLAY(40.09,355.3,.09,"Type of Plan:") 51 ; 52 S IBFLD1="(bold=accepted on merge)",IBFLD2="(bold=replaced on overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") 53 Q 54 ; 55 POLICY(IBBUFDA,IBPOLDA) ; display a buffer entry's patient policy fields and an existing patient policy's fields for comparison 56 N DFN,IBEXTDA,IBFLD1,IBFLD2,X,Y,DIR,DIRUT I '$G(IBBUFDA) Q 57 S DFN=+$G(^IBA(355.33,IBBUFDA,60)) 58 ; 59 S IBEXTDA=$G(IBPOLDA)_","_DFN_"," 60 ; 61 W ! D WRTFLD(" Policy Data: Buffer Data Selected Policy ",0,80,"BU") 62 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,"","","") 63 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,40.03),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(2.312,IBEXTDA,21),1:"") D WRTLN("Group #:",IBFLD1,IBFLD2,"","","") 64 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,60.01),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(2,DFN,.01),1:"") D WRTLN("Patient Name:",IBFLD1,IBFLD2,"","","") 65 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") 66 ; 67 D DISPLAY(60.02,2.312,8,"Effective Date:") 68 D DISPLAY(60.03,2.312,3,"Expiration Date:") 69 D DISPLAY(60.04,2.312,1,"Subscriber Id:") 70 D DISPLAY(60.05,2.312,6,"Whose Insurance:") 71 D DISPLAY(60.06,2.312,16,"Relationship:") 72 D DISPLAY(60.07,2.312,17,"Name of Insured:") 73 D DISPLAY(60.08,2.312,3.01,"Insured's DOB:") 74 D DISPLAY(60.09,2.312,3.05,"Insured's SSN:") 75 D DISPLAY(60.13,2.312,3.12,"Insured's SEX:") 76 D DISPLAY(60.1,2.312,4.01,"Primary Provider:") 77 D DISPLAY(60.11,2.312,4.02,"Provider Phone:") 78 D DISPLAY(60.12,2.312,.2,"Coor of Benefits:") 79 D DISPLAY(61.01,2.312,2.1,"Emp Sponsored?:") 80 D DISPLAY(62.01,2.312,5.01,"Patient Id:") 81 ; 82 I +$G(^IBA(355.33,IBBUFDA,61))!($$GET1^DIQ(2.312,IBEXTDA,2.1)="YES") D ESGHP 83 ; 84 S IBFLD1="(bold=accepted on merge)",IBFLD2="(bold=replaced on overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") 85 ; 86 Q 87 ; 88 ESGHP ; display employee sponsored group health plan 89 W ! S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR W ! Q:$D(DIRUT) 90 ; 91 D DISPLAY(61.02,2.312,2.015,"Employer Name:") 92 D DISPLAY(61.03,2.312,2.11,"Emp Status:") 93 D DISPLAY(61.04,2.312,2.12,"Retirement Date:") 94 D DISPLAY(61.05,2.312,2.01,"Send to Employer:") 95 D DISPLAY(61.06,2.312,2.02,"Emp Street Ln 1:") 96 D DISPLAY(61.07,2.312,2.03,"Emp Street Ln 2:") 97 D DISPLAY(61.08,2.312,2.04,"Emp Street Ln 3:") 98 D DISPLAY(61.09,2.312,2.05,"Emp City:") 99 D DISPLAY(61.1,2.312,2.06,"Emp State:") 100 D DISPLAY(61.11,2.312,2.07,"Emp Zip Code:") 101 D DISPLAY(61.12,2.312,2.08,"Emp Phone:") 102 ; 103 Q 104 ; 105 DISPLAY(BFLD,IFILE,IFLD,LABEL) ; extract, compare, write the two corresponding fields; one from buffer, one from ins files 106 N BUFDATA,EXTDATA,IBOVER,IBMERG S EXTDATA="" 107 S BUFDATA=$$GET1^DIQ(355.33,IBBUFDA,BFLD) 108 I +IBEXTDA S EXTDATA=$$GET1^DIQ(IFILE,IBEXTDA,IFLD) 109 ; 110 S IBOVER=$S(BUFDATA'=""&(BUFDATA'=EXTDATA):"B",1:""),IBMERG=$S(EXTDATA="":"B",1:"") 111 ; 112 D WRTLN(LABEL,BUFDATA,EXTDATA,IBOVER,IBMERG) 113 Q 114 ; 115 WRTLN(LABEL,FLD1,FLD2,OVER,MERG,ATTR) ; write a line of formatted data with label and two fields 116 S ATTR=$G(ATTR),OVER=ATTR_$G(OVER),MERG=ATTR_$G(MERG) 117 S LABEL=$J(LABEL,17)_" ",FLD1=FLD1_$J("",29-$L(FLD1)),FLD2=FLD2_$J("",29-$L(FLD2)) 118 W ! 119 D WRTFLD(LABEL,0,19,ATTR),WRTFLD(FLD1,19,29,MERG) 120 D WRTFLD(" | ",48,3,ATTR),WRTFLD(FLD2,51,29,OVER) 121 Q 122 ; 123 WRTFLD(STRING,COL,WD,ATTR) ; write an individual field with display attributes 124 N ATTRB,ATTRE,DX,DY,X,Y 125 S ATTRB="",ATTRB=$S(ATTR["B":$G(IOINHI),1:"")_$S(ATTR["U":$G(IOUON),1:"") 126 S ATTRE="",ATTRE=$S(ATTR["B":$G(IOINORM),1:"")_$S(ATTR["U":$G(IOUOFF),1:"") 127 ; 128 S DX=COL,DY=$Y X IOXY 129 W ATTRB,$E(STRING,1,WD),ATTRE 130 S DX=(COL+WD),DY=$Y X IOXY 131 Q 1 IBCNBCD ;ALB/ARH-Ins Buffer: display/compare buffer and existing ins ;1 Jun 97 2 ;;2.0;INTEGRATED BILLING;**82,251,361**;21-MAR-94;Build 9 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 INS(IBBUFDA,IBINSDA) ; display a buffer entry's insurance company fields and 6 ; an existing insurance company's fields for comparison 7 N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q 8 ; 9 S IBEXTDA=$G(IBINSDA)_"," 10 ; 11 I +$P($G(^DIC(36,+IBEXTDA,0)),U,5) W !,?10,"Selected Insurance Company "_$$GET1^DIQ(36,IBEXTDA,.01)_" is Inactive!",! 12 ; 13 W ! D WRTFLD(" Insurance Data: Buffer Data Selected Insurance Company ",0,80,"BU") 14 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,"","","") 15 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,20.05),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(36,IBEXTDA,1),1:"") D WRTLN("Reimburse?:",IBFLD1,IBFLD2,"","","U") 16 ; 17 D DISPLAY(20.02,36,.131,"Phone Number:") 18 D DISPLAY(20.03,36,.132,"Billing Phone:") 19 D DISPLAY(20.04,36,.133,"Pre-Cert Phone:") 20 D DISPLAY(21.01,36,.111,"Street [Line 1]:") 21 D DISPLAY(21.02,36,.112,"Street [Line 2]:") 22 D DISPLAY(21.03,36,.113,"Street [Line 3]:") 23 D DISPLAY(21.04,36,.114,"City:") 24 D DISPLAY(21.05,36,.115,"State:") 25 D DISPLAY(21.06,36,.116,"Zip Code:") 26 ; 27 S IBFLD1="(bold=accepted on Merge)",IBFLD2="(bold=replaced on Overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") 28 Q 29 ; 30 GRP(IBBUFDA,IBGRPDA) ; display a buffer entry's group insurance fields and an existing group/plan's fields for comparison 31 N IBEXTDA,IBFLD1,IBFLD2,X I '$G(IBBUFDA) Q 32 ; 33 S IBEXTDA=$G(IBGRPDA)_"," 34 ; 35 I +$P($G(^IBA(355.3,+IBEXTDA,0)),U,11) W !,?23,"Selected Group/Plan is Inactive!",! 36 ; 37 W ! D WRTFLD(" Group/Plan Data: Buffer Data Selected Group/Plan ",0,80,"BU") 38 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,"","","") 39 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") 40 ; 41 D DISPLAY(40.02,355.3,.03,"Group Name:") 42 D DISPLAY(40.03,355.3,.04,"Group Number:") 43 D DISPLAY(40.1,355.3,6.02,"BIN:") ;;Daou/EEN - adding BIN and PCN 44 D DISPLAY(40.11,355.3,6.03,"PCN:") 45 D DISPLAY(40.04,355.3,.05,"Require UR:") 46 D DISPLAY(40.05,355.3,.06,"Require Pre-Cert:") 47 D DISPLAY(40.06,355.3,.12,"Require Amb Cert:") 48 D DISPLAY(40.07,355.3,.07,"Exclude Pre-Cond:") 49 D DISPLAY(40.08,355.3,.08,"Benefits Assign:") 50 D DISPLAY(40.09,355.3,.09,"Type of Plan:") 51 ; 52 S IBFLD1="(bold=accepted on merge)",IBFLD2="(bold=replaced on overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") 53 Q 54 ; 55 POLICY(IBBUFDA,IBPOLDA) ; display a buffer entry's patient policy fields and an existing patient policy's fields for comparison 56 N DFN,IBEXTDA,IBFLD1,IBFLD2,X,Y,DIR,DIRUT I '$G(IBBUFDA) Q 57 S DFN=+$G(^IBA(355.33,IBBUFDA,60)) 58 ; 59 S IBEXTDA=$G(IBPOLDA)_","_DFN_"," 60 ; 61 W ! D WRTFLD(" Policy Data: Buffer Data Selected Policy ",0,80,"BU") 62 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,"","","") 63 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,40.03),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(2.312,IBEXTDA,21),1:"") D WRTLN("Group #:",IBFLD1,IBFLD2,"","","") 64 S IBFLD1=$$GET1^DIQ(355.33,IBBUFDA,60.01),IBFLD2=$S(+IBEXTDA:$$GET1^DIQ(2,DFN,.01),1:"") D WRTLN("Patient Name:",IBFLD1,IBFLD2,"","","") 65 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") 66 ; 67 D DISPLAY(60.02,2.312,8,"Effective Date:") 68 D DISPLAY(60.03,2.312,3,"Expiration Date:") 69 D DISPLAY(60.04,2.312,1,"Subscriber Id:") 70 D DISPLAY(60.05,2.312,6,"Whose Insurance:") 71 D DISPLAY(60.06,2.312,16,"Relationship:") 72 D DISPLAY(60.07,2.312,17,"Name of Insured:") 73 D DISPLAY(60.08,2.312,3.01,"Insured's DOB:") 74 D DISPLAY(60.09,2.312,3.05,"Insured's SSN:") 75 D DISPLAY(60.13,2.312,3.12,"Insured's SEX:") 76 D DISPLAY(60.1,2.312,4.01,"Primary Provider:") 77 D DISPLAY(60.11,2.312,4.02,"Provider Phone:") 78 D DISPLAY(60.12,2.312,.2,"Coor of Benefits:") 79 D DISPLAY(61.01,2.312,2.1,"Emp Sponsored?:") 80 ; 81 I +$G(^IBA(355.33,IBBUFDA,61))!($$GET1^DIQ(2.312,IBEXTDA,2.1)="YES") D ESGHP 82 ; 83 S IBFLD1="(bold=accepted on merge)",IBFLD2="(bold=replaced on overwrite)" D WRTLN("",IBFLD1,IBFLD2,"","","U") 84 ; 85 Q 86 ; 87 ESGHP ; display employee sponsored group health plan 88 W ! S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR W ! Q:$D(DIRUT) 89 ; 90 D DISPLAY(61.02,2.312,2.015,"Employer Name:") 91 D DISPLAY(61.03,2.312,2.11,"Emp Status:") 92 D DISPLAY(61.04,2.312,2.12,"Retirement Date:") 93 D DISPLAY(61.05,2.312,2.01,"Send to Employer:") 94 D DISPLAY(61.06,2.312,2.02,"Emp Street Ln 1:") 95 D DISPLAY(61.07,2.312,2.03,"Emp Street Ln 2:") 96 D DISPLAY(61.08,2.312,2.04,"Emp Street Ln 3:") 97 D DISPLAY(61.09,2.312,2.05,"Emp City:") 98 D DISPLAY(61.1,2.312,2.06,"Emp State:") 99 D DISPLAY(61.11,2.312,2.07,"Emp Zip Code:") 100 D DISPLAY(61.12,2.312,2.08,"Emp Phone:") 101 ; 102 Q 103 ; 104 DISPLAY(BFLD,IFILE,IFLD,LABEL) ; extract, compare, write the two corresponding fields; one from buffer, one from ins files 105 N BUFDATA,EXTDATA,IBOVER,IBMERG S EXTDATA="" 106 S BUFDATA=$$GET1^DIQ(355.33,IBBUFDA,BFLD) 107 I +IBEXTDA S EXTDATA=$$GET1^DIQ(IFILE,IBEXTDA,IFLD) 108 ; 109 S IBOVER=$S(BUFDATA'=""&(BUFDATA'=EXTDATA):"B",1:""),IBMERG=$S(EXTDATA="":"B",1:"") 110 ; 111 D WRTLN(LABEL,BUFDATA,EXTDATA,IBOVER,IBMERG) 112 Q 113 ; 114 WRTLN(LABEL,FLD1,FLD2,OVER,MERG,ATTR) ; write a line of formatted data with label and two fields 115 S ATTR=$G(ATTR),OVER=ATTR_$G(OVER),MERG=ATTR_$G(MERG) 116 S LABEL=$J(LABEL,17)_" ",FLD1=FLD1_$J("",29-$L(FLD1)),FLD2=FLD2_$J("",29-$L(FLD2)) 117 W ! 118 D WRTFLD(LABEL,0,19,ATTR),WRTFLD(FLD1,19,29,MERG) 119 D WRTFLD(" | ",48,3,ATTR),WRTFLD(FLD2,51,29,OVER) 120 Q 121 ; 122 WRTFLD(STRING,COL,WD,ATTR) ; write an individual field with display attributes 123 N ATTRB,ATTRE,DX,DY,X,Y 124 S ATTRB="",ATTRB=$S(ATTR["B":$G(IOINHI),1:"")_$S(ATTR["U":$G(IOUON),1:"") 125 S ATTRE="",ATTRE=$S(ATTR["B":$G(IOINORM),1:"")_$S(ATTR["U":$G(IOUOFF),1:"") 126 ; 127 S DX=COL,DY=$Y X IOXY 128 W ATTRB,$E(STRING,1,WD),ATTRE 129 S DX=(COL+WD),DY=$Y X IOXY 130 Q
Note:
See TracChangeset
for help on using the changeset viewer.
