IBCNEHL1A ;AITC/DJW - HL7 Process Incoming RPI Messages (Cont.) ; 10-JAN-2025
;;2.0;INTEGRATED BILLING;**806**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
Q ; No direct calls allowed
;
AUTOUPD(RIEN) ;
;DTG - Rewrote tag to split logic between Medicare policies and commercial policies
;
;Returns "1^file 2 ien^file 2.312 ien^2nd file 2.312 ien^Medicare flag^subscriber flag", if entry
; in file 365 is eligible for auto-update, returns 0 otherwise.
;
;Medicare flag: 1 for Medicare, 0 otherwise
;Subscriber flag: 1 if patient is the subscriber, 0 otherwise
;
;For non-Medicare response: 1st file 2.312 ien is set, 2nd file 2.312 ien is empty, pieces 5-7 are empty
;For Medicare response: 1st file 2.312 ien contains ien for Medicare Part A, 2nd file 2.312 ien contains ien for Medicare Part B,
; either one may be empty, but at least one of them is set if entry is eligible.
;
;RIEN - ien in file 365
;
N APPIEN,GDATA,GIEN,GNAME,GNUM,GNUM1,GOK,IEN2,IEN312,IEN36,IDATA0,IDATA3,ISSUB,MWNRA,MWNRB,MWNRIEN,MWNRTYP
N ONEPOL,PIEN,RDATA0,RDATA1,RES,TQIEN,IDATA7,RDATA13,RDATA14,ISBLUE
N IBGETTQ,IBGETWE,IBGETSTC,IBGETDEF,IBGETNOK
S RES=0
I +$G(RIEN)'>0 Q RES ;Invalid ien for file 365
; - if entry is missing from #200, file in buffer
I '$$FIND1^DIC(200,,"M",IBEIVUSR) Q RES ;use variable for name
;
; - Moved up the next 5 lines.
S RDATA0=$G(^IBCN(365,RIEN,0)),RDATA1=$G(^IBCN(365,RIEN,1))
;
;Longer fields for GROUP NAME, GROUP NUMBER, NAME OF INSURED, & SUBSCRIBER ID
S RDATA13=$G(^IBCN(365,RIEN,13)),RDATA14=$G(^IBCN(365,RIEN,14))
S PIEN=$P(RDATA0,U,3)
S ISBLUE=$$GET1^DIQ(365.12,PIEN_",",.09,"I")
;
; - Moved up the next 2 lines.
S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25),MWNRTYP=0,(MWNRA,MWNRB)=""
I PIEN=MWNRIEN S MWNRTYP=$$ISMCR^IBCNEHLU(RIEN)
;
I +MWNRTYP D CHKMCR Q RES ; call CHKMCR for Medicare policies
;
;Only auto-update 'active policy' responses
I $G(IIVSTAT)'=1 Q RES
; Changed app to EIV from IIV
I +PIEN>0 S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
I +$G(APPIEN)'>0 Q RES ;couldn't find eIV application entry
;
; Don't allow any entry with HMS SOI to auto-update
; Don't allow any entry with Contract Services SOI to auto-update
I $P(RDATA0,U,5)'="" I "^HMS^CONTRACT SERVICES^"[("^"_$$GET1^DIQ(365.1,$P(RDATA0,U,5)_",","SOURCE OF INFORMATION","E")_"^") Q RES ; HAN IB*621
;
; Start, allow auto update for some "Request Electronic Insurance Inquiry" requests
;
;Check dictionary 365.1 MANUAL REQUEST DATE/TIME Flag, Quit if Set.
;I $P(RDATA0,U,5)'="",$P($G(^IBCN(365.1,$P(RDATA0,U,5),3)),U,1)'="" Q RES
;
; get values
S (IBGETTQ,IBGETDEF,IBGETWE,IBGETSTC)=""
; Get 365.1 transmission queue number
S IBGETTQ=$$GET1^DIQ(365,RIEN_",",.05,"I") I IBGETTQ="" Q RES
; Get 365.1 which extract
S IBGETNOK=0
S IBGETWE=$$GET1^DIQ(365.1,IBGETTQ_",",.1,"I") I IBGETWE=5 D I IBGETNOK Q RES
. ; Get 350.9 default service type code
. S IBGETDEF=$$GET1^DIQ(350.9,1_",",60.01,"I") I IBGETDEF="" S IBGETNOK=1 Q
. ; Get 365 requested service type code
. S IBGETSTC=$$GET1^DIQ(365,RIEN_",",.15,"I") I IBGETSTC'=IBGETDEF S IBGETNOK=1 Q
;
; End, allow auto update for some "Request Electronic Insurance Inquiry" requests
;
; Changed to new field location
I '$$GET1^DIQ(365.121,APPIEN_","_PIEN_",",4.01,"I") Q RES ; auto-update is OFF
S IEN2=$P(RDATA0,U,2) I +IEN2'>0 Q RES ; couldn't find patient
S ONEPOL=$$ONEPOL^IBCNEHLU(PIEN,IEN2)
;try to find a matching pat. insurance
; - Modify next two lines to check for ISBLUE
; - Remove the check for ISBLUE and RES
;S IEN36="" F S IEN36=$O(^DIC(36,"AC",PIEN,IEN36)) Q:IEN36="" D I 'ISBLUE&(RES>0) Q
;.S IEN312="" F S IEN312=$O(^DPT(IEN2,.312,"B",IEN36,IEN312)) Q:IEN312="" D I ('ISBLUE)&(RES>0&('+MWNRTYP)) Q
S IEN36="" F S IEN36=$O(^DIC(36,"AC",PIEN,IEN36)) Q:IEN36="" D
.S IEN312="" F S IEN312=$O(^DPT(IEN2,.312,"B",IEN36,IEN312)) Q:IEN312="" D
..S IDATA0=$G(^DPT(IEN2,.312,IEN312,0)),IDATA3=$G(^DPT(IEN2,.312,IEN312,3))
..S IDATA7=$G(^DPT(IEN2,.312,IEN312,7))
.. ; $$EXPIRED was moved from IBCNEDE2 to IBCNEHL1
..I $$EXPIRED^IBCNEHL1($P(IDATA0,U,4)) Q ;Insurance policy has expired
..S ISSUB=$$PATISSUB^IBCNEHLU(IDATA0)
..;Patient is the subscriber
..I ISSUB,'$$CHK1^IBCNEHL3 Q
..;Patient is the dependent
..; Sub call needs to know this is not Medicare
..;I 'ISSUB,'$$CHK2^IBCNEHL3(MWNRTYP) Q
..I 'ISSUB,'$$CHK2^IBCNEHL3(0) Q
..;check group #
..S GNUM=$P(RDATA14,U,2),GIEN=+$P(IDATA0,U,18),GOK=1 ;IB*497 - group # needs to be retrieved from new field
..; Remove check for non Medicare group # ;I '+MWNRTYP D Q:'GOK
..D Q:'GOK ;Group # doesn't match
...I 'ONEPOL D
... .I GIEN'>0 S GOK=0 Q
... .S GNUM1=$P($G(^IBA(355.3,GIEN,2)),U,2) ;IB*497 (vd)
... .I GNUM=""!(GNUM1="")!(GNUM'=GNUM1) S GOK=0
...I ONEPOL D
... .I GNUM'="",GIEN'="" S GNUM1=$P($G(^IBA(355.3,GIEN,2)),U,2) I GNUM1'="",GNUM'=GNUM1 S GOK=0 ;IB*497 (vd)
..; Process Blues and non-MWNR
.. D ;Not Medicare
... S P3=$P(RES,U,3),P3=P3_$S($L(P3):"~",1:"")_IEN312
... S RES=1_U_IEN2_U_P3_U_U_0_U_ISSUB ;Process Blues and non-MWNR
Q RES
;
; -----------------------------------------------
CHKMCR ; Medicare checks to determine if we can auto-load new policy
; or auto-update existing policy
;
;Changed app to EIV from IIV
I +PIEN>0 S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
I +$G(APPIEN)'>0 Q ;couldn't find eIV application entry
;
S LOAD=$$LOAD^IBCNEHL5A(RIEN) I LOAD Q ; LOADING the Medicare policy if allowed
;
;
; Only continue if we didn't load the active policy to patient's record as a new policy
;
;Don't allow any entry with HMS SOI to auto-update
;Don't allow any entry with Contract Services SOI to auto-update
I $P(RDATA0,U,5)'="" I "^HMS^CONTRACT SERVICES^"[("^"_$$GET1^DIQ(365.1,$P(RDATA0,U,5)_",","SOURCE OF INFORMATION","E")_"^") Q RES
;
; allow auto update for some "Request Electronic Insurance Inquiry" requests
;
; get values
S (IBGETTQ,IBGETDEF,IBGETWE,IBGETSTC)=""
; Get 365.1 transmission queue number
S IBGETTQ=$$GET1^DIQ(365,RIEN_",",.05,"I") I IBGETTQ="" Q
; Get 365.1 which extract
S IBGETNOK=0
S IBGETWE=$$GET1^DIQ(365.1,IBGETTQ_",",.1,"I") I IBGETWE=5 D I IBGETNOK Q
. ; Get 350.9 default service type code
. S IBGETDEF=$$GET1^DIQ(350.9,1_",",60.01,"I") I IBGETDEF="" S IBGETNOK=1 Q
. ; Get 365 requested service type code
. S IBGETSTC=$$GET1^DIQ(365,RIEN_",",.15,"I") I IBGETSTC'=IBGETDEF S IBGETNOK=1 Q
;
I '$$GET1^DIQ(365.121,APPIEN_","_PIEN_",",4.01,"I") Q ; auto-update is OFF
;
S IEN2=$P(RDATA0,U,2) I +IEN2'>0 Q ; couldn't find patient
;
;try to find a matching pat. insurance
S IEN36="" F S IEN36=$O(^DIC(36,"AC",PIEN,IEN36)) Q:IEN36="" D
.S IEN312="" F S IEN312=$O(^DPT(IEN2,.312,"B",IEN36,IEN312)) Q:IEN312="" D
..S IDATA0=$G(^DPT(IEN2,.312,IEN312,0)),IDATA3=$G(^DPT(IEN2,.312,IEN312,3))
..S IDATA7=$G(^DPT(IEN2,.312,IEN312,7))
..I $$EXPIRED^IBCNEHL1($P(IDATA0,U,4)) Q ;Insurance policy has expired
..S ISSUB=$$PATISSUB^IBCNEHLU(IDATA0)
..;Patient is the subscriber
..I ISSUB,'$$CHK1^IBCNEHL3 Q
..;Patient is the dependent
..I 'ISSUB,'$$CHK2^IBCNEHL3(MWNRTYP) Q
..;check group #
..S GNUM=$P(RDATA14,U,2),GIEN=+$P(IDATA0,U,18),GOK=1
..D Q:'GOK ;Group # doesn't match
...I GIEN'>0 S GOK=0 Q
...S GDATA=$G(^IBA(355.3,GIEN,0))
...I $P(GDATA,U,14)="A" D
....I $P(MWNRTYP,U,5)="MA"!($P(MWNRTYP,U,5)="B") S MWNRA=IEN312 Q
....S GOK=0
...I $P(GDATA,U,14)="B" D
... .I $P(MWNRTYP,U,5)="MB"!($P(MWNRTYP,U,5)="B") S MWNRB=IEN312 Q
... .S GOK=0
..S RES=1_U_IEN2_U_MWNRA_U_MWNRB_U_1_U_ISSUB Q ;Process MWNR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEHL1A 7782 printed Jan 29, 2026@15:13:28 Page 2
IBCNEHL1A ;AITC/DJW - HL7 Process Incoming RPI Messages (Cont.) ; 10-JAN-2025
+1 ;;2.0;INTEGRATED BILLING;**806**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; No direct calls allowed
QUIT
+5 ;
AUTOUPD(RIEN) ;
+1 ;DTG - Rewrote tag to split logic between Medicare policies and commercial policies
+2 ;
+3 ;Returns "1^file 2 ien^file 2.312 ien^2nd file 2.312 ien^Medicare flag^subscriber flag", if entry
+4 ; in file 365 is eligible for auto-update, returns 0 otherwise.
+5 ;
+6 ;Medicare flag: 1 for Medicare, 0 otherwise
+7 ;Subscriber flag: 1 if patient is the subscriber, 0 otherwise
+8 ;
+9 ;For non-Medicare response: 1st file 2.312 ien is set, 2nd file 2.312 ien is empty, pieces 5-7 are empty
+10 ;For Medicare response: 1st file 2.312 ien contains ien for Medicare Part A, 2nd file 2.312 ien contains ien for Medicare Part B,
+11 ; either one may be empty, but at least one of them is set if entry is eligible.
+12 ;
+13 ;RIEN - ien in file 365
+14 ;
+15 NEW APPIEN,GDATA,GIEN,GNAME,GNUM,GNUM1,GOK,IEN2,IEN312,IEN36,IDATA0,IDATA3,ISSUB,MWNRA,MWNRB,MWNRIEN,MWNRTYP
+16 NEW ONEPOL,PIEN,RDATA0,RDATA1,RES,TQIEN,IDATA7,RDATA13,RDATA14,ISBLUE
+17 NEW IBGETTQ,IBGETWE,IBGETSTC,IBGETDEF,IBGETNOK
+18 SET RES=0
+19 ;Invalid ien for file 365
IF +$GET(RIEN)'>0
QUIT RES
+20 ; - if entry is missing from #200, file in buffer
+21 ;use variable for name
IF '$$FIND1^DIC(200,,"M",IBEIVUSR)
QUIT RES
+22 ;
+23 ; - Moved up the next 5 lines.
+24 SET RDATA0=$GET(^IBCN(365,RIEN,0))
SET RDATA1=$GET(^IBCN(365,RIEN,1))
+25 ;
+26 ;Longer fields for GROUP NAME, GROUP NUMBER, NAME OF INSURED, & SUBSCRIBER ID
+27 SET RDATA13=$GET(^IBCN(365,RIEN,13))
SET RDATA14=$GET(^IBCN(365,RIEN,14))
+28 SET PIEN=$PIECE(RDATA0,U,3)
+29 SET ISBLUE=$$GET1^DIQ(365.12,PIEN_",",.09,"I")
+30 ;
+31 ; - Moved up the next 2 lines.
+32 SET MWNRIEN=$PIECE($GET(^IBE(350.9,1,51)),U,25)
SET MWNRTYP=0
SET (MWNRA,MWNRB)=""
+33 IF PIEN=MWNRIEN
SET MWNRTYP=$$ISMCR^IBCNEHLU(RIEN)
+34 ;
+35 ; call CHKMCR for Medicare policies
IF +MWNRTYP
DO CHKMCR
QUIT RES
+36 ;
+37 ;Only auto-update 'active policy' responses
+38 IF $GET(IIVSTAT)'=1
QUIT RES
+39 ; Changed app to EIV from IIV
+40 IF +PIEN>0
SET APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+41 ;couldn't find eIV application entry
IF +$GET(APPIEN)'>0
QUIT RES
+42 ;
+43 ; Don't allow any entry with HMS SOI to auto-update
+44 ; Don't allow any entry with Contract Services SOI to auto-update
+45 ; HAN IB*621
IF $PIECE(RDATA0,U,5)'=""
IF "^HMS^CONTRACT SERVICES^"[("^"_$$GET1^DIQ(365.1,$PIECE(RDATA0,U,5)_",","SOURCE OF INFORMATION","E")_"^")
QUIT RES
+46 ;
+47 ; Start, allow auto update for some "Request Electronic Insurance Inquiry" requests
+48 ;
+49 ;Check dictionary 365.1 MANUAL REQUEST DATE/TIME Flag, Quit if Set.
+50 ;I $P(RDATA0,U,5)'="",$P($G(^IBCN(365.1,$P(RDATA0,U,5),3)),U,1)'="" Q RES
+51 ;
+52 ; get values
+53 SET (IBGETTQ,IBGETDEF,IBGETWE,IBGETSTC)=""
+54 ; Get 365.1 transmission queue number
+55 SET IBGETTQ=$$GET1^DIQ(365,RIEN_",",.05,"I")
IF IBGETTQ=""
QUIT RES
+56 ; Get 365.1 which extract
+57 SET IBGETNOK=0
+58 SET IBGETWE=$$GET1^DIQ(365.1,IBGETTQ_",",.1,"I")
IF IBGETWE=5
Begin DoDot:1
+59 ; Get 350.9 default service type code
+60 SET IBGETDEF=$$GET1^DIQ(350.9,1_",",60.01,"I")
IF IBGETDEF=""
SET IBGETNOK=1
QUIT
+61 ; Get 365 requested service type code
+62 SET IBGETSTC=$$GET1^DIQ(365,RIEN_",",.15,"I")
IF IBGETSTC'=IBGETDEF
SET IBGETNOK=1
QUIT
End DoDot:1
IF IBGETNOK
QUIT RES
+63 ;
+64 ; End, allow auto update for some "Request Electronic Insurance Inquiry" requests
+65 ;
+66 ; Changed to new field location
+67 ; auto-update is OFF
IF '$$GET1^DIQ(365.121,APPIEN_","_PIEN_",",4.01,"I")
QUIT RES
+68 ; couldn't find patient
SET IEN2=$PIECE(RDATA0,U,2)
IF +IEN2'>0
QUIT RES
+69 SET ONEPOL=$$ONEPOL^IBCNEHLU(PIEN,IEN2)
+70 ;try to find a matching pat. insurance
+71 ; - Modify next two lines to check for ISBLUE
+72 ; - Remove the check for ISBLUE and RES
+73 ;S IEN36="" F S IEN36=$O(^DIC(36,"AC",PIEN,IEN36)) Q:IEN36="" D I 'ISBLUE&(RES>0) Q
+74 ;.S IEN312="" F S IEN312=$O(^DPT(IEN2,.312,"B",IEN36,IEN312)) Q:IEN312="" D I ('ISBLUE)&(RES>0&('+MWNRTYP)) Q
+75 SET IEN36=""
FOR
SET IEN36=$ORDER(^DIC(36,"AC",PIEN,IEN36))
if IEN36=""
QUIT
Begin DoDot:1
+76 SET IEN312=""
FOR
SET IEN312=$ORDER(^DPT(IEN2,.312,"B",IEN36,IEN312))
if IEN312=""
QUIT
Begin DoDot:2
+77 SET IDATA0=$GET(^DPT(IEN2,.312,IEN312,0))
SET IDATA3=$GET(^DPT(IEN2,.312,IEN312,3))
+78 SET IDATA7=$GET(^DPT(IEN2,.312,IEN312,7))
+79 ; $$EXPIRED was moved from IBCNEDE2 to IBCNEHL1
+80 ;Insurance policy has expired
IF $$EXPIRED^IBCNEHL1($PIECE(IDATA0,U,4))
QUIT
+81 SET ISSUB=$$PATISSUB^IBCNEHLU(IDATA0)
+82 ;Patient is the subscriber
+83 IF ISSUB
IF '$$CHK1^IBCNEHL3
QUIT
+84 ;Patient is the dependent
+85 ; Sub call needs to know this is not Medicare
+86 ;I 'ISSUB,'$$CHK2^IBCNEHL3(MWNRTYP) Q
+87 IF 'ISSUB
IF '$$CHK2^IBCNEHL3(0)
QUIT
+88 ;check group #
+89 ;IB*497 - group # needs to be retrieved from new field
SET GNUM=$PIECE(RDATA14,U,2)
SET GIEN=+$PIECE(IDATA0,U,18)
SET GOK=1
+90 ; Remove check for non Medicare group # ;I '+MWNRTYP D Q:'GOK
+91 ;Group # doesn't match
Begin DoDot:3
+92 IF 'ONEPOL
Begin DoDot:4
+93 IF GIEN'>0
SET GOK=0
QUIT
+94 ;IB*497 (vd)
SET GNUM1=$PIECE($GET(^IBA(355.3,GIEN,2)),U,2)
+95 IF GNUM=""!(GNUM1="")!(GNUM'=GNUM1)
SET GOK=0
End DoDot:4
+96 IF ONEPOL
Begin DoDot:4
+97 ;IB*497 (vd)
IF GNUM'=""
IF GIEN'=""
SET GNUM1=$PIECE($GET(^IBA(355.3,GIEN,2)),U,2)
IF GNUM1'=""
IF GNUM'=GNUM1
SET GOK=0
End DoDot:4
End DoDot:3
if 'GOK
QUIT
+98 ; Process Blues and non-MWNR
+99 ;Not Medicare
Begin DoDot:3
+100 SET P3=$PIECE(RES,U,3)
SET P3=P3_$SELECT($LENGTH(P3):"~",1:"")_IEN312
+101 ;Process Blues and non-MWNR
SET RES=1_U_IEN2_U_P3_U_U_0_U_ISSUB
End DoDot:3
End DoDot:2
End DoDot:1
+102 QUIT RES
+103 ;
+104 ; -----------------------------------------------
CHKMCR ; Medicare checks to determine if we can auto-load new policy
+1 ; or auto-update existing policy
+2 ;
+3 ;Changed app to EIV from IIV
+4 IF +PIEN>0
SET APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+5 ;couldn't find eIV application entry
IF +$GET(APPIEN)'>0
QUIT
+6 ;
+7 ; LOADING the Medicare policy if allowed
SET LOAD=$$LOAD^IBCNEHL5A(RIEN)
IF LOAD
QUIT
+8 ;
+9 ;
+10 ; Only continue if we didn't load the active policy to patient's record as a new policy
+11 ;
+12 ;Don't allow any entry with HMS SOI to auto-update
+13 ;Don't allow any entry with Contract Services SOI to auto-update
+14 IF $PIECE(RDATA0,U,5)'=""
IF "^HMS^CONTRACT SERVICES^"[("^"_$$GET1^DIQ(365.1,$PIECE(RDATA0,U,5)_",","SOURCE OF INFORMATION","E")_"^")
QUIT RES
+15 ;
+16 ; allow auto update for some "Request Electronic Insurance Inquiry" requests
+17 ;
+18 ; get values
+19 SET (IBGETTQ,IBGETDEF,IBGETWE,IBGETSTC)=""
+20 ; Get 365.1 transmission queue number
+21 SET IBGETTQ=$$GET1^DIQ(365,RIEN_",",.05,"I")
IF IBGETTQ=""
QUIT
+22 ; Get 365.1 which extract
+23 SET IBGETNOK=0
+24 SET IBGETWE=$$GET1^DIQ(365.1,IBGETTQ_",",.1,"I")
IF IBGETWE=5
Begin DoDot:1
+25 ; Get 350.9 default service type code
+26 SET IBGETDEF=$$GET1^DIQ(350.9,1_",",60.01,"I")
IF IBGETDEF=""
SET IBGETNOK=1
QUIT
+27 ; Get 365 requested service type code
+28 SET IBGETSTC=$$GET1^DIQ(365,RIEN_",",.15,"I")
IF IBGETSTC'=IBGETDEF
SET IBGETNOK=1
QUIT
End DoDot:1
IF IBGETNOK
QUIT
+29 ;
+30 ; auto-update is OFF
IF '$$GET1^DIQ(365.121,APPIEN_","_PIEN_",",4.01,"I")
QUIT
+31 ;
+32 ; couldn't find patient
SET IEN2=$PIECE(RDATA0,U,2)
IF +IEN2'>0
QUIT
+33 ;
+34 ;try to find a matching pat. insurance
+35 SET IEN36=""
FOR
SET IEN36=$ORDER(^DIC(36,"AC",PIEN,IEN36))
if IEN36=""
QUIT
Begin DoDot:1
+36 SET IEN312=""
FOR
SET IEN312=$ORDER(^DPT(IEN2,.312,"B",IEN36,IEN312))
if IEN312=""
QUIT
Begin DoDot:2
+37 SET IDATA0=$GET(^DPT(IEN2,.312,IEN312,0))
SET IDATA3=$GET(^DPT(IEN2,.312,IEN312,3))
+38 SET IDATA7=$GET(^DPT(IEN2,.312,IEN312,7))
+39 ;Insurance policy has expired
IF $$EXPIRED^IBCNEHL1($PIECE(IDATA0,U,4))
QUIT
+40 SET ISSUB=$$PATISSUB^IBCNEHLU(IDATA0)
+41 ;Patient is the subscriber
+42 IF ISSUB
IF '$$CHK1^IBCNEHL3
QUIT
+43 ;Patient is the dependent
+44 IF 'ISSUB
IF '$$CHK2^IBCNEHL3(MWNRTYP)
QUIT
+45 ;check group #
+46 SET GNUM=$PIECE(RDATA14,U,2)
SET GIEN=+$PIECE(IDATA0,U,18)
SET GOK=1
+47 ;Group # doesn't match
Begin DoDot:3
+48 IF GIEN'>0
SET GOK=0
QUIT
+49 SET GDATA=$GET(^IBA(355.3,GIEN,0))
+50 IF $PIECE(GDATA,U,14)="A"
Begin DoDot:4
+51 IF $PIECE(MWNRTYP,U,5)="MA"!($PIECE(MWNRTYP,U,5)="B")
SET MWNRA=IEN312
QUIT
+52 SET GOK=0
End DoDot:4
+53 IF $PIECE(GDATA,U,14)="B"
Begin DoDot:4
+54 IF $PIECE(MWNRTYP,U,5)="MB"!($PIECE(MWNRTYP,U,5)="B")
SET MWNRB=IEN312
QUIT
+55 SET GOK=0
End DoDot:4
End DoDot:3
if 'GOK
QUIT
+56 ;Process MWNR
SET RES=1_U_IEN2_U_MWNRA_U_MWNRB_U_1_U_ISSUB
QUIT
End DoDot:2
End DoDot:1
+57 QUIT
+58 ;
