- 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 Feb 18, 2025@23:42:16 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 ;
