IBCNICB2 ;FA/ALB - Update utilities for the ICB interface ;1 SEP 2009
;;2.0;INTEGRATED BILLING;**549**;21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
; IB*2.0*549 - New routine because of routine size of IBCNICB
;
EXACTM(IBINSDA,IBBUFDA) ;EP
; Check for an exact match on an existing group plan when trying to add a
; new one
; IB*2.0*549 - Added method
; Input: IBINSDA - IEN of the Insurance Company (file 36) associated
; with the group plan being added
; IBBUFDA - IEN of the Insurance Buffer entry (file 355.33)
; Returns: 1 - Exact match found on Insurance Company, Group Name and Group Number
; 0 - Otherwise
N BGRPNM,BGRPNUM,FOUND,GRPNM,GRPNUM,IEN
S BGRPNM=$$GET1^DIQ(355.33,IBBUFDA_",",90.01) ; External Group Name from buffer
S BGRPNM=$$UP^XLFSTR(BGRPNM) ; Convert to Upper case
S BGRPNM=$$TRIM^XLFSTR(BGRPNM,"R"," ") ; Strip Trailing spaces
S BGRPNUM=$$GET1^DIQ(355.33,IBBUFDA_",",90.02) ; External Group Number from buffer
S BGRPNUM=$$UP^XLFSTR(BGRPNUM) ; Convert to Upper case
S BGRPNUM=$$TRIM^XLFSTR(BGRPNUM,"R"," ") ; Strip Trailing spaces
S FOUND=0,IEN=""
;
; No need to execute for loop if no group name and no group number
I BGRPNM="",BGRPNUM="" Q FOUND
F D Q:IEN=""!FOUND
. S IEN=$O(^IBA(355.3,"B",IBINSDA,IEN))
. Q:IEN=""
. S GRPNM=$$GET1^DIQ(355.3,IEN_",",2.01) ; External Group Name from group plan
. S GRPNM=$$UP^XLFSTR(GRPNM) ; Convert to Upper case
. S GRPNM=$$TRIM^XLFSTR(GRPNM,"R"," ") ; Strip Trailing spaces
. Q:GRPNM'=BGRPNM ; Not an 'exact' match
. S GRPNUM=$$GET1^DIQ(355.3,IEN_",",2.02) ; External Group Number from group plan
. S GRPNUM=$$UP^XLFSTR(GRPNUM) ; Convert to Upper case
. S GRPNUM=$$TRIM^XLFSTR(GRPNUM,"R"," ") ; Strip Trailing spaces
. Q:GRPNUM'=BGRPNUM ; Not an 'exact' match
. S FOUND=1
Q FOUND
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNICB2 2134 printed Oct 16, 2024@18:16:32 Page 2
IBCNICB2 ;FA/ALB - Update utilities for the ICB interface ;1 SEP 2009
+1 ;;2.0;INTEGRATED BILLING;**549**;21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IB*2.0*549 - New routine because of routine size of IBCNICB
+5 ;
EXACTM(IBINSDA,IBBUFDA) ;EP
+1 ; Check for an exact match on an existing group plan when trying to add a
+2 ; new one
+3 ; IB*2.0*549 - Added method
+4 ; Input: IBINSDA - IEN of the Insurance Company (file 36) associated
+5 ; with the group plan being added
+6 ; IBBUFDA - IEN of the Insurance Buffer entry (file 355.33)
+7 ; Returns: 1 - Exact match found on Insurance Company, Group Name and Group Number
+8 ; 0 - Otherwise
+9 NEW BGRPNM,BGRPNUM,FOUND,GRPNM,GRPNUM,IEN
+10 ; External Group Name from buffer
SET BGRPNM=$$GET1^DIQ(355.33,IBBUFDA_",",90.01)
+11 ; Convert to Upper case
SET BGRPNM=$$UP^XLFSTR(BGRPNM)
+12 ; Strip Trailing spaces
SET BGRPNM=$$TRIM^XLFSTR(BGRPNM,"R"," ")
+13 ; External Group Number from buffer
SET BGRPNUM=$$GET1^DIQ(355.33,IBBUFDA_",",90.02)
+14 ; Convert to Upper case
SET BGRPNUM=$$UP^XLFSTR(BGRPNUM)
+15 ; Strip Trailing spaces
SET BGRPNUM=$$TRIM^XLFSTR(BGRPNUM,"R"," ")
+16 SET FOUND=0
SET IEN=""
+17 ;
+18 ; No need to execute for loop if no group name and no group number
+19 IF BGRPNM=""
IF BGRPNUM=""
QUIT FOUND
+20 FOR
Begin DoDot:1
+21 SET IEN=$ORDER(^IBA(355.3,"B",IBINSDA,IEN))
+22 if IEN=""
QUIT
+23 ; External Group Name from group plan
SET GRPNM=$$GET1^DIQ(355.3,IEN_",",2.01)
+24 ; Convert to Upper case
SET GRPNM=$$UP^XLFSTR(GRPNM)
+25 ; Strip Trailing spaces
SET GRPNM=$$TRIM^XLFSTR(GRPNM,"R"," ")
+26 ; Not an 'exact' match
if GRPNM'=BGRPNM
QUIT
+27 ; External Group Number from group plan
SET GRPNUM=$$GET1^DIQ(355.3,IEN_",",2.02)
+28 ; Convert to Upper case
SET GRPNUM=$$UP^XLFSTR(GRPNUM)
+29 ; Strip Trailing spaces
SET GRPNUM=$$TRIM^XLFSTR(GRPNUM,"R"," ")
+30 ; Not an 'exact' match
if GRPNUM'=BGRPNUM
QUIT
+31 SET FOUND=1
End DoDot:1
if IEN=""!FOUND
QUIT
+32 QUIT FOUND
+33 ;
