IBCNICB2.m

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 ---IBCNICB2   2134     printed  Apr 09, 2024@21:19:06                                                                                                                                                                                                    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      ;