Routine: IBCNEML

IBCNEML ;BP/YMG - MAILMAN NOTIFICATION TO LINK PAYERS ;27-AUG-2010

 ;;2.0;INTEGRATED BILLING;**438,668**;21-MAR-94;Build 28

 ;;Per VA Directive 6402, this routine should not be modified.

EN ; entry point

 N ACTIVE,APP,DATA,IEN,INS,INSTID,LN,LOACT,MGRP,MSG,MSUBJ,NAACT,PAYER,PROFID,RPTDATA,STR1,STR2,TOTAL

 ; build a cross reference with all existing professional and institutional EDI ID numbers in file 36.

 S INS=0 F  S INS=$O(^DIC(36,INS)) Q:'INS  D

 .I '$$ACTIVE^IBCNEUT4(INS) Q  ; inactive ins co

 .S DATA=$G(^DIC(36,INS,3)) I $P(DATA,U,10)'="" Q  ; already linked to a payer

 .S PROFID=$P(DATA,U,2),INSTID=$P(DATA,U,4)

 .I PROFID'="" S RPTDATA("P",PROFID)=""

 .I INSTID'="" S RPTDATA("I",INSTID)=""

.Q

 ; loop through payers - if there is an unlinked insurance company with the same prof/inst id, this payer has

 ; potential payer-insurance company links that have not yet been made.

 S (TOTAL,IEN)=0 F  S IEN=$O(^IBE(365.12,IEN)) Q:'IEN  D

 .I '$$ACTAPP^IBCNEUT5(IEN) Q  ; no active payer applications

 .; Must have at least 1 nationally active payer application

 .S APP=0,ACTIVE=0 F  S APP=$O(^IBE(365.12,IEN,1,APP)) Q:'APP!ACTIVE  D

 ..I $P($G(^IBE(365.12,IEN,1,APP,0)),U,2)=1 S ACTIVE=1

..Q

 .Q:'ACTIVE    ; no nationally active payer application found

 .S DATA=$G(^IBE(365.12,IEN,0)),PAYER=$P(DATA,U),PROFID=$P(DATA,U,5),INSTID=$P(DATA,U,6)

 .I PROFID'="",$D(RPTDATA("P",PROFID)) S:'$D(RPTDATA("PYR",IEN)) RPTDATA("PYR",IEN)="",TOTAL=TOTAL+1

 .I INSTID'="",$D(RPTDATA("I",INSTID)) S:'$D(RPTDATA("PYR",IEN)) RPTDATA("PYR",IEN)="",TOTAL=TOTAL+1

 .; if payer is nationally active, but locally inactive, add it to the list

 .;IB*668/TAZ - Changed Payer Application from IIV to EIV

 .S APP=$$PYRAPP^IBCNEUT5("EIV",IEN),(LOACT,NAACT)=0

 .I 'APP Q

 .S DATA=$G(^IBE(365.12,IEN,1,APP,0)),NAACT=$P(DATA,U,2),LOACT=$P(DATA,U,3)

 .I NAACT,'LOACT,$D(RPTDATA("PYR",IEN)) S RPTDATA("INACTIVE",IEN)=PAYER

.Q

 ; create and send Mailman messages

 S MGRP=$$MGRP^IBCNEUT5(),STR1="Immediate Attention Required:",STR2="-----------------------------"

 I TOTAL D

 .S MSUBJ="ACTION REQ: POTENTIAL PAYERS TO BE LINKED",LN=0

 .S LN=LN+1,MSG(LN)="TOTAL NUMBER OF PAYERS WITH POTENTIAL INSURANCE COMPANY MATCHES: "_TOTAL

 .S LN=LN+1,MSG(LN)=""

 .S LN=LN+1,MSG(LN)=STR1

 .S LN=LN+1,MSG(LN)=STR2

 .S LN=LN+1,MSG(LN)="Please link the associated active insurance companies to these payers at your"

 .S LN=LN+1,MSG(LN)="earliest convenience. Please visit the e-Business Projects Webpage on VistA"

 .S LN=LN+1,MSG(LN)="University Website to download the Link Payer Instructions."

 .D MSG^IBCNEUT5(MGRP,MSUBJ,"MSG(")

