| 1 | RCDPEWL4 ;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 | ; RCSCR variable must be defined for this routine
|
---|
| 5 | Q
|
---|
| 6 | ;
|
---|
| 7 | DISTADJ(RCFR,RCTO,RCAMT,RCCOM) ; Action that distributes an adjustment amount
|
---|
| 8 | ; against another line item's payment
|
---|
| 9 | ; Assumes RCSCR = ien of the entry in file 344.49
|
---|
| 10 | ; RCFR = ien of entry in 344.491 that has a negative net
|
---|
| 11 | ; RCTO = ien of entry in 344.491 that will be decremented
|
---|
| 12 | ; RCAMT = the amount being adjusted (positive #)
|
---|
| 13 | ; RCCOM = the comment to place on the decrease adjustment
|
---|
| 14 | ;
|
---|
| 15 | N RCFRX,RCREF,RCFR0,RCFR1,RCFR10,RCTO0,RCTO1,RCTO10,RCY,DIK,DA,DR,DIC,X,Y,DLAYGO,DD,DO,DIE,DIR
|
---|
| 16 | I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL Q
|
---|
| 17 | S RCFR0=$G(^RCY(344.49,RCSCR,1,RCFR,0)),RCTO0=$G(^RCY(344.49,RCSCR,1,RCTO,0)),RCFRX=+$O(^RCY(344.49,RCSCR,1,"B",RCFR0\1,0)),RCFRX=$G(^RCY(344.49,RCSCR,1,RCFRX,0))
|
---|
| 18 | S RCREF=$P($P(RCFRX,U,2),"**ADJ",2),RCREF=$S(RCREF="":"",RCREF=0:$P(RCFRX,U,9),1:$P($G(^RCY(344.4,RCSCR,2,+RCREF,0)),U))
|
---|
| 19 | S RCFR1=+$O(^RCY(344.49,RCSCR,1,"B",RCFR0\1,0)),RCTO1=+$O(^RCY(344.49,RCSCR,1,"B",RCTO0\1,0))
|
---|
| 20 | S RCFR10=$G(^RCY(344.49,RCSCR,1,RCFR1,0)),RCTO10=$G(^RCY(344.49,RCSCR,1,RCTO1,0))
|
---|
| 21 | S RCFR0=$G(^RCY(344.49,RCSCR,1,RCFR,0)),RCTO0=$G(^RCY(344.49,RCSCR,1,RCTO,0))
|
---|
| 22 | S DA(2)=RCSCR,DA(1)=RCFR
|
---|
| 23 | S DIC("DR")=".02////1;.03////"_RCAMT_";.04////"_$S($P(RCTO0,U,2)'="":$P(RCTO0,U,2),RCREF'="":RCREF,1:"UNKNOWN")
|
---|
| 24 | S DIC("DR")=DIC("DR")_";.05////0;.06////0;.09////RETRACTED FUNDS DEDUCTED FROM OTHER PAYMENT ON THIS ERA",DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
|
---|
| 25 | S DLAYGO=344.4911,DIC(0)="L",X=+$O(^RCY(344.49,RCSCR,1,RCFR,1,"B",""),-1)+1
|
---|
| 26 | D FILE^DICN K DIC,DD,DO,DLAYGO
|
---|
| 27 | S RCY=+Y
|
---|
| 28 | I RCY'>0 D Q
|
---|
| 29 | . S DIR(0)="EA",DIR("A",1)="PROBLEM ADDING ADJUSTMENT - NO DISTRIBUTION PERFORMED",DIR("A")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
|
---|
| 30 | ;
|
---|
| 31 | S DA(2)=RCSCR,DA(1)=RCTO
|
---|
| 32 | S DIC("DR")=".02////0;.03////"_$J(-RCAMT,"",2)
|
---|
| 33 | S DIC("DR")=DIC("DR")_";.04////"_$S($P(RCFR0,U,2)'="":$P(RCFR0,U,2),RCREF'="":RCREF,1:"UNKNOWN")_";.05////"_$S($P($G(^RCY(344.49,RCSCR,1,RCTO1,0)),U,2)'["**ADJ":"1;.08////0",1:0)_";.06////0"_$S(RCCOM'="":";.09////"_RCCOM,1:"")
|
---|
| 34 | S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
|
---|
| 35 | S DLAYGO=344.4911,DIC(0)="L",X=+$O(^RCY(344.49,RCSCR,1,RCTO,1,"B",""),-1)+1
|
---|
| 36 | D FILE^DICN K DIC,DD,DO,DLAYGO
|
---|
| 37 | S RCY=+Y
|
---|
| 38 | ;
|
---|
| 39 | I RCY'>0 D Q
|
---|
| 40 | . N DA
|
---|
| 41 | . S DA(2)=RCSCR,DA(1)=RCFR,DA=RCY,DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1," D ^DIK
|
---|
| 42 | . S DIR(0)="EA",DIR("A",1)="PROBLEM ADDING ADJUSTMENT - NO DISTRIBUTION PERFORMED",DIR("A")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
|
---|
| 43 | ;
|
---|
| 44 | S DA(1)=RCSCR,DA=RCFR,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCFR0,U,6)+RCAMT,"",2)_";.08////"_$J($P(RCFR0,U,8)+RCAMT,"",2) D ^DIE
|
---|
| 45 | S DA=RCFR1,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCFR10,U,6)+RCAMT,"",2) D ^DIE
|
---|
| 46 | S DA(1)=RCSCR,DA=RCTO,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCTO0,U,6)-RCAMT,"",2)_";.03////"_$J($P(RCTO0,U,3)-RCAMT,"",2)_";.08////"_$J($P(RCTO0,U,8)-RCAMT,"",2) D ^DIE
|
---|
| 47 | S DA(1)=RCSCR,DA=RCTO1,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCTO10,U,6)-RCAMT,"",2)_";.03////"_$J($P(RCTO10,U,3)-RCAMT,"",2)_";.08////"_$J($P(RCTO10,U,8)-RCAMT,"",2) D ^DIE
|
---|
| 48 | D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | NEWREC ; Create a new receipt from scratch pad entry
|
---|
| 52 | N Z,Z0,RCOK,RCRECTDA,RCSTOP,DIR,X,Y,RECTDA,CT,DIE,DA,DR,RCER,RCPAYTY,RCHAC,RCDEP,DIC
|
---|
| 53 | D FULL^VALM1
|
---|
| 54 | I $G(RCSCR("NOEDIT"))=2 D NOTAV^RCDPEWL2 G NEWRECQ
|
---|
| 55 | S (RCSTOP,RCOK)=0,VALMBCK="R"
|
---|
| 56 | S RECTDA=$P($G(^RCY(344.49,RCSCR,0)),U,2)
|
---|
| 57 | I 'RECTDA S RECTDA=$P($G(^RCY(344.4,RCSCR,0)),U,8)
|
---|
| 58 | I RECTDA D G NEWRECQ
|
---|
| 59 | . S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - "_$P($G(^RCY(344,+$P($G(^RCY(344.49,RCSCR,0)),U,2),0)),U)_" - NO RECEIPT CREATED",DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
|
---|
| 60 | S DIR("A",1)="THIS ACTION WILL CREATE THE RECEIPT FOR THIS ERA. ONCE THE RECEIPT IS",DIR("A",2)=" CREATED HERE, NO MORE AUTOMATIC ADJUSTMENTS MAY BE MADE FOR THIS ERA.",DIR("A",3)=" "
|
---|
| 61 | S DIR("A")="ARE YOU SURE YOU ARE READY TO CREATE THIS RECEIPT?: ",DIR("B")="NO",DIR(0)="YA"
|
---|
| 62 | W ! D ^DIR K DIR W !
|
---|
| 63 | I Y'=1 S DIR(0)="EA",DIR("A")="NO RECEIPT CREATED - PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR G NEWRECQ
|
---|
| 64 | I $$HASADJ^RCDPEWL8(RCSCR,.RCOK) D G NEWRECQ
|
---|
| 65 | . S DIR(0)="EA",DIR("A",1)="AT LEAST ONE LINE ITEM WAS FOUND WITH A NEGATIVE PAYMENT AMOUNT",DIR("A")="NO RECEIPT CAN BE CREATED - PRESS RETURN TO CONTINUE " D ^DIR K DIR S RCSTOP=1
|
---|
| 66 | I 'RCOK S DIR(0)="EA",DIR("A")="NO RECEIPT CAN BE CREATED - NO POSTABLE LINE ITEMS WERE FOUND" W ! D ^DIR K DIR G NEWRECQ
|
---|
| 67 | ;
|
---|
| 68 | S RCHAC=$$HACERA^RCDPEU(RCSCR)
|
---|
| 69 | S RCPAYTY=$S(RCHAC:8,$P($G(^RCY(344.4,+RCSCR,0)),U,13)="":14,1:4)
|
---|
| 70 | S RCDEP=""
|
---|
| 71 | I RCPAYTY=4 D
|
---|
| 72 | . N RCOK1
|
---|
| 73 | . F D Q:RCOK1
|
---|
| 74 | .. S RCOK1=1
|
---|
| 75 | .. S DIC="^RCY(344.1,",DIC("S")="I $P(^(0),U,12)=1",DIC(0)="AEMQ" D ^DIC
|
---|
| 76 | .. Q:Y'>0
|
---|
| 77 | .. S RCDEP=+Y
|
---|
| 78 | .. I RCDEP,$$TOOOLD^RCDPEWLA(RCDEP) S RCOK1=0,RCDEP=""
|
---|
| 79 | S RECTDA=$$BLDRCPT^RCDPUREC(DT,+RCDEP_$S(RCPAYTY=4:"ERACHK",1:""),+$O(^RC(341.1,"AC",+RCPAYTY,0))) ; Note:ERA with paper check is type 4, but receipt needs to start with an 'E'
|
---|
| 80 | I 'RECTDA W ! S DIR(0)="EA",DIR("A",1)="A PROBLEM WAS ENCOUNTERED ADDING THE RECEIPT - NO RECEIPT ADDED",DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR G NEWRECQ
|
---|
| 81 | ;
|
---|
| 82 | D RCPTDET^RCDPEM(RCSCR,RECTDA,.RCER)
|
---|
| 83 | ;
|
---|
| 84 | S DIE="^RCY(344.49,",DA=RCSCR,DR=".02////"_RECTDA D ^DIE
|
---|
| 85 | S DIE="^RCY(344.4,",DA=RCSCR,DR=".08////"_RECTDA D ^DIE
|
---|
| 86 | S Z=+$O(^RCY(344.31,"AERA",RCSCR,0))
|
---|
| 87 | S DIE="^RCY(344,",DA=RECTDA,DR=".18////"_RCSCR_$S(Z:";.17////"_Z,1:"")_$S(RCPAYTY=4:";.06////"_RCDEP,1:"")_$S($P($G(^RCY(344.31,Z,0)),U,15)'="":";.16////"_$P(^RCY(344.31,Z,0),U,15),1:"") D ^DIE
|
---|
| 88 | ;
|
---|
| 89 | I $O(RCER(0)) D
|
---|
| 90 | . S CT=1,DIR(0)="EA",DIR("A",1)="THE FOLLOWING PROBLEMS OCCURRED WHILE ADDING THE RECEIPT: "
|
---|
| 91 | . S Z=0 F S Z=$O(RCER(Z)) Q:'Z S CT=CT+1,DIR("A",CT)=RCER(Z)
|
---|
| 92 | . S DIR("A")="PRESS RETURN TO CONTINUE "
|
---|
| 93 | . W ! D ^DIR K DIR
|
---|
| 94 | ;
|
---|
| 95 | S DIR(0)="YA",DIR("A")="DO YOU WANT TO GO TO RECEIPT PROCESSING NOW? ",DIR("A",1)=" ",DIR("A",2)="RECEIPT "_$P($G(^RCY(344,+RECTDA,0)),U)_" HAS BEEN CREATED FOR THIS ERA",DIR("B")="YES" W ! D ^DIR K DIR
|
---|
| 96 | I Y=1 S RCRECTDA=RECTDA D EN^VALM("RCDP RECEIPT PROFILE")
|
---|
| 97 | S RCSCR=0
|
---|
| 98 | S VALMBCK="Q"
|
---|
| 99 | ;
|
---|
| 100 | NEWRECQ Q
|
---|
| 101 | ;
|
---|
| 102 | VRECPT ; Preview receipt lines
|
---|
| 103 | N RCZ,RCOK,Z,Z0,DIR,X,Y
|
---|
| 104 | D FULL^VALM1
|
---|
| 105 | S VALMBCK="R"
|
---|
| 106 | I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL Q
|
---|
| 107 | I $O(^RCY(344.49,RCSCR,3,0)) D Q:'RCOK
|
---|
| 108 | . S RCOK=1
|
---|
| 109 | . S Z=0 F S Z=$O(^RCY(344.49,RCSCR,3,Z)) Q:'Z I '$P($G(^(Z,0)),U,3) S RCOK=0 Q
|
---|
| 110 | . I 'RCOK S DIR(0)="EA",DIR("A",1)="A RECEIPT CANNOT BE PREVIEWED UNTIL ALL BATCHES FOR THIS ERA ARE MARKED AS",DIR("A",2)="'READY TO POST'",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
|
---|
| 111 | ;
|
---|
| 112 | S Z=0 F S Z=$O(^RCY(344.49,RCSCR,1,Z)) Q:'Z I $P(Z,".",2) S Z0=$G(^(Z,0)) I $P(Z0,U,6)<0 S RCZ($P(Z0,U))=$P(Z0,U,2)_U_$P(Z0,U,6)
|
---|
| 113 | I $O(RCZ(""))'="" D
|
---|
| 114 | . W !,"THE FOLLOWING LINES HAVE A NET PAYMENT LESS THAN 0. THESE LINES MUST HAVE",!,"THIS NEGATIVE AMOUNT DISTRIBUTED TO OTHER LINE(S) IN THE ERA BEFORE A",!,"RECEIPT CAN BE CREATED."
|
---|
| 115 | . S Z="" F S Z=$O(RCZ(Z)) Q:Z="" W !,$J("",5)_$J(Z,10)_" "_$E($P(RCZ(Z),U)_$J("",15),1,15)_" "_$J(+$P(RCZ(Z),U,2),"",2)
|
---|
| 116 | . W !
|
---|
| 117 | . S DIR(0)="E" D ^DIR K DIR
|
---|
| 118 | ;
|
---|
| 119 | D EN^VALM("RCDPE EOB RECEIPT PREVIEW")
|
---|
| 120 | S VALMBCK=$S('$G(RCSCR):"Q",1:"R")
|
---|
| 121 | Q
|
---|
| 122 | ;
|
---|