RCDPEDS ;ALB/TMK/DWA - Display EEOB detail from receipt ;07/30/10
;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
;;Per VHA Directive 10-93-142, this routine should not be modified.
; IA for call to GETEOB^IBCECSA6 = 4044
;
DISP(RCTDA) ; Display EEOB detail/raw data from file 344.4
; RCTDA = ien of entry in file 344.4 to display
; Returns global ^TMP("$J,"RCDISP")
;
N RCZ,RCZ0,RCCT
K ^TMP($J,"RCDISP")
S RCCT=0
;
D SUM(RCTDA,.RCCT)
;
S RCZ=0 F S RCZ=$O(^RCY(344.4,RCTDA,1,RCZ)) Q:'RCZ S RCZ0=$G(^(RCZ,0)) I RCZ0'="" D SEQ(RCTDA,.RCCT,RCZ,RCZ0)
;
Q
;
SEQ(RCTDA,RCCT,RC34441,RC0) ;
; RCTDA = ien of record in file 344.4
; RCCT = line counter, updated if passed by ref
; RC34441 = ien of seq # in file 344.41
; RC0 = the data on the 0-node of the sequence entry in file 344.41
;
N RCIEN,RCZ,RCDPDATA
I $P(RC0,U,2) D ; Get detail from EOB file
. K ^TMP("PRCA_EOB",$J)
. S RCIEN=+$P(RC0,U,2)
. D GETEOB^IBCECSA6(RCIEN,1) ; IA 4044
. I $O(^IBM(361.1,RCIEN,"ERR",0)) D ; Add error msgs
.. D GETERR(RCIEN,+$O(^TMP("PRCA_EOB",$J,RCIEN," "),-1))
. D SEQHDR(RCTDA,RC34441,.RCCT)
. S RCZ=0
. F S RCZ=$O(^TMP("PRCA_EOB",$J,RCIEN,RCZ)) Q:'RCZ S RCCT=RCCT+1 S ^TMP($J,"RCDISP",RCCT)=$G(^TMP("PRCA_EOB",$J,RCIEN,RCZ))
;
I '$P(RC0,U,2),$O(^RCY(344.4,RCTDA,1,RC34441,1,0)) D ; Get detail from raw data in file 344.411
. K ^TMP($J,"RCOUT"),^TMP($J,"RCRAW")
. D SEQHDR(RCTDA,RC34441,.RCCT)
. D DISP^RCDPESR0("^RCY(344.4,"_RCTDA_",1,"_RC34441_",1)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75,1)
. K ^TMP($J,"RCRAW")
. S RCZ=0
. F S RCZ=$O(^TMP($J,"RCOUT",RCZ)) Q:'RCZ S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$G(^TMP($J,"RCOUT",RCZ))
K ^TMP($J,"RCOUT"),^TMP("PRCA_EOB",$J)
Q
;
SEQHDR(RCTDA,RC34441,RCCT) ; Extract header data from sequence record
; RCTDA = ien of record in file 344.4
; RC34441 = ien of seq # in file 344.41
; RCCT = line counter, updated if passed by ref
; Returns line # incremented and ^TMP($J,"RCDISP" array
;
N RCDPDATA,RCINV
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=" "
D DIQ34441(RCTDA,RC34441,".01:.15")
S RCCT=RCCT+1
S RCINV=($G(RCDPDATA(344.41,RC34441,.02,"E"))="")
S ^TMP($J,"RCDISP",RCCT)=$E("Sequence #: "_$G(RCDPDATA(344.41,RC34441,.01,"E"))_$S(RCINV:" (Not Stored in IB)",1:"")_$J("",32),1,32)
S ^TMP($J,"RCDISP",RCCT)=^TMP($J,"RCDISP",RCCT)_"Bill Number: "_$S('RCINV:RCDPDATA(344.41,RC34441,.02,"E"),1:$G(RCDPDATA(344.41,RC34441,.05,"E"))_" (Not in AR)")
I $G(RCDPDATA(344.41,RC34441,.14,"E"))="YES" S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=" *** REVERSAL ***"
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("Amount "_$S($G(RCDPDATA(344.41,RC34441,.14,"E"))="YES":"Reversed",1:"Paid")_": "_$G(RCDPDATA(344.41,RC34441,.03,"E"))_$J("",32),1,32)_"Ins Co: "_$E($G(RCDPDATA(344.41,RC34441,.04,"E")),1,30)
I $G(RCDPDATA(344.41,RC34441,.07,"E"))'="" S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="Error: "_RCDPDATA(344.41,RC34441,.07,"E")_$S($G(RCDPDATA(344.41,RC34441,.08,"E"))'="":" - "_$G(RCDPDATA(344.41,RC34441,.08,"E")),1:"")
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="Worklist Status: "_$G(RCDPDATA(344.41,RC34441,.06,"E"))
Q
;
GETERR(RCIEN,Z) ; Extract error messages from entry RCIEN in file 361.1
; Z = the last line # in the ^TMP("PRCA_EOB",$J,RCIEN,n array
; Function returns error lines from file #361.1 in the
; ^TMP("PRCA_EOB",$J,RCIEN,n array in subscripts at the end of the
; array
N Z0,DATA,RCRAW,RCFORM,RCLINE,X,RCV5
S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)="EEOB FILING ERRORS:"
S Z0=0 F S Z0=$O(^IBM(361.1,RCIEN,"ERR",Z0)) Q:'Z0 S X=$G(^(Z0,0)) D
. I +X,+X=835,+$P(X,U,16)>0 S RCV5=1
. I +X S RCLINE=+X_$S($G(RCV5)=1:"^RCDPES10",1:"^RCDPESR9") I $T(@RCLINE)'="" D Q
.. S RCRAW(1,0)=X
.. D DISP^RCDPESR0("RCRAW","RCFORM",1,"RCDATA",80,0)
.. S X=0 F S X=$O(RCFORM(X)) Q:'X S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)=" "_RCFORM(X)
. S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)=" "_$G(^IBM(361.1,RCIEN,"ERR",Z0,0))
Q
;
SUM(RCTDA,RCCT) ; Extract pertinent top-level data
; RCTDA = ien of record in file 344.4
; RCCT = line counter, updated if passed by ref
;
N Z,Z0,CT,CT1,RCDPDATA,RCADJ,RCREV
D DIQ3444(RCTDA,".02:.11")
S (Z,CT,RCADJ)=0 F S Z=$O(^RCY(344.4,RCTDA,2,Z)) Q:'Z S CT=CT+1,RCADJ=RCADJ+$J($P($G(^(Z,0)),U,3),0,2)
S (Z,CT1,RCREV)=0 S Z=0 F S Z0=$O(^RCY(344.4,RCTDA,1,"ATB",1,Z)) Q:'Z S Z0=$G(^RCY(344.4,RCTDA,1,Z,0)),CT1=CT1+1,RCREV(Z)=$$BILLREF^RCDPESR0(RCTDA,Z)_U_$J($P(Z0,U,3),0,2),RCREV=RCREV+$P(RCREV(Z),U,2)
S RCCT=RCCT+1,Z="There is data for "_+$G(RCDPDATA(344.4,RCTDA,.11,"E"))_" EEOBs"_$S(CT:", "_CT_" ERA adjustments",1:"")_$S(CT1:", "_CT1_" EEOB reversals",1:"")
S ^TMP($J,"RCDISP",RCCT)=$J("",(80-$L(Z))\2)_Z
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT PAID: "_+$G(RCDPDATA(344.4,RCTDA,.05,"E"))
I RCADJ D
. S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT ERA ADJUSTED: "_RCADJ
. D DISPADJ^RCDPESR8(RCTDA,"RCADJ")
. S Z=0 F S Z=$O(RCADJ(Z)) Q:'Z S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=" "_RCADJ(Z)
I RCREV D
. S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT REVERSED: "_RCREV
. S Z=0 F S Z=$O(RCREV(Z)) Q:'Z S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E(" BILL REFERENCE: "_$P(RCREV(Z),U)_$J("",30),1,30)_" REVERSAL AMT: "_$P(RCREV,U,2)
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("TRACE #: "_$G(RCDPDATA(344.4,RCTDA,.02,"E"))_$J("",35),1,35)_"RECEIPT #: "_$G(RCDPDATA(344.4,RCTDA,.08,"E"))
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("INS CO ID: "_$G(RCDPDATA(344.4,RCTDA,.03,"E"))_$J("",35),1,35)_"NAME: "_$E($G(RCDPDATA(344.4,RCTDA,.06,"E")),1,29)
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("ERA DATE: "_$G(RCDPDATA(344.4,RCTDA,.04,"E"))_$J("",35),1,35)_"DATE ERA RECEIVED: "_$G(RCDPDATA(344.4,RCTDA,.07,"E"))
S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="EFT MATCH STATUS: "_$G(RCDPDATA(344.4,RCTDA,.09,"E"))
Q
;
DIQ34441(RCTDA,RC0,DR,ARR) ; DIQ call to retrieve data for DR fields in
; file 344.41
N %I,D0,D1,DA,DIC,DIQ,DIQ2,YY
I $G(ARR)="" S ARR="RCDPDATA"
K @ARR@(344.41,RC0)
S DA=RC0,DA(1)=RCTDA,DIQ(0)="E",DIC="^RCY(344.4,"_DA(1)_",1,",DIQ=ARR D EN^DIQ1
Q
;
DIQ3444(DA,DR,ARR) ; DIQ call to retrieve data for DR fields in file 344.41
N %I,D0,DIC,DIQ,DIQ2,YY
I $G(ARR)="" S ARR="RCDPDATA"
K @ARR@(344.4,DA)
S DIQ(0)="E",DIC="^RCY(344.4,",DIQ=ARR D EN^DIQ1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEDS 6321 printed Dec 13, 2024@01:44:33 Page 2
RCDPEDS ;ALB/TMK/DWA - Display EEOB detail from receipt ;07/30/10
+1 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ; IA for call to GETEOB^IBCECSA6 = 4044
+4 ;
DISP(RCTDA) ; Display EEOB detail/raw data from file 344.4
+1 ; RCTDA = ien of entry in file 344.4 to display
+2 ; Returns global ^TMP("$J,"RCDISP")
+3 ;
+4 NEW RCZ,RCZ0,RCCT
+5 KILL ^TMP($JOB,"RCDISP")
+6 SET RCCT=0
+7 ;
+8 DO SUM(RCTDA,.RCCT)
+9 ;
+10 SET RCZ=0
FOR
SET RCZ=$ORDER(^RCY(344.4,RCTDA,1,RCZ))
if 'RCZ
QUIT
SET RCZ0=$GET(^(RCZ,0))
IF RCZ0'=""
DO SEQ(RCTDA,.RCCT,RCZ,RCZ0)
+11 ;
+12 QUIT
+13 ;
SEQ(RCTDA,RCCT,RC34441,RC0) ;
+1 ; RCTDA = ien of record in file 344.4
+2 ; RCCT = line counter, updated if passed by ref
+3 ; RC34441 = ien of seq # in file 344.41
+4 ; RC0 = the data on the 0-node of the sequence entry in file 344.41
+5 ;
+6 NEW RCIEN,RCZ,RCDPDATA
+7 ; Get detail from EOB file
IF $PIECE(RC0,U,2)
Begin DoDot:1
+8 KILL ^TMP("PRCA_EOB",$JOB)
+9 SET RCIEN=+$PIECE(RC0,U,2)
+10 ; IA 4044
DO GETEOB^IBCECSA6(RCIEN,1)
+11 ; Add error msgs
IF $ORDER(^IBM(361.1,RCIEN,"ERR",0))
Begin DoDot:2
+12 DO GETERR(RCIEN,+$ORDER(^TMP("PRCA_EOB",$JOB,RCIEN," "),-1))
End DoDot:2
+13 DO SEQHDR(RCTDA,RC34441,.RCCT)
+14 SET RCZ=0
+15 FOR
SET RCZ=$ORDER(^TMP("PRCA_EOB",$JOB,RCIEN,RCZ))
if 'RCZ
QUIT
SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=$GET(^TMP("PRCA_EOB",$JOB,RCIEN,RCZ))
End DoDot:1
+16 ;
+17 ; Get detail from raw data in file 344.411
IF '$PIECE(RC0,U,2)
IF $ORDER(^RCY(344.4,RCTDA,1,RC34441,1,0))
Begin DoDot:1
+18 KILL ^TMP($JOB,"RCOUT"),^TMP($JOB,"RCRAW")
+19 DO SEQHDR(RCTDA,RC34441,.RCCT)
+20 DO DISP^RCDPESR0("^RCY(344.4,"_RCTDA_",1,"_RC34441_",1)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75,1)
+21 KILL ^TMP($JOB,"RCRAW")
+22 SET RCZ=0
+23 FOR
SET RCZ=$ORDER(^TMP($JOB,"RCOUT",RCZ))
if 'RCZ
QUIT
SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=$GET(^TMP($JOB,"RCOUT",RCZ))
End DoDot:1
+24 KILL ^TMP($JOB,"RCOUT"),^TMP("PRCA_EOB",$JOB)
+25 QUIT
+26 ;
SEQHDR(RCTDA,RC34441,RCCT) ; Extract header data from sequence record
+1 ; RCTDA = ien of record in file 344.4
+2 ; RC34441 = ien of seq # in file 344.41
+3 ; RCCT = line counter, updated if passed by ref
+4 ; Returns line # incremented and ^TMP($J,"RCDISP" array
+5 ;
+6 NEW RCDPDATA,RCINV
+7 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=" "
+8 DO DIQ34441(RCTDA,RC34441,".01:.15")
+9 SET RCCT=RCCT+1
+10 SET RCINV=($GET(RCDPDATA(344.41,RC34441,.02,"E"))="")
+11 SET ^TMP($JOB,"RCDISP",RCCT)=$EXTRACT("Sequence #: "_$GET(RCDPDATA(344.41,RC34441,.01,"E"))_$SELECT(RCINV:" (Not Stored in IB)",1:"")_$JUSTIFY("",32),1,32)
+12 SET ^TMP($JOB,"RCDISP",RCCT)=^TMP($JOB,"RCDISP",RCCT)_"Bill Number: "_$SELECT('RCINV:RCDPDATA(344.41,RC34441,.02,"E"),1:$GET(RCDPDATA(344.41,RC34441,.05,"E"))_" (Not in AR)")
+13 IF $GET(RCDPDATA(344.41,RC34441,.14,"E"))="YES"
SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=" *** REVERSAL ***"
+14 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=$EXTRACT("Amount "_$SELECT($GET(RCDPDATA(344.41,RC34441,.14,"E"))="YES":"Reversed",1:"Paid")_": "_$GET(RCDPDATA(344.41,RC34441,.03,"E"))_$JUSTIFY("",32),1,32)_"Ins Co: "_$EXTRACT(...
... $GET(RCDPDATA(344.41,RC34441,.04,"E")),1,30)
+15 IF $GET(RCDPDATA(344.41,RC34441,.07,"E"))'=""
SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)="Error: "_RCDPDATA(344.41,RC34441,.07,"E")_$SELECT($GET(RCDPDATA(344.41,RC34441,.08,"E"))'="":" - "_$GET(RCDPDATA(344.41,RC34441,.08,"E")),1:"")
+16 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)="Worklist Status: "_$GET(RCDPDATA(344.41,RC34441,.06,"E"))
+17 QUIT
+18 ;
GETERR(RCIEN,Z) ; Extract error messages from entry RCIEN in file 361.1
+1 ; Z = the last line # in the ^TMP("PRCA_EOB",$J,RCIEN,n array
+2 ; Function returns error lines from file #361.1 in the
+3 ; ^TMP("PRCA_EOB",$J,RCIEN,n array in subscripts at the end of the
+4 ; array
+5 NEW Z0,DATA,RCRAW,RCFORM,RCLINE,X,RCV5
+6 SET Z=Z+1
SET ^TMP("PRCA_EOB",$JOB,RCIEN,Z)="EEOB FILING ERRORS:"
+7 SET Z0=0
FOR
SET Z0=$ORDER(^IBM(361.1,RCIEN,"ERR",Z0))
if 'Z0
QUIT
SET X=$GET(^(Z0,0))
Begin DoDot:1
+8 IF +X
IF +X=835
IF +$PIECE(X,U,16)>0
SET RCV5=1
+9 IF +X
SET RCLINE=+X_$SELECT($GET(RCV5)=1:"^RCDPES10",1:"^RCDPESR9")
IF $TEXT(@RCLINE)'=""
Begin DoDot:2
+10 SET RCRAW(1,0)=X
+11 DO DISP^RCDPESR0("RCRAW","RCFORM",1,"RCDATA",80,0)
+12 SET X=0
FOR
SET X=$ORDER(RCFORM(X))
if 'X
QUIT
SET Z=Z+1
SET ^TMP("PRCA_EOB",$JOB,RCIEN,Z)=" "_RCFORM(X)
End DoDot:2
QUIT
+13 SET Z=Z+1
SET ^TMP("PRCA_EOB",$JOB,RCIEN,Z)=" "_$GET(^IBM(361.1,RCIEN,"ERR",Z0,0))
End DoDot:1
+14 QUIT
+15 ;
SUM(RCTDA,RCCT) ; Extract pertinent top-level data
+1 ; RCTDA = ien of record in file 344.4
+2 ; RCCT = line counter, updated if passed by ref
+3 ;
+4 NEW Z,Z0,CT,CT1,RCDPDATA,RCADJ,RCREV
+5 DO DIQ3444(RCTDA,".02:.11")
+6 SET (Z,CT,RCADJ)=0
FOR
SET Z=$ORDER(^RCY(344.4,RCTDA,2,Z))
if 'Z
QUIT
SET CT=CT+1
SET RCADJ=RCADJ+$JUSTIFY($PIECE($GET(^(Z,0)),U,3),0,2)
+7 SET (Z,CT1,RCREV)=0
SET Z=0
FOR
SET Z0=$ORDER(^RCY(344.4,RCTDA,1,"ATB",1,Z))
if 'Z
QUIT
SET Z0=$GET(^RCY(344.4,RCTDA,1,Z,0))
SET CT1=CT1+1
SET RCREV(Z)=$$BILLREF^RCDPESR0(RCTDA,Z)_U_$JUSTIFY($PIECE(Z0,U,3),0,2)
SET RCREV=RCREV+$PIECE(RCREV(Z),U,2)
+8 SET RCCT=RCCT+1
SET Z="There is data for "_+$GET(RCDPDATA(344.4,RCTDA,.11,"E"))_" EEOBs"_$SELECT(CT:", "_CT_" ERA adjustments",1:"")_$SELECT(CT1:", "_CT1_" EEOB reversals",1:"")
+9 SET ^TMP($JOB,"RCDISP",RCCT)=$JUSTIFY("",(80-$LENGTH(Z))\2)_Z
+10 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)="TOTAL AMT PAID: "_+$GET(RCDPDATA(344.4,RCTDA,.05,"E"))
+11 IF RCADJ
Begin DoDot:1
+12 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)="TOTAL AMT ERA ADJUSTED: "_RCADJ
+13 DO DISPADJ^RCDPESR8(RCTDA,"RCADJ")
+14 SET Z=0
FOR
SET Z=$ORDER(RCADJ(Z))
if 'Z
QUIT
SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=" "_RCADJ(Z)
End DoDot:1
+15 IF RCREV
Begin DoDot:1
+16 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)="TOTAL AMT REVERSED: "_RCREV
+17 SET Z=0
FOR
SET Z=$ORDER(RCREV(Z))
if 'Z
QUIT
SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=$EXTRACT(" BILL REFERENCE: "_$PIECE(RCREV(Z),U)_$JUSTIFY("",30),1,30)_" REVERSAL AMT: "_$PIECE(RCREV,U,2)
End DoDot:1
+18 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=$EXTRACT("TRACE #: "_$GET(RCDPDATA(344.4,RCTDA,.02,"E"))_$JUSTIFY("",35),1,35)_"RECEIPT #: "_$GET(RCDPDATA(344.4,RCTDA,.08,"E"))
+19 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=$EXTRACT("INS CO ID: "_$GET(RCDPDATA(344.4,RCTDA,.03,"E"))_$JUSTIFY("",35),1,35)_"NAME: "_$EXTRACT($GET(RCDPDATA(344.4,RCTDA,.06,"E")),1,29)
+20 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)=$EXTRACT("ERA DATE: "_$GET(RCDPDATA(344.4,RCTDA,.04,"E"))_$JUSTIFY("",35),1,35)_"DATE ERA RECEIVED: "_$GET(RCDPDATA(344.4,RCTDA,.07,"E"))
+21 SET RCCT=RCCT+1
SET ^TMP($JOB,"RCDISP",RCCT)="EFT MATCH STATUS: "_$GET(RCDPDATA(344.4,RCTDA,.09,"E"))
+22 QUIT
+23 ;
DIQ34441(RCTDA,RC0,DR,ARR) ; DIQ call to retrieve data for DR fields in
+1 ; file 344.41
+2 NEW %I,D0,D1,DA,DIC,DIQ,DIQ2,YY
+3 IF $GET(ARR)=""
SET ARR="RCDPDATA"
+4 KILL @ARR@(344.41,RC0)
+5 SET DA=RC0
SET DA(1)=RCTDA
SET DIQ(0)="E"
SET DIC="^RCY(344.4,"_DA(1)_",1,"
SET DIQ=ARR
DO EN^DIQ1
+6 QUIT
+7 ;
DIQ3444(DA,DR,ARR) ; DIQ call to retrieve data for DR fields in file 344.41
+1 NEW %I,D0,DIC,DIQ,DIQ2,YY
+2 IF $GET(ARR)=""
SET ARR="RCDPDATA"
+3 KILL @ARR@(344.4,DA)
+4 SET DIQ(0)="E"
SET DIC="^RCY(344.4,"
SET DIQ=ARR
DO EN^DIQ1
+5 QUIT
+6 ;
