| 1 | IBCEDP ;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 | ;
|
|---|
| 7 | PRINT ; 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 | ;
|
|---|
| 40 | PX ;
|
|---|
| 41 | I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
|
|---|
| 42 | PRINTX ;
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | PRT(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
|
|---|
| 70 | PRTX ;
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | HDR ; 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 | ;
|
|---|
| 108 | HDRX ;
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | SD(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
|
|---|
| 143 | SDX ;
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
