Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPESR0

RCDPESR0.m

Go to the documentation of this file.
  1. RCDPESR0 ;ALB/TMK/DWA - Server auto-update utilities - EDI Lockbox ; 9/30/10 6:05pm
  1. ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ; IA for read access to ^IBM(361.1 = 4051
  1. ;
  1. DISP(RCMIN,RCMOUT,RCFMT,RCFULL,RCW,RC3444) ; Format the 835 return msg
  1. ; RCMIN = the name of the array that contains the raw message data
  1. ; The data is contained at the next level and the subscript is
  1. ; numeric and greater than 0 or the data can be at the
  1. ; 0-node subsequent to the final subscript.
  1. ; If the message array is a global ^TMP($J,"MSG",n), RCMIN
  1. ; will equal "^TMP($J,""MSG"")" and the message text will be
  1. ; in ^TMP($J,"MSG",1), ^TMP($J,"MSG",2), etc. OR
  1. ; the message text can be defined at TMP($J,"MSG",1,0) ^...,2,0)
  1. ; etc.
  1. ; RCMOUT = the name of the array that should be returned. This array
  1. ; will follow the same convention as the input array. The
  1. ; array will be returned with a numeric final subscript. If
  1. ; RCMOUT is passed as "^TMP($J,""MSG1"")", then the display
  1. ; lines will be returned in ^TMP($J,"MSG1",1),
  1. ; ^TMP($J,"MSG1",2), etc. Note the array RCMOUT is killed
  1. ; on entry to this call
  1. ; RCFMT = 0 or null if call should return raw data, 1 to execute the
  1. ; transforms attached to the fields
  1. ; RCFULL = the name of an array if the data should be returned in
  1. ; this array, formatted into lines for display. If not sent,
  1. ; only the display data by element is returned in RCMOUT. If
  1. ; RCFULL is sent, the array is killed before populating it
  1. ; RCW = max # of characters per line to return in array RCFULL
  1. ; RC3444 = flag that indicates only return bill data, not header data
  1. ;
  1. N Z,Z0,Z1,RC,RCCT,RCREF,RCDATA,RCQ,R
  1. S RCCT=0,RCREF="" K @RCMOUT
  1. S Z=0 F S Z=$O(@RCMIN@(Z)) Q:'Z S Z0=$S($G(@RCMIN@(Z))'="":@RCMIN@(Z),1:$G(@RCMIN@(Z,0))) I Z0'="" S RCQ=0 D
  1. . I '$G(RCV5),+$P(Z0,U)=835,+$P(Z0,U,16)>0 S RCV5=1
  1. . F Z1=1:1:$L(Z0,U) I $P(Z0,U,Z1)'="" D Q:RCQ
  1. .. S RCDATA=$P(Z0,U,Z1)
  1. .. I Z1=1 D Q:RCQ
  1. ... S RC=""
  1. ... I RCDATA'="",RCDATA?.N.A,$G(RCV5) D
  1. .... S RCREF=$S($E(RCDATA,1,3)'="835":$E(RCDATA,1,8),1:"835"),R=RCREF_"^RCDPES10",RC=$P($T(@R),";;",2)
  1. ... I RCDATA'="",RCDATA?.N.A,'$G(RCV5) D
  1. .... S RCREF=$S($E(RCDATA,1,3)'="835":$E(RCDATA,1,8),1:"835"),R=RCREF_"^RCDPESR9",RC=$P($T(@R),";;",2)
  1. ... I RC="" S RCCT=RCCT+1,@RCMOUT@(RCCT)="<<<INVALID LINE TYPE - RAW DATA IS:",RCCT=RCCT+1,@RCMOUT@(RCCT)=Z0,RCDATA=""
  1. .. Q:RCDATA=""!(RCREF="")!$S(RCREF="835":$G(RC3444),1:0)
  1. .. S RC=""
  1. .. I RCREF?.A.N,$G(RCV5) D
  1. ... S R=RCREF_"+"_Z1_"^RCDPES10",RC=$P($T(@R),";;",2)
  1. .. I RCREF?.A.N,'$G(RCV5) D
  1. ... S R=RCREF_"+"_Z1_"^RCDPESR9",RC=$P($T(@R),";;",2)
  1. .. I RC=""!($P(RC,U)'=RCREF) S:$S(RCDATA'="":1,1:'$P(RC,U,2)) RCCT=RCCT+1,@RCMOUT@(RCCT)="NO DATA DEFINITION PC "_Z1_": "_RCDATA Q
  1. .. I RC'="" D
  1. ... N X,X1,Y
  1. ... S X1=$P(RC,U,4,99)
  1. ... I $G(RCFMT),X1'="" S X=RCDATA X X1 S RCDATA=Y ; Output transform
  1. ... Q:RCDATA=""&($P(RC,U,2)) ; Don't output if null data
  1. ... S RC=$P(RC,U,3)
  1. ... S RCCT=RCCT+1,@RCMOUT@(RCCT)=$S(Z1=1:"<<<",1:"")_RC_": "_RCDATA_$S(Z1=1:">>>",1:"")
  1. I $G(RCFULL)'="" D FMTDSP(RCMOUT,RCFULL,$G(RCW),$G(RC3444))
  1. Q
  1. ;
  1. FMTDSP(RCMUN,RCMFO,RCW,RCNOH05) ; Format the display data in array named in
  1. ; RCMUN into lines up to RCW characters wide RCMUN must be set up the
  1. ; same as the output of the DISP call above
  1. ; Returns array named in RCMFO with the last subscript being the line #
  1. ; Note @RCMFO is killed on entry to this call
  1. ; Default is 80 if RCW=0 or null
  1. ; RCNOH05 = flag that if =1, suppresses the '05' header
  1. ;
  1. N Z,RCLINE,RCCT,RCCT1,RCMID,RCD,RCSTART,RCLINE,RCDASH
  1. K @RCMFO
  1. S:'$G(RCW) RCW=80
  1. S RCDASH=" "_$TR($J("",RCW-2)," ","-")
  1. S (RCCT,RCCT1)=0,RCLINE="",RCMID=RCW\2-1
  1. S Z=0 F S Z=$O(@RCMUN@(Z)) Q:'Z S RCD=$G(@RCMUN@(Z)) D
  1. . I $E(RCD,1,3)="<<<" D Q ; New line needed ... record start
  1. .. I $L(RCLINE)>0 S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
  1. .. I $L(RCLINE)=0 D
  1. ... I Z>1 S RCCT=RCCT+1,@RCMFO@(RCCT)=" "
  1. ... I RCD["<<<Line Type: 05 ",'$G(RCNOH05) S RCCT1=RCCT1+1,RCCT=RCCT+1,@RCMFO@(RCCT)=RCDASH,RCCT=RCCT+1,@RCMFO@(RCCT)="****** ERA DETAIL START ******",RCCT=RCCT+1,@RCMFO@(RCCT)=RCDASH
  1. ... I $L(RCD)>RCW D Q
  1. .... S RCSTART=1
  1. .... F S RCCT=RCCT+1,@RCMFO@(RCCT)=$E(RCD,RCSTART,RCSTART+RCW-1),RCSTART=RCSTART+RCW Q:RCSTART>$L(RCD)
  1. ... S RCCT=RCCT+1,@RCMFO@(RCCT)=RCD
  1. . ;
  1. . I $L(RCD)>RCW D Q ; Split line if greater than width given
  1. .. I $L(RCLINE) S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE
  1. .. S RCSTART=1
  1. .. F S RCCT=RCCT+1,@RCMFO@(RCCT)=$E(RCD,RCSTART,RCSTART+RCW-1),RCSTART=RCSTART+RCW Q:RCSTART>$L(RCD)
  1. .. S RCLINE=""
  1. . I $L(RCLINE)=0 D Q ; Format left side of line
  1. .. S RCLINE=RCD
  1. .. ;
  1. .. I $L(RCLINE)>RCMID S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
  1. . ;
  1. . I (RCMID+$L(RCD)+1)>RCW D Q ; data too long for right side of line
  1. .. S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCCT=RCCT+1,@RCMFO@(RCCT)=RCD,RCLINE=""
  1. . S RCLINE=$E(RCLINE_$J("",RCMID),1,RCMID)_" "_RCD,RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
  1. I $L(RCLINE) S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE
  1. Q
  1. ;
  1. BULLERA(RC,RCTDA,RCXMG,RCSUBJ,RCERR,RCTYP) ; Send a bulletin for entries in 344.5
  1. ; RC = flags for data to include (one or more can can be used)
  1. ; 'D': display text 'R': raw data 'F': formatted data from raw
  1. ; data in file 344.5
  1. ; RCTDA = ien of the entry in file 344.5
  1. ; RCXMG = mail msg # for the ERA
  1. ; RCSUBJ = subject of the bulletin
  1. ; RCERR = error text in array or name of error global
  1. ; RCTYP = if 0:ERA 1:EEOB
  1. ;
  1. N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,Z,Z0,CT,RCXM,RCVAR
  1. K ^TMP("RCXM_344.5",$J)
  1. S RCERR=$G(RCERR)
  1. S RCVAR=$S($E(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
  1. S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")="",CT=0,RCTYP=$S('$G(RCTYP):"ERA",1:"EEOB")
  1. S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="The following electronic "_RCTYP_" was received at your site.",CT=CT+1,^TMP("RCXM_344.5",$J,CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
  1. S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="This message is sent to alert you to conditions regarding this "_RCTYP_".",CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
  1. I RC["D" D DTXT(RCTDA,.RCXM,.CT) M ^TMP("RCXM_344.5",$J)=RCXM K RCXM
  1. S Z=0 F S Z=$O(@RCVAR@(Z)) Q:'Z I $D(@RCVAR@(Z,"*")) S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z,"*")
  1. I $G(RCERR)'="",RCVAR="RCERR" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=RCERR,CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
  1. I $O(@RCVAR@(""))'="" D
  1. . S Z="" F S Z=$O(@RCVAR@(Z)) Q:Z="" D
  1. .. I $G(@RCVAR@(Z))'="" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z)
  1. .. I $O(@RCVAR@(Z,0)) S Z0="" F S Z0=$O(@RCVAR@(Z,Z0)) Q:Z0="" I Z0'="*" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z,Z0)
  1. I RC["F" D
  1. . N RCCT1
  1. . S RCCT1=0
  1. . K ^TMP($J,"PRCAZ_RAW"),^TMP($J,"PRCAZ_FMT1"),^TMP($J,"PRCAZ_FMT")
  1. . D DISP("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCAZ_FMT1"")",1,"^TMP($J,""PRCAZ_FMT"")",75)
  1. . S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="FORMATTED DATA: "
  1. . S Z=0 F S Z=$O(^TMP($J,"PRCAZ_FMT",Z)) Q:'Z S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=^TMP($J,"PRCAZ_FMT",Z)
  1. . S:RC["R" CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
  1. I RC["R" D
  1. . S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="RAW DATA: "
  1. . S Z=0 F S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=$G(^RCY(344.5,RCTDA,2,Z,0))
  1. S XMBODY="^TMP(""RCXM_344.5"",$J)"
  1. D
  1. . N DUZ S DUZ=.5,DUZ(0)="@"
  1. . D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
  1. K ^TMP($J,"PRCAZ_RAW"),^TMP($J,"PRCAZ_FMT1"),^TMP($J,"PRCAZ_FMT"),^TMP("RCXM_344.5",$J)
  1. Q
  1. ;
  1. BULLEFT(RCTDA,RCXMG,RCSUBJ,RCERR) ; Send a bulletin for 'bad' EFT entries
  1. ; RCTDA = ien of the entry in file 344.3
  1. ; RCXMG = mail msg # for the EFT
  1. ; RCSUBJ = subject of the bulletin
  1. ; RCERR = error text in array
  1. N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z,Z0,CT
  1. S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")="",CT=0
  1. S CT=CT+1,RCXM(CT)="The following electronic EFT deposit was received at your site.",CT=CT+1,RCXM(CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
  1. S CT=CT+1,RCXM(CT)="This message is sent to alert you to conditions regarding this EFT.",CT=CT+1,RCXM(CT)=" "
  1. I $G(RCERR)'="" S CT=CT+1,RCXM(CT)=RCERR,CT=CT+1,RCXM(CT)=" "
  1. I $O(RCERR(""))'="" D
  1. . S Z="" F S Z=$O(RCERR(Z)) Q:Z="" D
  1. .. I $G(RCERR(Z))'="" S CT=CT+1,RCXM(CT)=RCERR(Z)
  1. .. I $O(RCERR(Z,0)) S Z0="" F S Z0=$O(RCERR(Z,Z0)) Q:Z0="" S CT=CT+1,RCXM(CT)=RCERR(Z,Z0)
  1. S XMBODY="RCXM"
  1. D
  1. . N DUZ S DUZ=.5,DUZ(0)="@"
  1. . D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
  1. Q
  1. ;
  1. DTXT(RCTDA,RCXM,RCNT) ; Add display text to array RCXM(CT)
  1. ; RCTDA = ien of entry in file 344.5
  1. ; Send RCNT and RCXM by reference for return values
  1. N RCDIQ
  1. D GETS^DIQ(344.5,RCTDA_",",1,"EN","RCDIQ")
  1. D TXTDE^RCDPEX(RCTDA,.RCDIQ,1,.RCXM,.RCNT)
  1. Q
  1. ;
  1. BILLREF(RC3444,RC34441) ; Returns the bill # for the EOB in file 344.4, entry
  1. ; number RC3444 and subfile entry RC34441
  1. N RCARR
  1. D DIQ34441^RCDPEDS(RC3444,RC34441,99,"RCARR")
  1. Q $G(RCARR(344.41,RC34441,99,"E"))
  1. ;
  1. GETBILL(DA) ; Called from computed field to find bill reference
  1. ; Assumes DA(1)= ien of file 344.4, DA = ien of file 344.41
  1. N Z,VAL
  1. S Z=$G(^RCY(344.4,DA(1),1,DA,0))
  1. I $P(Z,U,2) S VAL=$$BN1^PRCAFN(+$G(^IBM(361.1,+$P(Z,U,2),0))) ; IA 4051
  1. I $G(VAL)="" S VAL=$P(Z,U,5)
  1. Q VAL
  1. ;