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.
;
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEML 3439 printed Dec 13, 2024@02:14:51 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
