- RCXVDC3 ;DAOU/ALA-AR Data Extraction Data Creation ; 23 Jul 2007 10:32 AM
- ;;4.5;Accounts Receivable;**201,227,228,232,248,251,270**;Mar 20, 1995;Build 25
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; CLAIMS (# 399)
- Q
- D399 ;
- NEW RCXVD,RCXVBC,RCXVDT,RCXVD1,RCXVD2,RCXVD3
- NEW RCXVD4,RCXVD5,RCXVD6,RCXVD7,RCXVDA,RCXVDB,RCXVDC,RCXVDD
- NEW RCXVP1,RCXVP2,RCXVD0C,RCXVP3,RCXVP4,RCXVP5,RCXVCFL,RCXVPAY
- NEW RCXVINS,RCXVVAN,RCXVDRG,RCXVCAN,RCXVSNR,IBD,X1,X2,RCXVNPI
- ;
- ;WCJ;PRCA*4.5*270;Start
- ;I $P(RCXVBLNA,"-",2)="" Q
- ;S RCXVD0=$O(^DGCR(399,"B",$P(RCXVBLNA,"-",2),""))
- ;I RCXVD0="" Q
- Q:'+$G(RCXVBLN)
- S RCXVD0=RCXVBLN
- ;WCJ;PRCA*4.5*270;End
- ;
- S RCXVD1=$G(^DGCR(399,RCXVD0,0))
- Q:RCXVD1="" ;WCJ;PRCA*4.5*270
- I $G(DFN)="" S DFN=$P(RCXVD1,U,2)
- Q:'DFN ;WCJ;PRCA*4.5*270
- S RCXVD2=$G(^DGCR(399,RCXVD0,"S"))
- S RCXVD3=$G(^DGCR(399,RCXVD0,"U"))
- S RCXVD7=$G(^DGCR(399,RCXVD0,"TX"))
- S RCXVDA=$P(RCXVD1,U,1) ; BILL #
- S (RCXVEVDT,RCXVDT)=$P($P(RCXVD1,U,3),".",1)
- ;S RCXVDA=RCXVBLNB_RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; EVNT DT
- S RCXVDA=RCXVBLNA_RCXVU_$P(^DPT(DFN,0),U,9) ; SSN
- S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; EVNT DT
- S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,5) ; BILL CLASS
- S RCXVP1=$P(RCXVD1,U,7),RCXVP2=""
- I RCXVP1'="" S RCXVP2=$P($G(^DGCR(399.3,RCXVP1,0)),U,1)
- S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; RATE TYPE (P)
- S RCXVP1=$P(RCXVD2,U,11),RCXVP2=""
- I RCXVP1'="" S RCXVP2=$P($G(^VA(200,RCXVP1,2,0)),U,1)_RCXVP1 ; SITE_IEN
- S RCXVDA=RCXVDA_RCXVU_RCXVSITE_RCXVP2 ; Authorizer (P)
- S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,13) ; Stat
- S RCXVDT=$P(RCXVD1,U,14)
- S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Stat DT
- S RCXVP1=$P(RCXVD1,U,22),RCXVP2="",RCXVNPI=""
- I RCXVP1'="" S RCXVP2=$$GET1^DIQ(40.8,RCXVP1,1) ;$P($G(^DG(40.8,RCXVP1,0)),U,2)
- S:$G(RCXVP1)'="" RCXVNPI=$P($$NPI^XUSNPI("Organization_ID",$$GET1^DIQ(40.8,RCXVP1,.07,"I")),RCXVU,1) S:+RCXVNPI<1 RCXVNPI="" ;Default Division NPI
- S RCXVDA=RCXVDA_RCXVU_RCXVP2_RCXVU_RCXVNPI ; Default division^Default division NPI
- S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,24) ; UB92 Location
- S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,27) ; Bill Chrg type
- S RCXVDT=$P(RCXVD2,U,10)
- S RCXVDB=$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Auth. DT
- S RCXVDT=$P(RCXVD2,U,12)
- S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT 1st printed
- S (RCXVP1,RCXVD0C)=$P($G(^DGCR(399,RCXVD0,"M")),U,1),RCXVP2=""
- I RCXVP1'="" S RCXVP2=$P($G(^DIC(36,RCXVP1,0)),U,1)
- S RCXVDB=RCXVDB_RCXVU_RCXVP2 ; PRIM. INSR (P)
- ;
- ; Type of Plan
- S RCXVP2="",RCXVI=0,RCXVP3="",RCXVP4="",RCXVP5=""
- S IBD=$$IBAREXT^IBRFN4(RCXVD0,.IBD)
- S RCXVP2=$P(IBD("IN"),U),RCXVP5=$P(IBD("IN"),U,2),RCXVP3=$P(IBD("IN"),U,3),RCXVP4=$P(IBD("IN"),U,4)
- S RCXVDB=RCXVDB_RCXVU_RCXVP2_RCXVU_RCXVP5_RCXVU_RCXVP3_RCXVU_RCXVP4,RCXVD5="",RCXVD6=""
- ;
- ; 36, 36.3 ADDRESS/EDI
- I RCXVD0C S RCXVD5=$G(^DIC(36,RCXVD0C,.11))
- S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,1) ; STRT ADD 1
- S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,2) ; STRT ADD 2
- S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,4) ; CITY
- S RCXVP1=$P(RCXVD5,U,5),RCXVP2=""
- I RCXVP1'="" S RCXVP2=$P($G(^DIC(5,RCXVP1,0)),U,1)
- S RCXVDB=RCXVDB_RCXVU_RCXVP2 ; STATE (P)
- S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,6) ; ZIP
- I RCXVD0C'="" S RCXVD6=$G(^DIC(36,RCXVD0C,3))
- S RCXVDB=RCXVDB_RCXVU_$P(RCXVD6,U,2) ; EDI - PROF
- S RCXVDB=RCXVDB_RCXVU_$P(RCXVD6,U,4) ; EDI - INST
- S RCXVDB=RCXVDB_RCXVU_$$GET1^DIQ(36,RCXVD0C_",",1,"I") ; REIMBURSE?
- ;
- S RCXVPFDT=$P(RCXVD3,U,1)
- S RCXVDC=$$HLDATE^HLFNC(RCXVPFDT) ; STMT COVERS FROM
- S RCXVPTDT=$P(RCXVD3,U,2)
- S RCXVDC=RCXVDC_RCXVU_$$HLDATE^HLFNC(RCXVPTDT) ; STMT COVERS TO
- S RCXVP1=$P(RCXVD3,U,11),RCXVP2=""
- I RCXVP1'="" S RCXVP2=$P($G(^DGCR(399.1,RCXVP1,0)),U,1)
- S RCXVDC=RCXVDC_RCXVU_RCXVP2 ; DISCH. BED SEC.
- S RCXVD4=$G(^DGCR(399,RCXVD0,"U1"))
- S RCXVDC=RCXVDC_RCXVU_$P(RCXVD4,U,1) ; TOT CHRG
- ;
- S RCXVP1=$P($G(^DGCR(399,RCXVD0,"U2")),U,10),RCXVP2="",RCXVNPI=""
- I RCXVP1'="" S RCXVP2=$P($G(^IBA(355.93,RCXVP1,0)),U,1)
- S:$G(RCXVP2)'="" RCXVNPI=$P($$NPI^XUSNPI("Non_VA_Provider_ID",RCXVP1),RCXVU,1) S:+RCXVNPI<1 RCXVNPI=""
- I RCXVNPI="",$G(RCXVP2)'="" S RCXVNPI=$$GET1^DIQ(355.93,RCXVP1,41.01,"I") ;This line is used if the XUSNPI API does not work
- S RCXVDC=RCXVDC_RCXVU_RCXVP2_RCXVU_RCXVNPI ; NON VA FAC (P)^NON VA FAC NPI
- ;
- ; Get VACARE or NONVACARE flag
- NEW RCXVIEN
- D CARE^RCXVUTIL(RCXVD0)
- S RCXVDC=RCXVDC_RCXVU_$S(RCXVCFL=1:"VACARE",1:"NONVACARE")
- ; MRA data
- S RCXVDT=$P(IBD,U,2)
- S RCXVDD=$E($$HLDATE^HLFNC(RCXVDT),1,8) ; MRA Requested DT
- S RCXVDT=$P(IBD,U,3)
- S RCXVDD=RCXVDD_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Last Electronic Extract Date
- S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,4) ;Printed VIA EDI
- S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,5) ;Force Claim To Print
- S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,6) ;Claim MRA Status
- S RCXVDT=$P(IBD,U,7)
- S RCXVDD=RCXVDD_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;MRA Recorded Date
- S RCXVDT=$P(IBD,U,8)
- S RCXVDD=RCXVDD_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Date Cancelled
- S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,9) ;Form Type
- S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,16)_RCXVU_$P(IBD,U,15) ;PAYER&VA NAT.ID #
- S RCXVDRG=$P(IBD,U,11)
- S RCXVDD=RCXVDD_RCXVU_RCXVDRG ;DRG
- S RCXVSNR=$P(IBD,U,14) ;Days site not responsible for MRA request
- S RCXVDD=RCXVDD_RCXVU_RCXVSNR
- S RCXVDD=RCXVDD_RCXVU_$P($P(IBD,U,12),";") ;ECME #
- S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,17) ;Offset Amount
- S ^TMP($J,RCXVBLN,"3-399A")=RCXVDA
- S ^TMP($J,RCXVBLN,"3-399B")=RCXVDB
- S ^TMP($J,RCXVBLN,"3-399C")=RCXVDC
- S ^TMP($J,RCXVBLN,"3-399D")=RCXVDD
- Q
- ;
- REJ() ;Checks for reject on a claim
- S X="NO"
- S X1=$P(RCXVD1,U,15) S D0=RCXVD0
- F D G REJQ:'D0
- . S I=0 F S I=$O(^IBM(361,"B",D0,I)) Q:'I D Q:'D0
- ..S X2=$P($G(^IBM(361,I,0)),U,3)
- ..I X2="R" S X="YES",D0=""
- ..Q
- .I X="YES" Q
- .I X1=D0 S D0="" Q
- .S D0=X1 Q:'D0 S X1=$P($G(^DGCR(399,X1,0)),U,15)
- .Q
- K I
- REJQ Q X
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVDC3 5915 printed Jan 18, 2025@02:50:45 Page 2
- RCXVDC3 ;DAOU/ALA-AR Data Extraction Data Creation ; 23 Jul 2007 10:32 AM
- +1 ;;4.5;Accounts Receivable;**201,227,228,232,248,251,270**;Mar 20, 1995;Build 25
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; CLAIMS (# 399)
- +5 QUIT
- D399 ;
- +1 NEW RCXVD,RCXVBC,RCXVDT,RCXVD1,RCXVD2,RCXVD3
- +2 NEW RCXVD4,RCXVD5,RCXVD6,RCXVD7,RCXVDA,RCXVDB,RCXVDC,RCXVDD
- +3 NEW RCXVP1,RCXVP2,RCXVD0C,RCXVP3,RCXVP4,RCXVP5,RCXVCFL,RCXVPAY
- +4 NEW RCXVINS,RCXVVAN,RCXVDRG,RCXVCAN,RCXVSNR,IBD,X1,X2,RCXVNPI
- +5 ;
- +6 ;WCJ;PRCA*4.5*270;Start
- +7 ;I $P(RCXVBLNA,"-",2)="" Q
- +8 ;S RCXVD0=$O(^DGCR(399,"B",$P(RCXVBLNA,"-",2),""))
- +9 ;I RCXVD0="" Q
- +10 if '+$GET(RCXVBLN)
- QUIT
- +11 SET RCXVD0=RCXVBLN
- +12 ;WCJ;PRCA*4.5*270;End
- +13 ;
- +14 SET RCXVD1=$GET(^DGCR(399,RCXVD0,0))
- +15 ;WCJ;PRCA*4.5*270
- if RCXVD1=""
- QUIT
- +16 IF $GET(DFN)=""
- SET DFN=$PIECE(RCXVD1,U,2)
- +17 ;WCJ;PRCA*4.5*270
- if 'DFN
- QUIT
- +18 SET RCXVD2=$GET(^DGCR(399,RCXVD0,"S"))
- +19 SET RCXVD3=$GET(^DGCR(399,RCXVD0,"U"))
- +20 SET RCXVD7=$GET(^DGCR(399,RCXVD0,"TX"))
- +21 ; BILL #
- SET RCXVDA=$PIECE(RCXVD1,U,1)
- +22 SET (RCXVEVDT,RCXVDT)=$PIECE($PIECE(RCXVD1,U,3),".",1)
- +23 ;S RCXVDA=RCXVBLNB_RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; EVNT DT
- +24 ; SSN
- SET RCXVDA=RCXVBLNA_RCXVU_$PIECE(^DPT(DFN,0),U,9)
- +25 ; EVNT DT
- SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +26 ; BILL CLASS
- SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD1,U,5)
- +27 SET RCXVP1=$PIECE(RCXVD1,U,7)
- SET RCXVP2=""
- +28 IF RCXVP1'=""
- SET RCXVP2=$PIECE($GET(^DGCR(399.3,RCXVP1,0)),U,1)
- +29 ; RATE TYPE (P)
- SET RCXVDA=RCXVDA_RCXVU_RCXVP2
- +30 SET RCXVP1=$PIECE(RCXVD2,U,11)
- SET RCXVP2=""
- +31 ; SITE_IEN
- IF RCXVP1'=""
- SET RCXVP2=$PIECE($GET(^VA(200,RCXVP1,2,0)),U,1)_RCXVP1
- +32 ; Authorizer (P)
- SET RCXVDA=RCXVDA_RCXVU_RCXVSITE_RCXVP2
- +33 ; Stat
- SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD1,U,13)
- +34 SET RCXVDT=$PIECE(RCXVD1,U,14)
- +35 ; Stat DT
- SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +36 SET RCXVP1=$PIECE(RCXVD1,U,22)
- SET RCXVP2=""
- SET RCXVNPI=""
- +37 ;$P($G(^DG(40.8,RCXVP1,0)),U,2)
- IF RCXVP1'=""
- SET RCXVP2=$$GET1^DIQ(40.8,RCXVP1,1)
- +38 ;Default Division NPI
- if $GET(RCXVP1)'=""
- SET RCXVNPI=$PIECE($$NPI^XUSNPI("Organization_ID",$$GET1^DIQ(40.8,RCXVP1,.07,"I")),RCXVU,1)
- if +RCXVNPI<1
- SET RCXVNPI=""
- +39 ; Default division^Default division NPI
- SET RCXVDA=RCXVDA_RCXVU_RCXVP2_RCXVU_RCXVNPI
- +40 ; UB92 Location
- SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD1,U,24)
- +41 ; Bill Chrg type
- SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD1,U,27)
- +42 SET RCXVDT=$PIECE(RCXVD2,U,10)
- +43 ; Auth. DT
- SET RCXVDB=$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +44 SET RCXVDT=$PIECE(RCXVD2,U,12)
- +45 ; DT 1st printed
- SET RCXVDB=RCXVDB_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +46 SET (RCXVP1,RCXVD0C)=$PIECE($GET(^DGCR(399,RCXVD0,"M")),U,1)
- SET RCXVP2=""
- +47 IF RCXVP1'=""
- SET RCXVP2=$PIECE($GET(^DIC(36,RCXVP1,0)),U,1)
- +48 ; PRIM. INSR (P)
- SET RCXVDB=RCXVDB_RCXVU_RCXVP2
- +49 ;
- +50 ; Type of Plan
- +51 SET RCXVP2=""
- SET RCXVI=0
- SET RCXVP3=""
- SET RCXVP4=""
- SET RCXVP5=""
- +52 SET IBD=$$IBAREXT^IBRFN4(RCXVD0,.IBD)
- +53 SET RCXVP2=$PIECE(IBD("IN"),U)
- SET RCXVP5=$PIECE(IBD("IN"),U,2)
- SET RCXVP3=$PIECE(IBD("IN"),U,3)
- SET RCXVP4=$PIECE(IBD("IN"),U,4)
- +54 SET RCXVDB=RCXVDB_RCXVU_RCXVP2_RCXVU_RCXVP5_RCXVU_RCXVP3_RCXVU_RCXVP4
- SET RCXVD5=""
- SET RCXVD6=""
- +55 ;
- +56 ; 36, 36.3 ADDRESS/EDI
- +57 IF RCXVD0C
- SET RCXVD5=$GET(^DIC(36,RCXVD0C,.11))
- +58 ; STRT ADD 1
- SET RCXVDB=RCXVDB_RCXVU_$PIECE(RCXVD5,U,1)
- +59 ; STRT ADD 2
- SET RCXVDB=RCXVDB_RCXVU_$PIECE(RCXVD5,U,2)
- +60 ; CITY
- SET RCXVDB=RCXVDB_RCXVU_$PIECE(RCXVD5,U,4)
- +61 SET RCXVP1=$PIECE(RCXVD5,U,5)
- SET RCXVP2=""
- +62 IF RCXVP1'=""
- SET RCXVP2=$PIECE($GET(^DIC(5,RCXVP1,0)),U,1)
- +63 ; STATE (P)
- SET RCXVDB=RCXVDB_RCXVU_RCXVP2
- +64 ; ZIP
- SET RCXVDB=RCXVDB_RCXVU_$PIECE(RCXVD5,U,6)
- +65 IF RCXVD0C'=""
- SET RCXVD6=$GET(^DIC(36,RCXVD0C,3))
- +66 ; EDI - PROF
- SET RCXVDB=RCXVDB_RCXVU_$PIECE(RCXVD6,U,2)
- +67 ; EDI - INST
- SET RCXVDB=RCXVDB_RCXVU_$PIECE(RCXVD6,U,4)
- +68 ; REIMBURSE?
- SET RCXVDB=RCXVDB_RCXVU_$$GET1^DIQ(36,RCXVD0C_",",1,"I")
- +69 ;
- +70 SET RCXVPFDT=$PIECE(RCXVD3,U,1)
- +71 ; STMT COVERS FROM
- SET RCXVDC=$$HLDATE^HLFNC(RCXVPFDT)
- +72 SET RCXVPTDT=$PIECE(RCXVD3,U,2)
- +73 ; STMT COVERS TO
- SET RCXVDC=RCXVDC_RCXVU_$$HLDATE^HLFNC(RCXVPTDT)
- +74 SET RCXVP1=$PIECE(RCXVD3,U,11)
- SET RCXVP2=""
- +75 IF RCXVP1'=""
- SET RCXVP2=$PIECE($GET(^DGCR(399.1,RCXVP1,0)),U,1)
- +76 ; DISCH. BED SEC.
- SET RCXVDC=RCXVDC_RCXVU_RCXVP2
- +77 SET RCXVD4=$GET(^DGCR(399,RCXVD0,"U1"))
- +78 ; TOT CHRG
- SET RCXVDC=RCXVDC_RCXVU_$PIECE(RCXVD4,U,1)
- +79 ;
- +80 SET RCXVP1=$PIECE($GET(^DGCR(399,RCXVD0,"U2")),U,10)
- SET RCXVP2=""
- SET RCXVNPI=""
- +81 IF RCXVP1'=""
- SET RCXVP2=$PIECE($GET(^IBA(355.93,RCXVP1,0)),U,1)
- +82 if $GET(RCXVP2)'=""
- SET RCXVNPI=$PIECE($$NPI^XUSNPI("Non_VA_Provider_ID",RCXVP1),RCXVU,1)
- if +RCXVNPI<1
- SET RCXVNPI=""
- +83 ;This line is used if the XUSNPI API does not work
- IF RCXVNPI=""
- IF $GET(RCXVP2)'=""
- SET RCXVNPI=$$GET1^DIQ(355.93,RCXVP1,41.01,"I")
- +84 ; NON VA FAC (P)^NON VA FAC NPI
- SET RCXVDC=RCXVDC_RCXVU_RCXVP2_RCXVU_RCXVNPI
- +85 ;
- +86 ; Get VACARE or NONVACARE flag
- +87 NEW RCXVIEN
- +88 DO CARE^RCXVUTIL(RCXVD0)
- +89 SET RCXVDC=RCXVDC_RCXVU_$SELECT(RCXVCFL=1:"VACARE",1:"NONVACARE")
- +90 ; MRA data
- +91 SET RCXVDT=$PIECE(IBD,U,2)
- +92 ; MRA Requested DT
- SET RCXVDD=$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +93 SET RCXVDT=$PIECE(IBD,U,3)
- +94 ;Last Electronic Extract Date
- SET RCXVDD=RCXVDD_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +95 ;Printed VIA EDI
- SET RCXVDD=RCXVDD_RCXVU_$PIECE(IBD,U,4)
- +96 ;Force Claim To Print
- SET RCXVDD=RCXVDD_RCXVU_$PIECE(IBD,U,5)
- +97 ;Claim MRA Status
- SET RCXVDD=RCXVDD_RCXVU_$PIECE(IBD,U,6)
- +98 SET RCXVDT=$PIECE(IBD,U,7)
- +99 ;MRA Recorded Date
- SET RCXVDD=RCXVDD_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +100 SET RCXVDT=$PIECE(IBD,U,8)
- +101 ;Date Cancelled
- SET RCXVDD=RCXVDD_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
- +102 ;Form Type
- SET RCXVDD=RCXVDD_RCXVU_$PIECE(IBD,U,9)
- +103 ;PAYER&VA NAT.ID #
- SET RCXVDD=RCXVDD_RCXVU_$PIECE(IBD,U,16)_RCXVU_$PIECE(IBD,U,15)
- +104 SET RCXVDRG=$PIECE(IBD,U,11)
- +105 ;DRG
- SET RCXVDD=RCXVDD_RCXVU_RCXVDRG
- +106 ;Days site not responsible for MRA request
- SET RCXVSNR=$PIECE(IBD,U,14)
- +107 SET RCXVDD=RCXVDD_RCXVU_RCXVSNR
- +108 ;ECME #
- SET RCXVDD=RCXVDD_RCXVU_$PIECE($PIECE(IBD,U,12),";")
- +109 ;Offset Amount
- SET RCXVDD=RCXVDD_RCXVU_$PIECE(IBD,U,17)
- +110 SET ^TMP($JOB,RCXVBLN,"3-399A")=RCXVDA
- +111 SET ^TMP($JOB,RCXVBLN,"3-399B")=RCXVDB
- +112 SET ^TMP($JOB,RCXVBLN,"3-399C")=RCXVDC
- +113 SET ^TMP($JOB,RCXVBLN,"3-399D")=RCXVDD
- +114 QUIT
- +115 ;
- REJ() ;Checks for reject on a claim
- +1 SET X="NO"
- +2 SET X1=$PIECE(RCXVD1,U,15)
- SET D0=RCXVD0
- +3 FOR
- Begin DoDot:1
- +4 SET I=0
- FOR
- SET I=$ORDER(^IBM(361,"B",D0,I))
- if 'I
- QUIT
- Begin DoDot:2
- +5 SET X2=$PIECE($GET(^IBM(361,I,0)),U,3)
- +6 IF X2="R"
- SET X="YES"
- SET D0=""
- +7 QUIT
- End DoDot:2
- if 'D0
- QUIT
- +8 IF X="YES"
- QUIT
- +9 IF X1=D0
- SET D0=""
- QUIT
- +10 SET D0=X1
- if 'D0
- QUIT
- SET X1=$PIECE($GET(^DGCR(399,X1,0)),U,15)
- +11 QUIT
- End DoDot:1
- if 'D0
- GOTO REJQ
- +12 KILL I
- REJQ QUIT X
- +1 ;