Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEMU3

IBCEMU3.m

Go to the documentation of this file.
  1. IBCEMU3 ;ALB/ESG - MRA UTILITY - INS CO CHECKER ;14-JUNE-2004
  1. ;;2.0;INTEGRATED BILLING;**155**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. INSCHK ; Check insurance company file for "rogue" Medicare WNR entries
  1. ; Send an email message reporting any problems
  1. NEW IEN,INSNAME,CNT,MSG,Z,XMTEXT,XMDUZ,XMSUB,XMY,XMDUN,XMZ,XMMG
  1. NEW D,D0,D1,D2,DG,DIC,DICR,DISYS,DIW,DIFROM,DA,DIK,X,Y
  1. NEW MCR,DATA,Z0,Z5,PCE,TOC,IBX,INACTXT
  1. KILL ^TMP($J,"P155")
  1. S IEN=0,CNT=0,MCR=0
  1. F S IEN=$O(^DIC(36,IEN)) Q:'IEN D
  1. . I '$$MCRWNR^IBEFUNC(IEN) Q ; not Medicare WNR
  1. . ;I $P($G(^DIC(36,IEN,0)),U,5) Q ; inactive
  1. . ;I $P($G(^DIC(36,IEN,5)),U,1) Q ; scheduled for deletion
  1. . S INSNAME=$P($G(^DIC(36,IEN,0)),U,1)
  1. . I INSNAME="MEDICARE (WNR)" D Q ; this is what it should be
  1. .. S MCR=MCR+1
  1. .. D MCRPRV(IEN),PROVID(IEN) ; do some stuff with MCRWNR
  1. .. Q
  1. . I INSNAME="" S INSNAME="~UNKNOWN"
  1. . S CNT=CNT+1
  1. . S ^TMP($J,"P155",1,INSNAME,IEN)=""
  1. . Q
  1. ;
  1. ; Either none or more than 1 Medicare WNR entries exist
  1. I MCR'=1 D
  1. . S IEN=0,INSNAME="MEDICARE (WNR)"
  1. . I '$D(^DIC(36,"B",INSNAME)) S ^TMP($J,"P155",2,0)="DNE" Q
  1. . F S IEN=$O(^DIC(36,"B",INSNAME,IEN)) Q:'IEN D
  1. .. S DATA="",Z0=$G(^DIC(36,IEN,0)),Z5=$G(^DIC(36,IEN,5))
  1. .. I $P(Z0,U,2)'="N" S $P(DATA,U,1)=$$EXTERNAL^DILFD(36,1,,$P(Z0,U,2))
  1. .. S TOC=$$EXTERNAL^DILFD(36,.13,,$P(Z0,U,13)) ; type of coverage
  1. .. I TOC'="MEDICARE" S $P(DATA,U,2)=TOC
  1. .. I $P(Z0,U,5) S $P(DATA,U,3)=$$EXTERNAL^DILFD(36,.05,,$P(Z0,U,5))
  1. .. I $P(Z5,U,1) S $P(DATA,U,4)=$$EXTERNAL^DILFD(36,5.01,,$P(Z5,U,1))
  1. .. S ^TMP($J,"P155",2,IEN)=DATA
  1. .. Q
  1. . Q
  1. ;
  1. ; Check the Medicare related plans
  1. S IBX=$$GETWNR^IBCNSMM1()
  1. I 'IBX S ^TMP($J,"P155",3)=IBX
  1. ;
  1. S MSG(1)="MRA has been installed at the following site:"
  1. I '$$VFIELD^DILFD(350.9,8.11) S MSG(1)="Pre-MRA Insurance Company checker utility from:"
  1. ;
  1. S MSG(2)=""
  1. S MSG(3)=" "_$P($G(^DIC(4,+$P($G(^IBE(350.9,1,0)),U,2),0)),U,1)
  1. S MSG(4)=" "_$G(^XMB("NETNAME"))
  1. S MSG(5)=" "_$$SITE^VASITE()
  1. S MSG(6)=""
  1. S MSG(7)="Version Information: "_$G(^XPD(9.7,+$O(^XPD(9.7,"B","IB*2.0*155",""),-1),2))
  1. S MSG(8)="",Z=8
  1. ;
  1. I '$D(^TMP($J,"P155")) D
  1. . S Z=Z+1,MSG(Z)="No problems detected with the set-up of MEDICARE (WNR)."
  1. . S Z=Z+1,MSG(Z)=""
  1. . Q
  1. ;
  1. I $D(^TMP($J,"P155",2)) D
  1. . S Z=Z+1,MSG(Z)="*** MEDICARE (WNR) IS NOT SET-UP CORRECTLY ***"
  1. . S Z=Z+1,MSG(Z)=""
  1. . ;
  1. . I $D(^TMP($J,"P155",2,0)) D Q
  1. .. S Z=Z+1,MSG(Z)=" There is no insurance company on file named ""MEDICARE (WNR)""."
  1. .. S Z=Z+1,MSG(Z)=""
  1. .. Q
  1. . ;
  1. . I MCR>1 D
  1. .. S Z=Z+1,MSG(Z)=" There are multiple MEDICARE (WNR) entries defined."
  1. .. S Z=Z+1,MSG(Z)=""
  1. .. Q
  1. . ;
  1. . S IEN=0
  1. . F S IEN=$O(^TMP($J,"P155",2,IEN)) Q:'IEN D
  1. .. S DATA=^TMP($J,"P155",2,IEN)
  1. .. S Z=Z+1,MSG(Z)=" "_$P($G(^DIC(36,IEN,0)),U,1)_" ien="_IEN
  1. .. I DATA="" S Z=Z+1,MSG(Z)=" VALID"
  1. .. F PCE=1:1:4 I $P(DATA,U,PCE)'="" D
  1. ... S Z=Z+1
  1. ... I PCE=1 S MSG(Z)="REIMBURSE?"
  1. ... I PCE=2 S MSG(Z)="TYPE OF COVERAGE"
  1. ... I PCE=3 S MSG(Z)="INACTIVE"
  1. ... I PCE=4 S MSG(Z)="SCHEDULED FOR DELETION"
  1. ... S MSG(Z)=" "_MSG(Z)_" = "_$P(DATA,U,PCE)
  1. ... Q
  1. .. S Z=Z+1,MSG(Z)=""
  1. .. Q
  1. . S Z=Z+1,MSG(Z)=""
  1. . Q
  1. ;
  1. I $D(^TMP($J,"P155",3)) D
  1. . S Z=Z+1,MSG(Z)="Additional Information:"
  1. . S Z=Z+1,MSG(Z)=" "_$G(^TMP($J,"P155",3))
  1. . S Z=Z+1,MSG(Z)=""
  1. . Q
  1. ;
  1. I $D(^TMP($J,"P155",1)) D
  1. . S Z=Z+1,MSG(Z)="The following insurance company is "
  1. . I CNT>1 S MSG(Z)="The following "_CNT_" insurance companies are "
  1. . S MSG(Z)=MSG(Z)_"incorrectly set-up like Medicare WNR:"
  1. . S Z=Z+1,MSG(Z)=""
  1. . S INSNAME=""
  1. . 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
  1. .. S INACTXT=""
  1. .. I $P($G(^DIC(36,IEN,0)),U,5) S INACTXT="Inactive"
  1. .. S Z=Z+1,MSG(Z)=" "_$$LJ^XLFSTR(INSNAME,35)
  1. .. S MSG(Z)=MSG(Z)_$$LJ^XLFSTR(INACTXT,15)
  1. .. S MSG(Z)=MSG(Z)_"ien="_IEN
  1. .. Q
  1. . S Z=Z+1,MSG(Z)=""
  1. . S Z=Z+1,MSG(Z)="According to the VA guidelines for the Standardization of Medicare"
  1. . S Z=Z+1,MSG(Z)="Information, the only entry should be ""MEDICARE (WNR)""."
  1. . S Z=Z+1,MSG(Z)=""
  1. . Q
  1. ;
  1. ; Send this message to holders of the IB INSURANCE SUPERVISOR key
  1. S Z=Z+1,MSG(Z)="Local recipients of this message hold the IB INSURANCE SUPERVISOR key"
  1. S Z=Z+1,MSG(Z)=""
  1. S IBX=0
  1. F S IBX=$O(^XUSEC("IB INSURANCE SUPERVISOR",IBX)) Q:'IBX D
  1. . N INFO,PHONE,NAME,PHONE2
  1. . S INFO=$G(^VA(200,IBX,0))
  1. . I $P(INFO,U,7) Q ; disuser
  1. . I $P(INFO,U,11) Q ; termination date
  1. . S XMY(IBX)=""
  1. . S PHONE=$P($G(^VA(200,IBX,.13)),U,2)
  1. . S PHONE2=$P($G(^VA(200,IBX,.13)),U,5)
  1. . I PHONE2'="" S PHONE=PHONE_$S(PHONE'="":" / ",1:"")_PHONE2
  1. . I PHONE="" S PHONE="Unknown phone #"
  1. . S NAME=$P(INFO,U,1)
  1. . S Z=Z+1,MSG(Z)=" "_$$LJ^XLFSTR(NAME,40)_PHONE
  1. . Q
  1. S Z=Z+1,MSG(Z)=""
  1. ;
  1. ; MailMan variables and message sending
  1. S XMTEXT="MSG("
  1. S XMDUZ=DUZ
  1. S XMSUB="MEDICARE WNR ENTRIES"
  1. S XMY(DUZ)=""
  1. S XMY("michael.f.pida@us.pwc.com")=""
  1. S XMY("Janet.Harris2@domain.ext")=""
  1. S XMY("Loretta.Gulley2@domain.ext")=""
  1. S XMY("eric.gustafson@daou.com")=""
  1. ;
  1. D ^XMD ; send it!
  1. ;
  1. INSCHKX ;
  1. KILL ^TMP($J,"P155")
  1. Q
  1. ;
  1. MCRPRV(INSIEN) ; Update fields in the MCRWNR entry
  1. ; This procedure updates the Hospital Provider Number field (.11)
  1. ; and the Professional Provider Number field (.17) in file 36 for the
  1. ; MEDICARE (WNR) entry. These numbers have been assigned to the VA
  1. ; by Medicare.
  1. ;
  1. NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,Y
  1. S INSIEN=+$G(INSIEN)
  1. I '$D(^DIC(36,INSIEN)) G MCRPRVX
  1. S DIE=36,DA=INSIEN,DR=".11///670899;.17///670899"
  1. D ^DIE
  1. MCRPRVX ;
  1. Q
  1. ;
  1. 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
  1. ; into this file for the MEDICARE (WNR) insurance company entry.
  1. ;
  1. NEW DA,DATA,DIK,DG,DIC,DICR,DIW,X,Y
  1. S INSIEN=+$G(INSIEN)
  1. I '$D(^DIC(36,INSIEN)) G PROVIDX
  1. S DA=0
  1. F S DA=$O(^IBA(355.91,"B",INSIEN,DA)) Q:'DA D
  1. . S DATA=$G(^IBA(355.91,DA,0))
  1. . I $$EXTERNAL^DILFD(355.91,.06,,$P(DATA,U,6))'="UPIN" Q
  1. . S DIK="^IBA(355.91," D ^DIK ; delete existing MCRWNR/upin entry
  1. . Q
  1. ;
  1. ; Add the new MCRWNR/upin entry
  1. NEW DIC,DO,DA,DINUM,X,Y,UPIN,DG,DICR,DIW
  1. S DIC="^IBA(355.91,",DIC(0)="F",X=INSIEN
  1. S UPIN=$O(^IBE(355.97,"B","UPIN",0)) I 'UPIN G PROVIDX
  1. S DIC("DR")=".04////0;.05////0;.06////"_UPIN_";.07////VAD000;.1////*N/A*"
  1. D FILE^DICN
  1. PROVIDX ;
  1. Q
  1. ;