source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNERPD.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1IBCNERPD ;DAOU/RO - IIV PAYER LINK REPORT PRINT;AUG-2003
2 ;;2.0;INTEGRATED BILLING;**184,252**;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 IBCNERPB
8 ; Input from IBCNERPB/C:
9 ;
10 ; ^TMP($J,IBCNERTN,S1,S2,CT,0)
11 ; IBCNERTN="IBCNERPB",
12 ; CT=Seq ct
13 ; ^TMP($J,IBCNERTN,S1,S2,CT,1)
14 ;
15EN3(IBCNERTN,IBCNESPC) ; Entry pt.
16 N IBTYP,IBSRT,CRT,MAXCNT,IBPXT
17 N IBPGC,X,Y,DIR,DTOUT,DUOUT,LIN,IBTRC,IBMAT,IBREP,IBDET,IBPPYR,ZZ
18 S IBREP=$G(IBCNESPC("REP"))
19 S IBDET=$G(IBCNESPC("PDET"))
20 S IBTYP=$G(IBCNESPC("PTYPE"))
21 S IBSRT=$G(IBCNESPC("PSORT"))
22 S IBPPYR=$G(IBCNESPC("PPYR"))
23 ; Ins Report
24 I IBREP=2 D
25 . S IBTYP=$G(IBCNESPC("ITYPE"))
26 . S IBSRT=$G(IBCNESPC("ISORT"))
27 . S IBMAT=$G(IBCNESPC("IMAT"))
28 S (IBPXT,IBPGC)=0
29 ; Determine IO params
30 I IOST["C-" S MAXCNT=IOSL-3,CRT=1
31 E S MAXCNT=IOSL-6,CRT=0
32 D PRINT(IBCNERTN,IBREP,IBDET,IBTYP,IBSRT,.IBPGC,.IBPXT,MAXCNT,CRT)
33 I $G(ZTSTOP)!IBPXT G EXIT3
34 I CRT,IBPGC>0,'$D(ZTQUEUED) D
35 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
36 . S DIR(0)="E" D ^DIR K DIR
37EXIT3 ; Exit pt
38 Q
39 ;
40PRINT(RTN,REP,DET,TYP,SRT,PGC,PXT,MAX,CRT) ; Print data
41 ; Input: RTN="IBCENRPB"
42 ; PGC=page ct, PXT=exit flg,
43 ; MAX=max line ct/pg, CRT=1/0
44 N EORMSG,NONEMSG,SORT1,SORT2,CNT,DASH
45 S EORMSG="*** END OF REPORT ***"
46 S NONEMSG="* * * N O D A T A F O U N D * * *"
47 S (SORT1,SORT2)="",$P(DASH,"-",132)=""
48 I '$D(^TMP($J,RTN)) D HEADER W !,?(80-$L(NONEMSG)\2),NONEMSG,!!
49 F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:PXT!$G(ZTSTOP)
50 . S SORT2="" F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:PXT!$G(ZTSTOP)
51 . . S CNT="" F S CNT=$O(^TMP($J,RTN,SORT1,SORT2,CNT)) Q:CNT="" D Q:PXT!$G(ZTSTOP)
52 . . . K DISPDATA ; Init disp
53 . . . D DATA(.DISPDATA),LINE(.DISPDATA) ; build/display data
54 ;
55 I $G(ZTSTOP)!PXT G PRINTX
56 I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
57 W !,?(80-$L(EORMSG)\2),EORMSG
58PRINTX ;
59 Q
60 ;
61HEADER ; Print hdr info
62 N X,Y,DIR,DTOUT,DUOUT,OFFSET,HDR,LIN,HDR
63 I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX
64 . I MAX<51 F LIN=1:1:(MAX-$Y) W !
65 . S DIR(0)="E" D ^DIR K DIR
66 . I $D(DTOUT)!($D(DUOUT)) S PXT=1 Q
67 I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 G HEADERX
68 S PGC=PGC+1
69 W @IOF,!,?1,"IIV Payer Link Report"
70 S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC,OFFSET=131-$L(HDR)
71 W ?OFFSET,HDR
72 W !,?1,"Report Option: "_$S(REP=1:"Payer List",1:"Insurance Company List")
73 I REP=1 D
74 . S HDR=$S(TYP=1:"Unlinked Payers Only",TYP=2:"Linked Payers Only",1:"All Payers")
75 . I TYP=3 S HDR=HDR_", "_$S(DET=1:"With Ins. Co. Detail",1:"Without Ins. Co. Detail")
76 I REP=2 D
77 . S HDR=$S(TYP=1:"Unlinked Insurance Companies Only",TYP=2:"Linked Insurance Companies Only",1:"All Insurance Companies")
78 S OFFSET=79-$L(HDR)
79 W ?OFFSET,HDR
80 W !
81 I REP=1 D
82 . I IBPPYR'="" W ?1,"For Single Payer: ",$P(IBPPYR,"^",2)
83 . W !?39,"National",?54,"# Linked",?67,"Nationally",?82,"Locally",?94,"Prof.",?115,"Inst."
84 . W !,"Payer Name:",?39,"Payer ID",?54,"Ins. Co.",?67,"Active?",?82,"Active?",?94,"EDI#",?115,"EDI#"
85 I REP=2 D
86 . I IBMAT'="" W ?1,"Only Insurance Companies that match: ",IBMAT
87 . W !?56,"Nat.",?71,"Loc.",?83,"Prof.",?104,"Inst."
88 . W !,"Insurance Company:",?56,"Act?",?71,"Act?",?83,"EDI#",?104,"EDI#"
89 . I TYP'=1 W !," Payer:",?41,"VA ID"
90 W !,DASH
91HEADERX ;
92 Q
93 ;
94LINE(DISPDATA) ; Print data
95 N LNCT,LNTOT,NWPG
96 S LNTOT=+$O(DISPDATA(""),-1)
97 S NWPG=0
98 F LNCT=1:1:LNTOT D Q:$G(ZTSTOP)!PXT
99 . I $Y+1>MAX!('PGC) D HEADER S NWPG=1 I $G(ZTSTOP)!PXT Q
100 . W !,?1,DISPDATA(LNCT) Q
101 . I 'NWPG!(NWPG&(DISPDATA(LNCT)'="")) W !,?1,DISPDATA(LNCT)
102 . I NWPG S NWPG=0
103 . Q
104LINEX Q
105 ;
106DATA(DISPDATA) ; Build disp lines
107 N LCT,CT,CT2,RPTDATA,XX,YY,ZZ
108 ; Merge into local array
109 N %X,%Y
110 S %X="^TMP($J,RTN,SORT1,SORT2,CNT,"
111 S %Y="RPTDATA("
112 I $D(^TMP($J,RTN,SORT1,SORT2,CNT))#10=1 S RPTDATA=^TMP($J,RTN,SORT1,SORT2,CNT)
113 D %XY^%RCR K %X,%Y
114 ; Build
115 ;
116 ; PAYER REPORT
117 I REP=1 D
118 . ; 1st line is payer
119 . S LCT=1,DISPDATA(1)=$$FO^IBCNEUT1(SORT2,35,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,1),10,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,6),5,"R")_" "_$$FO^IBCNEUT1($S($P(RPTDATA,U,4)=1:"YES",1:"NO"),15,"L")
120 . S DISPDATA(1)=DISPDATA(1)_$$FO^IBCNEUT1($S($P(RPTDATA,U,5)=1:"YES",1:"NO"),12,"L")_$$FO^IBCNEUT1($P(RPTDATA,U,2),16,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,3),16,"L")
121 . ; See if detail is required
122 . I DET=1 D
123 . . I $O(RPTDATA(""))'="" S LCT=LCT+1,DISPDATA(LCT)=" Linked Insurance Companies:"
124 . . S (XX,YY,ZZ)="" F S XX=$O(RPTDATA(XX)) Q:XX="" F S YY=$O(RPTDATA(XX,YY)) Q:YY="" D
125 . . . S ZZ=RPTDATA(XX,YY)
126 . . . S LCT=LCT+1,DISPDATA(LCT)=" "_$$FO^IBCNEUT1(XX,35,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,1),20,"L")_" "_$E($P(ZZ,U,4),1,15)
127 . . . ; don't display ','s if no address/state on file
128 . . . I $P(ZZ,U,5)'="" S DISPDATA(LCT)=DISPDATA(LCT)_", "_$P($G(^DIC(5,$P(ZZ,U,5)+0,0)),U,2)
129 . . . S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1(" ",93-$L(DISPDATA(LCT)),"L")
130 . . . ; display EDI#'s
131 . . . S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($P(ZZ,U,7),16,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,8),16,"L")
132 ;
133 ; Insurance Company Report
134 I REP=2 D
135 . ; Ins carrier
136 . S DISPDATA(1)=$$FO^IBCNEUT1(SORT2,82,"L")
137 . ; Ins address
138 . S ZZ=$P(RPTDATA,"~",2),DISPDATA(1)=DISPDATA(1)_$$FO^IBCNEUT1($P(ZZ,U,2),16,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,4),16,"L")
139 . S DISPDATA(2)=" "_$P(RPTDATA,U,8)_" "_$P(RPTDATA,U,11)
140 . ; Add state/zip if defined
141 . I $P(RPTDATA,U,12)'="" S DISPDATA(2)=DISPDATA(2)_", "_$P($G(^DIC(5,$P(RPTDATA,U,12)+0,0)),U,2)_" "_$$FO^IBCNEUT1($P(RPTDATA,U,13),5,"L")
142 . ; if no payer is linked AND displaying payers
143 . I $P(RPTDATA,U)="",TYP'=1 S DISPDATA(3)=" ** NOT CURRENTLY LINKED **",LCT=4,DISPDATA(4)=" " Q
144 . ; if no payer and not displaying then quit
145 . I $P(RPTDATA,U)="" S LCT=3,DISPDATA(3)=" " Q
146 . ; Display Payer Info Line
147 . S DISPDATA(3)=" "_$$FO^IBCNEUT1($P(RPTDATA,U,1),35,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,2),15,"L")_$$FO^IBCNEUT1($S($P(RPTDATA,U,5)=1:"YES",1:"NO"),15,"L")
148 . S DISPDATA(3)=DISPDATA(3)_$$FO^IBCNEUT1($S($P(RPTDATA,U,6)=1:"YES",1:"NO"),12,"L")_$$FO^IBCNEUT1($P(RPTDATA,U,4),16,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,4),16,"L")
149 . S LCT=4,DISPDATA(4)=" "
150 S LCT=LCT+1
151 Q
Note: See TracBrowser for help on using the repository browser.