- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEWL0.m
r613 r623 1 RCDPEWL0 ;ALB/TMK - ELECTRONIC EOB WORKLIST ACTIONS ;06 Jun 2007 11:50 AM 2 ;;4.5;Accounts Receivable;**173,208,252**;Mar 20, 1995;Build 63 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ; 6 PARAMS ; Select params for ERA list 7 ; Return ^TMP("RCERA_PARAMS",$J) array 8 N DIR,X,Y,RCDFR,RCDTO,RCPAYR,RCQUIT,DUOUT,DTOUT 9 K ^TMP("RCERA_PARAMS",$J) 10 S RCQUIT=0 11 W !!,"SELECT PARAMETERS FOR DISPLAYING THE LIST OF ERAs" 12 S DIR(0)="SA^U:UNPOSTED;P:POSTED;B:BOTH",DIR("B")="UNPOSTED",DIR("A")="ERA POSTING STATUS: " W ! D ^DIR K DIR 13 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 14 S ^TMP("RCERA_PARAMS",$J,"RCPOST")=Y 15 S DIR(0)="SA^N:NOT MATCHED;M:MATCHED;B:BOTH",DIR("B")="BOTH",DIR("A")="ERA-EFT MATCH STATUS: " W ! D ^DIR K DIR 16 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 17 S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=Y 18 ; 19 DT1 S RCDTO=DT,RCDFR=0 20 S RCQUIT=0,DIR(0)="YA",DIR("A")="LIMIT THE SELECTION TO A DATE RANGE WHEN THE ERA WAS RECEIVED?: ",DIR("B")="NO" W ! D ^DIR K DIR 21 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 22 I Y=1 S RCQUIT=0 D I RCQUIT K ^TMP("RCERA_PARAMS",$J,"RCDT") G DT1 23 . S DIR(0)="DA",DIR("A")="EARLIEST DATE: " D ^DIR K DIR 24 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 25 . S RCDFR=Y 26 . S DIR(0)="DA^"_RCDFR_";"_DT,DIR("A")="LATEST DATE: " D ^DIR K DIR 27 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 28 . S RCDTO=Y 29 S ^TMP("RCERA_PARAMS",$J,"RCDT")=(RCDFR_U_RCDTO) 30 ; 31 PAYR S RCQUIT=0,DIR(0)="SA^A:ALL;R:RANGE",DIR("A")="(A)LL PAYERS, (R)ANGE OF PAYER NAMES: ",DIR("B")="ALL" W ! D ^DIR K DIR 32 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 33 S RCPAYR=Y,^TMP("RCERA_PARAMS",$J,"RCPAYR")=Y 34 I RCPAYR="A" G PARAMSQ 35 I RCPAYR="R" D I RCQUIT K ^TMP("RCERA_PARAMS",$J,"RCPAYR") G PAYR 36 . W !,"NAMES YOU SELECT HERE WILL BE THE PAYER NAMES FROM THE ERA, NOT THE INS FILE" 37 . S DIR("?")="ENTER A NAME BETWEEN 1 AND 30 CHARACTERS IN UPPERCASE" 38 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="START WITH PAYER NAME: " W ! D ^DIR K DIR 39 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 40 . S RCPAYR("FROM")=Y,$P(^TMP("RCERA_PARAMS",$J,"RCPAYR"),U,2)=Y 41 . S DIR("?")="ENTER A NAME BETWEEN 1 AND 30 CHARACTERS IN UPPERCASE" 42 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="GO TO PAYER NAME: ",DIR("B")=$E(RCPAYR("FROM"),1,27)_"ZZZ" W ! D ^DIR K DIR 43 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 44 . S $P(^TMP("RCERA_PARAMS",$J,"RCPAYR"),U,3)=Y 45 W ! 46 ; 47 PARAMSQ ; 48 D PARAMS^RCDPEWLD(.RCQUIT) 49 Q 50 ; 51 FILTER(Y) ; Returns 1 if record in entry Y in 344.4 passes 52 ; the edits for the worklist selection of ERAs 53 ; Parameters found in ^TMP("RCERA_PARAMS",$J) 54 N OK,RCPOST,RCMATCH,RCDFR,RCDTO,RCPAYFR,RCPAYTO,RCPAYR,RC0 55 S OK=1,RC0=$G(^RCY(344.4,Y,0)) 56 ; 57 S RCMATCH=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")),RCPOST=$G(^TMP("RCERA_PARAMS",$J,"RCPOST")) 58 S RCDFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTO=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2) 59 S RCPAYR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U),RCPAYFR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,2),RCPAYTO=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,3) 60 ; 61 ; If receipt exists, scratchpad must exist 62 ;I $P(RC0,U,8),'$D(^RCY(344.49,+Y,0)) S OK=0 G FQ 63 ; Post status 64 I $S(RCPOST="B":0,RCPOST="U":$P(RC0,U,14),1:'$P(RC0,U,14)) S OK=0 G FQ 65 ; Match status 66 I $S(RCMATCH="B":0,RCMATCH="N":$P(RC0,U,9),1:'$P(RC0,U,9)) S OK=0 G FQ 67 ; dt rec'd range 68 I $S(RCDFR=0:0,1:$P(RC0,U,7)\1<RCDFR) S OK=0 G FQ 69 I $S(RCDTO=DT:0,1:$P(RC0,U,7)\1>RCDTO) S OK=0 G FQ 70 ; Payer name 71 I RCPAYR'="A" D G:'OK FQ 72 . N Q 73 . S Q=$$UPPER^RCDPEWL7($P(RC0,U,6)) 74 . I $S(Q=RCPAYFR:1,Q=RCPAYTO:1,Q]RCPAYFR:RCPAYTO]Q,1:0) Q 75 . S OK=0 76 FQ Q OK 77 ; 78 SPLIT ; Split line in ERA list 79 N RCLINE,RCZ,RCDA,Q,Q0,Z,Z0,DIR,X,Y,CT,L,L1,RCONE,RCQUIT 80 D FULL^VALM1 81 I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G SPLITQ 82 W !!,"SELECT THE ENTRY THAT HAS A LINE YOU NEED TO SPLIT/EDIT",! 83 D SEL^RCDPEWL(.RCDA) 84 S Z=+$O(RCDA(0)) G:'$G(RCDA(Z)) SPLITQ 85 S RCLINE=+RCDA(Z),Z0=+$O(^TMP("RCDPE-EOB_WLDX",$J,Z_".999"),-1) 86 S RCZ=Z F S RCZ=$O(^TMP("RCDPE-EOB_WLDX",$J,RCZ)) Q:'RCZ!(RCZ\1'=Z) D 87 . S Q=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCZ)),U,2) 88 . Q:'Q 89 . S RCZ(RCZ)=Q 90 . S Q0=0 F S Q0=$O(^RCY(344.49,RCSCR,1,Q,1,Q0)) Q:'Q0 I "01"[$P($G(^(Q0,0)),U,2) K RCZ(RCZ) Q 91 I '$O(RCZ(0)) D G SPLITQ 92 . S DIR(0)="EA",DIR("A",1)="THIS ENTRY HAS NO LINES AVAILABLE TO EDIT/SPLIT",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR 93 S RCQUIT=0 94 I $P($G(^RCY(344.49,RCSCR,1,RCLINE,0)),U,13) D G:RCQUIT SPLITQ 95 . S DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR 96 . I Y'=1 S RCQUIT=1 97 S CT=0,CT=CT+1,DIR("?",CT)="Enter the line # that you want to split or edit:",RCONE=1 98 S L=Z F S L=$O(RCZ(L)) Q:'L D 99 . S L1=+$G(^TMP("RCDPE-EOB_WLDX",$J,L)) 100 . S CT=CT+1 101 . S DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1,0)),CT=CT+1,DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1+1,0)) S RCONE(1)=$S(RCONE:L,1:"") S RCONE=0 102 S DIR("?")=" ",Y=-1 103 I $G(RCONE(1)) S Y=+RCONE(1) K DIR G:'Y SPLITQ 104 I '$G(RCONE(1)) D K DIR I $D(DTOUT)!$D(DUOUT)!(Y\1'=Z) G SPLITQ 105 . F S DIR(0)="NAO^"_(Z+.001)_":"_Z0_":3",DIR("A")="WHICH LINE OF ENTRY "_Z_" DO YOU WANT TO SPLIT/EDIT?: " S:$G(RCONE(1))'="" DIR("B")=RCONE(1) D ^DIR Q:'Y!$D(DUOUT)!$D(DTOUT) D Q:Y>0 106 .. I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !!,"LINE "_Y_" DOES NOT EXIST - TRY AGAIN",! S Y=-1 Q 107 .. I '$D(RCZ(Y)) W !!,"LINE "_Y_" HAS BEEN USED IN A DISTRIBUTE ADJ ACTION AND CAN'T BE EDITED",! S Y=-1 Q 108 .. S Q=+$O(^RCY(344.49,RCSCR,1,"B",Y,0)) 109 ; 110 K ^TMP("RCDPE_SPLIT_REBLD",$J) 111 D SPLIT^RCDPEWL3(RCSCR,+Y) 112 I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM"))) 113 ; 114 SPLITQ S VALMBCK="R" 115 Q 116 ; 117 PRTERA ; View/prt 118 N DIC,X,Y,RCSCR 119 S DIC="^RCY(344.4,",DIC(0)="AEMQ" D ^DIC 120 Q:Y'>0 121 S RCSCR=+Y 122 D PRERA1 123 Q 124 ; 125 PRERA ; RCSCR is assumed to be defined 126 D FULL^VALM1 ; Protocol entry 127 PRERA1 ; Option entry 128 N %ZIS,ZTRTN,ZTSAVE,ZTDESC,POP,DIR,X,Y,RCERADET 129 S DIR("?",1)="INCLUDING EXPANDED DETAIL WILL SIGNIFICANTLY INCREASE THE SIZE OF THIS REPORT",DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE" 130 S DIR("?")="LISTED. IF YOU WANT JUST SUMMARY DATA FOR EACH EEOB, DO NOT INCLUDE IT." 131 S DIR(0)="YA",DIR("A")="DO YOU WANT TO INCLUDE EXPANDED EEOB DETAIL?: ",DIR("B")="NO" W ! D ^DIR K DIR 132 I $D(DUOUT)!$D(DTOUT) G PRERAQ 133 S RCERADET=+Y 134 S %ZIS="QM" D ^%ZIS G:POP PRERAQ 135 I $D(IO("Q")) D G PRERAQ 136 . S ZTRTN="VPERA^RCDPEWL0("_RCSCR_","_RCERADET_")",ZTDESC="AR - Print ERA From Worklist" 137 . D ^%ZTLOAD 138 . W !!,$S($D(ZTSK):"Your task # "_ZTSK_" has been queued.",1:"Unable to queue this job.") 139 . K ZTSK,IO("Q") D HOME^%ZIS 140 U IO 141 D VPERA(RCSCR,RCERADET) 142 Q 143 ; 144 VPERA(RCSCR,RCERADET) ; Queued entry 145 ; RCSCR = ien of entry in file 344.4 146 ; RCERADET = 1 if inclusion of all EOB details from file 361.1 is 147 ; desired, 0 if not 148 N Z,Z0,RCSTOP,RCZ,RCPG,RCDOT,RCDIQ,RCDIQ1,RCDIQ2,RCXM1,RC,RCSCR1,RC3611 149 K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"RC_SUMALL") 150 S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)="" 151 D GETS^DIQ(344.4,RCSCR_",","*","IEN","RCDIQ") 152 D TXT0^RCDPEX31(RCSCR,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned flds 153 I $O(^RCY(344.4,RCSCR,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**" 154 S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,2,RCSCR1)) Q:'RCSCR1 D 155 . K RCDIQ2 156 . D GETS^DIQ(344.42,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ2") 157 . D TXT2^RCDPEX31(RCSCR,RCSCR1,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs 158 S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,1,RCSCR1)) Q:'RCSCR1 D 159 . K RCDIQ1 160 . D GETS^DIQ(344.41,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ1") 161 . D TXT00^RCDPEX31(RCSCR,RCSCR1,.RCDIQ1,.RCXM1,.RC) 162 . S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_$$PNM4^RCDPEWL1(RCSCR,RCSCR1)_$J("",41),1,41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1),RCXM1(RC)=" " 163 . D PROV^RCDPEWLD(RCSCR,RCSCR1,.RCXM1,.RC) 164 . S RC3611=$P($G(^RCY(344.4,RCSCR,1,RCSCR1,0)),U,2) 165 . I RCERADET D 166 .. I 'RC3611 D Q 167 ... D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_RCSCR1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75,1) 168 ..; 169 .. E D ; Detail record is in 361.1 170 ... K ^TMP("PRCA_EOB",$J) 171 ... D GETEOB^IBCECSA6(RC3611,2) 172 ... I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors 173 ... S Z=0 F S Z=$O(^TMP("PRCA_EOB",$J,RC3611,Z)) Q:'Z S RC=RC+1,^TMP($J,"RC_SUMOUT",RC)=$G(^TMP("PRCA_EOB",$J,RC3611,Z)) 174 ... S RC=RC+2,^TMP($J,"RC_SUMOUT",RC-1)=" ",^TMP($J,"RC_SUMOUT",RC)=" " 175 ... K ^TMP("PRCA_EOB",$J) 176 . I $D(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2)) D 177 .. S RC=RC+1,RCXM1(RC)=" **EXCEPTION RESOLUTION LOG DATA**" 178 .. S Z=0 F S Z=$O(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)) Q:'Z S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z) 179 . S RC=RC+1,RCXM1(RC)=" " 180 . S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1) 181 . S Z=0 F S Z=$O(RCXM1(Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z) 182 . K RCXM1 S RC=0 183 . S Z=0 F S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=$G(^TMP($J,"RC_SUMOUT",Z)) 184 S RCSTOP=0,Z="" 185 F S Z=$O(^TMP($J,"RC_SUMALL",Z)) Q:'Z D Q:RCSTOP 186 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q 187 . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q 188 .. D:RCPG ASK(.RCSTOP) I RCSTOP Q 189 .. D HDR(.RCPG) 190 . W !,$G(^TMP($J,"RC_SUMALL",Z)) 191 ; 192 I 'RCSTOP,RCPG D ASK(.RCSTOP) 193 ; 194 I $D(ZTQUEUED) S ZTREQ="@" 195 I '$D(ZTQUEUED) D ^%ZISC 196 ; 197 PRERAQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"SUMALL") 198 S VALMBCK="R" 199 Q 200 ; 201 HDR(RCPG) ;Report hdr 202 ; RCPG = last page # 203 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13 204 S RCPG=$G(RCPG)+1 205 W !,?5,"EDI LOCKBOX WORKLIST - ERA DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=") 206 Q 207 ; 208 ASK(RCSTOP) ; 209 I $E(IOST,1,2)'["C-" Q 210 N DIR,DIROUT,DIRUT,DTOUT,DUOUT 211 S DIR(0)="E" W ! D ^DIR 212 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q 213 Q 214 ; 1 RCDPEWL0 ;ALB/TMK - ELECTRONIC EOB WORKLIST ACTIONS ;26-NOV-02 2 ;;4.5;Accounts Receivable;**173,208**;Mar 20, 1995 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 Q 5 ; 6 PARAMS ; Select params for ERA list 7 ; Return ^TMP("RCERA_PARAMS",$J) array 8 N DIR,X,Y,RCDFR,RCDTO,RCPAYR,RCQUIT 9 K ^TMP("RCERA_PARAMS",$J) 10 S RCQUIT=0 11 W !!,"SELECT PARAMETERS FOR DISPLAYING THE LIST OF ERAs" 12 S DIR(0)="SA^U:UNPOSTED;P:POSTED;B:BOTH",DIR("B")="UNPOSTED",DIR("A")="ERA POSTING STATUS: " W ! D ^DIR K DIR 13 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 14 S ^TMP("RCERA_PARAMS",$J,"RCPOST")=Y 15 S DIR(0)="SA^N:NOT MATCHED;M:MATCHED;B:BOTH",DIR("B")="BOTH",DIR("A")="ERA-EFT MATCH STATUS: " W ! D ^DIR K DIR 16 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 17 S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=Y 18 ; 19 DT1 S RCDTO=DT,RCDFR=0 20 S RCQUIT=0,DIR(0)="YA",DIR("A")="LIMIT THE SELECTION TO A DATE RANGE WHEN THE ERA WAS RECEIVED?: ",DIR("B")="NO" W ! D ^DIR K DIR 21 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 22 I Y=1 S RCQUIT=0 D I RCQUIT K ^TMP("RCERA_PARAMS",$J,"RCDT") G DT1 23 . S DIR(0)="DA",DIR("A")="EARLIEST DATE: " D ^DIR K DIR 24 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 25 . S RCDFR=Y 26 . S DIR(0)="DA^"_RCDFR_";"_DT,DIR("A")="LATEST DATE: " D ^DIR K DIR 27 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 28 . S RCDTO=Y 29 S ^TMP("RCERA_PARAMS",$J,"RCDT")=(RCDFR_U_RCDTO) 30 ; 31 PAYR S RCQUIT=0,DIR(0)="SA^A:ALL;R:RANGE",DIR("A")="(A)LL PAYERS, (R)ANGE OF PAYER NAMES: ",DIR("B")="ALL" W ! D ^DIR K DIR 32 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ 33 S RCPAYR=Y,^TMP("RCERA_PARAMS",$J,"RCPAYR")=Y 34 I RCPAYR="A" G PARAMSQ 35 I RCPAYR="R" D I RCQUIT K ^TMP("RCERA_PARAMS",$J,"RCPAYR") G PAYR 36 . W !,"NAMES YOU SELECT HERE WILL BE THE PAYER NAMES FROM THE ERA, NOT THE INS FILE" 37 . S DIR("?")="ENTER A NAME BETWEEN 1 AND 30 CHARACTERS IN UPPERCASE" 38 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="START WITH PAYER NAME: " W ! D ^DIR K DIR 39 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 40 . S RCPAYR("FROM")=Y,$P(^TMP("RCERA_PARAMS",$J,"RCPAYR"),U,2)=Y 41 . S DIR("?")="ENTER A NAME BETWEEN 1 AND 30 CHARACTERS IN UPPERCASE" 42 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="GO TO PAYER NAME: ",DIR("B")=$E(RCPAYR("FROM"),1,27)_"ZZZ" W ! D ^DIR K DIR 43 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 44 . S $P(^TMP("RCERA_PARAMS",$J,"RCPAYR"),U,3)=Y 45 W ! 46 ; 47 PARAMSQ I $G(RCQUIT) K ^TMP("RCERA_PARAMS",$J) 48 Q 49 ; 50 FILTER(Y) ; Returns 1 if record in entry Y in 344.4 passes 51 ; the edits for the worklist selection of ERAs 52 ; Parameters found in ^TMP("RCERA_PARAMS",$J) 53 N OK,RCPOST,RCMATCH,RCDFR,RCDTO,RCPAYFR,RCPAYTO,RCPAYR,RC0 54 S OK=1,RC0=$G(^RCY(344.4,Y,0)) 55 ; 56 S RCMATCH=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")),RCPOST=$G(^TMP("RCERA_PARAMS",$J,"RCPOST")) 57 S RCDFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTO=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2) 58 S RCPAYR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U),RCPAYFR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,2),RCPAYTO=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,3) 59 ; 60 ; If receipt exists, scratchpad must exist 61 ;I $P(RC0,U,8),'$D(^RCY(344.49,+Y,0)) S OK=0 G FQ 62 ; Post status 63 I $S(RCPOST="B":0,RCPOST="U":$P(RC0,U,14),1:'$P(RC0,U,14)) S OK=0 G FQ 64 ; Match status 65 I $S(RCMATCH="B":0,RCMATCH="N":$P(RC0,U,9),1:'$P(RC0,U,9)) S OK=0 G FQ 66 ; dt rec'd range 67 I $S(RCDFR=0:0,1:$P(RC0,U,7)\1<RCDFR) S OK=0 G FQ 68 I $S(RCDTO=DT:0,1:$P(RC0,U,7)\1>RCDTO) S OK=0 G FQ 69 ; Payer name 70 I RCPAYR'="A" D G:'OK FQ 71 . N Q 72 . S Q=$$UPPER^RCDPEWL7($P(RC0,U,6)) 73 . I $S(Q=RCPAYFR:1,Q=RCPAYTO:1,Q]RCPAYFR:RCPAYTO]Q,1:0) Q 74 . S OK=0 75 FQ Q OK 76 ; 77 SPLIT ; Split line in ERA list 78 N RCLINE,RCZ,RCDA,Q,Q0,Z,Z0,DIR,X,Y,CT,L,L1,RCONE,RCQUIT 79 D FULL^VALM1 80 I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G SPLITQ 81 W !!,"SELECT THE ENTRY THAT HAS A LINE YOU NEED TO SPLIT/EDIT",! 82 D SEL^RCDPEWL(.RCDA) 83 S Z=+$O(RCDA(0)) G:'$G(RCDA(Z)) SPLITQ 84 S RCLINE=+RCDA(Z),Z0=+$O(^TMP("RCDPE-EOB_WLDX",$J,Z_".999"),-1) 85 S RCZ=Z F S RCZ=$O(^TMP("RCDPE-EOB_WLDX",$J,RCZ)) Q:'RCZ!(RCZ\1'=Z) D 86 . S Q=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCZ)),U,2) 87 . Q:'Q 88 . S RCZ(RCZ)=Q 89 . S Q0=0 F S Q0=$O(^RCY(344.49,RCSCR,1,Q,1,Q0)) Q:'Q0 I "01"[$P($G(^(Q0,0)),U,2) K RCZ(RCZ) Q 90 I '$O(RCZ(0)) D G SPLITQ 91 . S DIR(0)="EA",DIR("A",1)="THIS ENTRY HAS NO LINES AVAILABLE TO EDIT/SPLIT",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR 92 S RCQUIT=0 93 I $P($G(^RCY(344.49,RCSCR,1,RCLINE,0)),U,13) D G:RCQUIT SPLITQ 94 . S DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR 95 . I Y'=1 S RCQUIT=1 96 S CT=0,CT=CT+1,DIR("?",CT)="Enter the line # that you want to split or edit:",RCONE=1 97 S L=Z F S L=$O(RCZ(L)) Q:'L D 98 . S L1=+$G(^TMP("RCDPE-EOB_WLDX",$J,L)) 99 . S CT=CT+1 100 . S DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1,0)),CT=CT+1,DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1+1,0)) S RCONE(1)=$S(RCONE:L,1:"") S RCONE=0 101 S DIR("?")=" ",Y=-1 102 I $G(RCONE(1)) S Y=+RCONE(1) K DIR G:'Y SPLITQ 103 I '$G(RCONE(1)) D K DIR I $D(DTOUT)!$D(DUOUT)!(Y\1'=Z) G SPLITQ 104 . F S DIR(0)="NAO^"_(Z+.001)_":"_Z0_":3",DIR("A")="WHICH LINE OF ENTRY "_Z_" DO YOU WANT TO SPLIT/EDIT?: " S:$G(RCONE(1))'="" DIR("B")=RCONE(1) D ^DIR Q:'Y!$D(DUOUT)!$D(DTOUT) D Q:Y>0 105 .. I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !!,"LINE "_Y_" DOES NOT EXIST - TRY AGAIN",! S Y=-1 Q 106 .. I '$D(RCZ(Y)) W !!,"LINE "_Y_" HAS BEEN USED IN A DISTRIBUTE ADJ ACTION AND CAN'T BE EDITED",! S Y=-1 Q 107 .. S Q=+$O(^RCY(344.49,RCSCR,1,"B",Y,0)) 108 ; 109 K ^TMP("RCDPE_SPLIT_REBLD",$J) 110 D SPLIT^RCDPEWL3(RCSCR,+Y) 111 I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM"))) 112 ; 113 SPLITQ S VALMBCK="R" 114 Q 115 ; 116 PRTERA ; View/prt 117 N DIC,X,Y,RCSCR 118 S DIC="^RCY(344.4,",DIC(0)="AEMQ" D ^DIC 119 Q:Y'>0 120 S RCSCR=+Y 121 D PRERA1 122 Q 123 ; 124 PRERA ; RCSCR is assumed to be defined 125 D FULL^VALM1 ; Protocol entry 126 PRERA1 ; Option entry 127 N %ZIS,ZTRTN,ZTSAVE,ZTDESC,POP,DIR,X,Y,RCERADET 128 S DIR("?",1)="INCLUDING EXPANDED DETAIL WILL SIGNIFICANTLY INCREASE THE SIZE OF THIS REPORT",DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE" 129 S DIR("?")="LISTED. IF YOU WANT JUST SUMMARY DATA FOR EACH EEOB, DO NOT INCLUDE IT." 130 S DIR(0)="YA",DIR("A")="DO YOU WANT TO INCLUDE EXPANDED EEOB DETAIL?: ",DIR("B")="NO" W ! D ^DIR K DIR 131 I $D(DUOUT)!$D(DTOUT) G PRERAQ 132 S RCERADET=+Y 133 S %ZIS="QM" D ^%ZIS G:POP PRERAQ 134 I $D(IO("Q")) D G PRERAQ 135 . S ZTRTN="VPERA^RCDPEWL0("_RCSCR_","_RCERADET_")",ZTDESC="AR - Print ERA From Worklist" 136 . D ^%ZTLOAD 137 . W !!,$S($D(ZTSK):"Your task # "_ZTSK_" has been queued.",1:"Unable to queue this job.") 138 . K ZTSK,IO("Q") D HOME^%ZIS 139 U IO 140 D VPERA(RCSCR,RCERADET) 141 Q 142 ; 143 VPERA(RCSCR,RCERADET) ; Queued entry 144 ; RCSCR = ien of entry in file 344.4 145 ; RCERADET = 1 if inclusion of all EOB details from file 361.1 is 146 ; desired, 0 if not 147 N Z,Z0,RCSTOP,RCZ,RCPG,RCDOT,RCDIQ,RCDIQ1,RCDIQ2,RCXM1,RC,RCSCR1,RC3611 148 K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"RC_SUMALL") 149 S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)="" 150 D GETS^DIQ(344.4,RCSCR_",","*","IEN","RCDIQ") 151 D TXT0^RCDPEX31(RCSCR,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned flds 152 I $O(^RCY(344.4,RCSCR,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**" 153 S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,2,RCSCR1)) Q:'RCSCR1 D 154 . K RCDIQ2 155 . D GETS^DIQ(344.42,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ2") 156 . D TXT2^RCDPEX31(RCSCR,RCSCR1,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs 157 S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,1,RCSCR1)) Q:'RCSCR1 D 158 . K RCDIQ1 159 . D GETS^DIQ(344.41,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ1") 160 . D TXT00^RCDPEX31(RCSCR,RCSCR1,.RCDIQ1,.RCXM1,.RC) 161 . S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_$$PNM4^RCDPEWL1(RCSCR,RCSCR1)_$J("",41),1,41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1),RCXM1(RC)=" " 162 . S RC3611=$P($G(^RCY(344.4,RCSCR,1,RCSCR1,0)),U,2) 163 . I RCERADET D ; Include formatted txt from 361.1 or 344.411 164 .. I 'RC3611 D Q ; Formatted raw data 165 ... D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_RCSCR1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75,1) 166 ..; 167 .. E D ; Detail record is in 361.1 168 ... K ^TMP("PRCA_EOB",$J) 169 ... D GETEOB^IBCECSA6(RC3611,2) 170 ... I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors 171 ... S Z=0 F S Z=$O(^TMP("PRCA_EOB",$J,RC3611,Z)) Q:'Z S RC=RC+1,^TMP($J,"RC_SUMOUT",RC)=$G(^TMP("PRCA_EOB",$J,RC3611,Z)) 172 ... S RC=RC+2,^TMP($J,"RC_SUMOUT",RC-1)=" ",^TMP($J,"RC_SUMOUT",RC)=" " 173 ... K ^TMP("PRCA_EOB",$J) 174 . I $D(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2)) D 175 .. S RC=RC+1,RCXM1(RC)=" **EXCEPTION RESOLUTION LOG DATA**" 176 .. S Z=0 F S Z=$O(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)) Q:'Z S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z) 177 . S RC=RC+1,RCXM1(RC)=" " 178 . S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1) 179 . S Z=0 F S Z=$O(RCXM1(Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z) 180 . K RCXM1 S RC=0 181 . S Z=0 F S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=$G(^TMP($J,"RC_SUMOUT",Z)) 182 S RCSTOP=0,Z="" 183 F S Z=$O(^TMP($J,"RC_SUMALL",Z)) Q:'Z D Q:RCSTOP 184 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q 185 . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q 186 .. D:RCPG ASK(.RCSTOP) I RCSTOP Q 187 .. D HDR(.RCPG) 188 . W !,$G(^TMP($J,"RC_SUMALL",Z)) 189 ; 190 I 'RCSTOP,RCPG D ASK(.RCSTOP) 191 ; 192 I $D(ZTQUEUED) S ZTREQ="@" 193 I '$D(ZTQUEUED) D ^%ZISC 194 ; 195 PRERAQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"SUMALL") 196 S VALMBCK="R" 197 Q 198 ; 199 HDR(RCPG) ;Report hdr 200 ; RCPG = last page # 201 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13 202 S RCPG=$G(RCPG)+1 203 W !,?5,"EDI LOCKBOX WORKLIST - ERA DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=") 204 Q 205 ; 206 ASK(RCSTOP) ; 207 I $E(IOST,1,2)'["C-" Q 208 N DIR,DIROUT,DIRUT,DTOUT,DUOUT 209 S DIR(0)="E" W ! D ^DIR 210 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q 211 Q 212 ;
Note:
See TracChangeset
for help on using the changeset viewer.
