- 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 Feb 18, 2025@23:10:57 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 ;