.Q

 I $D(RPTDATA("INACTIVE")) D

 .K MSG

 .S MSUBJ="ACTION REQ: PAYERS TO BE LOCALLY ACTIVATED",LN=0

 .S LN=LN+1,MSG(LN)="Nationally Active Payers that are Locally Inactive:"

 .S LN=LN+1,MSG(LN)="---------------------------------------------------"

 .S LN=LN+1,MSG(LN)=""

 .S IEN="" F  S IEN=$O(RPTDATA("INACTIVE",IEN)) Q:IEN=""  S LN=LN+1,MSG(LN)=$$FO^IBCNEUT1(RPTDATA("INACTIVE",IEN),79)

 .S LN=LN+1,MSG(LN)=""

 .S LN=LN+1,MSG(LN)=STR1

 .S LN=LN+1,MSG(LN)=STR2

 .S LN=LN+1,MSG(LN)="Please locally activate the payers after you link insurance companies to them."

 .S LN=LN+1,MSG(LN)="Please visit the e-Business Projects Webpage on VistA University Website to"

 .S LN=LN+1,MSG(LN)="download the Payer Activation Instructions."

 .D MSG^IBCNEUT5(MGRP,MSUBJ,"MSG(")

.Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEML   3439     printed  Feb 18, 2025@23:41:15                                                                                                                                                                                                     Page 2

IBCNEML   ;BP/YMG - MAILMAN NOTIFICATION TO LINK PAYERS ;27-AUG-2010

 +1       ;;2.0;INTEGRATED BILLING;**438,668**;21-MAR-94;Build 28

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4        QUIT

 +5       ;

EN        ; entry point

 +1        NEW ACTIVE,APP,DATA,IEN,INS,INSTID,LN,LOACT,MGRP,MSG,MSUBJ,NAACT,PAYER,PROFID,RPTDATA,STR1,STR2,TOTAL

 +2       ; build a cross reference with all existing professional and institutional EDI ID numbers in file 36.

 +3        SET INS=0

FOR

               SET INS=$ORDER(^DIC(36,INS))

               if 'INS

                   QUIT

               Begin DoDot:1

 +4       ; inactive ins co

                   IF '$$ACTIVE^IBCNEUT4(INS)

                       QUIT

 +5       ; already linked to a payer

                   SET DATA=$GET(^DIC(36,INS,3))

                   IF $PIECE(DATA,U,10)'=""

                       QUIT

 +6                SET PROFID=$PIECE(DATA,U,2)

                   SET INSTID=$PIECE(DATA,U,4)

 +7                IF PROFID'=""

                       SET RPTDATA("P",PROFID)=""

 +8                IF INSTID'=""

                       SET RPTDATA("I",INSTID)=""

 +9                QUIT

               End DoDot:1

 +10      ; loop through payers - if there is an unlinked insurance company with the same prof/inst id, this payer has

 +11      ; potential payer-insurance company links that have not yet been made.

 +12       SET (TOTAL,IEN)=0

FOR

               SET IEN=$ORDER(^IBE(365.12,IEN))

               if 'IEN

                   QUIT

               Begin DoDot:1

 +13      ; no active payer applications

                   IF '$$ACTAPP^IBCNEUT5(IEN)

                       QUIT

 +14      ; Must have at least 1 nationally active payer application

 +15               SET APP=0

                   SET ACTIVE=0

