| 1 | RCDPEX3 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;10-OCT-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 | ; IA REF TO ^IBE(350.9 = 4049
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | VP ; View/Print ERA Msgs - File 344.4
|
|---|
| 8 | N X,Y,RCDA,RCTDA,RCALL,DIR,POP
|
|---|
| 9 | D FULL^VALM1
|
|---|
| 10 | S DIR(0)="SA^A:ALL;S:SELECTED",DIR("A")="PRINT (A)LL or (S)ELECTED RECORDS?: "
|
|---|
| 11 | S DIR("B")="ALL"
|
|---|
| 12 | D ^DIR K DIR
|
|---|
| 13 | G:$D(DUOUT)!$D(DTOUT) VPQ
|
|---|
| 14 | S RCALL=(Y="A")
|
|---|
| 15 | ;
|
|---|
| 16 | I 'RCALL D G:'$O(RCDA("")) VPQ
|
|---|
| 17 | . D SEL(.RCDA)
|
|---|
| 18 | ;
|
|---|
| 19 | ; device
|
|---|
| 20 | N %ZIS,ZTRTN,ZTSAVE,ZTDESC
|
|---|
| 21 | S %ZIS="QM" D ^%ZIS G:POP VPQ
|
|---|
| 22 | I $D(IO("Q")) D G VPQ
|
|---|
| 23 | . S ZTRTN="VPOUT^RCDPEX3",ZTDESC="AR - Print ERA/EEOB Data With Exceptions"
|
|---|
| 24 | . S ZTSAVE("RCDA")="",ZTSAVE("RCALL")="",ZTSAVE("^TMP(""RCDPEX_SUM-EOBDX"",$J,")=""
|
|---|
| 25 | . D ^%ZTLOAD
|
|---|
| 26 | . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
|
|---|
| 27 | . K ZTSK,IO("Q") D HOME^%ZIS
|
|---|
| 28 | U IO
|
|---|
| 29 | ;
|
|---|
| 30 | VPOUT ; Entrypoint queued job
|
|---|
| 31 | ; RCDA, RCALL must be defined
|
|---|
| 32 | N Z,RCSTOP,RCZ,RCPG,RCDOT,RCTDA1
|
|---|
| 33 | K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT")
|
|---|
| 34 | S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)=""
|
|---|
| 35 | I RCALL D
|
|---|
| 36 | . S RCZ=0 F S RCZ=$O(^TMP("RCDPEX_SUM-EOBDX",$J,RCZ)) Q:'RCZ S RCTDA=$G(^(RCZ)),RCTDA1=+$P(RCTDA,U,3),RCTDA=+$P(RCTDA,U,2) D Q:RCSTOP
|
|---|
| 37 | .. D PRT(RCTDA,RCTDA1,.RCPG,.RCSTOP)
|
|---|
| 38 | .. I $O(^TMP("RCDPEX_SUM-EOBDX",$J,RCZ)) D WRTSEP(RCDOT,RCPG)
|
|---|
| 39 | I 'RCALL D
|
|---|
| 40 | . S RCZ=0 F S RCZ=$O(RCDA(RCZ)) Q:'RCZ D
|
|---|
| 41 | .. S RCTDA1=+$P(RCDA(RCZ),U,2),RCTDA=+RCDA(RCZ) D PRT(RCTDA,RCTDA1,.RCPG,.RCSTOP) I $O(RCDA(RCZ)) D WRTSEP(RCDOT,RCPG)
|
|---|
| 42 | ;
|
|---|
| 43 | I '$D(ZTQUEUED),'RCSTOP,RCPG D ASK(.RCSTOP)
|
|---|
| 44 | ;
|
|---|
| 45 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 46 | I '$D(ZTQUEUED) D ^%ZISC
|
|---|
| 47 | ;
|
|---|
| 48 | VPQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT")
|
|---|
| 49 | S VALMBCK="R"
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | WRTSEP(RCDOT,RCPG) ; Separating lines if more records to print
|
|---|
| 53 | W !,RCDOT,!,RCDOT
|
|---|
| 54 | I (($Y+5)>IOSL) D HDR(.RCPG) Q
|
|---|
| 55 | W !!
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | PRT(RCTDA,RCTDA1,RCPG,RCSTOP) ; Print data from file 344.4 and 344.41
|
|---|
| 59 | ; RCTDA = ien file 344.4
|
|---|
| 60 | ; RCTDA1 = ien file 344.41
|
|---|
| 61 | ; RCPG = last page extracted
|
|---|
| 62 | ; RCSTOP = returned 1 if passed by ref and process stopped
|
|---|
| 63 | ;
|
|---|
| 64 | N RCDIQ,RCDIQ1,RCDIQ2,RCXM1,RC,Z
|
|---|
| 65 | D GETS^DIQ(344.4,RCTDA_",","*","IEN","RCDIQ")
|
|---|
| 66 | D TXT0^RCDPEX31(RCTDA,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned fields
|
|---|
| 67 | ;
|
|---|
| 68 | I $O(^RCY(344.4,RCTDA,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**"
|
|---|
| 69 | S Z=0 F S Z=$O(^RCY(344.4,RCTDA,2,Z)) Q:'Z D
|
|---|
| 70 | . D GETS^DIQ(344.42,Z_","_RCTDA_",","*","IEN","RCDIQ2")
|
|---|
| 71 | . D TXT2^RCDPEX31(RCTDA,Z,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs
|
|---|
| 72 | ;
|
|---|
| 73 | D GETS^DIQ(344.41,RCTDA1_","_RCTDA_",","*","IEN","RCDIQ1")
|
|---|
| 74 | D TXT00^RCDPEX31(RCTDA,RCTDA1,.RCDIQ1,.RCXM1,.RC)
|
|---|
| 75 | D DISP^RCDPESR0("^RCY(344.4,"_RCTDA_",1,"_RCTDA1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75) ; Get formatted 'raw' data
|
|---|
| 76 | ;
|
|---|
| 77 | I $D(RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2)) D
|
|---|
| 78 | . S RC=RC+1,RCXM1(RC)=" **RESOLUTION LOG DATA**"
|
|---|
| 79 | . S Z=0 F S Z=$O(RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2,Z)) Q:'Z S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2,Z)
|
|---|
| 80 | . S RC=RC+1,RCXM1(RC)=" "
|
|---|
| 81 | S (RCSTOP,Z)=0
|
|---|
| 82 | F S Z=$O(RCXM1(Z)) Q:'Z S ^TMP($J,"RC_SUMOUT",Z-999)=RCXM1(Z)
|
|---|
| 83 | S Z=""
|
|---|
| 84 | F S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z D Q:RCSTOP
|
|---|
| 85 | . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
|
|---|
| 86 | . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
|
|---|
| 87 | .. D:RCPG ASK(.RCSTOP) I RCSTOP Q
|
|---|
| 88 | .. D HDR(.RCPG)
|
|---|
| 89 | . W !,$G(^TMP($J,"RC_SUMOUT",Z))
|
|---|
| 90 | ;
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | XFR ; Transfer EOB(s) to other site
|
|---|
| 94 | N RC,RC0,RCCHG,RCOK,RCDOMAIN,RCDEF,RCDA,RCWHY,RCER,RCECT,RCXTO,RCALL,RCCONT,DIR,X,Y,DA,DIE,DR,POP,RCDA,RCXDA,RCXDA1,RCDUZ,XMBODY,XMTO
|
|---|
| 95 | D FULL^VALM1
|
|---|
| 96 | D SEL(.RCDA)
|
|---|
| 97 | ;
|
|---|
| 98 | G:'$O(RCDA(0)) XFRQ
|
|---|
| 99 | S DIR("S")="I +$G(^DIC(4,+Y,6))",DIR(0)="PA^4:AME",DIR("A")="TRANSFER TO WHICH SITE?: " D ^DIR K DIR
|
|---|
| 100 | I $D(DUOUT)!$D(DTOUT) G XFRQ
|
|---|
| 101 | S RCXTO=+Y,RCCHG=0
|
|---|
| 102 | ;
|
|---|
| 103 | S RCDOMAIN=$$EXTERNAL^DILFD(4,60,,+$G(^DIC(4,+RCXTO,6))),RCECT=0
|
|---|
| 104 | I RCDOMAIN="" D G XFRQ
|
|---|
| 105 | . S DIR("A",1)="THERE IS NO VALID DOMAIN SET UP FOR THIS SITE. YOU MUST CHOOSE ANOTHER ONE.",DIR("A")="PRESS RETURN TO CONTINUE",DIR(0)="EA" W ! D ^DIR K DIR
|
|---|
| 106 | ;
|
|---|
| 107 | S RCDEF=$S($P($G(^IBE(350.9,1,2)),U,6)'="":$E("AGENT CASHIER-"_$P(^IBE(350.9,1,2),U,6),1,45),1:"")
|
|---|
| 108 | S DIR("A",1)="ENTER THE CONTACT INFORMATION FOR THE PERSON AT YOUR SITE",DIR("A",2)=" WHO MAY BE CONTACTED BY THE OTHER SITE REGARDING THIS EEOB",DIR("A")=" (1-45 CHARACTERS): "_$S(RCDEF'="":RCDEF_"// ",1:"") ; IA 4049
|
|---|
| 109 | S DIR(0)="FA"_$S(RCDEF'="":"O",1:"")_"^1:45" W ! D ^DIR K DIR
|
|---|
| 110 | I $D(DUOUT)!$D(DTOUT) G XFRQ
|
|---|
| 111 | I Y="" S Y=RCDEF
|
|---|
| 112 | S RCCONT=Y
|
|---|
| 113 | ;
|
|---|
| 114 | S DIR(0)="YA",DIR("A")="DO YOU WANT TO PRINT THE EEOB(s)?: ",DIR("B")="Y"
|
|---|
| 115 | D ^DIR K DIR
|
|---|
| 116 | I $D(DUOUT)!$D(DTOUT) G XFRQ
|
|---|
| 117 | I Y=1 S RCER=0 D I RCER G XFRQ
|
|---|
| 118 | . N %ZIS,ZTRTN,ZTSAVE,ZTDESC
|
|---|
| 119 | . S %ZIS="QM" D ^%ZIS I POP S RCER=1 Q
|
|---|
| 120 | . I $D(IO("Q")) D Q
|
|---|
| 121 | .. S RCALL=0
|
|---|
| 122 | .. S ZTRTN="VPOUT^RCDPEX3",ZTDESC="AR - Print EEOB Data Before Transfer"
|
|---|
| 123 | .. S ZTSAVE("RCDA")="",ZTSAVE("RCALL")="",ZTSAVE("^TMP(""RCDPEX_SUM-EOBDX"",$J)")=""
|
|---|
| 124 | .. D ^%ZTLOAD
|
|---|
| 125 | .. I '$D(ZTSK) S RCER=1
|
|---|
| 126 | .. K ZTSK,IO("Q") D HOME^%ZIS
|
|---|
| 127 | . S RCALL=0
|
|---|
| 128 | . D VPOUT^RCDPEX3
|
|---|
| 129 | ;
|
|---|
| 130 | S RCWHY(1)="Transfer EEOB detail to another site"
|
|---|
| 131 | S RC=0 F S RC=$O(RCDA(RC)) Q:'RC D L -^RCY(344.4,RCXDA,1,RCXDA1,0)
|
|---|
| 132 | . N RCBODY,RCAMT,RCBILL,RCX,XMZ
|
|---|
| 133 | . S RCXDA=+RCDA(RC),RCXDA1=+$P(RCDA(RC),U,2),RCWHY(2)=""
|
|---|
| 134 | . I '$$LOCK^RCDPEX31(RCXDA,RCXDA1,1) D Q
|
|---|
| 135 | .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" is being edited by another user - ... please try again later"
|
|---|
| 136 | . ;
|
|---|
| 137 | . S RC0=$G(^RCY(344.4,RCXDA,1,RCXDA1,0))
|
|---|
| 138 | . M RCBODY=^RCY(344.4,RCXDA,1,RCXDA1,1)
|
|---|
| 139 | . S RCAMT=$P(RC0,U,3)*100
|
|---|
| 140 | . S RCBILL=$P(RC0,U,5)
|
|---|
| 141 | . S DIR("A",1)="ONCE THIS EEOB HAS BEEN TRANSFERRED, ITS BILL # CANNOT BE EDITED",DIR("A")="ARE YOU SURE THIS IS NOT A CLAIM FOR YOUR SITE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
|
|---|
| 142 | . Q:Y'=1
|
|---|
| 143 | . I $P(RC0,U,11) D Q:'RCOK
|
|---|
| 144 | .. S RCOK=1
|
|---|
| 145 | .. S DIR("A",1)="WARNING: EEOB FOR #"_RC_" ("_RCBILL_") HAS ALREADY BEEN TRANSFERRED",DIR("A",2)=" TO "_$P($G(^DIC(4,+$P(RC0,U,11),0)),U)_" ON: "_$$FMTE^XLFDT($P(RC0,U,12),2)
|
|---|
| 146 | .. S DIR("A")="ARE YOU SURE YOU WANT TO TRANSFER IT AGAIN?: "
|
|---|
| 147 | .. S DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
|
|---|
| 148 | .. I Y=1 Q
|
|---|
| 149 | .. S RCOK=0
|
|---|
| 150 | .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" already transferred - "_RCBILL_" NOT transferred again"
|
|---|
| 151 | . K RCBODY(0)
|
|---|
| 152 | . S RCX=$G(RCBODY(1,0))
|
|---|
| 153 | . ;
|
|---|
| 154 | . I $P($G(^RCY(344.4,RCXDA,1,RCXDA1,0)),U,7)'=1 D Q
|
|---|
| 155 | .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" is not available for transfer - "_RCBILL_" NOT transferred"
|
|---|
| 156 | . ;
|
|---|
| 157 | . I $P(RCX,U)'["835ERA"!'$O(RCBODY(1)) D Q
|
|---|
| 158 | .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" format is not valid for transfer - "_RCBILL_" NOT transferred"
|
|---|
| 159 | . ;
|
|---|
| 160 | . S $P(RCX,U)="835XFR",$P(RCX,U,10,16)=(RCAMT_"^^^^^^"_RCCONT)
|
|---|
| 161 | . S RCBODY(1,0)=RCX
|
|---|
| 162 | . S RCBODY(+$O(RCBODY(""),-1)+1,0)="99^$"
|
|---|
| 163 | . S RCBODY(+$O(RCBODY(""),-1)+1,0)="NNNN"
|
|---|
| 164 | . S XMTO("S.RCDPE EDI LOCKBOX SERVER@"_RCDOMAIN)=""
|
|---|
| 165 | . S XMBODY="RCBODY",RCDUZ=$G(DUZ),DUZ=.5
|
|---|
| 166 | . D SENDMSG^XMXAPI(.5,"TRANSFER 3RD PARTY EEOB "_RCBILL_"(REF #"_RCXDA_";"_RCXDA1_"#)",XMBODY,.XMTO,,.XMZ)
|
|---|
| 167 | . ;
|
|---|
| 168 | . S DUZ=RCDUZ
|
|---|
| 169 | . I $G(XMZ) D ; Report msg #
|
|---|
| 170 | .. S RCCHG=1
|
|---|
| 171 | .. S RCECT=RCECT+1,RCER(RCECT)="Entry #"_RC_" was successfully transferred - msg # is "_XMZ
|
|---|
| 172 | .. S DA(1)=RCXDA,DA=RCXDA1,DIE="^RCY(344.4,"_DA(1)_",1,",DR=".09////"_XMZ_";.11////"_RCXTO_";.12////"_$E($$NOW^XLFDT(),1,12) D ^DIE
|
|---|
| 173 | .. S RCWHY(2)=" Transfer to "_$P($G(^DIC(4,+RCXTO,0)),U)_" was successful"
|
|---|
| 174 | .. ;
|
|---|
| 175 | . E D ; error - transfer not done
|
|---|
| 176 | .. S RCECT=RCECT+1,RCER(RCECT)="**Entry #"_RC_" was NOT transferred due to a msg build error ("_RCBILL_")"
|
|---|
| 177 | .. S RCWHY(2)=" Transfer to "_$P($G(^DIC(4,+RCXTO,0)),U)_" was UNSUCCESSFUL"
|
|---|
| 178 | .. ;
|
|---|
| 179 | . D STORACT^RCDPEX31(RCXDA,RCXDA1,.RCWHY)
|
|---|
| 180 | ;
|
|---|
| 181 | I $O(RCER(0)) D
|
|---|
| 182 | . ; Write msgs
|
|---|
| 183 | . W !!,"TRANSFER OF EEOB TO "_$P($G(^DIC(4,RCXTO,0)),U)_" RESULTS: ",!
|
|---|
| 184 | . S RCECT=0 F S RCECT=$O(RCER(RCECT)) Q:'RCECT W !," ",RCER(RCECT)
|
|---|
| 185 | . W !
|
|---|
| 186 | ;
|
|---|
| 187 | D PAUSE^VALM1
|
|---|
| 188 | ;
|
|---|
| 189 | XFRQ I $G(RCCHG) D BLD^RCDPEX2
|
|---|
| 190 | S VALMBCK="R"
|
|---|
| 191 | Q
|
|---|
| 192 | ;
|
|---|
| 193 | SEL(RCDA,ONE) ; Select entry(s) from list
|
|---|
| 194 | ; RCDA = array returned if selections made
|
|---|
| 195 | ; RCDA(n)=ien of bill selected file 344.4
|
|---|
| 196 | ; ONE = if set to 1, only one selection can be made at a time
|
|---|
| 197 | N RC
|
|---|
| 198 | K RCDA
|
|---|
| 199 | D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
|
|---|
| 200 | S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RC=$G(^TMP("RCDPEX_SUM-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2)_U_+$P(RC,U,3)
|
|---|
| 201 | Q
|
|---|
| 202 | ;
|
|---|
| 203 | HDR(RCPG) ;Print report hdr
|
|---|
| 204 | ; RCPG = last page #
|
|---|
| 205 | I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
|
|---|
| 206 | S RCPG=$G(RCPG)+1
|
|---|
| 207 | W !,?5,"EDI LOCKBOX EEOB DATA EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=")
|
|---|
| 208 | Q
|
|---|
| 209 | ;
|
|---|
| 210 | ASK(RCSTOP) ;
|
|---|
| 211 | I $E(IOST,1,2)'["C-" Q
|
|---|
| 212 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 213 | S DIR(0)="E" W ! D ^DIR
|
|---|
| 214 | I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
|
|---|
| 215 | Q
|
|---|
| 216 | ; ***
|
|---|
| 217 | ; *** Entrypoints TXT* assume these variable definitions ***
|
|---|
| 218 | ; ***
|
|---|
| 219 | ; FUNCTIONs returns RCXM1 and RC if passed by reference
|
|---|
| 220 | ; RCTDA = ien, file 344.4
|
|---|
| 221 | ; RCXM1 = array returned with text, captioned
|
|---|
| 222 | ; RC = # of lines already in array (optional)
|
|---|
| 223 | ; RCDIQ and RCDIQ1 = arrays returned from GETS^DIQ
|
|---|
| 224 | ; ***
|
|---|
| 225 | ;
|
|---|
| 226 | UPD ; Try to update the IB EOB file from exception in 344.41
|
|---|
| 227 | D UPD^RCDPEX31 ; Moved for space
|
|---|
| 228 | Q
|
|---|
| 229 | ;
|
|---|
