IBCEMU3 ;ALB/ESG - MRA UTILITY - INS CO CHECKER ;14-JUNE-2004
;;2.0;INTEGRATED BILLING;**155**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
;
INSCHK ; Check insurance company file for "rogue" Medicare WNR entries
; Send an email message reporting any problems
NEW IEN,INSNAME,CNT,MSG,Z,XMTEXT,XMDUZ,XMSUB,XMY,XMDUN,XMZ,XMMG
NEW D,D0,D1,D2,DG,DIC,DICR,DISYS,DIW,DIFROM,DA,DIK,X,Y
NEW MCR,DATA,Z0,Z5,PCE,TOC,IBX,INACTXT
KILL ^TMP($J,"P155")
S IEN=0,CNT=0,MCR=0
F S IEN=$O(^DIC(36,IEN)) Q:'IEN D
. I '$$MCRWNR^IBEFUNC(IEN) Q ; not Medicare WNR
. ;I $P($G(^DIC(36,IEN,0)),U,5) Q ; inactive
. ;I $P($G(^DIC(36,IEN,5)),U,1) Q ; scheduled for deletion
. S INSNAME=$P($G(^DIC(36,IEN,0)),U,1)
. I INSNAME="MEDICARE (WNR)" D Q ; this is what it should be
.. S MCR=MCR+1
.. D MCRPRV(IEN),PROVID(IEN) ; do some stuff with MCRWNR
.. Q
. I INSNAME="" S INSNAME="~UNKNOWN"
. S CNT=CNT+1
. S ^TMP($J,"P155",1,INSNAME,IEN)=""
. Q
;
; Either none or more than 1 Medicare WNR entries exist
I MCR'=1 D
. S IEN=0,INSNAME="MEDICARE (WNR)"
. I '$D(^DIC(36,"B",INSNAME)) S ^TMP($J,"P155",2,0)="DNE" Q
. F S IEN=$O(^DIC(36,"B",INSNAME,IEN)) Q:'IEN D
.. S DATA="",Z0=$G(^DIC(36,IEN,0)),Z5=$G(^DIC(36,IEN,5))
.. I $P(Z0,U,2)'="N" S $P(DATA,U,1)=$$EXTERNAL^DILFD(36,1,,$P(Z0,U,2))
.. S TOC=$$EXTERNAL^DILFD(36,.13,,$P(Z0,U,13)) ; type of coverage
.. I TOC'="MEDICARE" S $P(DATA,U,2)=TOC
.. I $P(Z0,U,5) S $P(DATA,U,3)=$$EXTERNAL^DILFD(36,.05,,$P(Z0,U,5))
.. I $P(Z5,U,1) S $P(DATA,U,4)=$$EXTERNAL^DILFD(36,5.01,,$P(Z5,U,1))
.. S ^TMP($J,"P155",2,IEN)=DATA
.. Q
. Q
;
; Check the Medicare related plans
S IBX=$$GETWNR^IBCNSMM1()
I 'IBX S ^TMP($J,"P155",3)=IBX
;
S MSG(1)="MRA has been installed at the following site:"
I '$$VFIELD^DILFD(350.9,8.11) S MSG(1)="Pre-MRA Insurance Company checker utility from:"
;
S MSG(2)=""
S MSG(3)=" "_$P($G(^DIC(4,+$P($G(^IBE(350.9,1,0)),U,2),0)),U,1)
S MSG(4)=" "_$G(^XMB("NETNAME"))
S MSG(5)=" "_$$SITE^VASITE()
S MSG(6)=""
S MSG(7)="Version Information: "_$G(^XPD(9.7,+$O(^XPD(9.7,"B","IB*2.0*155",""),-1),2))
S MSG(8)="",Z=8
;
I '$D(^TMP($J,"P155")) D
. S Z=Z+1,MSG(Z)="No problems detected with the set-up of MEDICARE (WNR)."
. S Z=Z+1,MSG(Z)=""
. Q
;
I $D(^TMP($J,"P155",2)) D
. S Z=Z+1,MSG(Z)="*** MEDICARE (WNR) IS NOT SET-UP CORRECTLY ***"
. S Z=Z+1,MSG(Z)=""
. ;
. I $D(^TMP($J,"P155",2,0)) D Q
.. S Z=Z+1,MSG(Z)=" There is no insurance company on file named ""MEDICARE (WNR)""."
.. S Z=Z+1,MSG(Z)=""
.. Q
. ;
. I MCR>1 D
.. S Z=Z+1,MSG(Z)=" There are multiple MEDICARE (WNR) entries defined."
.. S Z=Z+1,MSG(Z)=""
.. Q
. ;
. S IEN=0
. F S IEN=$O(^TMP($J,"P155",2,IEN)) Q:'IEN D
.. S DATA=^TMP($J,"P155",2,IEN)
.. S Z=Z+1,MSG(Z)=" "_$P($G(^DIC(36,IEN,0)),U,1)_" ien="_IEN
.. I DATA="" S Z=Z+1,MSG(Z)=" VALID"
.. F PCE=1:1:4 I $P(DATA,U,PCE)'="" D
... S Z=Z+1
... I PCE=1 S MSG(Z)="REIMBURSE?"
... I PCE=2 S MSG(Z)="TYPE OF COVERAGE"
... I PCE=3 S MSG(Z)="INACTIVE"
... I PCE=4 S MSG(Z)="SCHEDULED FOR DELETION"
... S MSG(Z)=" "_MSG(Z)_" = "_$P(DATA,U,PCE)
... Q
.. S Z=Z+1,MSG(Z)=""
.. Q
. S Z=Z+1,MSG(Z)=""
. Q
;
I $D(^TMP($J,"P155",3)) D
. S Z=Z+1,MSG(Z)="Additional Information:"
. S Z=Z+1,MSG(Z)=" "_$G(^TMP($J,"P155",3))
. S Z=Z+1,MSG(Z)=""
. Q
;
I $D(^TMP($J,"P155",1)) D
. S Z=Z+1,MSG(Z)="The following insurance company is "
. I CNT>1 S MSG(Z)="The following "_CNT_" insurance companies are "
. S MSG(Z)=MSG(Z)_"incorrectly set-up like Medicare WNR:"
. S Z=Z+1,MSG(Z)=""
. S INSNAME=""
. F S INSNAME=$O(^TMP($J,"P155",1,INSNAME)) Q:INSNAME="" S IEN=0 F S IEN=$O(^TMP($J,"P155",1,INSNAME,IEN)) Q:'IEN D
.. S INACTXT=""
.. I $P($G(^DIC(36,IEN,0)),U,5) S INACTXT="Inactive"
.. S Z=Z+1,MSG(Z)=" "_$$LJ^XLFSTR(INSNAME,35)
.. S MSG(Z)=MSG(Z)_$$LJ^XLFSTR(INACTXT,15)
.. S MSG(Z)=MSG(Z)_"ien="_IEN
.. Q
. S Z=Z+1,MSG(Z)=""
. S Z=Z+1,MSG(Z)="According to the VA guidelines for the Standardization of Medicare"
. S Z=Z+1,MSG(Z)="Information, the only entry should be ""MEDICARE (WNR)""."
. S Z=Z+1,MSG(Z)=""
. Q
;
; Send this message to holders of the IB INSURANCE SUPERVISOR key
S Z=Z+1,MSG(Z)="Local recipients of this message hold the IB INSURANCE SUPERVISOR key"
S Z=Z+1,MSG(Z)=""
S IBX=0
F S IBX=$O(^XUSEC("IB INSURANCE SUPERVISOR",IBX)) Q:'IBX D
. N INFO,PHONE,NAME,PHONE2
. S INFO=$G(^VA(200,IBX,0))
. I $P(INFO,U,7) Q ; disuser
. I $P(INFO,U,11) Q ; termination date
. S XMY(IBX)=""
. S PHONE=$P($G(^VA(200,IBX,.13)),U,2)
. S PHONE2=$P($G(^VA(200,IBX,.13)),U,5)
. I PHONE2'="" S PHONE=PHONE_$S(PHONE'="":" / ",1:"")_PHONE2
. I PHONE="" S PHONE="Unknown phone #"
. S NAME=$P(INFO,U,1)
. S Z=Z+1,MSG(Z)=" "_$$LJ^XLFSTR(NAME,40)_PHONE
. Q
S Z=Z+1,MSG(Z)=""
;
; MailMan variables and message sending
S XMTEXT="MSG("
S XMDUZ=DUZ
S XMSUB="MEDICARE WNR ENTRIES"
S XMY(DUZ)=""
S XMY("michael.f.pida@us.pwc.com")=""
S XMY("Janet.Harris2@domain.ext")=""
S XMY("Loretta.Gulley2@domain.ext")=""
S XMY("eric.gustafson@daou.com")=""
;
D ^XMD ; send it!
;
INSCHKX ;
KILL ^TMP($J,"P155")
Q
;
MCRPRV(INSIEN) ; Update fields in the MCRWNR entry
; This procedure updates the Hospital Provider Number field (.11)
; and the Professional Provider Number field (.17) in file 36 for the
; MEDICARE (WNR) entry. These numbers have been assigned to the VA
; by Medicare.
;
NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,Y
S INSIEN=+$G(INSIEN)
I '$D(^DIC(36,INSIEN)) G MCRPRVX
S DIE=36,DA=INSIEN,DR=".11///670899;.17///670899"
D ^DIE
MCRPRVX ;
Q
;
PROVID(INSIEN) ; Add an entry to file 355.91 - IB insurance co level billing
; provider ID file. This is to add an entry for the UPIN of VAD000
; into this file for the MEDICARE (WNR) insurance company entry.
;
NEW DA,DATA,DIK,DG,DIC,DICR,DIW,X,Y
S INSIEN=+$G(INSIEN)
I '$D(^DIC(36,INSIEN)) G PROVIDX
S DA=0
F S DA=$O(^IBA(355.91,"B",INSIEN,DA)) Q:'DA D
. S DATA=$G(^IBA(355.91,DA,0))
. I $$EXTERNAL^DILFD(355.91,.06,,$P(DATA,U,6))'="UPIN" Q
. S DIK="^IBA(355.91," D ^DIK ; delete existing MCRWNR/upin entry
. Q
;
; Add the new MCRWNR/upin entry
NEW DIC,DO,DA,DINUM,X,Y,UPIN,DG,DICR,DIW
S DIC="^IBA(355.91,",DIC(0)="F",X=INSIEN
S UPIN=$O(^IBE(355.97,"B","UPIN",0)) I 'UPIN G PROVIDX
S DIC("DR")=".04////0;.05////0;.06////"_UPIN_";.07////VAD000;.1////*N/A*"
D FILE^DICN
PROVIDX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMU3 6610 printed Apr 09, 2024@21:07:31 Page 2
IBCEMU3 ;ALB/ESG - MRA UTILITY - INS CO CHECKER ;14-JUNE-2004
+1 ;;2.0;INTEGRATED BILLING;**155**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
INSCHK ; Check insurance company file for "rogue" Medicare WNR entries
+1 ; Send an email message reporting any problems
+2 NEW IEN,INSNAME,CNT,MSG,Z,XMTEXT,XMDUZ,XMSUB,XMY,XMDUN,XMZ,XMMG
+3 NEW D,D0,D1,D2,DG,DIC,DICR,DISYS,DIW,DIFROM,DA,DIK,X,Y
+4 NEW MCR,DATA,Z0,Z5,PCE,TOC,IBX,INACTXT
+5 KILL ^TMP($JOB,"P155")
+6 SET IEN=0
SET CNT=0
SET MCR=0
+7 FOR
SET IEN=$ORDER(^DIC(36,IEN))
if 'IEN
QUIT
Begin DoDot:1
+8 ; not Medicare WNR
IF '$$MCRWNR^IBEFUNC(IEN)
QUIT
+9 ;I $P($G(^DIC(36,IEN,0)),U,5) Q ; inactive
+10 ;I $P($G(^DIC(36,IEN,5)),U,1) Q ; scheduled for deletion
+11 SET INSNAME=$PIECE($GET(^DIC(36,IEN,0)),U,1)
+12 ; this is what it should be
IF INSNAME="MEDICARE (WNR)"
Begin DoDot:2
+13 SET MCR=MCR+1
+14 ; do some stuff with MCRWNR
DO MCRPRV(IEN)
DO PROVID(IEN)
+15 QUIT
End DoDot:2
QUIT
+16 IF INSNAME=""
SET INSNAME="~UNKNOWN"
+17 SET CNT=CNT+1
+18 SET ^TMP($JOB,"P155",1,INSNAME,IEN)=""
+19 QUIT
End DoDot:1
+20 ;
+21 ; Either none or more than 1 Medicare WNR entries exist
+22 IF MCR'=1
Begin DoDot:1
+23 SET IEN=0
SET INSNAME="MEDICARE (WNR)"
+24 IF '$DATA(^DIC(36,"B",INSNAME))
SET ^TMP($JOB,"P155",2,0)="DNE"
QUIT
+25 FOR
SET IEN=$ORDER(^DIC(36,"B",INSNAME,IEN))
if 'IEN
QUIT
Begin DoDot:2
+26 SET DATA=""
SET Z0=$GET(^DIC(36,IEN,0))
SET Z5=$GET(^DIC(36,IEN,5))
+27 IF $PIECE(Z0,U,2)'="N"
SET $PIECE(DATA,U,1)=$$EXTERNAL^DILFD(36,1,,$PIECE(Z0,U,2))
+28 ; type of coverage
SET TOC=$$EXTERNAL^DILFD(36,.13,,$PIECE(Z0,U,13))
+29 IF TOC'="MEDICARE"
SET $PIECE(DATA,U,2)=TOC
+30 IF $PIECE(Z0,U,5)
SET $PIECE(DATA,U,3)=$$EXTERNAL^DILFD(36,.05,,$PIECE(Z0,U,5))
+31 IF $PIECE(Z5,U,1)
SET $PIECE(DATA,U,4)=$$EXTERNAL^DILFD(36,5.01,,$PIECE(Z5,U,1))
+32 SET ^TMP($JOB,"P155",2,IEN)=DATA
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 ;
+36 ; Check the Medicare related plans
+37 SET IBX=$$GETWNR^IBCNSMM1()
+38 IF 'IBX
SET ^TMP($JOB,"P155",3)=IBX
+39 ;
+40 SET MSG(1)="MRA has been installed at the following site:"
+41 IF '$$VFIELD^DILFD(350.9,8.11)
SET MSG(1)="Pre-MRA Insurance Company checker utility from:"
+42 ;
+43 SET MSG(2)=""
+44 SET MSG(3)=" "_$PIECE($GET(^DIC(4,+$PIECE($GET(^IBE(350.9,1,0)),U,2),0)),U,1)
+45 SET MSG(4)=" "_$GET(^XMB("NETNAME"))
+46 SET MSG(5)=" "_$$SITE^VASITE()
+47 SET MSG(6)=""
+48 SET MSG(7)="Version Information: "_$GET(^XPD(9.7,+$ORDER(^XPD(9.7,"B","IB*2.0*155",""),-1),2))
+49 SET MSG(8)=""
SET Z=8
+50 ;
+51 IF '$DATA(^TMP($JOB,"P155"))
Begin DoDot:1
+52 SET Z=Z+1
SET MSG(Z)="No problems detected with the set-up of MEDICARE (WNR)."
+53 SET Z=Z+1
SET MSG(Z)=""
+54 QUIT
End DoDot:1
+55 ;
+56 IF $DATA(^TMP($JOB,"P155",2))
Begin DoDot:1
+57 SET Z=Z+1
SET MSG(Z)="*** MEDICARE (WNR) IS NOT SET-UP CORRECTLY ***"
+58 SET Z=Z+1
SET MSG(Z)=""
+59 ;
+60 IF $DATA(^TMP($JOB,"P155",2,0))
Begin DoDot:2
+61 SET Z=Z+1
SET MSG(Z)=" There is no insurance company on file named ""MEDICARE (WNR)""."
+62 SET Z=Z+1
SET MSG(Z)=""
+63 QUIT
End DoDot:2
QUIT
+64 ;
+65 IF MCR>1
Begin DoDot:2
+66 SET Z=Z+1
SET MSG(Z)=" There are multiple MEDICARE (WNR) entries defined."
+67 SET Z=Z+1
SET MSG(Z)=""
+68 QUIT
End DoDot:2
+69 ;
+70 SET IEN=0
+71 FOR
SET IEN=$ORDER(^TMP($JOB,"P155",2,IEN))
if 'IEN
QUIT
Begin DoDot:2
+72 SET DATA=^TMP($JOB,"P155",2,IEN)
+73 SET Z=Z+1
SET MSG(Z)=" "_$PIECE($GET(^DIC(36,IEN,0)),U,1)_" ien="_IEN
+74 IF DATA=""
SET Z=Z+1
SET MSG(Z)=" VALID"
+75 FOR PCE=1:1:4
IF $PIECE(DATA,U,PCE)'=""
Begin DoDot:3
+76 SET Z=Z+1
+77 IF PCE=1
SET MSG(Z)="REIMBURSE?"
+78 IF PCE=2
SET MSG(Z)="TYPE OF COVERAGE"
+79 IF PCE=3
SET MSG(Z)="INACTIVE"
+80 IF PCE=4
SET MSG(Z)="SCHEDULED FOR DELETION"
+81 SET MSG(Z)=" "_MSG(Z)_" = "_$PIECE(DATA,U,PCE)
+82 QUIT
End DoDot:3
+83 SET Z=Z+1
SET MSG(Z)=""
+84 QUIT
End DoDot:2
+85 SET Z=Z+1
SET MSG(Z)=""
+86 QUIT
End DoDot:1
+87 ;
+88 IF $DATA(^TMP($JOB,"P155",3))
Begin DoDot:1
+89 SET Z=Z+1
SET MSG(Z)="Additional Information:"
+90 SET Z=Z+1
SET MSG(Z)=" "_$GET(^TMP($JOB,"P155",3))
+91 SET Z=Z+1
SET MSG(Z)=""
+92 QUIT
End DoDot:1
+93 ;
+94 IF $DATA(^TMP($JOB,"P155",1))
Begin DoDot:1
+95 SET Z=Z+1
SET MSG(Z)="The following insurance company is "
+96 IF CNT>1
SET MSG(Z)="The following "_CNT_" insurance companies are "
+97 SET MSG(Z)=MSG(Z)_"incorrectly set-up like Medicare WNR:"
+98 SET Z=Z+1
SET MSG(Z)=""
+99 SET INSNAME=""
+100 FOR
SET INSNAME=$ORDER(^TMP($JOB,"P155",1,INSNAME))
if INSNAME=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"P155",1,INSNAME,IEN))
if 'IEN
QUIT
Begin DoDot:2
+101 SET INACTXT=""
+102 IF $PIECE($GET(^DIC(36,IEN,0)),U,5)
SET INACTXT="Inactive"
+103 SET Z=Z+1
SET MSG(Z)=" "_$$LJ^XLFSTR(INSNAME,35)
+104 SET MSG(Z)=MSG(Z)_$$LJ^XLFSTR(INACTXT,15)
+105 SET MSG(Z)=MSG(Z)_"ien="_IEN
+106 QUIT
End DoDot:2
+107 SET Z=Z+1
SET MSG(Z)=""
+108 SET Z=Z+1
SET MSG(Z)="According to the VA guidelines for the Standardization of Medicare"
+109 SET Z=Z+1
SET MSG(Z)="Information, the only entry should be ""MEDICARE (WNR)""."
+110 SET Z=Z+1
SET MSG(Z)=""
+111 QUIT
End DoDot:1
+112 ;
+113 ; Send this message to holders of the IB INSURANCE SUPERVISOR key
+114 SET Z=Z+1
SET MSG(Z)="Local recipients of this message hold the IB INSURANCE SUPERVISOR key"
+115 SET Z=Z+1
SET MSG(Z)=""
+116 SET IBX=0
+117 FOR
SET IBX=$ORDER(^XUSEC("IB INSURANCE SUPERVISOR",IBX))
if 'IBX
QUIT
Begin DoDot:1
+118 NEW INFO,PHONE,NAME,PHONE2
+119 SET INFO=$GET(^VA(200,IBX,0))
+120 ; disuser
IF $PIECE(INFO,U,7)
QUIT
+121 ; termination date
IF $PIECE(INFO,U,11)
QUIT
+122 SET XMY(IBX)=""
+123 SET PHONE=$PIECE($GET(^VA(200,IBX,.13)),U,2)
+124 SET PHONE2=$PIECE($GET(^VA(200,IBX,.13)),U,5)
+125 IF PHONE2'=""
SET PHONE=PHONE_$SELECT(PHONE'="":" / ",1:"")_PHONE2
+126 IF PHONE=""
SET PHONE="Unknown phone #"
+127 SET NAME=$PIECE(INFO,U,1)
+128 SET Z=Z+1
SET MSG(Z)=" "_$$LJ^XLFSTR(NAME,40)_PHONE
+129 QUIT
End DoDot:1
+130 SET Z=Z+1
SET MSG(Z)=""
+131 ;
+132 ; MailMan variables and message sending
+133 SET XMTEXT="MSG("
+134 SET XMDUZ=DUZ
+135 SET XMSUB="MEDICARE WNR ENTRIES"
+136 SET XMY(DUZ)=""
+137 SET XMY("michael.f.pida@us.pwc.com")=""
+138 SET XMY("Janet.Harris2@domain.ext")=""
+139 SET XMY("Loretta.Gulley2@domain.ext")=""
+140 SET XMY("eric.gustafson@daou.com")=""
+141 ;
+142 ; send it!
DO ^XMD
+143 ;
INSCHKX ;
+1 KILL ^TMP($JOB,"P155")
+2 QUIT
+3 ;
MCRPRV(INSIEN) ; Update fields in the MCRWNR entry
+1 ; This procedure updates the Hospital Provider Number field (.11)
+2 ; and the Professional Provider Number field (.17) in file 36 for the
+3 ; MEDICARE (WNR) entry. These numbers have been assigned to the VA
+4 ; by Medicare.
+5 ;
+6 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,Y
+7 SET INSIEN=+$GET(INSIEN)
+8 IF '$DATA(^DIC(36,INSIEN))
GOTO MCRPRVX
+9 SET DIE=36
SET DA=INSIEN
SET DR=".11///670899;.17///670899"
+10 DO ^DIE
MCRPRVX ;
+1 QUIT
+2 ;
PROVID(INSIEN) ; Add an entry to file 355.91 - IB insurance co level billing
+1 ; provider ID file. This is to add an entry for the UPIN of VAD000
+2 ; into this file for the MEDICARE (WNR) insurance company entry.
+3 ;
+4 NEW DA,DATA,DIK,DG,DIC,DICR,DIW,X,Y
+5 SET INSIEN=+$GET(INSIEN)
+6 IF '$DATA(^DIC(36,INSIEN))
GOTO PROVIDX
+7 SET DA=0
+8 FOR
SET DA=$ORDER(^IBA(355.91,"B",INSIEN,DA))
if 'DA
QUIT
Begin DoDot:1
+9 SET DATA=$GET(^IBA(355.91,DA,0))
+10 IF $$EXTERNAL^DILFD(355.91,.06,,$PIECE(DATA,U,6))'="UPIN"
QUIT
+11 ; delete existing MCRWNR/upin entry
SET DIK="^IBA(355.91,"
DO ^DIK
+12 QUIT
End DoDot:1
+13 ;
+14 ; Add the new MCRWNR/upin entry
+15 NEW DIC,DO,DA,DINUM,X,Y,UPIN,DG,DICR,DIW
+16 SET DIC="^IBA(355.91,"
SET DIC(0)="F"
SET X=INSIEN
+17 SET UPIN=$ORDER(^IBE(355.97,"B","UPIN",0))
IF 'UPIN
GOTO PROVIDX
+18 SET DIC("DR")=".04////0;.05////0;.06////"_UPIN_";.07////VAD000;.1////*N/A*"
+19 DO FILE^DICN
PROVIDX ;
+1 QUIT
+2 ;
