- 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/RCDPEX32.m
r613 r623 1 RCDPEX32 2 ;;4.5;Accounts Receivable;**173,249**;Mar 20, 1995;Build 2 3 4 5 EDITNUM 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 . S RCEOB=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"",1)",RCBILL) ; IA 404251 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 EDITNQ 84 85 86 87 88 CHGED(DA,RCEOB,RCSAVE) 89 90 91 92 93 94 95 1 RCDPEX32 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;10-OCT-02 2 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 EDITNUM ; Edit invalid claim # to valid, refile EOB 6 N RC,RC0,RCDA,RCXDA,RCXDA1,RCSAVE,RCEOB,RCWARN,Q,Q0,DA,DR,DIE,DIC,DIR,X,Y,RCBILL,RCCHG 7 D FULL^VALM1 8 D SEL^RCDPEX3(.RCDA) 9 G:'$O(RCDA(0)) EDITNQ 10 ; 11 S RC=0 F S RC=$O(RCDA(RC)) Q:'RC D L -^RCY(344.4,RCXDA1,1,RCXDA,0) 12 . S RCXDA1=+RCDA(RC),RCXDA=+$P(RCDA(RC),U,2),RCSAVE="" 13 . I '$$LOCK^RCDPEX31(RCXDA1,RCXDA,1) D Q 14 .. S DIR(0)="EA",DIR("A",1)="**Selection #"_RC_" is being edited by another user - ... please try again later",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR 15 . S RC0=$G(^RCY(344.4,RCXDA1,1,RCXDA,0)) 16 . I $P(RC0,U,5)="" D Q 17 .. S DIR(0)="EA",DIR("A",1)="The claim for selection #"_RC_" can't be edited as the bill # is not invalid",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR 18 . I $P(RC0,U,9) D Q 19 .. S DIR(0)="EA",DIR("A",1)="The claim for selection #"_RC_" can't be edited as the claim has already",DIR("A")="been transferred to another site - PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR 20 . ; 21 . I $D(^RCY(344.49,RCXDA1)) D 22 .. N X 23 .. S X=$G(^RCY(344,+$P($G(^RCY(344.49,RCXDA1,0)),U,2),0)) 24 .. W !!,*7,"Warning: EEOB Worklist entry #"_RCXDA1_$S($P(X,U)'="":" and receipt "_$P(X,U),1:"")_" exist for this EEOB" 25 .. I X="" W !,"You should refresh the worklist entry to include the new claim #",!," before creating the receipt",! 26 . I $P($G(^RCY(344.4,RCXDA1,0)),U,8) D 27 .. W !,"Since the receipt for this EEOB ("_$P($G(^RCY(344,+$P($G(^RCY(344.4,RCXDA1,0)),U,8),0)),U)_") already exists" 28 .. I '$P($G(^RCY(344,+$P($G(^RCY(344.4,RCXDA1,0)),U,8),0)),U,14) W !," and is closed, you will need to use link payment to apply the payment",!," to the correct account",! Q 29 .. W !," you should edit the receipt and change the claim # so it posts to the",!," correct account",! 30 . ; 31 . I $P(RC0,U,17)="" S RCSAVE=$P(RC0,U,5) 32 . W !,"Selection #: "_RC_$J("",5)_$P(RC0,U,5) 33 . S DIC("A")="Select A/R Bill this EEOB is actually paying on: ",DIC="^PRCA(430,",DIC(0)="AEMQ",DIC("S")="I $D(^DGCR(399,+Y,0))" W ! D ^DIC K DIC 34 . Q:Y'>0 35 . S RCBILL=+Y,RCBILL(1)=$P($G(^PRCA(430,RCBILL,0)),U),RCWARN=0 36 . I $P($G(^RCY(344.4,RCXDA1,0)),U,14) S RCWARN=RCWARN+1,DIR("A",RCWARN+1)=$J("",4)_"THE RECEIPT FOR THIS EEOB HAS ALREADY BEEN POSTED." 37 . I $P($G(^PRCA(430.3,+$P($G(^PRCA(430,RCBILL,0)),U,8),0)),U,3)'=102 S RCWARN=RCWARN+1,DIR("A",RCWARN+1)=$J("",4)_"THIS IS NOT AN ACTIVE ACCOUNTS RECEIVABLE." 38 . I RCWARN D I Y'=1 Q 39 .. S DIR("A",1)="** WARNING"_$S(RCWARN>1:"S",1:"")_":" 40 .. S DIR("A",RCWARN+1)=" " 41 .. S DIR(0)="YA",DIR("A")="ARE YOU SURE YOU WANT TO FILE THIS EEOB FOR CLAIM #: "_RCBILL(1)_"?: ",DIR("B")="NO" W ! D ^DIR K DIR 42 .. ; 43 . ; File EOB for new claim # 44 . K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR") 45 . S Q=0 F S Q=$O(^RCY(344.4,RCXDA1,1,RCXDA,1,Q)) Q:'Q S Q0=$G(^(Q,0)) D 46 .. I $P(Q0,U)["835ERA" S ^TMP($J,"RCDPEOB","HDR")=Q0 47 .. I $P(Q0,U,2)=$P(RC0,U,5) S $P(Q0,U,2)=RCBILL(1) 48 .. S ^TMP($J,"RCDP-EOB",1,Q,0)=Q0 49 . S ^TMP($J,"RCDP-EOB",1,.5,0)="835ERA" 50 . S RCEOB=$$DUP^IBCEOB(RCBILL,"^TMP("_$J_",""RCDP-EOB"",1)") ; IA 4042 51 . K ^TMP($J,"RCDP-EOB",1,.5,0) 52 . I RCEOB D Q 53 .. N RCWHY S RCWHY(1)="EEOB already found on file while trying to change claim # and filing into IB" 54 .. D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY) 55 .. S RCCHG=1,DA(1)=RCXDA1,DA=RCXDA D CHGED(.DA,RCEOB,RCSAVE) 56 .. S DIR(0)="YA",DIR("A",1)="EEOB detail is already on file for "_RCBILL(1)_" - Exception removed",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR 57 . ; 58 . ; Add stub rec to 361.1 if not there 59 . S RCEOB=+$$ADD3611^IBCEOB(+$P($G(^RCY(344.4,RCXDA1,0)),U,12),"","",RCBILL,1,"^TMP("_$J_",""RCDP-EOB"",1)") ; IA 4042 60 . ; 61 . I RCEOB<0 D Q 62 .. N RCWHY S RCWHY(1)="Error encountered trying to change claim # and file into IB" 63 .. D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY) 64 .. S DIR("A")="EA",DIR("A",1)="Error - EEOB detail not added to IB for bill "_RCBILL(1),DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR 65 . ; 66 . ; Update EOB in file 361.1 67 . ; Call needs ^TMP arrays: $J,"RCDPEOB","HDR" and $J,"RCDP-EOB" 68 . D UPD3611^IBCEOB(RCEOB,1,1) ; IA 4042 69 . ; errors in ^TMP("RCDPERR-EOB",$J 70 . I $O(^TMP("RCDPERR-EOB",$J,0)) D 71 .. D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB") ; Adds error msgs to IB file 361.1 ; IA 4042 72 . ; 73 . S RCCHG=1 74 . N RCWHY S RCWHY(1)="EEOB claim # changed and filed into IB under new claim #" 75 . D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY) 76 . S DA(1)=RCXDA1,DA=RCXDA 77 . D CHGED(.DA,RCEOB,RCSAVE) 78 . S DIE="^RCY(344.4,"_DA(1)_",1,",DR="1///@" D ^DIE 79 . S DIR("A",1)="EEOB Filed. Its detail may be viewed using Third Party Joint Inquiry",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA" 80 . W ! D ^DIR K DIR 81 . S VALMBG=1 82 ; 83 EDITNQ I $G(RCCHG) D BLD^RCDPEX2 84 K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$J) 85 S VALMBCK="R" 86 Q 87 ; 88 CHGED(DA,RCEOB,RCSAVE) ; Change bad bill # to good one for EOB 89 ; DA = DA and DA(1) to use for DIE call 90 ; RCEOB = the ien of the entry in file 361.1 91 ; RCSAVE = the free text of the original bill # 92 N DIE,DR,X,Y 93 S DIE="^RCY(344.4,"_DA(1)_",1,",DR=".05///@;.02////"_RCEOB_";.13////1"_$S(RCSAVE'="":";.17////"_RCSAVE,1:"")_";.07///@" D ^DIE 94 Q 95 ;
Note:
See TracChangeset
for help on using the changeset viewer.
