| [613] | 1 | RCDPEWL3 ;ALB/TMK - ELECTRONIC EOB WORKLIST ACTIONS ;24-FEB-03
|
|---|
| 2 | ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | SPLIT(RCSCR,RCL) ; Perform line splits
|
|---|
| 7 | N Z,Z0,DIR,X,Y,RCL1,DA,DR,DIE,DIC,RCDONE,RCDIR,RCSPLIT,RCTOT,RCOK,RCLINE
|
|---|
| 8 | ;
|
|---|
| 9 | D CLEAR^VALM1
|
|---|
| 10 | S ^TMP($J,"RCDPE_SPLIT")=""
|
|---|
| 11 | S RCLINE=$G(^TMP("RCDPE-EOB_WLDX",$J,RCL)),RCL1=$G(^TMP("RCDPE-EOB_WLDX",$J,RCL\1))
|
|---|
| 12 | ;
|
|---|
| 13 | S Z=+$O(^TMP("RCDPE-EOB_WLDX",$J,RCL)),Z0=+$G(^TMP("RCDPE-EOB_WLDX",$J,Z)) S:'Z0 Z0=999
|
|---|
| 14 | W !
|
|---|
| 15 | F Z=+RCLINE:1:Z0 Q:'$D(^TMP("RCDPE-EOB_WL",$J,Z,0))!(Z'<Z0) W !,^TMP("RCDPE-EOB_WL",$J,Z,0)
|
|---|
| 16 | ;
|
|---|
| 17 | I $E($P(RCL1,U,2),1,3)["ADJ" D G SPLITQ
|
|---|
| 18 | . W !,"THIS IS AN ERA-LEVEL ADJUSTMENT - ONLY THE ADJUSTMENT COMMENT CAN BE EDITED"
|
|---|
| 19 | . S DIR(0)="A" D ^DIR K DIR
|
|---|
| 20 | . S DA(2)=RCSCR,DA(1)=+$P(RCLINE,U,2),DA=+$P($P(RCL1,U,2),"ADJ",2)
|
|---|
| 21 | . Q:'DA
|
|---|
| 22 | . D EDITCOM(.DA)
|
|---|
| 23 | ;
|
|---|
| 24 | S RCDONE=0,RCDIR(1)=$P($G(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),0)),U,2),RCDIR(2)=$P($G(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),0)),U,5),RCDIR(3)=$P($G(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),0)),U,8),RCDIR(6)=+$P(RCLINE,U,2)
|
|---|
| 25 | S RCDIR=RCDIR(1)_U_RCDIR(2)_U_RCDIR(3)
|
|---|
| 26 | ;
|
|---|
| 27 | S RCSPLIT=0
|
|---|
| 28 | I $P(RCDIR,U,3) W !!,"NOTE: THIS LINE HAS AN ADJUSTMENT RECORD ASSOCIATED WITH IT",!
|
|---|
| 29 | F D Q:RCDONE
|
|---|
| 30 | . S RCSPLIT=RCSPLIT+1
|
|---|
| 31 | . D EDIT(RCSCR,RCLINE,.RCDIR,.RCSPLIT,"",.RCDONE)
|
|---|
| 32 | . I '$D(RCSPLIT(RCSPLIT)) S RCSPLIT=RCSPLIT-1
|
|---|
| 33 | ;
|
|---|
| 34 | G:'$O(RCSPLIT(0)) SPLITQ
|
|---|
| 35 | N VALMCNT,VALMBG
|
|---|
| 36 | S VALMCNT=0,VALMBG=1
|
|---|
| 37 | S ^TMP($J,"RCDPE_SPLIT_FILE")=1
|
|---|
| 38 | D EN^VALM("RCDPE EOB WORKLIST SPLIT")
|
|---|
| 39 | ;
|
|---|
| 40 | SPLITQ Q
|
|---|
| 41 | ;
|
|---|
| 42 | TOT(N,RCSPLIT,RCLINE) ; CALCULATE TOTAL OF PAY (N=2) or ADJ (N=3)
|
|---|
| 43 | ; RCSPLIT = the array (passed by ref) where the amounts are stored
|
|---|
| 44 | ; RCLINE = if editing, this is the line # NOT to add in when
|
|---|
| 45 | ; determining previous amounts entered
|
|---|
| 46 | N Z,Z0
|
|---|
| 47 | S (Z,Z0)=0
|
|---|
| 48 | F S Z=$O(RCSPLIT(Z)) Q:'Z I $S('$G(RCLINE):1,1:RCLINE'=Z) S Z0=Z0+$P(RCSPLIT(Z),U,N)
|
|---|
| 49 | Q $J(Z0,"",2)
|
|---|
| 50 | ;
|
|---|
| 51 | UPD(Q,Q1) ;
|
|---|
| 52 | N DA,DIE,DR,X,Y
|
|---|
| 53 | S DA(1)=Q,DA=Q1
|
|---|
| 54 | S DIE="^RCY(344.49,"_DA(1)_",1,",DR="2.03////"_DUZ_";2.04////"_$$NOW^XLFDT() D ^DIE
|
|---|
| 55 | S ^TMP("RCDPE_SPLIT_REBLD",$J)=1
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | HDR ;
|
|---|
| 59 | N Z,Z0,ZCT
|
|---|
| 60 | S ZCT=0
|
|---|
| 61 | S Z=+$O(^TMP("RCDPE-EOB_WLDX",$J,RCL)),Z0=+$G(^TMP("RCDPE-EOB_WLDX",$J,Z)) S:'Z0 Z0=999
|
|---|
| 62 | F Z=+RCLINE:1:Z0 Q:'$D(^TMP("RCDPE-EOB_WL",$J,Z,0))!(Z'<Z0)!(ZCT'<6) S ZCT=ZCT+1,VALMHDR(ZCT)=^TMP("RCDPE-EOB_WL",$J,Z,0)
|
|---|
| 63 | S ZCT=ZCT+1,VALMHDR(ZCT)=" "
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | FNL ;
|
|---|
| 67 | K ^TMP("RCDPE_EOB_SPLIT",$J),^TMP("RCDPE_EOB_SPLIT_OK",$J),^TMP("RCDPE_EOB_SPLITDX",$J)
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | INIT ; Build screen for display
|
|---|
| 71 | ; RCSCR, RCDIR, RCSPLIT must already exist
|
|---|
| 72 | N Z,RCTOT,DIR,X,Y,RCNT,RCCT,Q,RCT
|
|---|
| 73 | K ^TMP("RCDPE_EOB_SPLIT",$J)
|
|---|
| 74 | S (VALMCNT,RCNT)=0
|
|---|
| 75 | S ^TMP("RCDPE_EOB_SPLIT_OK",$J)=1
|
|---|
| 76 | F Z=2,3 S RCTOT(Z)=$$TOT(Z,.RCSPLIT)
|
|---|
| 77 | I +RCTOT(2)'=+$P(RCDIR,U,2)!(+RCTOT(3)'=+$P(RCDIR,U,3)) D
|
|---|
| 78 | . D SET("**** TOTAL AMOUNTS ENTERED DO NOT MATCH THE ORIGINAL AMOUNTS ****",1),SET(" ",1)
|
|---|
| 79 | . S ^TMP("RCDPE_EOB_SPLIT_OK",$J)=0
|
|---|
| 80 | ;
|
|---|
| 81 | S (RCCT,Z,RCT(1),RCT(2),RCT(3))=0
|
|---|
| 82 | F S Z=$O(RCSPLIT(Z)) Q:'Z D
|
|---|
| 83 | . S X="",RCCT=RCCT+1
|
|---|
| 84 | . S X=$$SETFLD^VALM1(RCCT,X,"NUM")
|
|---|
| 85 | . S X=$$SETFLD^VALM1($P(RCSPLIT(Z),U)_$S('$P(RCSPLIT(Z),U,5):" (NOT IN A/R)",1:""),X,"CLAIM")
|
|---|
| 86 | . S X=$$SETFLD^VALM1($J(+$P(RCSPLIT(Z),U,2),15,2),X,"PAYMENT"),RCT(1)=RCT(1)+$P(RCSPLIT(Z),U,2)
|
|---|
| 87 | . S X=$$SETFLD^VALM1($J(+$P(RCSPLIT(Z),U,3),15,2),X,"ADJUSTMENT"),RCT(2)=RCT(2)+$P(RCSPLIT(Z),U,3)
|
|---|
| 88 | . S X=$$SETFLD^VALM1($J($P(RCSPLIT(Z),U,2)+$P(RCSPLIT(Z),U,3),15,2),X,"NET"),RCT(3)=RCT(3)+$P(RCSPLIT(Z),U,2)+$P(RCSPLIT(Z),U,3)
|
|---|
| 89 | . D SET(X,RCCT)
|
|---|
| 90 | . I $P(RCSPLIT(Z),U,6)'="",$P(RCSPLIT(Z),U,6)'="@" S X=$$SETSTR^VALM1($J("",10)_$P(RCSPLIT(Z),U,6),"",1,70) D SET(X,RCCT)
|
|---|
| 91 | S Q="",$P(Q,"=",15)=""
|
|---|
| 92 | D SET($J("",32)_Q_" "_Q_" "_Q,RCCT),SET($E(" TOTALS: "_$J("",31),1,31)_$E($J(+RCT(1),15,2)_$J("",17),1,17)_$E($J(+RCT(2),15,2)_$J("",17),1,17)_$E($J(+RCT(3),15,2)_$J("",17),1,17),RCCT)
|
|---|
| 93 | ;
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | SET(X,RCSEQ) ;
|
|---|
| 97 | S VALMCNT=VALMCNT+1
|
|---|
| 98 | S ^TMP("RCDPE_EOB_SPLIT",$J,VALMCNT,0)=X
|
|---|
| 99 | S ^TMP("RCDPE_EOB_SPLIT",$J,"IDX",VALMCNT,RCSEQ)=""
|
|---|
| 100 | S ^TMP("RCDPE_EOB_SPLITDX",$J,RCSEQ)=VALMCNT
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | EDITCOM(DA) ; Edit the comment for an adjustment entry
|
|---|
| 104 | N RCX,DIE,X,Y,DR
|
|---|
| 105 | S RCX=$P($G(^RCY(344.49,DA(2),1,DA(1),1,DA,0)),U,9)
|
|---|
| 106 | S DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,",DR=".09"
|
|---|
| 107 | D ^DIE
|
|---|
| 108 | Q:$P($G(^RCY(344.49,DA(2),1,DA(1),1,DA,0)),U,9)=RCX
|
|---|
| 109 | D UPD(DA(2),DA(1))
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | EDIT(RCSCR,RCLINE,RCDIR,RCSPLIT,RCDEF,RCDONE) ; Edit a split line
|
|---|
| 113 | ;
|
|---|
| 114 | N CT,DIR,DIC,X,Y,RCOK,RCL,Z,DUOUT,DTOUT
|
|---|
| 115 | ; Enter claim #
|
|---|
| 116 | S RCL=$G(RCDIR(6))
|
|---|
| 117 | EDCL S DIR("?",1)="ENTER THE CLAIM # TO WHICH THE PAYMENT OR ADJUSTMENT WILL BE APPLIED.",DIR("?",2)="THE CLAIM # DOES NOT HAVE TO EXIST IN YOUR AR IF THE PAYMENT/ADJUSTMENT",DIR("?")="BELONGS TO ANOTHER SITE."
|
|---|
| 118 | S DIR(0)="FAO^1:15",DIR("A")="CLAIM #: " S:$P($G(RCDEF),U)'="" DIR("B")=$P(RCDEF,U) S:$G(RCDIR(1))'=""&($G(DIR("B"))="") DIR("B")=RCDIR(1) W ! D ^DIR K DIR
|
|---|
| 119 | I $D(DTOUT)!$D(DUOUT) D ABORT Q
|
|---|
| 120 | I Y="" D G:'RCDONE EDCL Q
|
|---|
| 121 | . S DIR(0)="YA",DIR("A",1)="YOU MUST SPLIT THE ENTIRE AMOUNT OF THE LINE.",DIR("A",2)=" $"_$J(+RCDIR(2),"",2)_" PAYMENT IS LEFT"_$S($P(RCDIR,U,3)&$G(RCDIR(3)):" AND $"_$J(+RCDIR(3),"",2)_" ADJ IS LEFT",1:"")
|
|---|
| 122 | . S DIR("A")="DO YOU WANT TO ABORT THIS SPLIT NOW?: ",DIR("B")="NO" W ! D ^DIR K DIR
|
|---|
| 123 | . I Y'=0 D ABORT Q
|
|---|
| 124 | S $P(RCSPLIT(RCSPLIT),U)=Y
|
|---|
| 125 | ;
|
|---|
| 126 | I $E(Y,1,3)?3N,$L(Y)>7,Y'["-" S Y=$E(Y,1,3)_"-"_$E(Y,4,$L(Y))
|
|---|
| 127 | I $TR(Y," ")="" S Y=-1
|
|---|
| 128 | I Y'=-1 S DIC(0)="M",DIC="^PRCA(430,",X=Y D ^DIC
|
|---|
| 129 | I Y<0 D G:'RCOK EDCL
|
|---|
| 130 | . S RCOK=1
|
|---|
| 131 | . S DIR("A")=" THIS CLAIM WAS NOT FOUND IN YOUR AR. DO YOU WANT TO CONTINUE?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR W ! I Y'=1 K RCSPLIT(RCSPLIT) S RCOK=0
|
|---|
| 132 | E D
|
|---|
| 133 | . S $P(RCSPLIT(RCSPLIT),U,5)=+Y
|
|---|
| 134 | . W " >>Current claim balance is: ",$J(+$P($$BILL^RCJIBFN2(+Y),U,3),"",2)
|
|---|
| 135 | ; Enter payment
|
|---|
| 136 | S RCDIR(1)=""
|
|---|
| 137 | S DIR("?",1)="**************"
|
|---|
| 138 | S CT=1
|
|---|
| 139 | I $P(RCDIR,U,3) D
|
|---|
| 140 | . S DIR("?",CT+1)="SINCE THIS LINE HAS AN ADJUSTMENT, THE AMOUNT ENTERED HERE SHOULD BE THE",DIR("?",CT+2)="CORRECTED AMOUNT THE PAYER INDICATED THEY SHOULD HAVE PAID FOR THE CLAIM",DIR("?",CT+3)=" ",CT=CT+3
|
|---|
| 141 | S CT=CT+1,DIR("?",CT)="ENTER THE AMT FROM THE PAYMENT TOTAL FOR THIS LINE ("_$J(+$P(RCDIR,U,2),"",2)_")"
|
|---|
| 142 | I $G(RCDEF)="" D
|
|---|
| 143 | . S CT=CT+1,DIR("?",CT)=" THAT APPLIES TO THIS CLAIM. THE PAYMENT AMOUNT ALREADY USED FOR THIS"
|
|---|
| 144 | . S CT=CT+1,DIR("?",CT)=" LINE SPLIT IS: "_$J(+$$TOT(2,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_" LEAVING A BALANCE TO DISTRIBUTE OF: "_$J($P(RCDIR,U,2)-$$TOT(2,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)
|
|---|
| 145 | S CT=CT+1,DIR("?",CT)="THE TOTAL PAYMENTS ENTERED DURING THIS SPLIT MUST EQUAL THE ORIGINAL LINE",DIR("?")=" PAYMENT AMOUNT OF $"_$J(+$P(RCDIR,U,2),"",2)
|
|---|
| 146 | S DIR(0)="NAO^0:"_$S(RCDEF="":$P(RCDIR,U,2)-$$TOT(2,.RCSPLIT,RCSPLIT),1:$P(RCDIR,U,2))_":2"
|
|---|
| 147 | S DIR("A")="PAYMENT AMOUNT TO APPLY TO THIS CLAIM: " S:$P($G(RCDEF),U,2)'="" DIR("B")=$J(+$P(RCDEF,U,2),"",2) S:$G(RCDIR(2))'=""&($G(DIR("B"))="") DIR("B")=RCDIR(2) D ^DIR K DIR
|
|---|
| 148 | I $D(DTOUT)!$D(DUOUT) K RCSPLIT(RCSPLIT) G EDCL
|
|---|
| 149 | S $P(RCSPLIT(RCSPLIT),U,2)=Y,RCDIR(2)=$J($P(RCDIR,U,2)-$$TOT(2,.RCSPLIT),"",2)
|
|---|
| 150 | ; Enter adj
|
|---|
| 151 | I $O(^RCY(344.49,RCSCR,1,+$P(RCLINE,U,2),1,0)) D G:'RCOK EDCL
|
|---|
| 152 | . S RCOK=1
|
|---|
| 153 | . W !!,$J("",5)_"THIS LINE CONTAINS AN ADJUSTMENT AMOUNT OF $"_$J(+$P(RCDIR,U,3),"",2),!,$J("",5)_"THIS AMT IS USUALLY THE AMT THE PAYER PREVIOUSLY PAID",!,$J("",5),"ON A CLAIM WHICH THEY HAVE NOW AMENDED. IF THERE WAS"
|
|---|
| 154 | . W !,$J("",5)_"AN AMT PREVIOUSLY PAID FOR THIS CLAIM, ENTER THAT AMOUNT",!,$J("",5),"AS A NEGATIVE AMOUNT HERE.",!
|
|---|
| 155 | . S DIR("?",1)="**************"
|
|---|
| 156 | . S DIR("?",2)="ENTER THE AMT FROM THE ADJUSTMENT TOTAL FOR THIS LINE ("_$J(+$P(RCDIR,U,3),"",2)_")",DIR("?",3)=" THAT APPLIES TO THIS CLAIM. THE ADJUSTMENT AMOUNT ALREADY USED FOR THIS"
|
|---|
| 157 | . S DIR("?",4)=" LINE SPLIT IS "_$J(+$$TOT(3,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_" LEAVING A BALANCE OF "_$J($P(RCDIR,U,3)-$$TOT(3,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_" TO DISTRIBUTE"
|
|---|
| 158 | . S DIR("?",5)=" ENTER IT AS THE NEGATIVE OF THE AMT THE PAYER PREVIOUSLY PAID ON THIS CLAIM"
|
|---|
| 159 | . S DIR("?",6)="THE TOTAL ADJUSTMENTS ENTERED DURING THIS SPLIT MUST EQUAL THE ORIGINAL LINE",DIR("?")=" ADJUSTMENT AMOUNT OF $"_$J(+$P(RCDIR,U,3),"",2)
|
|---|
| 160 | . S DIR(0)="NAO^"_$J($P(RCDIR,U,3)-$$TOT(3,.RCSPLIT,$S(RCDEF="":"",1:RCSPLIT)),"",2)_":0:2",DIR("A")="ADJUSTMENT AMOUNT: " S:$P($G(RCDEF),U,3)'="" DIR("B")=$J(+$P(RCDEF,U,3),"",2) S:$G(RCDIR(3))'=""&($G(DIR("B"))="") DIR("B")=RCDIR(3)
|
|---|
| 161 | . D ^DIR K DIR
|
|---|
| 162 | . I $D(DTOUT)!$D(DUOUT) S RCOK=0 K RCSPLIT(RCSPLIT) Q
|
|---|
| 163 | . S $P(RCSPLIT(RCSPLIT),U,3)=Y,RCDIR(3)=$J($P(RCDIR,U,3)-$$TOT(3,.RCSPLIT),"",2)
|
|---|
| 164 | I +RCDIR(2)=0,+RCDIR(3)=0 S RCDONE=1
|
|---|
| 165 | S DIR(0)="344.491,.1AO",DIR("A")="RECEIPT LINE COMMENT: "
|
|---|
| 166 | I $P($G(RCSPLIT(RCSPLIT)),U,6)'="" D
|
|---|
| 167 | . I $P(RCSPLIT(RCSPLIT),U,6)'="@" S DIR("B")=$P(RCSPLIT(RCSPLIT),U,6)
|
|---|
| 168 | E D
|
|---|
| 169 | . I $P($G(^RCY(344.49,RCSCR,1,+RCL,0)),U,10)'="" S DIR("B")=$P(^(0),U,10)
|
|---|
| 170 | D ^DIR
|
|---|
| 171 | I Y="",$G(DIR("B"))'="" W " Comment will be deleted"
|
|---|
| 172 | K DIR
|
|---|
| 173 | I $D(DTOUT)!$D(DUOUT) K RCSPLIT(RCSPLIT) G EDCL
|
|---|
| 174 | S $P(RCSPLIT(RCSPLIT),U,6)=$S(Y="":"@",1:Y)
|
|---|
| 175 | Q
|
|---|
| 176 | ;
|
|---|
| 177 | ABORT ; User aborted split - kill split array
|
|---|
| 178 | N Z
|
|---|
| 179 | S Z=RCSPLIT K RCSPLIT S RCSPLIT=Z,RCDONE=1
|
|---|
| 180 | Q
|
|---|
| 181 | ;
|
|---|
