source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNERPA.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: 5.8 KB
Line 
1IBCNERPA ;DAOU/BHS - IBCNE IIV RESPONSE REPORT (cont'd) ;03-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,345**;21-MAR-94;Build 28
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; IIV - Insurance Identification and Verification Interface
6 ;
7 ; Input from IBCNERP1/2:
8 ; IBCNERTN="IBCNERP1" - Driver rtn
9 ; IBCNESPC("BEGDT")=Start Dt, IBCNESPC("ENDDT")=End Dt
10 ; IBCNESPC("PYR")=Pyr IEN OR "" for all
11 ; IBCNESPC("PAT")=Pat IEN OR "" for all
12 ; IBCNESPC("TYPE")=A (All Responses) OR M (Most Recent Responses) for
13 ; unique Pyr/Pt pair
14 ; IBCNESPC("SORT")=1 (PyrNm) OR 2 (PatNm)
15 ; IBCNESPC("TRCN")=Trace #^IEN, if non-null, all params null
16 ; IBCNESPC("RFLAG")=Report Flag used to indicate which report is being
17 ; run. Response Report (O), Inactive Report (1), or Ambiguous
18 ; Report (2).
19 ; IBCNESPC("DTEXP")=Expiration date used in the inactive policy report
20 ;
21 ; Based on structure of IIV Response File (#365)
22 ; ^TMP($J,IBCNERTN,S1,S2,CT,0) based on ^IBCN(365,DA,0)
23 ; IBCNERTN="IBCNERP1", S1=PyrName(SORT=1) or PatNm(SORT=2),
24 ; S2=PatName(SORT=1) or PyrName(SORT=2), CT=Seq ct
25 ; ^TMP($J,IBCNERTN,S1,S2,CT,1) based on ^IBCN(365,DA,1)
26 ; ^TMP($J,IBCNERTN,S1,S2,2,EBCT) based on ^IBCN(365,DA,2)
27 ; EBCT=E/B IEN (365.02)
28 ; ^TMP($J,IBCNERTN,S1,S2,2,EBCT,NTCT)=based on ^IBCN(365,DA,2,EB,NT)
29 ; NTCT=Notes Ct, may not be Notes IEN, if line wrapped (365.021)
30 ; ^TMP($J,IBCNERTN,S1,S2,2,CNCT) based on ^IBCN(365,DA,3)
31 ; CNCT=Cont Pers IEN (365.03)
32 ; ^TMP($J,IBCNERTN,S1,S2,4,CT)= err txt based on ^IBCN(365,DA,4)
33 ; CT=1/2 if >60 ch long
34 ; Must call at one of the entry points, EN3 or EN6
35 Q
36 ;
37EN3(IBCNERTN,IBCNESPC) ; Entry pt. Calls IBCNERP3
38 N IBBDT,IBEDT,IBPY,IBPT,IBTYP,IBSRT,CRT,MAXCNT,IBPXT
39 N IBPGC,X,Y,DIR,DTOUT,DUOUT,LIN,IBTRC,IPRF
40 S IBBDT=$G(IBCNESPC("BEGDT")),IBEDT=$G(IBCNESPC("ENDDT"))
41 S IBPY=$G(IBCNESPC("PYR")),IBPT=$G(IBCNESPC("PAT"))
42 S IBTYP=$G(IBCNESPC("TYPE")),IBSRT=$G(IBCNESPC("SORT"))
43 S IBTRC=$P($G(IBCNESPC("TRCN")),U,1),(IBPXT,IBPGC)=0
44 S IBEXP=$G(IBCNESPC("DTEXP"))
45 S IPRF=$G(IBCNESPC("RFLAG"))
46 ; Determine IO params
47 I IOST["C-" S MAXCNT=IOSL-3,CRT=1
48 E S MAXCNT=IOSL-6,CRT=0
49 D PRINT^IBCNERP3(IBCNERTN,IBBDT,IBEDT,IBPY,IBPT,IBTYP,IBSRT,.IBPGC,.IBPXT,MAXCNT,CRT,IBTRC,IBEXP,IPRF)
50 I $G(ZTSTOP)!IBPXT G EXIT3
51 I CRT,IBPGC>0,'$D(ZTQUEUED) D
52 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
53 . S DIR(0)="E" D ^DIR K DIR
54EXIT3 ; Exit pt
55 Q
56 ;
57 ;
58EN6(IBCNERTN,IBCNESPC) ; Entry pt. Calls IBCNERP6
59 ;
60 ; Init vars
61 N CRT,MAXCNT,IBPXT,IBPGC,IBBDT,IBEDT,IBPY,IBSRT,IBDTL
62 N X,Y,DIR,DTOUT,DUOUT,LIN,TOTALS
63 ;
64 S IBBDT=$G(IBCNESPC("BEGDT"))
65 S IBEDT=$G(IBCNESPC("ENDDT"))
66 S IBPY=$G(IBCNESPC("PYR"))
67 S IBDTL=$G(IBCNESPC("DTL"))
68 S IBSRT=$G(IBCNESPC("SORT"))
69 S (IBPXT,IBPGC)=0
70 ;
71 ; Determine IO parameters
72 I IOST["C-" S MAXCNT=IOSL-3,CRT=1
73 E S MAXCNT=IOSL-6,CRT=0
74 ;
75 D PRINT^IBCNERP6(IBCNERTN,IBBDT,IBEDT,IBPY,IBDTL,IBSRT,.IBPGC,.IBPXT,MAXCNT,CRT)
76 I $G(ZTSTOP)!IBPXT G EXIT6
77 I CRT,IBPGC>0,'$D(ZTQUEUED) D
78 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
79 . S DIR(0)="E" D ^DIR K DIR
80 ;
81EXIT6 ; Exit pt
82 Q
83 ;
84EBDISP(RPTDATA,DISPDATA,LCT) ; Build sorted Elig/Ben notes for display
85 ; Called by IBCNERP3 - all inputs should be passed by reference
86 ; Init local variables
87 N EBCT,EBSEGS,CT,SRT1,SRT2,SRT3,SRT4,SRT5,SRT6,SEGCT,CT2,ITEM,NTCT
88 N STATFLG
89 ;
90 ; Only build more display lines if notes exist
91 S EBCT=+$O(RPTDATA(2,""),-1) I 'EBCT,'$D(RPTDATA(2,0)) G EBEXIT
92 S DISPDATA(LCT)="",LCT=LCT+1,DISPDATA(LCT)="Eligibility/Benefit Information:",LCT=LCT+1
93 S STATFLG=""
94 ; Build EB w/Notes
95 I $D(RPTDATA(2,0)) S STATFLG=RPTDATA(2,0)
96 F CT=1:1:EBCT D
97 . S (SRT1,SRT2,SRT3,SRT4,SRT5)="*"
98 . S SEGCT=$L($G(RPTDATA(2,CT)),U)
99 . F CT2=2:1:SEGCT S ITEM=$P(RPTDATA(2,CT),U,CT2) I $L(ITEM)>0 D
100 . . I CT2=3 S SRT4=ITEM Q
101 . . I CT2=4 S SRT2=ITEM Q
102 . . I CT2=5 S SRT3=ITEM Q
103 . . I CT2=13 S SRT1=ITEM Q
104 . S EBSEGS(SRT1,SRT2,SRT3,SRT4,SRT5,CT)=""
105 ; Display Active/Inactive/Undetermined message
106 S DISPDATA(LCT)="",LCT=LCT+1
107 I STATFLG]"" D
108 . I STATFLG="U" S DISPDATA(LCT)="IIV was unable to determine the status of this patient's policy.",LCT=LCT+1 Q
109 . S DISPDATA(LCT)="IIV has determined that this patient's policy is "_STATFLG_".",LCT=LCT+1
110 ; Loop thru sorted EB Notes
111 S SRT1="" F S SRT1=$O(EBSEGS(SRT1)) Q:SRT1="" D
112 . S DISPDATA(LCT)="",LCT=LCT+1
113 . I SRT1'="*" S DISPDATA(LCT)=" "_$$LBL^IBCNERP2(365.02,.13)_SRT1,LCT=LCT+1
114 . S SRT2="" F S SRT2=$O(EBSEGS(SRT1,SRT2)) Q:SRT2="" D
115 . . I SRT2'="*" S DISPDATA(LCT)=" "_$$LBL^IBCNERP2(365.02,.04)_SRT2,LCT=LCT+1
116 . . S SRT3="" F S SRT3=$O(EBSEGS(SRT1,SRT2,SRT3)) Q:SRT3="" D
117 . . . I SRT3'="*" S DISPDATA(LCT)=" "_$$LBL^IBCNERP2(365.02,.05)_SRT3,LCT=LCT+1
118 . . . S SRT4="" F S SRT4=$O(EBSEGS(SRT1,SRT2,SRT3,SRT4)) Q:SRT4="" D
119 . . . . I SRT4'="*" S DISPDATA(LCT)=" "_$$LBL^IBCNERP2(365.02,.03)_SRT4,LCT=LCT+1
120 . . . . S SRT5="" F S SRT5=$O(EBSEGS(SRT1,SRT2,SRT3,SRT4,SRT5)) Q:SRT5="" D
121 . . . . . I SRT5'="*" S DISPDATA(LCT)=" "_$$LBL^IBCNERP2(365.02,.02)_SRT5,LCT=LCT+1
122 . . . . . S SRT6="" F S SRT6=$O(EBSEGS(SRT1,SRT2,SRT3,SRT4,SRT5,SRT6)) Q:SRT6="" D
123 . . . . . . S DISPDATA(LCT)=" "
124 . . . . . . S SEGCT=$L($G(RPTDATA(2,CT)),U)
125 . . . . . . F CT2=2,6:1:$S(SEGCT>12:12,1:SEGCT) S ITEM=$P(RPTDATA(2,SRT6),U,CT2) I $L(ITEM)>0 D
126 . . . . . . . ; Display label for all but .09 field - Percentage
127 . . . . . . . S ITEM=$S(CT2'=9:$$LBL^IBCNERP2(365.02,(.01*CT2)),1:"")_ITEM
128 . . . . . . . I $L(ITEM)+$L(DISPDATA(LCT))>69 S LCT=LCT+1,DISPDATA(LCT)=" "_ITEM Q
129 . . . . . . . I DISPDATA(LCT)'=" " S DISPDATA(LCT)=DISPDATA(LCT)_", "_ITEM Q
130 . . . . . . . S DISPDATA(LCT)=" "_ITEM
131 . . . . . . ; Notes
132 . . . . . . S NTCT=$O(RPTDATA(2,SRT6,""),-1),ITEM="" I NTCT>0 D
133 . . . . . . . F CT2=1:1:NTCT S LCT=LCT+1,DISPDATA(LCT)=" "_RPTDATA(2,SRT6,CT2)
134 . . . . . . . S LCT=LCT+1,DISPDATA(LCT)=" "
135 . . . . . . I $TR(DISPDATA(LCT)," ","")'="" S LCT=LCT+1
136EBEXIT ; EBDISP exit point
137 Q
138 ;
Note: See TracBrowser for help on using the repository browser.