source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNERP3.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1IBCNERP3 ;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 ;
40PRINT(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
65PRINTX ;
66 Q
67 ;
68HEADER ; 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 !
113HEADERX ;
114 Q
115 ;
116LINE(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
135LINEX ;
136 Q
137 ;
138SSDB ; 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
Note: See TracBrowser for help on using the repository browser.