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

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1IBCEDP ;ALB/ESG - EDI CLAIM STATUS REPORT PRINT ;13-DEC-2007
2 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7PRINT ; entry point to print the report
8 NEW CRT,IBPAGE,IBSTOP,IBCT,SV1,SV2,SV3,IEN,DATA,NEWHDR
9 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
10 I IOST["C-" S CRT=1
11 E S CRT=0
12 ;
13 S IBPAGE=0,IBSTOP=0,IBCT=0,NEWHDR=0
14 ;
15 I '$D(^TMP($J,"IBCEDC")) D HDR W !!?5,"No data found for this report." G PX
16 I $G(ZTSTOP) D HDR W !!?5,"This report was halted during compilation by TaskManager Request." G PX
17 ;
18 D HDR ; initial header display
19 S SV1=""
20 F S SV1=$O(^TMP($J,"IBCEDC",SV1)) Q:SV1=""!IBSTOP D SD(SV1) D Q:IBSTOP
21 . S SV2=""
22 . F S SV2=$O(^TMP($J,"IBCEDC",SV1,SV2)) Q:SV2=""!IBSTOP D Q:IBSTOP
23 .. S SV3=""
24 .. F S SV3=$O(^TMP($J,"IBCEDC",SV1,SV2,SV3)) Q:SV3=""!IBSTOP D Q:IBSTOP
25 ... S IEN=0
26 ... F S IEN=$O(^TMP($J,"IBCEDC",SV1,SV2,SV3,IEN)) Q:'IEN!IBSTOP D Q:IBSTOP
27 .... S DATA=$G(^TMP($J,"IBCEDC",SV1,SV2,SV3,IEN))
28 .... D PRT(DATA)
29 .... Q
30 ... Q
31 .. Q
32 . Q
33 ;
34 I IBSTOP G PRINTX
35 D:$Y>(IOSL-4) HDR G:IBSTOP PRINTX
36 W !!?5,"Total number of EDI Claims: ",IBCT
37 D:$Y>(IOSL-4) HDR G:IBSTOP PRINTX
38 W !!,"*** End of Report ***"
39 ;
40PX ;
41 I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
42PRINTX ;
43 Q
44 ;
45PRT(Z) ; print a line on the report
46 ; Z - data from the scratch global node
47 N DIV,PAY,ADDR1
48 D:$Y>(IOSL-3) HDR G:IBSTOP PRTX
49 S IBCT=IBCT+1
50 S DIV=$P($G(^DG(40.8,+$P(Z,U,10),0)),U,2) ; division abbr
51 S PAY=$P($G(^DIC(36,+$P(Z,U,12),0)),U,1) ; payer name
52 S ADDR1=$P($G(^DIC(36,+$P(Z,U,12),.11)),U,1) ; payer address line 1
53 ;
54 W !,$P(Z,U,1) ; claim#
55 W ?9,$S($P(Z,U,2)=2:1500,1:"UB04") ; form type
56 W ?14,$S($P(Z,U,3):"INPT",1:"OUTPT") ; inpat/outpat
57 W ?21,$P(Z,U,4) ; payer sequence
58 W ?25,$P(Z,U,5) ; EDI status code
59 W ?29,$E($P(Z,U,13),1,9) ; IB status abbr
60 W ?39,$E($P(Z,U,11),1,2) ; ar status abbr
61 W ?44,$$FMTE^XLFDT($P(Z,U,6)\1,"2Z") ; last transmit date
62 W ?55,$J($P(Z,U,7),4) ; age in days
63 W ?62,$P(Z,U,8) ; batch#
64 W ?69,$J($FN($P(Z,U,9),"",2),9) ; balance due
65 W ?81,DIV ; division
66 W ?89,$E(PAY,1,23) ; payer name
67 W ?114,$E(ADDR1,1,18) ; payer address line 1
68 ;
69 S NEWHDR=0 ; toggle new header flag
70PRTX ;
71 Q
72 ;
73HDR ; report header
74 ;
75 ; if screen output and page# already exists, do a page break at the bottom of the screen
76 I IBPAGE,CRT D I IBSTOP G HDRX
77 . S DIR(0)="E" D ^DIR K DIR
78 . I 'Y S IBSTOP=1
79 . Q
80 ;
81 ; if screen output OR page# already exists, do a form feed
82 I IBPAGE!CRT W @IOF
83 I 'IBPAGE,'CRT W $C(13) ; first printer page - left margin set
84 ;
85 S IBPAGE=IBPAGE+1
86 ;
87 W "EDI Claim Status Report",?96,$$FMTE^XLFDT($$NOW^XLFDT)," Page: ",IBPAGE
88 W !,"** A claim may appear multiple times if transmitted more than once. **"
89 W !?3,"Sorted by ",$$SD^IBCEDS1($G(IBSORT1))
90 I $G(IBSORT2)'="" W ", then by ",$$SD^IBCEDS1(IBSORT2)
91 I $G(IBSORT3)'="" W ", then by ",$$SD^IBCEDS1(IBSORT3)
92 ;
93 ; display column headers
94 W !?25,"*-- Statuses --*"
95 W !,"Claim",?9,"Form",?14,"Type",?20,"Seq",?25,"EDI",?31,"IB",?39,"AR",?44,"Trans Dt",?56,"Age",?62,"Batch#",?71,"Bal Due"
96 W ?81,"Div",?89,"Payer"
97 ;
98 N Z S Z="",$P(Z,"-",133)="" W !,Z
99 ;
100 S NEWHDR=1 ; flag indicating a new page header was just printed
101 ;
102 ; check for a TaskManager stop request
103 I $D(ZTQUEUED),$$S^%ZTLOAD() D G HDRX
104 . S (ZTSTOP,IBSTOP)=1
105 . W !!!?5,"*** Report Halted by TaskManager Request ***"
106 . Q
107 ;
108HDRX ;
109 Q
110 ;
111SD(SV) ; primary sort value display break. This procedure is to display a break whenever the primary sort value changes
112 ; SV - subscript value of the primary sort
113 I IBSORT1=4!(IBSORT1=6) G SDX ; don't display a break for current balance or for claim# primary sorts
114 ;
115 D:$Y>(IOSL-4) HDR G:IBSTOP SDX
116 I 'NEWHDR W ! ; an extra line break if a page header was not just printed
117 I $E(SV)="-",$D(IBSORTOR(IBSORT1)) S SV=$E(SV,2,999) ; remove leading "-" on descending numerical sorts
118 ;
119 I IBSORT1=1 S SV=$$FMTE^XLFDT(SV,"5Z") ; last transmitted date/time
120 I IBSORT1=2 D ; payer name and address
121 . N INS,ADDR
122 . S INS=+$P(SV,U,2) ; ins co ien 2nd piece of subscript
123 . S ADDR=$$INSADD^IBCNSC02(INS) ; address fields
124 . S SV=$P(SV,U,1)_" "_$P(ADDR,U,2)_" "_$P(ADDR,U,6)_" "_$P(ADDR,U,5)
125 . Q
126 I IBSORT1=3 S SV=SV_" - "_$$EXTERNAL^DILFD(364,.03,,SV) ; edi claim status and description
127 I IBSORT1=5 D ; division
128 . N DZ,DIVNM
129 . S DZ=+$O(^DG(40.8,"C",SV,"")) ; division ien
130 . S DIVNM=$P($G(^DG(40.8,DZ,0)),U,1) ; division name
131 . S SV=SV_" - "_DIVNM
132 . Q
133 I IBSORT1=7 D ; AR status
134 . N AZ,ANM
135 . S AZ=+$O(^PRCA(430.3,"C",SV,"")) ; AR status ien
136 . S ANM=$P($G(^PRCA(430.3,AZ,0)),U,1) ; AR status description
137 . S SV=SV_" - "_ANM
138 . Q
139 I IBSORT1=8 S SV=SV_" Days"
140 ;
141 S SV=$$SD^IBCEDS1(IBSORT1)_": "_SV
142 W !,SV
143SDX ;
144 Q
145 ;
Note: See TracBrowser for help on using the repository browser.