RCDPEX2 ;ALB/TMK/KML/PJH - ELECTRONIC EOB DETAIL EXCEPTION MAIN LIST TEMPLATE ;20 Dec 2018 17:20:51
;;4.5;Accounts Receivable;**173,269,298,304,326,345,409,424**;Mar 20, 1995;Build 11
;Per VA Directive 6402, this routine should not be modified.
;
INIT ;EP from listman template RCDPEX EOB_SUM EXCEPTION LIST
; set up initial variables
S U="^",VALMCNT=0,VALMBG=1
D BLD
Q
;
REBLD ; Set up formatted global
;
BLD ;EP from RCDPEX3,RCDPEX31,RCDEPEX32
; Build list of messages from file 344.4
; Input: RCDWLIEN - Optional set to a selected ERA if the user opts to see
; exceptions after receiving an 'ACCESS DENIED' message
; in the ERA WORKLIST when they tried to create a scratch
; pad for the ERA (EXCDENY^RCDPEWLP). Otherwise, undefined
; RCPAY 'R' = RANGE, 'S' = SELECTED, 'A' = ALL
; RCTYPE - 'M' - Only display Medical Exceptions
; 'P' - Only display Pharmacy Exceptions
; 'T' - Tricare
; 'A' - Display Medical and Pharmacy and Tricare Exceptions
; ^TMP(^TMP("RCDPEU1",$J) holds selected payers to display.
;
N DA,DR,ERAIEN,RC0,RCBILL,RCDECME,RCDPDATA,RCPYRIEN,RCER,RCEXC,RCMSG1,RCS,RCSEQ,RCSUB
N RCX,RCX1,RCX2,X,XX,Y,YY ;PRCA*4.5*409 Added ERAIEN,RCX2
K ^TMP("RCDPEX_SUM-EOB",$J),^TMP("RCDPEX_SUM-EOBDX",$J)
K ^TMP("RCDPEADP",$J) ; Temp insurance array
S (RCSEQ,VALMCNT)=0
;
; Extract data from 344.4
S RCER=0
F D Q:'RCER
. S RCER=$O(^RCY(344.4,"AEXC",RCER))
. Q:'RCER
. S RCMSG=0
. F D Q:'RCMSG
. . S RCMSG=$O(^RCY(344.4,"AEXC",RCER,RCMSG))
. . Q:'RCMSG
. . S RCSUB=RCMSG_",",DR=".02:.06;.16;.17;.18",DA=RCMSG K DA(1) ;PRCA*4.5*409 Added ;.16;.17;.18
. . ;
. . I RCPAY'="A" D Q:'XX
. . . S XX=$$ISSEL^RCDPEU1(344.4,DA) ; PRCA*4.5*326 Check if payer was selected
. . E I RCTYPE'="A" D Q:'XX ; If all of a give type of payer selected
. . . S XX=$$ISTYPE^RCDPEU1(344.4,DA,RCTYPE) ; Check that payer matches type
. . ;
. . D DIQ3444(DA,DR,.RCDPDATA) ; Extract Trace #, Payer Name/TIN, ERA Date
. . ;
. . ; HIPPA 5010 - display of the Trace # on a separate line due to the increased
. . ; length from 30 to 50 characters
. . S RCX("TRACE")=$G(RCDPDATA(344.4,RCSUB,.02,"E"))
. . S RCX("INCOID")=$G(RCDPDATA(344.4,RCSUB,.03,"E"))
. . S RCX("PAYFROM")=$G(RCDPDATA(344.4,RCSUB,.06,"E"))
. . ;
. . ; Quit if the exception is not for a specified ERA (when called from the ERA worklist)
. . I $G(RCDWLIEN)'="",(RCDWLIEN'=+RCSUB) Q
. . ;
. . S RCDECME=0 ; PRCA*4.5*326 - no point looking for ECME# on data exception. It is not present.
. . S RCS=0,ERAIEN=RCSUB ; PRCA*4.5*409 Added ,ERAIEN=RCSUB
. . F D Q:'RCS
. . . S RCS=$O(^RCY(344.4,"AEXC",RCER,RCMSG,RCS))
. . . Q:'RCS
. . . S RC0=$G(^RCY(344.4,RCMSG,1,RCS,0))
. . . S DA(1)=RCMSG,DA=RCS,RCSUB=DA_","_DA(1)_","
. . . S DR=".01;.02;.03;.05;.07;.08;.1;.11;.12;.15;.24;9.01",DA=RCS
. . . D DIQ3444(.DA,DR,.RCDPDATA)
. . . S RCX1=$$SETSTR^VALM1($E(RCX("PAYFROM"),1,25)_"/"_$E(RCX("INCOID"),1,20),"",9,78)
. . . S RCX("SVCDT")=$$SDATE^RCDPEX4(RCMSG,RCS),RCX("SVCDT")=$E(RCX("SVCDT"),5,6)_"/"_$E(RCX("SVCDT"),7,8)_"/"_$E(RCX("SVCDT"),3,4)
. . . S RCX1=$$SETSTR^VALM1(RCX("SVCDT"),RCX1,63,8)
. . . S RCSEQ=RCSEQ+1
. . . S RCX=$$SETSTR^VALM1($E(RCSEQ_$J("",4),1,4)_" "_$G(RCX("TRACE")),"",1,80)
. . . S XX=$G(RCDPDATA(344.4,RCMSG_",",.04,"I")) ; ERA Date
. . . S RCX=$$SETSTR^VALM1(" "_$$FMTE^XLFDT(XX,"2DZ"),RCX,70,10)
. . . D SET(RCX,RCSEQ,RCMSG,RCS)
. . . D SET(RCX1,RCSEQ,RCMSG,RCS)
. . . ;
. . . ; PRCA*4.5*409 Start
. . . I $G(RCDPDATA(344.4,ERAIEN,.18,"E"))'="" D
. . . . S RCX2=" ***ERA Removed from Worklist on "
. . . . S XX=$G(RCDPDATA(344.4,ERAIEN,.17,"I"))
. . . . S XX=$$FMTE^XLFDT(XX,"2DZ"),RCX2=RCX2_XX
. . . . S RCX2=RCX2_" By: "_$G(RCDPDATA(344.4,ERAIEN,.16,"E"))_"***"
. . . E S RCX2=""
. . . D:RCX2'="" SET(RCX2,RCSEQ,RCMSG,RCS)
. . . S X=$$SETSTR^VALM1($J("",6)_"S: "_$G(RCDPDATA(344.41,RCSUB,.01,"E")),"",1,13)
. . . S XX=$G(RCDPDATA(344.41,RCSUB,.02,"E"))
. . . S RCBILL=$S(XX'="":XX,1:"*"_$G(RCDPDATA(344.41,RCSUB,.05,"E")))
. . . S X=$$SETSTR^VALM1(" Bill: "_RCBILL,X,14,25)
. . . S X=$$SETSTR^VALM1(" Pt: "_$G(RCDPDATA(344.41,RCSUB,.15,"E")),X,39,25)
. . . S X=$$SETSTR^VALM1(" Pd: "_$J(+$G(RCDPDATA(344.41,RCSUB,.03,"E")),"",2),X,65,15)
. . . ;
. . . ; PRCA*4.5*409 End
. . . D SET(X,RCSEQ,RCMSG,RCS)
. . . ;
. . . I +RCDECME D ;PRCA*4.5*298 Display pharmacy data when ECME number is present
. . . . S X=$$SETSTR^VALM1($J("",6)_"ECME #: "_$G(RCDPDATA(344.41,RCSUB,.24,"E")),X,1,28)
. . . . N RCOMMNT,RCRLSDT ; comment & release date
. . . . ; IA #4701, RELEASE DATE for the prescription/fill
. . . . S RCRLSDT=$$RXRLDT^PSOBPSUT($G(RCDPDATA(344.41,RCSUB,.24,"E"))) ; get release date
. . . . S X=$$SETSTR^VALM1(" Release Date: "_$$FMTE^XLFDT(RCRLSDT),X,29,51)
. . . . D SET(X,RCSEQ,RCMSG,RCS)
. . . . S RCOMMNT=$G(RCDPDATA(344.41,RCSUB,9.01,"E")) ; Rx comment
. . . . S X=$$SETSTR^VALM1(" Comment: "_RCOMMNT,X,1,80)
. . . . D SET(X,RCSEQ,RCMSG,RCS)
. . . ;
. . . ;I $P(RC0,U,11) D ; removed PRCA*4.5*345
. . . ;. S X=$J("",10)_"Transferred To: "_$G(RCDPDATA(344.41,RCSUB,.11,"E"))
. . . ;. S XX=$$FMTE^XLFDT($G(RCDPDATA(344.41,RCSUB,.12,"I")),"2DZ")
. . . ;. S X=$$SETSTR^VALM1(" On: "_XX,X,$L(X)+1,25)
. . . ;. D SET(X,RCSEQ,RCMSG,RCS)
. . . S XX=$G(RCDPDATA(344.41,RCSUB,.08,"E"))
. . . S RCEXC=$S($G(RCDPDATA(344.41,RCSUB,.07,"I"))=99:$S(XX'="":XX,1:"UNKNOWN"),1:$G(RCDPDATA(344.41,RCSUB,.07,"E")))
. . . ; PRCA*4.5*298 Remove comment " (TRANSFER NEEDED IF NOT YOURS)"
. . . S X=$J("",10)_"**Exception: "_RCEXC
. . . ;I $P(RC0,U,7)=1 D ; removed PRCA*4.5*345
. . . ; I $P(RC0,U,10)=0 S X=X_" (TRANSFER REJECTED)" Q
. . . ; I $P(RC0,U,16) S X=X_" (TRANSFER ACKNOWLEDGED)" Q
. . . ; S X=X_" (TRANSFER NOT ACKNOWLEDGED)"
. . . D SET(X,RCSEQ,RCMSG,RCS)
;
I '$D(^TMP("RCDPEX_SUM-EOB",$J)) D
. S VALMCNT=2,^TMP("RCDPEX_SUM-EOB",$J,1,0)=" "
. S ^TMP("RCDPEX_SUM-EOB",$J,2,0)=" There Are No EEOB Detail Exceptions On File"
Q
;
FNL ;EP from listman template RCDPEX EOB_SUM EXCEPTION LIST
; Clean up list
K ^TMP("RCDPEX_SUM-EOBDX",$J)
D CLEAN^VALM10
K RCFASTXT
Q
;
SET(X,RCSEQ,RCMSG,RCS) ; Set arrays for EOB exception records
; Input: X - Data to set into the global
; RCSEQ - Listman line #
; RCMSG - IEN for 344.41 multiple
; RCS - IEN for 344.4
; Output: Line added to the listman body
S VALMCNT=VALMCNT+1,^TMP("RCDPEX_SUM-EOB",$J,VALMCNT,0)=X
S ^TMP("RCDPEX_SUM-EOB",$J,"IDX",VALMCNT,RCSEQ)=""
S ^TMP("RCDPEX_SUM-EOBDX",$J,RCSEQ)=VALMCNT_U_RCMSG_U_RCS
Q
;
HDR ;EP from listman template RCDPEX EOB_SUM EXCEPTION LIST
S VALMHDR(1)=$J("",19)_"EEOB DETAIL DATA WITH EXCEPTION CONDITIONS"
;
; HIPPA 5010 - display of the following headers on a separate line due to the
; increased length of Trace # from 30 to 50 characters
S VALMHDR(2)=" # Trace #"_$J("",58)_"EOB Date"
Q
;
DIQ3444(DA,DR,RCPDATA) ; DIQ call to retrieve data for DR fields in file 344.4/344.41
; Input: DA - IEN for file 344.4
; DR - Semi-colon delimitted list of fields to be retrieved
; Output: RCPDATA - Array of selected fields
N %I,D0,DIC,DIQ,DIQ2,FILE,YY
S FILE=$S($D(DA(1)):344.41,1:344.4)
K RCDPDATA(FILE)
D GETS^DIQ(FILE,DA_","_$S($G(DA(1)):DA(1)_",",1:""),DR,"EI","RCDPDATA")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEX2 7722 printed Dec 13, 2024@01:45:56 Page 2
RCDPEX2 ;ALB/TMK/KML/PJH - ELECTRONIC EOB DETAIL EXCEPTION MAIN LIST TEMPLATE ;20 Dec 2018 17:20:51
+1 ;;4.5;Accounts Receivable;**173,269,298,304,326,345,409,424**;Mar 20, 1995;Build 11
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
INIT ;EP from listman template RCDPEX EOB_SUM EXCEPTION LIST
+1 ; set up initial variables
+2 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+3 DO BLD
+4 QUIT
+5 ;
REBLD ; Set up formatted global
+1 ;
BLD ;EP from RCDPEX3,RCDPEX31,RCDEPEX32
+1 ; Build list of messages from file 344.4
+2 ; Input: RCDWLIEN - Optional set to a selected ERA if the user opts to see
+3 ; exceptions after receiving an 'ACCESS DENIED' message
+4 ; in the ERA WORKLIST when they tried to create a scratch
+5 ; pad for the ERA (EXCDENY^RCDPEWLP). Otherwise, undefined
+6 ; RCPAY 'R' = RANGE, 'S' = SELECTED, 'A' = ALL
+7 ; RCTYPE - 'M' - Only display Medical Exceptions
+8 ; 'P' - Only display Pharmacy Exceptions
+9 ; 'T' - Tricare
+10 ; 'A' - Display Medical and Pharmacy and Tricare Exceptions
+11 ; ^TMP(^TMP("RCDPEU1",$J) holds selected payers to display.
+12 ;
+13 NEW DA,DR,ERAIEN,RC0,RCBILL,RCDECME,RCDPDATA,RCPYRIEN,RCER,RCEXC,RCMSG1,RCS,RCSEQ,RCSUB
+14 ;PRCA*4.5*409 Added ERAIEN,RCX2
NEW RCX,RCX1,RCX2,X,XX,Y,YY
+15 KILL ^TMP("RCDPEX_SUM-EOB",$JOB),^TMP("RCDPEX_SUM-EOBDX",$JOB)
+16 ; Temp insurance array
KILL ^TMP("RCDPEADP",$JOB)
+17 SET (RCSEQ,VALMCNT)=0
+18 ;
+19 ; Extract data from 344.4
+20 SET RCER=0
+21 FOR
Begin DoDot:1
+22 SET RCER=$ORDER(^RCY(344.4,"AEXC",RCER))
+23 if 'RCER
QUIT
+24 SET RCMSG=0
+25 FOR
Begin DoDot:2
+26 SET RCMSG=$ORDER(^RCY(344.4,"AEXC",RCER,RCMSG))
+27 if 'RCMSG
QUIT
+28 ;PRCA*4.5*409 Added ;.16;.17;.18
SET RCSUB=RCMSG_","
SET DR=".02:.06;.16;.17;.18"
SET DA=RCMSG
KILL DA(1)
+29 ;
+30 IF RCPAY'="A"
Begin DoDot:3
+31 ; PRCA*4.5*326 Check if payer was selected
SET XX=$$ISSEL^RCDPEU1(344.4,DA)
End DoDot:3
if 'XX
QUIT
+32 ; If all of a give type of payer selected
IF '$TEST
IF RCTYPE'="A"
Begin DoDot:3
+33 ; Check that payer matches type
SET XX=$$ISTYPE^RCDPEU1(344.4,DA,RCTYPE)
End DoDot:3
if 'XX
QUIT
+34 ;
+35 ; Extract Trace #, Payer Name/TIN, ERA Date
DO DIQ3444(DA,DR,.RCDPDATA)
+36 ;
+37 ; HIPPA 5010 - display of the Trace # on a separate line due to the increased
+38 ; length from 30 to 50 characters
+39 SET RCX("TRACE")=$GET(RCDPDATA(344.4,RCSUB,.02,"E"))
+40 SET RCX("INCOID")=$GET(RCDPDATA(344.4,RCSUB,.03,"E"))
+41 SET RCX("PAYFROM")=$GET(RCDPDATA(344.4,RCSUB,.06,"E"))
+42 ;
+43 ; Quit if the exception is not for a specified ERA (when called from the ERA worklist)
+44 IF $GET(RCDWLIEN)'=""
IF (RCDWLIEN'=+RCSUB)
QUIT
+45 ;
+46 ; PRCA*4.5*326 - no point looking for ECME# on data exception. It is not present.
SET RCDECME=0
+47 ; PRCA*4.5*409 Added ,ERAIEN=RCSUB
SET RCS=0
SET ERAIEN=RCSUB
+48 FOR
Begin DoDot:3
+49 SET RCS=$ORDER(^RCY(344.4,"AEXC",RCER,RCMSG,RCS))
+50 if 'RCS
QUIT
+51 SET RC0=$GET(^RCY(344.4,RCMSG,1,RCS,0))
+52 SET DA(1)=RCMSG
SET DA=RCS
SET RCSUB=DA_","_DA(1)_","
+53 SET DR=".01;.02;.03;.05;.07;.08;.1;.11;.12;.15;.24;9.01"
SET DA=RCS
+54 DO DIQ3444(.DA,DR,.RCDPDATA)
+55 SET RCX1=$$SETSTR^VALM1($EXTRACT(RCX("PAYFROM"),1,25)_"/"_$EXTRACT(RCX("INCOID"),1,20),"",9,78)
+56 SET RCX("SVCDT")=$$SDATE^RCDPEX4(RCMSG,RCS)
SET RCX("SVCDT")=$EXTRACT(RCX("SVCDT"),5,6)_"/"_$EXTRACT(RCX("SVCDT"),7,8)_"/"_$EXTRACT(RCX("SVCDT"),3,4)
+57 SET RCX1=$$SETSTR^VALM1(RCX("SVCDT"),RCX1,63,8)
+58 SET RCSEQ=RCSEQ+1
+59 SET RCX=$$SETSTR^VALM1($EXTRACT(RCSEQ_$JUSTIFY("",4),1,4)_" "_$GET(RCX("TRACE")),"",1,80)
+60 ; ERA Date
SET XX=$GET(RCDPDATA(344.4,RCMSG_",",.04,"I"))
+61 SET RCX=$$SETSTR^VALM1(" "_$$FMTE^XLFDT(XX,"2DZ"),RCX,70,10)
+62 DO SET(RCX,RCSEQ,RCMSG,RCS)
+63 DO SET(RCX1,RCSEQ,RCMSG,RCS)
+64 ;
+65 ; PRCA*4.5*409 Start
+66 IF $GET(RCDPDATA(344.4,ERAIEN,.18,"E"))'=""
Begin DoDot:4
+67 SET RCX2=" ***ERA Removed from Worklist on "
+68 SET XX=$GET(RCDPDATA(344.4,ERAIEN,.17,"I"))
+69 SET XX=$$FMTE^XLFDT(XX,"2DZ")
SET RCX2=RCX2_XX
+70 SET RCX2=RCX2_" By: "_$GET(RCDPDATA(344.4,ERAIEN,.16,"E"))_"***"
End DoDot:4
+71 IF '$TEST
SET RCX2=""
+72 if RCX2'=""
DO SET(RCX2,RCSEQ,RCMSG,RCS)
+73 SET X=$$SETSTR^VALM1($JUSTIFY("",6)_"S: "_$GET(RCDPDATA(344.41,RCSUB,.01,"E")),"",1,13)
+74 SET XX=$GET(RCDPDATA(344.41,RCSUB,.02,"E"))
+75 SET RCBILL=$SELECT(XX'="":XX,1:"*"_$GET(RCDPDATA(344.41,RCSUB,.05,"E")))
+76 SET X=$$SETSTR^VALM1(" Bill: "_RCBILL,X,14,25)
+77 SET X=$$SETSTR^VALM1(" Pt: "_$GET(RCDPDATA(344.41,RCSUB,.15,"E")),X,39,25)
+78 SET X=$$SETSTR^VALM1(" Pd: "_$JUSTIFY(+$GET(RCDPDATA(344.41,RCSUB,.03,"E")),"",2),X,65,15)
+79 ;
+80 ; PRCA*4.5*409 End
+81 DO SET(X,RCSEQ,RCMSG,RCS)
+82 ;
+83 ;PRCA*4.5*298 Display pharmacy data when ECME number is present
IF +RCDECME
Begin DoDot:4
+84 SET X=$$SETSTR^VALM1($JUSTIFY("",6)_"ECME #: "_$GET(RCDPDATA(344.41,RCSUB,.24,"E")),X,1,28)
+85 ; comment & release date
NEW RCOMMNT,RCRLSDT
+86 ; IA #4701, RELEASE DATE for the prescription/fill
+87 ; get release date
SET RCRLSDT=$$RXRLDT^PSOBPSUT($GET(RCDPDATA(344.41,RCSUB,.24,"E")))
+88 SET X=$$SETSTR^VALM1(" Release Date: "_$$FMTE^XLFDT(RCRLSDT),X,29,51)
+89 DO SET(X,RCSEQ,RCMSG,RCS)
+90 ; Rx comment
SET RCOMMNT=$GET(RCDPDATA(344.41,RCSUB,9.01,"E"))
+91 SET X=$$SETSTR^VALM1(" Comment: "_RCOMMNT,X,1,80)
+92 DO SET(X,RCSEQ,RCMSG,RCS)
End DoDot:4
+93 ;
+94 ;I $P(RC0,U,11) D ; removed PRCA*4.5*345
+95 ;. S X=$J("",10)_"Transferred To: "_$G(RCDPDATA(344.41,RCSUB,.11,"E"))
+96 ;. S XX=$$FMTE^XLFDT($G(RCDPDATA(344.41,RCSUB,.12,"I")),"2DZ")
+97 ;. S X=$$SETSTR^VALM1(" On: "_XX,X,$L(X)+1,25)
+98 ;. D SET(X,RCSEQ,RCMSG,RCS)
+99 SET XX=$GET(RCDPDATA(344.41,RCSUB,.08,"E"))
+100 SET RCEXC=$SELECT($GET(RCDPDATA(344.41,RCSUB,.07,"I"))=99:$SELECT(XX'="":XX,1:"UNKNOWN"),1:$GET(RCDPDATA(344.41,RCSUB,.07,"E")))
+101 ; PRCA*4.5*298 Remove comment " (TRANSFER NEEDED IF NOT YOURS)"
+102 SET X=$JUSTIFY("",10)_"**Exception: "_RCEXC
+103 ;I $P(RC0,U,7)=1 D ; removed PRCA*4.5*345
+104 ; I $P(RC0,U,10)=0 S X=X_" (TRANSFER REJECTED)" Q
+105 ; I $P(RC0,U,16) S X=X_" (TRANSFER ACKNOWLEDGED)" Q
+106 ; S X=X_" (TRANSFER NOT ACKNOWLEDGED)"
+107 DO SET(X,RCSEQ,RCMSG,RCS)
End DoDot:3
if 'RCS
QUIT
End DoDot:2
if 'RCMSG
QUIT
End DoDot:1
if 'RCER
QUIT
+108 ;
+109 IF '$DATA(^TMP("RCDPEX_SUM-EOB",$JOB))
Begin DoDot:1
+110 SET VALMCNT=2
SET ^TMP("RCDPEX_SUM-EOB",$JOB,1,0)=" "
+111 SET ^TMP("RCDPEX_SUM-EOB",$JOB,2,0)=" There Are No EEOB Detail Exceptions On File"
End DoDot:1
+112 QUIT
+113 ;
FNL ;EP from listman template RCDPEX EOB_SUM EXCEPTION LIST
+1 ; Clean up list
+2 KILL ^TMP("RCDPEX_SUM-EOBDX",$JOB)
+3 DO CLEAN^VALM10
+4 KILL RCFASTXT
+5 QUIT
+6 ;
SET(X,RCSEQ,RCMSG,RCS) ; Set arrays for EOB exception records
+1 ; Input: X - Data to set into the global
+2 ; RCSEQ - Listman line #
+3 ; RCMSG - IEN for 344.41 multiple
+4 ; RCS - IEN for 344.4
+5 ; Output: Line added to the listman body
+6 SET VALMCNT=VALMCNT+1
SET ^TMP("RCDPEX_SUM-EOB",$JOB,VALMCNT,0)=X
+7 SET ^TMP("RCDPEX_SUM-EOB",$JOB,"IDX",VALMCNT,RCSEQ)=""
+8 SET ^TMP("RCDPEX_SUM-EOBDX",$JOB,RCSEQ)=VALMCNT_U_RCMSG_U_RCS
+9 QUIT
+10 ;
HDR ;EP from listman template RCDPEX EOB_SUM EXCEPTION LIST
+1 SET VALMHDR(1)=$JUSTIFY("",19)_"EEOB DETAIL DATA WITH EXCEPTION CONDITIONS"
+2 ;
+3 ; HIPPA 5010 - display of the following headers on a separate line due to the
+4 ; increased length of Trace # from 30 to 50 characters
+5 SET VALMHDR(2)=" # Trace #"_$JUSTIFY("",58)_"EOB Date"
+6 QUIT
+7 ;
DIQ3444(DA,DR,RCPDATA) ; DIQ call to retrieve data for DR fields in file 344.4/344.41
+1 ; Input: DA - IEN for file 344.4
+2 ; DR - Semi-colon delimitted list of fields to be retrieved
+3 ; Output: RCPDATA - Array of selected fields
+4 NEW %I,D0,DIC,DIQ,DIQ2,FILE,YY
+5 SET FILE=$SELECT($DATA(DA(1)):344.41,1:344.4)
+6 KILL RCDPDATA(FILE)
+7 DO GETS^DIQ(FILE,DA_","_$SELECT($GET(DA(1)):DA(1)_",",1:""),DR,"EI","RCDPDATA")
+8 QUIT
+9 ;
