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