source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNBCD.m@ 699

Last change on this file since 699 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 6.1 KB
Line 
1IBCNBCD ;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 ;
5INS(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 ;
30GRP(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 ;
55POLICY(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 ;
87ESGHP ; 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 ;
104DISPLAY(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 ;
114WRTLN(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 ;
122WRTFLD(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 TracBrowser for help on using the repository browser.