RCDPEWLB ;ALB/TMK - EEOB WORKLIST BATCH PROCESSING ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**208,298**;Mar 20, 1995;Build 121
;Per VA Directive 6402, this routine should not be modified.
;
SETBATCH(RCERA) ; Set up batches for a worklist entry RCERA
; Returns ^TMP($J,"BATCHES",batch criteria code,start param data)=
; batch #^end param data
; Ask to split the ERA
; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
Q ;prca*4.5*298
N DIR,DTOUT,DUOUT,RCBAT,RCNAMES,RCNUM,RCS,RCSEL,RCY,RCZ,X,Y,Z,Z0
K ^TMP($J,"BATCHES")
S RCNUM=+$$CTEEOB(RCERA)
Q:RCNUM'>1
S DIR("A",1)="THERE ARE APPROXIMATELY "_RCNUM_" EEOBS IN THIS ERA",DIR("A")="DO YOU WANT TO SPLIT THIS ERA INTO BATCHES?: ",DIR(0)="YA",DIR("B")=$S(RCNUM>30:"YES",1:"NO") W ! D ^DIR K DIR
I Y'=1 Q
;
S DIR("A",1)="YOU MAY USE ANY ONE OF THE FOLLOWING CRITERIA TO SPLIT THE ERA INTO BATCHES: ",DIR("A",2)=" ",DIR("A",3)=$J("",10)_"1 - BY MAX # OF EEOBs TO INCLUDE IN A BATCH"
S DIR("A",4)=$J("",10)_"2 - BY RANGES OF PATIENT LAST NAME",DIR("A",5)=$J("",10)_"3 - BY EEOB PAYMENT STATUS (FULL/PARTIAL/NO PAY)"
S DIR("A",6)=$J("",10)_"4 - BY CO-PAY AND NON-COPAY FOR THE DATE OF SERVICE",DIR("A",7)=" "
S DIR(0)="SAO^1:MAX #;2:LAST NAME;3:PAY STATUS;4:CO-PAY STATUS",DIR("A")="CRITERIA SELECTION: "
W !! D ^DIR K DIR
Q:$D(DUOUT)!$D(DTOUT)!(Y="")
S RCBAT=0,RCSEL=Y,^TMP($J,"BATCHES")=RCSEL
S DIR(0)="YA",DIR("A")="DO YOU WANT TO NAME YOUR OWN BATCHES?: ",DIR("B")="NO" W ! D ^DIR K DIR
Q:$D(DUOUT)!$D(DTOUT)
S RCNAMES=+Y
I RCSEL=1 D
. W ! S DIR(0)="NA^1:"_RCNUM,DIR("A")="MAX # OF EEOBS TO INCLUDE IN A BATCH: ",DIR("?")="ENTER A NUMBER FROM 1 TO "_RCNUM D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) Q
. S RCY=Y
. F RCZ=1:1:RCNUM\RCY+$S(RCNUM#RCY:1,1:0) S RCS=((RCZ-1)*RCY)+1 D NEWBAT(RCERA,1,"",RCS_U_(RCS+RCY-1),.RCBAT,RCNAMES) S ^TMP($J,"BATCHES",1,RCS)=RCBAT_U_(RCS+RCY-1)
;
I RCSEL=2 D
. N RCNMF,RCQUIT,RCDONE
. S RCNMF="A",(RCQUIT,RCDONE)=0
. F D Q:RCQUIT!RCDONE
.. W !!,"START FROM LAST NAME BEGINNING WITH: ",RCNMF
.. S DIR("?")="ENTER A LETTER IN UPPERCASE"
.. S DIR(0)="FA^1:1^K:X'?.U X",DIR("A")="INCLUDE THROUGH LAST NAME BEGINNING WITH: " D ^DIR K DIR
.. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
.. S RCY=Y,RCSEL("NAME",RCNMF)=Y_"ZZZ"
.. I $A(RCY)=90 S RCDONE=1 Q
.. S RCNMF=$A(RCY)+1,RCNMF=$C(RCNMF)
. Q:RCQUIT
. S Z="" F S Z=$O(RCSEL("NAME",Z)) Q:Z="" D NEWBAT(RCERA,2,"",Z_U_RCSEL("NAME",Z),.RCBAT,RCNAMES) S ^TMP($J,"BATCHES",2,Z)=RCBAT_U_RCSEL("NAME",Z)
;
I RCSEL=3 D
. F Y=1:1:3 D NEWBAT(RCERA,3,$P("FULL PAYMENT^PARTIAL PAYMENT^NO PAYMENT",U,Y),Y,.RCBAT,RCNAMES) S ^TMP($J,"BATCHES",3,Y)=RCBAT
;
I RCSEL=4 D
. F Y=1,2 D NEWBAT(RCERA,RCSEL,$P("CO-PAY EXISTS^NO CO-PAY EXISTS",U,Y),Y,.RCBAT,RCNAMES) S ^TMP($J,"BATCHES",4,Y)=RCBAT
;
S DIR(0)="EA",DIR("A")=RCBAT_" BATCHES CREATED. PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
Q
;
NEWBAT(RCERA,RCSEL,RCDAT,RCVAL,RCBAT,RCNAMES) ; Add a new batch at the top level entry
; RCERA = the ien of the entry in file 344.49
; RCSEL = the # of the selection criteria selected
; RCDAT = the default 'name' of the batch based on the criteria used
; RCVAL = the start value^the end value
; RCBAT = if passed by reference, returned as the next batch #
; RCNAMES = 1 if user wants to name each batch, 0 to accept default
;
; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
Q ;prca*4.5*298
N DA,DD,DIC,DLAYGO,DO,DR,X,Y
S RCBAT=RCBAT+1
S DA(1)=RCERA,DIC="^RCY(344.49,"_DA(1)_",3,",DLAYGO=344.493,DIC(0)="L",X=RCBAT
I $G(RCNAMES) W !!,"**BATCH #: "_RCBAT
S DIC("DR")=".03////0;.04////"_DUZ_";.05////0;.06////"_RCSEL_";.07////"_$P(RCVAL,U)_$S($P(RCVAL,U,2)'="":";.08////"_$P(RCVAL,U,2),1:"")
S DIC("DR")=DIC("DR")_";.02R//"_$S(RCNAMES:"",1:"//")_$S(RCSEL=1:"BATCH #: "_RCBAT,RCSEL=2:"LAST NAME FROM "_$P(RCVAL,U)_" - "_$P(RCVAL,U,2),1:RCDAT)
D FILE^DICN K DLAYGO,DIC,DD,DO W !
Q
;
GETBATCH(RCZ0) ; Returns the batch # to be assigned to the data in RCZ0
; RCZ0 = 0-node of the entry in file 344.41 to be assigned to a batch
N BNUM,Z,Z0
S BNUM=""
I $G(^TMP($J,"BATCHES"))=1 D ; Max #
. N CT
. S CT=+$G(^TMP($J,"BATCHES","CT"))+1
. S ^TMP($J,"BATCHES","CT")=CT
. S Z=+$O(^TMP($J,"BATCHES",1,CT+1),-1),BNUM=+$G(^TMP($J,"BATCHES",1,Z)) S:'BNUM BNUM=1
;
I $G(^TMP($J,"BATCHES"))=2 D ; last name
. S Z=$P(RCZ0,U,15)
. I $P(RCZ0,U,2) S Z0=$P($G(^DGCR(399,+$G(^IBM(361.1,+$P(RCZ0,U,2),0)),0)),U,2),Z0=$P($G(^DPT(Z0,0)),U) I Z0'="" S Z=Z0
. S Z0=$A($E(Z))-1,Z0=$C(Z0),Z0=$O(^TMP($J,"BATCHES",2,Z0),-1)
. S BNUM=$S(Z0="":1,1:+$G(^TMP($J,"BATCHES",2,Z0))) S:'BNUM BNUM=1
;
I $G(^TMP($J,"BATCHES"))=3 D ; payment amount
. S Z=+$P(RCZ0,U,3)
. I Z'>0!'$P(RCZ0,U,2) S BNUM=3 Q ; 0-PAY/ADJUSTMENT/UNKNOWN CLAIM
. I +$P($G(^IBM(361.1,+$P(RCZ0,U,2))),U,4)'>+Z S BNUM=1 Q ; FULL PAY
. S BNUM=2 ; PARTIAL PAY
;
I $G(^TMP($J,"BATCHES"))=4 D ; Co-pay/not
. S BNUM=2
. Q:'$P(RCZ0,U,2)
. I $$COPAY^RCDPEWL1(+$G(^IBM(361.1,+$P(RCZ0,U,2),0))) S BNUM=1
;
Q BNUM
;
EDIT(RCERA,RCB,ABORT) ; Edit name and posting status of an existing batch
; RCERA = the ien of the worklist entry
; RCB = the ien of the current batch
; RCABORT = if passed by reference, returned as 1 if user aborts
;
; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
Q ;prca*4.5*298
N DA,DIE,DR,X,Y
D FULL^VALM1
S ABORT=0
S DA(1)=RCERA,DA=RCB,DIE="^RCY(344.49,"_DA(1)_",3,",DR=".02;.03" D ^DIE I $D(Y) S ABORT=1
K VALMHDR ; Used to rebuild the header
S VALMBCK="R"
Q
;
MARKALL(RCERA) ; Mark all batches as ready to post
; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
Q ;prca*4.5*298
N DIR,X,Y,Z,RCT,DA,DIE,DR
D FULL^VALM1
S VALMBCK="R"
I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL S VALMBCK="R" Q
I '$O(^RCY(344.49,RCERA,3,0)) D NOTSET^RCDPEWLC Q
S DIR(0)="YA",DIR("A",1)="THIS ACTION WILL MARK ALL BATCHES FOR THIS ERA AS READY TO POST",DIR("A")="ARE YOU SURE YOU WANT TO DO THIS?: ",DIR("B")="NO" W ! D ^DIR K DIR
S RCT=0
I Y D
. S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z I '$P($G(^(Z,0)),U,3) S RCT=RCT+1,DA(1)=RCERA,DA=Z,DIE="^RCY(344.49,"_DA(1)_",3,",DR=".03////1" D ^DIE
. W !!,RCT," BATCHES CHANGED TO READY TO POST",!,"ALL BATCHES ARE NOW READY TO POST"
. S DIR(0)="EA",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
. K VALMHDR
Q
;
EDITALL(RCERA) ; Edit all batches
; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
Q ;prca*4.5*298
N Z,RCQUIT
D FULL^VALM1
S VALMBCK="R"
W !
I '$O(^RCY(344.49,RCERA,3,0)) D NOTSET^RCDPEWLC Q
S (RCQUIT,Z)=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z W !!,"BATCH #: "_+$G(^(Z,0)) D EDIT(RCERA,Z,.RCQUIT) Q:RCQUIT
Q
;
REBATCH(RCERA) ; Allow to recreate batches
; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
Q ;prca*4.5*298
N DA,DIE,DIK,DIR,DR,RCLINE,RCQUIT,X,Y,Z,Z0
D FULL^VALM1
I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL G REBQ
;
I '$O(^RCY(344.49,RCERA,3,0)) W !!," ***** THIS ERA CURRENTLY HAS NO BATCHES DEFINED *****"
;
S RCQUIT=0
I $O(^RCY(344.49,RCERA,3,0)) D G:RCQUIT REBQ
. S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="THIS ACTION REMOVES ALL BATCH REFERENCES. THE BATCHES CAN THEN BE REBUILT.",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: " W ! D ^DIR K DIR
. I Y'=1 S RCQUIT=1 Q
. S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z S DA(1)=RCERA,DIK="^RCY(344.49,"_DA(1)_",3,",DA=Z D ^DIK
;
K ^TMP($J,"BATCHES")
D SETBATCH(RCERA)
S Z=0 F S Z=$O(^RCY(344.49,RCERA,1,Z)) Q:'Z S Z0=$G(^(Z,0)) I +Z0'["." D
. S RCLINE=$G(^RCY(344.4,RCERA,1,+$P(Z0,U,9),0)),DA(1)=RCERA,DIE="^RCY(344.49,"_DA(1)_",1,",DA=Z,DR=".14///"_$S(RCLINE="":"@",1:"/"_$$GETBATCH^RCDPEWLB(RCLINE)) D ^DIE
K ^TMP($J,"BATCHES")
REBQ S VALMBCK="R"
Q
;
CTEEOB(RCERA) ; Returns the approx # of EEOBs in ERA ien RCERA (file 344.4)
N RCNUM,Z
S (RCNUM,Z)=0 F S Z=$O(^RCY(344.4,RCERA,1,Z)) Q:'Z I $P($G(^(Z,0)),U,3)'<0 S RCNUM=RCNUM+1
Q RCNUM
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWLB 8329 printed Dec 13, 2024@01:45:49 Page 2
RCDPEWLB ;ALB/TMK - EEOB WORKLIST BATCH PROCESSING ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**208,298**;Mar 20, 1995;Build 121
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
SETBATCH(RCERA) ; Set up batches for a worklist entry RCERA
+1 ; Returns ^TMP($J,"BATCHES",batch criteria code,start param data)=
+2 ; batch #^end param data
+3 ; Ask to split the ERA
+4 ; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
+5 ;prca*4.5*298
QUIT
+6 NEW DIR,DTOUT,DUOUT,RCBAT,RCNAMES,RCNUM,RCS,RCSEL,RCY,RCZ,X,Y,Z,Z0
+7 KILL ^TMP($JOB,"BATCHES")
+8 SET RCNUM=+$$CTEEOB(RCERA)
+9 if RCNUM'>1
QUIT
+10 SET DIR("A",1)="THERE ARE APPROXIMATELY "_RCNUM_" EEOBS IN THIS ERA"
SET DIR("A")="DO YOU WANT TO SPLIT THIS ERA INTO BATCHES?: "
SET DIR(0)="YA"
SET DIR("B")=$SELECT(RCNUM>30:"YES",1:"NO")
WRITE !
DO ^DIR
KILL DIR
+11 IF Y'=1
QUIT
+12 ;
+13 SET DIR("A",1)="YOU MAY USE ANY ONE OF THE FOLLOWING CRITERIA TO SPLIT THE ERA INTO BATCHES: "
SET DIR("A",2)=" "
SET DIR("A",3)=$JUSTIFY("",10)_"1 - BY MAX # OF EEOBs TO INCLUDE IN A BATCH"
+14 SET DIR("A",4)=$JUSTIFY("",10)_"2 - BY RANGES OF PATIENT LAST NAME"
SET DIR("A",5)=$JUSTIFY("",10)_"3 - BY EEOB PAYMENT STATUS (FULL/PARTIAL/NO PAY)"
+15 SET DIR("A",6)=$JUSTIFY("",10)_"4 - BY CO-PAY AND NON-COPAY FOR THE DATE OF SERVICE"
SET DIR("A",7)=" "
+16 SET DIR(0)="SAO^1:MAX #;2:LAST NAME;3:PAY STATUS;4:CO-PAY STATUS"
SET DIR("A")="CRITERIA SELECTION: "
+17 WRITE !!
DO ^DIR
KILL DIR
+18 if $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
QUIT
+19 SET RCBAT=0
SET RCSEL=Y
SET ^TMP($JOB,"BATCHES")=RCSEL
+20 SET DIR(0)="YA"
SET DIR("A")="DO YOU WANT TO NAME YOUR OWN BATCHES?: "
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
+21 if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+22 SET RCNAMES=+Y
+23 IF RCSEL=1
Begin DoDot:1
+24 WRITE !
SET DIR(0)="NA^1:"_RCNUM
SET DIR("A")="MAX # OF EEOBS TO INCLUDE IN A BATCH: "
SET DIR("?")="ENTER A NUMBER FROM 1 TO "_RCNUM
DO ^DIR
KILL DIR
+25 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+26 SET RCY=Y
+27 FOR RCZ=1:1:RCNUM\RCY+$SELECT(RCNUM#RCY:1,1:0)
SET RCS=((RCZ-1)*RCY)+1
DO NEWBAT(RCERA,1,"",RCS_U_(RCS+RCY-1),.RCBAT,RCNAMES)
SET ^TMP($JOB,"BATCHES",1,RCS)=RCBAT_U_(RCS+RCY-1)
End DoDot:1
+28 ;
+29 IF RCSEL=2
Begin DoDot:1
+30 NEW RCNMF,RCQUIT,RCDONE
+31 SET RCNMF="A"
SET (RCQUIT,RCDONE)=0
+32 FOR
Begin DoDot:2
+33 WRITE !!,"START FROM LAST NAME BEGINNING WITH: ",RCNMF
+34 SET DIR("?")="ENTER A LETTER IN UPPERCASE"
+35 SET DIR(0)="FA^1:1^K:X'?.U X"
SET DIR("A")="INCLUDE THROUGH LAST NAME BEGINNING WITH: "
DO ^DIR
KILL DIR
+36 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
QUIT
+37 SET RCY=Y
SET RCSEL("NAME",RCNMF)=Y_"ZZZ"
+38 IF $ASCII(RCY)=90
SET RCDONE=1
QUIT
+39 SET RCNMF=$ASCII(RCY)+1
SET RCNMF=$CHAR(RCNMF)
End DoDot:2
if RCQUIT!RCDONE
QUIT
+40 if RCQUIT
QUIT
+41 SET Z=""
FOR
SET Z=$ORDER(RCSEL("NAME",Z))
if Z=""
QUIT
DO NEWBAT(RCERA,2,"",Z_U_RCSEL("NAME",Z),.RCBAT,RCNAMES)
SET ^TMP($JOB,"BATCHES",2,Z)=RCBAT_U_RCSEL("NAME",Z)
End DoDot:1
+42 ;
+43 IF RCSEL=3
Begin DoDot:1
+44 FOR Y=1:1:3
DO NEWBAT(RCERA,3,$PIECE("FULL PAYMENT^PARTIAL PAYMENT^NO PAYMENT",U,Y),Y,.RCBAT,RCNAMES)
SET ^TMP($JOB,"BATCHES",3,Y)=RCBAT
End DoDot:1
+45 ;
+46 IF RCSEL=4
Begin DoDot:1
+47 FOR Y=1,2
DO NEWBAT(RCERA,RCSEL,$PIECE("CO-PAY EXISTS^NO CO-PAY EXISTS",U,Y),Y,.RCBAT,RCNAMES)
SET ^TMP($JOB,"BATCHES",4,Y)=RCBAT
End DoDot:1
+48 ;
+49 SET DIR(0)="EA"
SET DIR("A")=RCBAT_" BATCHES CREATED. PRESS RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
+50 QUIT
+51 ;
NEWBAT(RCERA,RCSEL,RCDAT,RCVAL,RCBAT,RCNAMES) ; Add a new batch at the top level entry
+1 ; RCERA = the ien of the entry in file 344.49
+2 ; RCSEL = the # of the selection criteria selected
+3 ; RCDAT = the default 'name' of the batch based on the criteria used
+4 ; RCVAL = the start value^the end value
+5 ; RCBAT = if passed by reference, returned as the next batch #
+6 ; RCNAMES = 1 if user wants to name each batch, 0 to accept default
+7 ;
+8 ; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
+9 ;prca*4.5*298
QUIT
+10 NEW DA,DD,DIC,DLAYGO,DO,DR,X,Y
+11 SET RCBAT=RCBAT+1
+12 SET DA(1)=RCERA
SET DIC="^RCY(344.49,"_DA(1)_",3,"
SET DLAYGO=344.493
SET DIC(0)="L"
SET X=RCBAT
+13 IF $GET(RCNAMES)
WRITE !!,"**BATCH #: "_RCBAT
+14 SET DIC("DR")=".03////0;.04////"_DUZ_";.05////0;.06////"_RCSEL_";.07////"_$PIECE(RCVAL,U)_$SELECT($PIECE(RCVAL,U,2)'="":";.08////"_$PIECE(RCVAL,U,2),1:"")
+15 SET DIC("DR")=DIC("DR")_";.02R//"_$SELECT(RCNAMES:"",1:"//")_$SELECT(RCSEL=1:"BATCH #: "_RCBAT,RCSEL=2:"LAST NAME FROM "_$PIECE(RCVAL,U)_" - "_$PIECE(RCVAL,U,2),1:RCDAT)
+16 DO FILE^DICN
KILL DLAYGO,DIC,DD,DO
WRITE !
+17 QUIT
+18 ;
GETBATCH(RCZ0) ; Returns the batch # to be assigned to the data in RCZ0
+1 ; RCZ0 = 0-node of the entry in file 344.41 to be assigned to a batch
+2 NEW BNUM,Z,Z0
+3 SET BNUM=""
+4 ; Max #
IF $GET(^TMP($JOB,"BATCHES"))=1
Begin DoDot:1
+5 NEW CT
+6 SET CT=+$GET(^TMP($JOB,"BATCHES","CT"))+1
+7 SET ^TMP($JOB,"BATCHES","CT")=CT
+8 SET Z=+$ORDER(^TMP($JOB,"BATCHES",1,CT+1),-1)
SET BNUM=+$GET(^TMP($JOB,"BATCHES",1,Z))
if 'BNUM
SET BNUM=1
End DoDot:1
+9 ;
+10 ; last name
IF $GET(^TMP($JOB,"BATCHES"))=2
Begin DoDot:1
+11 SET Z=$PIECE(RCZ0,U,15)
+12 IF $PIECE(RCZ0,U,2)
SET Z0=$PIECE($GET(^DGCR(399,+$GET(^IBM(361.1,+$PIECE(RCZ0,U,2),0)),0)),U,2)
SET Z0=$PIECE($GET(^DPT(Z0,0)),U)
IF Z0'=""
SET Z=Z0
+13 SET Z0=$ASCII($EXTRACT(Z))-1
SET Z0=$CHAR(Z0)
SET Z0=$ORDER(^TMP($JOB,"BATCHES",2,Z0),-1)
+14 SET BNUM=$SELECT(Z0="":1,1:+$GET(^TMP($JOB,"BATCHES",2,Z0)))
if 'BNUM
SET BNUM=1
End DoDot:1
+15 ;
+16 ; payment amount
IF $GET(^TMP($JOB,"BATCHES"))=3
Begin DoDot:1
+17 SET Z=+$PIECE(RCZ0,U,3)
+18 ; 0-PAY/ADJUSTMENT/UNKNOWN CLAIM
IF Z'>0!'$PIECE(RCZ0,U,2)
SET BNUM=3
QUIT
+19 ; FULL PAY
IF +$PIECE($GET(^IBM(361.1,+$PIECE(RCZ0,U,2))),U,4)'>+Z
SET BNUM=1
QUIT
+20 ; PARTIAL PAY
SET BNUM=2
End DoDot:1
+21 ;
+22 ; Co-pay/not
IF $GET(^TMP($JOB,"BATCHES"))=4
Begin DoDot:1
+23 SET BNUM=2
+24 if '$PIECE(RCZ0,U,2)
QUIT
+25 IF $$COPAY^RCDPEWL1(+$GET(^IBM(361.1,+$PIECE(RCZ0,U,2),0)))
SET BNUM=1
End DoDot:1
+26 ;
+27 QUIT BNUM
+28 ;
EDIT(RCERA,RCB,ABORT) ; Edit name and posting status of an existing batch
+1 ; RCERA = the ien of the worklist entry
+2 ; RCB = the ien of the current batch
+3 ; RCABORT = if passed by reference, returned as 1 if user aborts
+4 ;
+5 ; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
+6 ;prca*4.5*298
QUIT
+7 NEW DA,DIE,DR,X,Y
+8 DO FULL^VALM1
+9 SET ABORT=0
+10 SET DA(1)=RCERA
SET DA=RCB
SET DIE="^RCY(344.49,"_DA(1)_",3,"
SET DR=".02;.03"
DO ^DIE
IF $DATA(Y)
SET ABORT=1
+11 ; Used to rebuild the header
KILL VALMHDR
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
MARKALL(RCERA) ; Mark all batches as ready to post
+1 ; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
+2 ;prca*4.5*298
QUIT
+3 NEW DIR,X,Y,Z,RCT,DA,DIE,DR
+4 DO FULL^VALM1
+5 SET VALMBCK="R"
+6 IF $GET(^TMP("RCBATCH_SELECTED",$JOB))
DO NOBATCH^RCDPEWL
SET VALMBCK="R"
QUIT
+7 IF '$ORDER(^RCY(344.49,RCERA,3,0))
DO NOTSET^RCDPEWLC
QUIT
+8 SET DIR(0)="YA"
SET DIR("A",1)="THIS ACTION WILL MARK ALL BATCHES FOR THIS ERA AS READY TO POST"
SET DIR("A")="ARE YOU SURE YOU WANT TO DO THIS?: "
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
+9 SET RCT=0
+10 IF Y
Begin DoDot:1
+11 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.49,RCERA,3,Z))
if 'Z
QUIT
IF '$PIECE($GET(^(Z,0)),U,3)
SET RCT=RCT+1
SET DA(1)=RCERA
SET DA=Z
SET DIE="^RCY(344.49,"_DA(1)_",3,"
SET DR=".03////1"
DO ^DIE
+12 WRITE !!,RCT," BATCHES CHANGED TO READY TO POST",!,"ALL BATCHES ARE NOW READY TO POST"
+13 SET DIR(0)="EA"
SET DIR("A")="PRESS RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
+14 KILL VALMHDR
End DoDot:1
+15 QUIT
+16 ;
EDITALL(RCERA) ; Edit all batches
+1 ; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
+2 ;prca*4.5*298
QUIT
+3 NEW Z,RCQUIT
+4 DO FULL^VALM1
+5 SET VALMBCK="R"
+6 WRITE !
+7 IF '$ORDER(^RCY(344.49,RCERA,3,0))
DO NOTSET^RCDPEWLC
QUIT
+8 SET (RCQUIT,Z)=0
FOR
SET Z=$ORDER(^RCY(344.49,RCERA,3,Z))
if 'Z
QUIT
WRITE !!,"BATCH #: "_+$GET(^(Z,0))
DO EDIT(RCERA,Z,.RCQUIT)
if RCQUIT
QUIT
+9 QUIT
+10 ;
REBATCH(RCERA) ; Allow to recreate batches
+1 ; prca*4.5*298 per requirements, keep code related to creating/maintaining batches but remove from execution
+2 ;prca*4.5*298
QUIT
+3 NEW DA,DIE,DIK,DIR,DR,RCLINE,RCQUIT,X,Y,Z,Z0
+4 DO FULL^VALM1
+5 IF $GET(^TMP("RCBATCH_SELECTED",$JOB))
DO NOBATCH^RCDPEWL
GOTO REBQ
+6 ;
+7 IF '$ORDER(^RCY(344.49,RCERA,3,0))
WRITE !!," ***** THIS ERA CURRENTLY HAS NO BATCHES DEFINED *****"
+8 ;
+9 SET RCQUIT=0
+10 IF $ORDER(^RCY(344.49,RCERA,3,0))
Begin DoDot:1
+11 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A",1)="THIS ACTION REMOVES ALL BATCH REFERENCES. THE BATCHES CAN THEN BE REBUILT."
SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
WRITE !
DO ^DIR
KILL DIR
+12 IF Y'=1
SET RCQUIT=1
QUIT
+13 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.49,RCERA,3,Z))
if 'Z
QUIT
SET DA(1)=RCERA
SET DIK="^RCY(344.49,"_DA(1)_",3,"
SET DA=Z
DO ^DIK
End DoDot:1
if RCQUIT
GOTO REBQ
+14 ;
+15 KILL ^TMP($JOB,"BATCHES")
+16 DO SETBATCH(RCERA)
+17 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.49,RCERA,1,Z))
if 'Z
QUIT
SET Z0=$GET(^(Z,0))
IF +Z0'["."
Begin DoDot:1
+18 SET RCLINE=$GET(^RCY(344.4,RCERA,1,+$PIECE(Z0,U,9),0))
SET DA(1)=RCERA
SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DA=Z
SET DR=".14///"_$SELECT(RCLINE="":"@",1:"/"_$$GETBATCH^RCDPEWLB(RCLINE))
DO ^DIE
End DoDot:1
+19 KILL ^TMP($JOB,"BATCHES")
REBQ SET VALMBCK="R"
+1 QUIT
+2 ;
CTEEOB(RCERA) ; Returns the approx # of EEOBs in ERA ien RCERA (file 344.4)
+1 NEW RCNUM,Z
+2 SET (RCNUM,Z)=0
FOR
SET Z=$ORDER(^RCY(344.4,RCERA,1,Z))
if 'Z
QUIT
IF $PIECE($GET(^(Z,0)),U,3)'<0
SET RCNUM=RCNUM+1
+3 QUIT RCNUM
+4 ;