FOR

                       SET APP=$ORDER(^IBE(365.12,IEN,1,APP))

                       if 'APP!ACTIVE

                           QUIT

                       Begin DoDot:2

 +16                       IF $PIECE($GET(^IBE(365.12,IEN,1,APP,0)),U,2)=1

                               SET ACTIVE=1

 +17                       QUIT

                       End DoDot:2

 +18      ; no nationally active payer application found

                   if 'ACTIVE

                       QUIT

 +19               SET DATA=$GET(^IBE(365.12,IEN,0))

                   SET PAYER=$PIECE(DATA,U)

                   SET PROFID=$PIECE(DATA,U,5)

                   SET INSTID=$PIECE(DATA,U,6)

 +20               IF PROFID'=""

                       IF $DATA(RPTDATA("P",PROFID))

                           if '$DATA(RPTDATA("PYR",IEN))

                               SET RPTDATA("PYR",IEN)=""

                               SET TOTAL=TOTAL+1

 +21               IF INSTID'=""

                       IF $DATA(RPTDATA("I",INSTID))

                           if '$DATA(RPTDATA("PYR",IEN))

                               SET RPTDATA("PYR",IEN)=""

                               SET TOTAL=TOTAL+1

 +22      ; if payer is nationally active, but locally inactive, add it to the list

 +23      ;IB*668/TAZ - Changed Payer Application from IIV to EIV

 +24               SET APP=$$PYRAPP^IBCNEUT5("EIV",IEN)

                   SET (LOACT,NAACT)=0

 +25               IF 'APP

                       QUIT

 +26               SET DATA=$GET(^IBE(365.12,IEN,1,APP,0))

                   SET NAACT=$PIECE(DATA,U,2)

                   SET LOACT=$PIECE(DATA,U,3)

 +27               IF NAACT

                       IF 'LOACT

                           IF $DATA(RPTDATA("PYR",IEN))

                               SET RPTDATA("INACTIVE",IEN)=PAYER

 +28               QUIT

               End DoDot:1

 +29      ; create and send Mailman messages

 +30       SET MGRP=$$MGRP^IBCNEUT5()

           SET STR1="Immediate Attention Required:"

           SET STR2="-----------------------------"

 +31       IF TOTAL

               Begin DoDot:1

 +32               SET MSUBJ="ACTION REQ: POTENTIAL PAYERS TO BE LINKED"

                   SET LN=0

 +33               SET LN=LN+1

                   SET MSG(LN)="TOTAL NUMBER OF PAYERS WITH POTENTIAL INSURANCE COMPANY MATCHES: "_TOTAL

 +34               SET LN=LN+1

                   SET MSG(LN)=""

 +35               SET LN=LN+1

                   SET MSG(LN)=STR1

 +36               SET LN=LN+1

                   SET MSG(LN)=STR2

 +37               SET LN=LN+1

                   SET MSG(LN)="Please link the associated active insurance companies to these payers at your"

 +38               SET LN=LN+1

                   SET MSG(LN)="earliest convenience. Please visit the e-Business Projects Webpage on VistA"

 +39               SET LN=LN+1

                   SET MSG(LN)="University Website to download the Link Payer Instructions."

 +40               DO MSG^IBCNEUT5(MGRP,MSUBJ,"MSG(")

 +41               QUIT

               End DoDot:1

 +42       IF $DATA(RPTDATA("INACTIVE"))

               Begin DoDot:1

 +43               KILL MSG

 +44               SET MSUBJ="ACTION REQ: PAYERS TO BE LOCALLY ACTIVATED"

                   SET LN=0

 +45               SET LN=LN+1

                   SET MSG(LN)="Nationally Active Payers that are Locally Inactive:"

 +46               SET LN=LN+1

                   SET MSG(LN)="---------------------------------------------------"

 +47               SET LN=LN+1

                   SET MSG(LN)=""

 +48               SET IEN=""

FOR

                       SET IEN=$ORDER(RPTDATA("INACTIVE",IEN))

                       if IEN=""

                           QUIT

                       SET LN=LN+1

                       SET MSG(LN)=$$FO^IBCNEUT1(RPTDATA("INACTIVE",IEN),79)

 +49               SET LN=LN+1

                   SET MSG(LN)=""

 +50               SET LN=LN+1

                   SET MSG(LN)=STR1

 +51               SET LN=LN+1

                   SET MSG(LN)=STR2

 +52               SET LN=LN+1

                   SET MSG(LN)="Please locally activate the payers after you link insurance companies to them."

 +53               SET LN=LN+1

                   SET MSG(LN)="Please visit the e-Business Projects Webpage on VistA University Website to"

 +54               SET LN=LN+1

                   SET MSG(LN)="download the Payer Activation Instructions."

 +55               DO MSG^IBCNEUT5(MGRP,MSUBJ,"MSG(")

 +56               QUIT

               End DoDot:1

 +57       QUIT

IBCNEML.m