1 | IBCNERP3 ;DAOU/BHS - IBCNE IIV RESPONSE REPORT PRINT ;03-JUN-2002
|
---|
2 | ;;2.0;INTEGRATED BILLING;**184,271**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; IIV - Insurance Identification and Verification
|
---|
6 | ;
|
---|
7 | ; Called by IBCNERPA
|
---|
8 | ; Input from IBCNERP1/2:
|
---|
9 | ; IBCNERTN="IBCNERP1" - Driver rtn
|
---|
10 | ; IBCNESPC("BEGDT")=Start Dt, IBCNESPC("ENDDT")=End Dt
|
---|
11 | ; IBCNESPC("PYR")=Pyr IEN OR "" for all
|
---|
12 | ; IBCNESPC("PAT")=Pat IEN OR "" for all
|
---|
13 | ; IBCNESPC("TYPE")=A (All Responses) OR M (Most Recent Responses) for
|
---|
14 | ; unique Pyr/Pt pair
|
---|
15 | ; IBCNESPC("SORT")=1 (PyrNm) OR 2 (PatNm)
|
---|
16 | ; IBCNESPC("TRCN")=Trace #^IEN, if non-null, all params null
|
---|
17 | ; IBCNESPC("RFLAG")=Report Flag used to indicate which report is being
|
---|
18 | ; run. Response Report (0), Inactive Report (1), or Ambiguous
|
---|
19 | ; Report (2).
|
---|
20 | ; IBCNESPC("DTEXP")=Expiration date used in the inactive policy report
|
---|
21 | ;
|
---|
22 | ; Based on structure of IIV Response File (#365)
|
---|
23 | ; ^TMP($J,IBCNERTN,S1,S2,CT,0) based on ^IBCN(365,DA,0)
|
---|
24 | ; IBCNERTN="IBCNERP1", S1=PyrName(SORT=1) or PatNm(SORT=2),
|
---|
25 | ; S2=PatName(SORT=1) or PyrName(SORT=2), CT=Seq ct
|
---|
26 | ; ^TMP($J,IBCNERTN,S1,S2,CT,1) based on ^IBCN(365,DA,1)
|
---|
27 | ; ^TMP($J,IBCNERTN,S1,S2,2,EBCT) based on ^IBCN(365,DA,2)
|
---|
28 | ; EBCT=E/B IEN (365.02)
|
---|
29 | ; ^TMP($J,IBCNERTN,S1,S2,2,EBCT,NTCT)=based on ^IBCN(365,DA,2,EB,NT)
|
---|
30 | ; NTCT=Notes Ct, may not be Notes IEN, if line wrapped (365.021)
|
---|
31 | ; ^TMP($J,IBCNERTN,S1,S2,2,CNCT) based on ^IBCN(365,DA,3)
|
---|
32 | ; CNCT=Cont Pers IEN (365.03)
|
---|
33 | ; ^TMP($J,IBCNERTN,S1,S2,4,CT)= err txt based on ^IBCN(365,DA,4)
|
---|
34 | ; CT=1/2 if >60 ch long
|
---|
35 | ; ^TMP($J,IBCNERTN,S1,S2,5,CT)= based on # lines of comments reqd
|
---|
36 | ; CT=1 to display future retransmission date
|
---|
37 | ; Must call at appropriate tag
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | PRINT(RTN,BDT,EDT,PYR,PAT,TYP,SRT,PGC,PXT,MAX,CRT,TRC,EXP,IPRF) ; Print data
|
---|
41 | ; Input: RTN="IBCENRP1", BDT=start dt, EDT=end dt, PYR=pyr ien,
|
---|
42 | ; PAT= pat ien, TYP=A/M, SRT=1/2, PGC=page ct, PXT=exit flg,
|
---|
43 | ; MAX=max line ct/pg, CRT=1/0, TRC=trc#, EXP=earliest expiration date
|
---|
44 | N EORMSG,NONEMSG,SORT1,SORT2,CNT,EBFLG,CNFLG,ERFLG,PRT1,PRT2 ;,DISPDATA
|
---|
45 | N OPRT1,OPRT2 ; Original values for PRT1 and PRT2, respectively
|
---|
46 | S EORMSG="*** END OF REPORT ***"
|
---|
47 | S NONEMSG="* * * N O D A T A F O U N D * * *"
|
---|
48 | S (SORT1,SORT2)=""
|
---|
49 | I '$D(^TMP($J,RTN)) D HEADER W !,?(80-$L(NONEMSG)\2),NONEMSG,!!
|
---|
50 | F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:PXT!$G(ZTSTOP)
|
---|
51 | . S (OPRT1,PRT1)=$S(SORT1="~NO PAYER":"* No Payer Identified",1:SORT1)
|
---|
52 | . S SORT2="" F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:PXT!$G(ZTSTOP)
|
---|
53 | . . S (OPRT2,PRT2)=$S(SORT2="~NO PAYER":"* No Payer Identified",1:SORT2)
|
---|
54 | . . S CNT="" F S CNT=$O(^TMP($J,RTN,SORT1,SORT2,CNT)) Q:CNT="" D Q:PXT!$G(ZTSTOP)
|
---|
55 | . . . D SSDB ; add SSN (from ^DPT) and DOB to patient header info
|
---|
56 | . . . D HEADER
|
---|
57 | . . . I $G(ZTSTOP)!PXT Q
|
---|
58 | . . . K DISPDATA ; Init disp
|
---|
59 | . . . D DATA^IBCNERPE(.DISPDATA),LINE(.DISPDATA) ; build/display data
|
---|
60 | ;
|
---|
61 | I $G(ZTSTOP)!PXT G PRINTX
|
---|
62 | S (EBFLG,CNFLG,ERFLG)=0
|
---|
63 | I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
|
---|
64 | W !,?(80-$L(EORMSG)\2),EORMSG
|
---|
65 | PRINTX ;
|
---|
66 | Q
|
---|
67 | ;
|
---|
68 | HEADER ; Print hdr info
|
---|
69 | N X,Y,DIR,DTOUT,DUOUT,OFFSET,HDR,LIN,HDR
|
---|
70 | I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX
|
---|
71 | . I MAX<51 F LIN=1:1:(MAX-$Y) W !
|
---|
72 | . S DIR(0)="E" D ^DIR K DIR
|
---|
73 | . I $D(DTOUT)!($D(DUOUT)) S PXT=1 Q
|
---|
74 | I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 G HEADERX
|
---|
75 | S PGC=PGC+1
|
---|
76 | W @IOF,!,?1,$S($G(IPRF)=1:"IIV Inactive Policy Report",$G(IPRF)=2:"IIV Ambiguous Policy Report",1:"IIV Response Report") I TRC'="" W " by Trace #"
|
---|
77 | S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC,OFFSET=79-$L(HDR)
|
---|
78 | W ?OFFSET,HDR
|
---|
79 | I TRC'="" S HDR="Trace #: "_TRC,OFFSET=80-$L(HDR)\2 W !,?OFFSET,HDR
|
---|
80 | I TRC="" D
|
---|
81 | . W !,?1,"Sorted by: "_$S(SRT=1:"Payer",1:"Patient")_" Name"
|
---|
82 | . S HDR="Responses Displayed: "_$S(TYP="M":"Most Recent",1:"All")
|
---|
83 | . S OFFSET=79-$L(HDR)
|
---|
84 | . W ?OFFSET,HDR
|
---|
85 | . I $G(IPRF)=1 W !,?1,"Earliest Policy Expiration Date: ",$$FMTE^XLFDT(EXP,"5Z"),!
|
---|
86 | . S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
|
---|
87 | . S OFFSET=80-$L(HDR)\2
|
---|
88 | . W !,?OFFSET,HDR
|
---|
89 | . ; Disp SORT1 rng
|
---|
90 | . S HDR=""
|
---|
91 | . I SRT=1,PYR="" S HDR="All Payers"
|
---|
92 | . I SRT=2,PAT="" S HDR="All Patients"
|
---|
93 | . I HDR="" D
|
---|
94 | .. I SRT=1 S HDR=$P($G(^IBE(365.12,PYR,0)),U,1) Q
|
---|
95 | .. S HDR=$P($G(^DPT(PAT,0)),U,1)
|
---|
96 | . S OFFSET=80-$L(HDR)\2
|
---|
97 | . W !,?OFFSET,HDR
|
---|
98 | . ; Disp SORT2 rng
|
---|
99 | . S HDR=""
|
---|
100 | . I SRT=1,PAT="" S HDR="All Patients"
|
---|
101 | . I SRT=2,PYR="" S HDR="All Payers"
|
---|
102 | . I HDR="" D
|
---|
103 | .. I SRT=1 S HDR=$P($G(^DPT(PAT,0)),U,1) Q
|
---|
104 | .. S HDR=$P($G(^IBE(365.12,PYR,0)),U,1)
|
---|
105 | . S OFFSET=80-$L(HDR)\2
|
---|
106 | . W !,?OFFSET,HDR
|
---|
107 | W !
|
---|
108 | ; Build disp
|
---|
109 | I SORT1'="",SORT2'="" D
|
---|
110 | . W !,?1,$$FO^IBCNEUT1($S(TRC'=""!(SRT=1):" Payer: ",1:"Patient: "),9)_$E(PRT1,1,69)
|
---|
111 | . W !,?1,$$FO^IBCNEUT1($S(TRC'=""!(SRT=1):"Patient: ",1:" Payer: "),9)_$E(PRT2,1,69)
|
---|
112 | . W !
|
---|
113 | HEADERX ;
|
---|
114 | Q
|
---|
115 | ;
|
---|
116 | LINE(DISPDATA) ; Print data
|
---|
117 | N LNCT,LNTOT,NWPG
|
---|
118 | S LNTOT=+$O(DISPDATA(""),-1)
|
---|
119 | S (EBFLG,CNFLG,ERFLG,NWPG)=0
|
---|
120 | F LNCT=1:1:LNTOT D Q:$G(ZTSTOP)!PXT
|
---|
121 | . I $Y+1>MAX!('PGC) D HEADER S NWPG=1 I $G(ZTSTOP)!PXT Q
|
---|
122 | . I DISPDATA(LNCT)="Eligibility/Benefit Information:"!(DISPDATA(LNCT)="Contact Information:")!(DISPDATA(LNCT)="Error Information:"),$Y+3>MAX S (EBFLG,CNFLG,ERFLG)=0 D HEADER S NWPG=1 I $G(ZTSTOP)!PXT Q
|
---|
123 | . I EBFLG,DISPDATA(LNCT)="",($G(DISPDATA(LNCT+1))="Contact Information:")!($G(DISPDATA(LNCT+1))="Error Information") S EBFLG=0
|
---|
124 | . I CNFLG,DISPDATA(LNCT)="",$G(DISPDATA(LNCT+1))="Error Information:" S CNFLG=0
|
---|
125 | . I NWPG,EBFLG W !,?1,"Eligibility/Benefit Information: (cont'd)",!
|
---|
126 | . I NWPG,CNFLG W !,?1,"Contact Information: (cont'd)",!
|
---|
127 | . I NWPG,ERFLG W !,?1,"Error Information: (cont'd)",!
|
---|
128 | . I 'NWPG!(NWPG&(DISPDATA(LNCT)'="")) W !,?1,DISPDATA(LNCT)
|
---|
129 | . I NWPG S NWPG=0
|
---|
130 | . I DISPDATA(LNCT)["Eligibility/Benefit Information:" S EBFLG=1,(CNFLG,ERFLG)=0
|
---|
131 | . I DISPDATA(LNCT)["Contact Information:" S (EBFLG,ERFLG)=0,CNFLG=1
|
---|
132 | . I DISPDATA(LNCT)["Error Information:" S (EBFLG,CNFLG)=0,ERFLG=1
|
---|
133 | . Q
|
---|
134 | S (EBFLG,CNFLG,ERFLG)=0
|
---|
135 | LINEX ;
|
---|
136 | Q
|
---|
137 | ;
|
---|
138 | SSDB ; Display last 4 digits of SSN and DOB to facilitate pt. identification
|
---|
139 | ; $$SSN^IBCNEDEQ(DFN) returns SSN followed by DOB
|
---|
140 | ;
|
---|
141 | N DFN
|
---|
142 | S DFN=$P($G(^TMP($J,RTN,SORT1,SORT2,CNT,0)),U,2)
|
---|
143 | I DFN D
|
---|
144 | . I SRT=1!TRC S PRT2=OPRT2_$$SSN^IBCNEDEQ(DFN) Q
|
---|
145 | . S PRT1=OPRT1_$$SSN^IBCNEDEQ(DFN)
|
---|
146 | Q
|
---|