| 1 | RCDPEWL5 ;ALB/TMK - ELECTRONIC EOB WORKLIST ACTIONS ;24-FEB-03
|
---|
| 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 | INIT ; Build receipt preview
|
---|
| 7 | N X,Z,Z1,Z10,Z0,Z2,RCZ
|
---|
| 8 | K ^TMP("RCDPE_EOB_PREVIEW",$J)
|
---|
| 9 | S VALMCNT=0,VALMBG=1
|
---|
| 10 | S Z=0 F S Z=$O(^RCY(344.49,RCSCR,1,Z)) Q:'Z S Z0=$G(^(Z,0)) D
|
---|
| 11 | . I $P(Z0,U)\1=+Z0 S Z2=$P(Z0,U,2)
|
---|
| 12 | . I $P($P(Z0,U),".",2) D
|
---|
| 13 | .. S:$P(Z0,U,2)="" $P(Z0,U,2)=Z2
|
---|
| 14 | .. S RCZ=$S(+$P(Z0,U,6)=0:0,+$P(Z0,U,6)<0:-1,$P(Z0,U,7):1,1:2)
|
---|
| 15 | .. S RCZ(RCZ,Z)=Z0
|
---|
| 16 | .. S Z1=0 F S Z1=$O(^RCY(344.49,RCSCR,1,Z,1,Z1)) Q:'Z1 S Z10=$G(^(Z1,0)) D
|
---|
| 17 | ... I $P(Z10,U,5)=1 S RCZ(RCZ,Z,"ADJ",Z1)="Dec adj $"_$J(0-$P(Z10,U,3),"",2)_" pending - ",RCZ(RCZ,Z,"ADJ",Z1,1)=$J("",4)_$P(Z10,U,9)
|
---|
| 18 | F RCZ=1,2,0,-1 D
|
---|
| 19 | . Q:'$D(RCZ(RCZ))
|
---|
| 20 | . I RCZ=1 D SET("PAYMENTS (LINES FOR RECEIPT):")
|
---|
| 21 | . I RCZ=0,VALMCNT>0 D SET(" ") D SET("ZERO DOLLAR PAYMENTS:")
|
---|
| 22 | . I RCZ=-1,VALMCNT>0 D SET(" ") D SET("LINES WITH NEGATIVE BALANCES STILL NEEDING TO BE DISTRIBUTED:")
|
---|
| 23 | . S Z=0 F S Z=$O(RCZ(RCZ,Z)) Q:'Z S Z0=RCZ(RCZ,Z) D
|
---|
| 24 | .. S X=""
|
---|
| 25 | .. S X=$$SETFLD^VALM1($P(Z0,U),X,"LINE #")
|
---|
| 26 | .. S X=$$SETFLD^VALM1($S($P(Z0,U,7):$$BN1^PRCAFN($P(Z0,U,7)),1:$S(RCZ=0:"",1:"[SUSPENSE]")_$S($P(Z0,U,2)["**ADJ"&'$P($P(Z0,U,2),"ADJ",2):"TOTALS MISMATCH ADJ",1:$P(Z0,U,2))),X,"ACCOUNT")
|
---|
| 27 | .. S X=$$SETFLD^VALM1($J(+$P(Z0,U,6),"",2),X,"AMOUNT")
|
---|
| 28 | .. D SET(X)
|
---|
| 29 | .. S Z1=0 F S Z1=$O(RCZ(RCZ,Z,"ADJ",Z1)) Q:'Z1 D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1))) S Z2=0 F S Z2=$O(RCZ(RCZ,Z,"ADJ",Z1,Z2)) Q:'Z2 D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1,Z2)))
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | SET(X) ;
|
---|
| 33 | S VALMCNT=VALMCNT+1
|
---|
| 34 | S ^TMP("RCDPE_EOB_PREVIEW",$J,VALMCNT,0)=X
|
---|
| 35 | Q
|
---|
| 36 | ;
|
---|
| 37 | HDR ;
|
---|
| 38 | D HDR^RCDPEWL
|
---|
| 39 | Q
|
---|
| 40 | ;
|
---|
| 41 | FNL ;
|
---|
| 42 | K ^TMP("RCDPE_EOB_PREVIEW",$J)
|
---|
| 43 | Q
|
---|
| 44 | ;
|
---|
| 45 | RCOMM ; Allow entry of receipt comment to be moved to line on receipt
|
---|
| 46 | N RCEDIT
|
---|
| 47 | D FULL^VALM1
|
---|
| 48 | ;
|
---|
| 49 | I $G(RCSCR("NOEDIT"))=2 D NOTAV^RCDPEWL2 G RCOMMQ
|
---|
| 50 | ;
|
---|
| 51 | D SEL^RCDPEWL2(.RCEDIT)
|
---|
| 52 | G:'RCEDIT RCOMMQ
|
---|
| 53 | ;
|
---|
| 54 | RCOMMQ S VALMBCK="R"
|
---|
| 55 | Q
|
---|
| 56 | ;
|
---|
| 57 | SUSPERA ; Option entrypoint to select an ERA to be posted to suspense
|
---|
| 58 | N DIC,X,Y,RCERA,RCSCR,DTOUT,DUOUT,DIR
|
---|
| 59 | S DIC(0)="AEMQ",DIC="^RCY(344.4,",DIC("S")="I '$P(^(0),U,8),'$G(^(20))"
|
---|
| 60 | D ^DIC K DIC
|
---|
| 61 | I Y'>0 Q
|
---|
| 62 | S RCERA=+Y
|
---|
| 63 | S DIR(0)="YA",DIR("B")="YES",DIR("A")="DO YOU WANT TO PRINT/VIEW THE ERA FIRST?: " W ! D ^DIR K DIR
|
---|
| 64 | Q:$D(DUOUT)!$D(DTOUT)
|
---|
| 65 | I Y=1 S RCSCR=RCERA D PRERA^RCDPEWL0
|
---|
| 66 | D SUSP(RCERA,0)
|
---|
| 67 | Q
|
---|
| 68 | ;
|
---|
| 69 | SUSP(RCERA,LM) ; Function to send receipt to suspense for ERA
|
---|
| 70 | ; RCERA = ien of entry in file 344.4
|
---|
| 71 | ; LM = flag to indicate it was called from list manager protocol
|
---|
| 72 | ; = 1 if true, 0 if false
|
---|
| 73 | N DIR,X,Y,RC0,RCCOM,RCER,RCPAYTY,RECTDA,RCTRANDA,DIE,DA,DR,Z,DTOUT,DUOUT
|
---|
| 74 | S RC0=$G(^RCY(344.4,RCERA,0))
|
---|
| 75 | I $G(LM) D FULL^VALM1
|
---|
| 76 | I $$HACERA^RCDPEU(RCERA) D G SUSPQ
|
---|
| 77 | . S DIR(0)="EA",DIR("A")="THIS IS NOT A VALID ACTION FOR AN ERA FROM HAC" W ! D ^DIR K DIR
|
---|
| 78 | S DIR(0)="YA",DIR("B")="NO"
|
---|
| 79 | I $P(RC0,U,5) D
|
---|
| 80 | . S DIR("A",1)="THIS WILL CREATE A RECEIPT THAT WILL MOVE THE FUNDS ($"_$J($P(RC0,U,5),"",2)_")",DIR("A",2)="FOR THIS ENTIRE ERA TO YOUR SUSPENSE ACCOUNT",Z=3
|
---|
| 81 | E D
|
---|
| 82 | . S DIR("A",1)="THIS WILL CREATE AND POST A RECEIPT FOR $0.00 FOR THIS ERA",Z=2
|
---|
| 83 | S DIR("A",Z+1)=" ",DIR("A",Z+2)="***ALL POSTINGS TO A/R FOR ANY CLAIMS IN THIS ERA MUST BE DONE MANUALLY***",DIR("A",Z+3)=" "
|
---|
| 84 | S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
|
---|
| 85 | W ! D ^DIR K DIR
|
---|
| 86 | I Y'=1 D NOACT G SUSPQ
|
---|
| 87 | S DIR("A",1)="ENTER A 1-60 CHARACTER COMMENT TO BE PLACED ON THE RECEIPT: ",DIR("A")=">: ",DIR(0)="FA^1:60",DIR("B")="REF ERA #:"_RCERA_" FROM "_$E($P(RC0,U,6),1,20) W ! D ^DIR K DIR
|
---|
| 88 | I $D(DTOUT)!$D(DUOUT) D NOACT G SUSPQ
|
---|
| 89 | S RCCOM=Y
|
---|
| 90 | S RCPAYTY=$S($P(RC0,U,13)="":14,1:4)
|
---|
| 91 | S RECTDA=$$BLDRCPT^RCDPUREC(DT,"",+$O(^RC(341.1,"AC",+RCPAYTY,0)))
|
---|
| 92 | I 'RECTDA D G SUSPQ
|
---|
| 93 | . S DIR(0)="EA",DIR("A",1)="A PROBLEM WAS ENCOUNTERED ADDING THE RECEIPT",DIR("A")="NO ACTION TAKEN - RETURN TO CONTINUE: " W ! D ^DIR K DIR
|
---|
| 94 | ;
|
---|
| 95 | S RCTRANDA=$$ADDTRAN^RCDPURET(RECTDA)
|
---|
| 96 | S DR=".04////"_(+$P(RC0,U,5))_$S($P(RC0,U,13)'="":";.13////"_$P(RC0,U,13),1:"")_$S(RCCOM'="":";1.02////"_RCCOM,1:"")
|
---|
| 97 | S DA(1)=RECTDA,DA=RCTRANDA,DIE="^RCY(344,"_DA(1)_",1,"
|
---|
| 98 | D ^DIE
|
---|
| 99 | ;
|
---|
| 100 | I $D(^RCY(344.49,RCERA,0)) S DIE="^RCY(344.49,",DA=RCERA,DR=".02////"_RECTDA D ^DIE
|
---|
| 101 | S DIE="^RCY(344.4,",DA=RCERA,DR=".08////"_RECTDA_";20.01///^S X=""NOW"";20.02////"_DUZ D ^DIE
|
---|
| 102 | S Z=+$O(^RCY(344.31,"AERA",RCERA,0))
|
---|
| 103 | S DIE="^RCY(344,",DA=RECTDA,DR=".18////"_RCERA_$S(Z:";.17////"_Z,1:"") D ^DIE
|
---|
| 104 | ;
|
---|
| 105 | D PROCESS^RCDPURE1(RECTDA,1)
|
---|
| 106 | I '$P(RC0,U,5) S DIE="^RCY(344.4,",DA=RCERA,DR=".09////3;.14////1" D ^DIE
|
---|
| 107 | S DIR(0)="E" W ! D ^DIR K DIR
|
---|
| 108 | ;
|
---|
| 109 | SUSPQ I $G(LM) S VALMBCK="R"
|
---|
| 110 | Q
|
---|
| 111 | ;
|
---|
| 112 | REVIEW ; Enter review information on worklist and turn review display on/off
|
---|
| 113 | ; Assumes RCSCR = ien of the entry in file 344.49
|
---|
| 114 | ;
|
---|
| 115 | N Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV
|
---|
| 116 | D FULL^VALM1
|
---|
| 117 | ;
|
---|
| 118 | S REVCHG=""
|
---|
| 119 | S DIR(0)="YA",RC=+$P($G(^TMP($J,"RC_SORTPARM")),U,2)
|
---|
| 120 | S DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$P("OFF^ON",U,RC+1),DIR("A")="DO YOU WANT TO TURN IT "_$P("ON^OFF",U,RC+1)_"?: ",DIR("B")=$S('RC:"YES",1:"NO") W ! D ^DIR K DIR
|
---|
| 121 | I Y=1 S $P(^TMP($J,"RC_SORTPARM"),U,2)=((RC+1)#2),REVCHG=1
|
---|
| 122 | S RCUSPREF=+$O(^RCY(344.49,RCSCR,2,"B",DUZ,0))
|
---|
| 123 | ;
|
---|
| 124 | I 'RCUSPREF D ; Add the user pref record
|
---|
| 125 | . S RCUSPREF=+$$ADDUSER(RCSCR,DUZ)
|
---|
| 126 | S RCLSTREV=+$P($G(^RCY(344.49,RCSCR,2,RCUSPREF,0)),U,2)
|
---|
| 127 | S DA(1)=RCSCR,DA=RCUSPREF
|
---|
| 128 | I DA,RCLSTREV'=$P($G(^TMP($J,"RC_SORTPARM")),U,2) D ; Update user pref
|
---|
| 129 | . S DIE="^RCY(344.49,"_DA(1)_",2,",DR=".02////"_+$P($G(^TMP($J,"RC_SORTPARM")),U,2) D ^DIE
|
---|
| 130 | W !
|
---|
| 131 | I '$P(^TMP($J,"RC_SORTPARM"),U,2) G REVIEWQ
|
---|
| 132 | ;
|
---|
| 133 | D SEL^RCDPEWL(.RCDA)
|
---|
| 134 | S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ)) G:'RCZ REVIEWQ
|
---|
| 135 | ;
|
---|
| 136 | S RCREV=0
|
---|
| 137 | I '$O(^RCY(344.49,RCSCR,1,"AC",DUZ,RCZ,0)) D
|
---|
| 138 | . S RCREV=$$NEWREV(RCSCR,RCZ,DUZ)
|
---|
| 139 | E D
|
---|
| 140 | . N DIR,X,Y
|
---|
| 141 | . S DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: ",DIR("B")="ADD",DIR(0)="SA^A:ADD;E:EDIT" W ! D ^DIR K DIR
|
---|
| 142 | . I $D(DUOUT)!$D(DTOUT) Q
|
---|
| 143 | . ;
|
---|
| 144 | . I Y="E" D Q ; Edit a review entry entered by same user
|
---|
| 145 | .. N DA,DR,DIE,X,Y
|
---|
| 146 | .. S DA(1)=RCSCR,DA=RCZ,DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ" D ^DIC
|
---|
| 147 | .. S RCREV=$S(Y>0:+Y,1:0)
|
---|
| 148 | .. I RCREV S DA(2)=RCSCR,DA(1)=RCZ,DA=RCREV,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DR=".03;.04////^S X=$$NOW^XLFDT()" D ^DIE
|
---|
| 149 | . ;
|
---|
| 150 | . S RCREV=$$NEWREV(RCSCR,RCZ,DUZ)
|
---|
| 151 | ;
|
---|
| 152 | I RCREV S DIE("NO^")="",DA(1)=RCSCR,DA=RCZ,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20" D ^DIE K DIE
|
---|
| 153 | D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
|
---|
| 154 | S REVCHG=""
|
---|
| 155 | ;
|
---|
| 156 | REVIEWQ I $G(REVCHG) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
|
---|
| 157 | S VALMBCK="R"
|
---|
| 158 | Q
|
---|
| 159 | ;
|
---|
| 160 | NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment
|
---|
| 161 | ; RCSCR = ien of entry in file 344.49
|
---|
| 162 | ; RCZ = ien of the EEOB (seq #)
|
---|
| 163 | ; RCDUZ =DUZ of user entering the comment
|
---|
| 164 | ; Function returns 0 if no new comment, ien of comment if added
|
---|
| 165 | N DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW
|
---|
| 166 | S RCNOW=$$NOW^XLFDT() W !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2")
|
---|
| 167 | S DA(2)=RCSCR,DA(1)=RCZ,X=RCNOW,DIC("DR")=".02////"_RCDUZ_";.03",DLAYGO=344.492,DIC(0)="L"
|
---|
| 168 | S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
|
---|
| 169 | K DO,DD
|
---|
| 170 | D FILE^DICN K DO,DD,DIC,DLAYGO
|
---|
| 171 | S RCREV=+Y
|
---|
| 172 | I RCREV'>0 S RCREV=0 G NEWREVQ
|
---|
| 173 | I '$O(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0)) S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DA=RCREV D ^DIK S RCREV=0 ; No comment - delete entry
|
---|
| 174 | ;
|
---|
| 175 | NEWREVQ Q RCREV
|
---|
| 176 | ;
|
---|
| 177 | NOACT ;
|
---|
| 178 | N DIR,X,Y
|
---|
| 179 | S DIR(0)="EA",DIR("A")="NO ACTION TAKEN - RETURN TO CONTINUE: " W ! D ^DIR K DIR
|
---|
| 180 | Q
|
---|
| 181 | ;
|
---|
| 182 | ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences
|
---|
| 183 | ; RCSCR = ien of entry in file 344.49
|
---|
| 184 | ; RCDUZ = the ien of the user
|
---|
| 185 | N DIC,DA,X,Y,DLAYGO,DO,DD
|
---|
| 186 | S Y=+$O(^RCY(344.49,RCSCR,2,"B",RCDUZ,0))
|
---|
| 187 | I Y G ADDUQ
|
---|
| 188 | S DLAYGO=344.492,DA(1)=RCSCR,DIC(0)="L",X=RCDUZ,DIC="^RCY(344.49,"_DA(1)_",2,",DIC("DR")=".02////0;.03////N"
|
---|
| 189 | D FILE^DICN K DIC,DLAYGO
|
---|
| 190 | ADDUQ Q $S(Y>0:Y,1:0)
|
---|
| 191 | ;
|
---|