227 lines
9.5 KiB
Mathematica
227 lines
9.5 KiB
Mathematica
RCDPEWL7 ;ALB/TMK - EDI LOCKBOX WORKLIST ERA DISPLAY SCREEN ;16-JAN-04
|
|
;;4.5;Accounts Receivable;**208,222**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
BLD(RCSORT) ; Build list with sort criteria
|
|
; RCSORT = the sort levels to use to display the data in ^ pieces
|
|
; piece 1 = the codes for the first level sort (sort code;null or -)
|
|
; piece 2 = the codes for the second level sort
|
|
; sort code is the type of data to sort by;- indicates reverse order
|
|
N Z,Z1,RCT,RCZ
|
|
S (RCT,VALMCNT)=0
|
|
I '$D(^TMP($J,"RCERA_LIST")) D
|
|
. S Z=0 F S Z=$O(^TMP("RCDPE-ERA_WLDX",$J,Z)) Q:'Z S RCZ=$P($G(^(Z)),U,2) D
|
|
.. I $$FILTER^RCDPEWL0(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,$P(RCSORT,U)),$$SL(RCZ,$P(RCSORT,U,2)),RCZ)=""
|
|
. K ^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCDPE-ERA_WL",$J)
|
|
;
|
|
S Z=""
|
|
I RCSORT'["PN;-" D
|
|
. F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
|
|
;
|
|
I $P(RCSORT,U)["PN;-" D
|
|
. F S Z=$O(^TMP($J,"RCERA_LIST",Z),-1) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
|
|
;
|
|
I $P(RCSORT,U,2)["PN;-" D
|
|
. F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1),-1) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
|
|
;
|
|
I '$O(^TMP($J,"RCERA_LIST",0)) D SET("No ERAs left for your selection criteria")
|
|
K ^TMP($J,"RCERA_LIST")
|
|
S ^TMP("RCERA_PARAMS",$J,"SORT")=RCSORT
|
|
Q
|
|
;
|
|
EXTRACT(RCSRT1,RCSRT2,RCT) ; Extract the data
|
|
; RCSRT1 = data value at 1st sort level
|
|
; RCSRT2 = data value at 2nd sort level
|
|
; RCT = running entry counter - returned if passed by ref
|
|
N FIRST,RCZ,RC0,RCEFT,RCSTAT,RCPOST,X,Z,Z0
|
|
S RCZ=0 F S RCZ=$O(^TMP($J,"RCERA_LIST",RCSRT1,RCSRT2,RCZ)) Q:'RCZ D
|
|
. S RCT=RCT+1,RC0=$G(^RCY(344.4,RCZ,0))
|
|
. S RCEFT=+$O(^RCY(344.31,"AERA",RCZ,0))
|
|
. S RCSTAT=$S('RCEFT:U_$S($P(RC0,U,15)="CHK":"(CHECK PAYMENT EXPECTED)",$P(RC0,U,15)="NON":"(NO PAYMENT EXPECTED)",$P(RC0,U,9)=2:"(CHECK PAYMENT CHOSEN)",1:"N/A"),1:$$FMSSTAT^RCDPUREC(+$P($G(^RCY(344.31,RCEFT,0)),U,9)))
|
|
. S RCPOST=$S(RCEFT:"EFT RECEIPT STATUS: ",1:"")_$P(RCSTAT,U,2)
|
|
. S X=$E(RCT_$J("",4),1,4)_$S($D(^RCY(344.49,RCZ)):" ",1:"-")_$E($P(RC0,U)_$J("",5),1,5)_" "_$E($P(RC0,U,2)_$J("",30),1,30)_" "_$J($$FMTE^XLFDT($P(RC0,U,7),"2D"),8)_$J("",5)_$J(+$P(RC0,U,5),12,2)
|
|
. S $E(X,73,80)=$$FMTE^XLFDT($P(RC0,U,7),"2D")
|
|
. D SET(X,RCT,RCZ)
|
|
. S X=$J("",12)_$E($P(RC0,U,6)_$J("",30),1,30)_" APPROX # EEOBs: "_+$$CTEEOB^RCDPEWLB(RCZ)
|
|
. D SET(X,RCT,RCZ)
|
|
. S X=$J("",12)_$E($$EXTERNAL^DILFD(344.4,.09,"",$P(RC0,U,9))_$J("",30),1,30)_" "_RCPOST
|
|
. D SET(X,RCT)
|
|
. I $G(^TMP("RCERA_PARAMS",$J,"BATCHON")) D
|
|
.. S Z=0 F S Z=$O(^RCY(344.49,RCZ,3,Z)) Q:'Z S Z0=$G(^(Z,0)) I Z0'="" D
|
|
... S X=$J("",12)_$E("- BATCH #"_$P(Z0,U)_$J("",4),1,13)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_" "_$S('$P(Z0,U,3):"NOT ",1:"")_"READY TO POST"
|
|
... D SET(X,RCT)
|
|
. D SET(" ",RCT)
|
|
S VALMSG="'-' Before the ERA # indicates no scratchpad entry yet"
|
|
;
|
|
Q
|
|
;
|
|
SL(Y,SORT) ; Returns data for sort level from entry Y in file 344.4
|
|
; SORT = the sort data in ';' delimited pieces
|
|
; pc 1 = code for sort data
|
|
; pc 2 = the order requested (- or null)
|
|
;
|
|
N RC0,DAT,SORT1,SORT2
|
|
S SORT1=$P(SORT,";"),SORT2=$P(SORT,";",2)
|
|
S RC0=$G(^RCY(344.4,Y,0)),DAT=" "
|
|
; No sort
|
|
I SORT="" G SLQ
|
|
; Amt paid
|
|
I SORT1="AP" D G SLQ
|
|
. S DAT=SORT2_+$P(RC0,U,5)
|
|
; ERA date pd
|
|
I SORT1="DP" D G SLQ
|
|
. S DAT=SORT2_($P(RC0,U,4)\1)
|
|
; Payer name
|
|
I SORT1="PN" D G SLQ
|
|
. S DAT=$$UPPER($P(RC0,U,6))
|
|
; ERA date received
|
|
I SORT1="DR" D G SLQ
|
|
. S DAT=SORT2_($P(RC0,U,7)\1)
|
|
;
|
|
SLQ Q $S(DAT'="":DAT,1:" ")
|
|
;
|
|
INIT ; Entry point for List template to build the display of ERAs
|
|
;
|
|
; Parameters for selecting ERAs to be included in the list are
|
|
; contained in the global ^TMP("RCERA_PARAMS",$J,parameter name)
|
|
;
|
|
N RCZ,RC0,RCT,RCTT,RCQUIT,RCDTFR,RCDTTO,DTOUT,DUOUT,DIR,X,Y,Z,Z1,RCPOST,RCEFT,RCINDX
|
|
D CLEAN^VALM10
|
|
K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST")
|
|
;
|
|
S (RCT,RCTT,RCQUIT)=0
|
|
;
|
|
S RCDTFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTTO=$S($P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2):$P(^("RCDT"),U,2),1:DT)
|
|
;
|
|
S RCINDX=$S(RCDTFR:RCDTFR-.00000001,1:0)
|
|
F S RCINDX=$O(^RCY(344.4,"AFD",RCINDX)) Q:'RCINDX!(RCINDX\1>RCDTTO)!RCQUIT S RCZ=0 F S RCZ=$O(^RCY(344.4,"AFD",RCINDX,RCZ)) Q:'RCZ D Q:RCQUIT
|
|
. ;
|
|
. S RCTT=RCTT+1 I '(RCTT#5000) D Q:RCQUIT
|
|
.. S DIR("A",1)=RCTT_" ERA RECORDS HAVE ALREADY BEEN SEARCHED USING YOUR CRITERIA",DIR("A",2)="LAST DATE SEARCHED WAS "_$$FMTE^XLFDT(RCINDX,"2D"),DIR("A")="DO YOU WANT TO CONTINUE THIS SEARCH?: "
|
|
.. S DIR("B")="NO",DIR("?")="RESPOND NO HERE AND RESTART TO SELECT A DATE RANGE TO LIMIT THE SEARCH",DIR(0)="YA" W ! D ^DIR K DIR
|
|
.. I Y=1!$D(DTOUT) W !,$S($D(DTOUT):"TIME OUT - ",1:""),"SEARCH CONTINUED",! Q
|
|
.. I $D(DUOUT)!(Y=0) S RCQUIT=1 Q
|
|
. ;
|
|
. S RC0=$G(^RCY(344.4,RCZ,0))
|
|
. I $$FILTER^RCDPEWL0(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,"DR"),$$SL(RCZ,""),RCZ)=""
|
|
;
|
|
; Output the list
|
|
I 'RCQUIT D
|
|
. D:$D(^TMP($J,"RCERA_LIST")) BLD("DR^N")
|
|
. I '$O(^TMP("RCDPE-ERA_WL",$J,0)) D
|
|
.. S DIR(0)="EA",DIR("A",1)="THERE ARE NO ERAs MATCHING YOUR SELECTION CRITERIA",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR S RCQUIT=1
|
|
I RCQUIT K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST") S VALMQUIT=""
|
|
Q
|
|
;
|
|
HDR ; Header for ERA list
|
|
N X
|
|
S X=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))
|
|
S VALMHDR(1)=$E("SELECTED: MATCH STATUS: "_$S(X="N":"NOT MATCHED",X="M":"MATCHED",1:"BOTH")_$J("",38),1,38)
|
|
S X=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
|
|
S VALMHDR(1)=VALMHDR(1)_" POST STATUS: "_$S(X="U":"UNPOSTED",X="P":"POSTED",1:"BOTH")
|
|
S X=$G(^TMP("RCERA_PARAMS",$J,"RCDT"))
|
|
S VALMHDR(2)=$J("",11)_"DATE RANGE : "_$S($P(X,U):$$FMTE^XLFDT($P(X,U),2)_$S($P(X,U,2):"-"_$$FMTE^XLFDT($P(X,U,2),2),1:""),1:"NONE SELECTED")
|
|
S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))
|
|
S VALMHDR(3)=$J("",11)_$S($P(X,U)="A"!(X=""):"ALL PAYERS",1:"PAYERS: "_$P(X,U,2)_"-"_$P(X,U,3))
|
|
Q
|
|
;
|
|
FNL ; -- Clean up list
|
|
K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCERA_PARAMS",$J),^TMP($J,"RCERA_LIST")
|
|
Q
|
|
;
|
|
SET(X,RCSEQ,RCSEQ1) ; -- set arrays
|
|
; X = the data to set into the global
|
|
; RCSEQ = the selectable line #
|
|
; RCSEQ1 = the ien of the entry in file 344.4
|
|
S VALMCNT=VALMCNT+1,^TMP("RCDPE-ERA_WL",$J,VALMCNT,0)=X
|
|
I $G(RCSEQ) S ^TMP("RCDPE-ERA_WL",$J,"IDX",VALMCNT,RCSEQ)=$G(RCSEQ1)
|
|
I $G(RCSEQ1) S ^TMP("RCDPE-ERA_WLDX",$J,RCSEQ)=VALMCNT_U_RCSEQ1
|
|
Q
|
|
;
|
|
ENTERWL ; Enter the worklist with an ERA
|
|
D WL($$SEL())
|
|
D BLD($G(^TMP("RCERA_PARAMS",$J,"SORT")))
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
SEL() ; Select an ERA from the ERA list
|
|
N RCDA,VALMY
|
|
D FULL^VALM1
|
|
D EN^VALM2($G(XQORNOD(0)),"S")
|
|
S RCERA=0
|
|
S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCERA=+$P($G(^TMP("RCDPE-ERA_WLDX",$J,RCDA)),U,2)
|
|
;
|
|
Q RCERA
|
|
;
|
|
WL(RCERA) ; Enter worklist
|
|
; RCERA = ien of the ERA entry in file 344.4
|
|
N RC0,RCNOED,RCQUIT,RCSORT,DA,DIE,X,Y,DR,DIR,DTOUT,DUOUT
|
|
Q:RCERA'>0
|
|
S (RCQUIT,RCNOED)=0,RC0=$G(^RCY(344.4,RCERA,0)),RCSORT=""
|
|
I $P(RC0,U,8) D
|
|
. I '$D(^RCY(344.49,RCERA,0)) D Q
|
|
.. S RCQUIT=1
|
|
.. W ! S DIR(0)="EA",DIR("A",1)="A SCRATCH PAD WAS NOT CREATED FOR THIS ERA BEFORE POSTING",DIR("A",2)="USE THE VIEW/PRINT ERA OPTION TO SEE ITS DETAIL",DIR("A")="PRESS RETURN TO CONTINUE: " D ^DIR K DIR Q
|
|
. ;
|
|
. S RCNOED=+$P(RC0,U,8)
|
|
. S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATCH PAD",DIR("A")="PRESS RETURN TO CONTINUE "
|
|
. W ! D ^DIR K DIR W !
|
|
I 'RCQUIT D
|
|
. N RCQUIT
|
|
. D DISP^RCDPEWL(RCERA,RCNOED)
|
|
;
|
|
I 'RCQUIT,$G(^TMP("RCBATCH_SELECTED",$J)) D
|
|
. S DA(1)=RCERA,DA=+$G(^TMP("RCBATCH_SELECTED",$J)),DR=".05////0",DIE="^RCY(344.49,"_DA(1)_",3," D ^DIE
|
|
. L -^RCY(344.49,DA(1),3,DA,0)
|
|
. K ^TMP("RCBATCH_SELECTED",$J)
|
|
E D
|
|
. L -^RCY(344.4,RCERA,0)
|
|
Q
|
|
;
|
|
PRERA ; View/Print ERA from ERA list menu
|
|
N RCSCR
|
|
S RCSCR=$$SEL()
|
|
I RCSCR>0 D PRERA^RCDPEWL0
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
BAT(RCERA) ; Select batch, if needed
|
|
; Returns 1 if batch selected OK or no batch needed
|
|
; RCERA = ien of entry in file 344.49
|
|
N RCINUSE,RCQUIT,RCADJ,RC0,RCOK,DIR,DTOUT,DUOUT,X,Y,Z
|
|
K ^TMP("RCBATCH_SELECTED",$J)
|
|
S RCOK=1
|
|
I '$O(^RCY(344.49,RCERA,3,0)) G BATQ
|
|
S RC0=$G(^RCY(344.4,RCERA,0))
|
|
S (RCQUIT,RCADJ)=0
|
|
I $$HASADJ^RCDPEWL8(RCERA) D
|
|
. S RCADJ=1
|
|
. S DIR("A",1)="THIS ERA HAS NEGATIVE ADJUSTMENTS THAT NEED TO BE DISTRIBUTED TO OTHER",DIR("A",2)="PAYMENTS ON THE ERA. YOU CANNOT SELECT ANY INDIVIDUAL BATCHES UNTIL",DIR("A",3)="THE DISTRIBUTIONS ARE COMPLETE."
|
|
. S DIR("A")="PRESS RETURN TO CONTINUE: ",DIR(0)="EA" W ! D ^DIR K DIR
|
|
S RCINUSE=+$O(^RCY(344.49,"AINUSE",1,RCERA,0))
|
|
I RCINUSE D
|
|
. N OK,Z
|
|
. Q:RCADJ!$P(RC0,U,8)
|
|
. S OK=0 S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z I '$P($G(^RCY(344.49,RCERA,3,Z,0)),U,5) S OK=1 Q
|
|
. I 'OK D Q
|
|
.. S DIR("A",1)="ALL BATCHES WITHIN THIS ERA ARE CURRENTLY IN USE - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1,RCOK=0 Q
|
|
. W !!,"AT LEAST 1 BATCH WITHIN THIS ERA IS CURRENTLY IN USE",!,"AT THIS TIME, YOU CAN ONLY ACCESS INDIVIDUAL BATCHES",!
|
|
. D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
|
|
. I RCQUIT S RCOK=0
|
|
E D
|
|
. Q:$P(RC0,U,8)!RCADJ ; Always require the entire ERA be used
|
|
. S DIR(0)="SA^E:(E)NTIRE ERA;B:(B)ATCH",DIR("A")="DO YOU WANT THE (E)NTIRE ERA OR JUST A (B)ATCH?: " W ! D ^DIR K DIR
|
|
. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1,RCOK=0 Q
|
|
. I Y="E" D Q
|
|
.. S RCQUIT=1 F Z=1:1:2 L +^RCY(344.4,RCERA,0):5 I $T S RCQUIT=0 Q
|
|
.. I RCQUIT S RCOK=0,DIR(0)="EA",DIR("A",1)="ANOTHER USER IS CURRENTLY USING THIS ERA, TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR Q
|
|
. D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
|
|
. I RCQUIT S RCOK=0
|
|
;
|
|
BATQ Q RCOK
|
|
;
|
|
UPPER(X) ; Function returns X as all upper case
|
|
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
;
|