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

IBCU5.m

Go to the documentation of this file.
  1. IBCU5 ;ALB/AAS - MCCR MAILING ADDRESS UTILITY ROUTINE ;26-FEB-90
  1. ;;2.0;INTEGRATED BILLING;**8,52,80,117,51,206,447**;21-MAR-94;Build 80
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRU5
  1. ;
  1. EN ;Entry from X-REF from who's responsible
  1. ;doesn't set primary insurance field, must be second trigger.
  1. S X=$P(^DGCR(399,DA,0),"^",11)
  1. I X="p" D MAILP G ENQ
  1. I X="o" S DGTAG=$S('$D(^DGCR(399,DA,"M")):"MAILP",'$P(^("M"),"^",11):"MAILP",'$D(^DIC(4,$P(^("M"),"^",11),0)):"MAILP",1:"MAILIN") D @DGTAG G ENQ
  1. I X="i",+$G(^DGCR(399,DA,"MP")) D MAILA G ENQ
  1. ENQ K DGTAG Q
  1. ;
  1. EN1 ;Now Trigger of primary insurance policy from who's responsible
  1. ;if only one active policy
  1. ;; old Trigger of primary insurer from who's responsible
  1. ;Only should be called if primary insurer is null (condition of trigger)
  1. ;return ifn of insurer in X
  1. ;
  1. S X=""
  1. I $S('$D(IBAC):1,IBAC=6:1,1:0) Q
  1. ;
  1. S IBINDT=$S($G(IBIDS(151)):IBIDS(151),$P($G(^DGCR(399,DA,"U")),"^"):$P($G(^DGCR(399,DA,"U")),"^"),1:DT)
  1. D ALL^IBCNS1(DFN,"IBDD",2,IBINDT)
  1. I $G(IBDD(0))=1 S X=+$O(IBDD(0)) G EN1Q
  1. ;
  1. ;S IBOUTP=1,IBINDT=$S($G(IBIDS(151)):IBIDS(151),$P($G(^DGCR(399,DA,"U")),"^"):$P($G(^DGCR(399,DA,"U")),"^"),1:DT)
  1. ;D ^IBCNS I IBINS S X=IBDD($O(IBDD(0))) S:$O(IBDD(+X)) X="" S X=$S($D(^DIC(36,+X,0)):+X,1:"") G EN1Q
  1. S X=""
  1. EN1Q K IBDD,IBINS,IBIN Q
  1. ;
  1. MAILA ;Store Mailing Address for Bill Payer Carrier (and if not copying bill or bill not authorized,
  1. ; insert Attending Physican Id [36,.1] into Form Locator 92 [399,213]
  1. ;
  1. S DA=$S('$D(DA):IBIFN,DA']"":IBIFN,1:DA)
  1. G MAILQ:$P(^DGCR(399,DA,0),U,11)="p" ; Patient is responsible for bill
  1. G MAILQ:$P(^DGCR(399,DA,0),U,11)="o" ; Other party is responsible for bill
  1. ;
  1. S IB01=+$G(^DGCR(399,DA,"MP"))
  1. G MAILQ:'$D(^DIC(36,+IB01,0)) ; Bad insurance data
  1. ;
  1. S IB02=$$ADD^IBCNADD(DA)
  1. ;
  1. D UPDMA(DA,IB01,IB02)
  1. ;
  1. ; Removed reference to obsolete data field with IB*2.0*447 BI
  1. ;I '$D(IBCAN)!($G(IBAC)<3) S $P(^DGCR(399,DA,"U1"),U,13)=$P($G(^DIC(36,+IB01,0)),U,10)
  1. ;
  1. MAILQ K IB01,IB02,IB03 Q
  1. ;
  1. UPDMA(DA,IB01,IB02) ; Update insurance company mailing address in file 399
  1. ; DA = bill ifn
  1. ;IB02 = string returned from call to ADD^IBCNADD
  1. ;IB01 = insurance company ifn
  1. S $P(^DGCR(399,DA,"M"),"^",4,9)=$E($P($G(^DIC(36,+IB01,0)),"^",1),1,30)_"^"_$P(IB02,"^",1)_"^"_$P(IB02,"^",2)_"^"_$P(IB02,"^",4)_"^"_$P(IB02,"^",5)_"^"_$P(IB02,"^",6)
  1. ;
  1. ; -- if send bill to employer, piece 7 = name
  1. I $P(IB02,"^",8)'="",+$P(IB02,"^",8)'=$P(IB02,"^",8) S $P(^DGCR(399,DA,"M"),"^",4)=$P(IB02,"^",8)
  1. ;
  1. S $P(^DGCR(399,DA,"M1"),U,1)=$P(IB02,U,3)
  1. Q
  1. ;
  1. MAILIN ;Store Mailing Address for Institution
  1. S DA=$S('$D(DA):IBIFN,DA']"":IBIFN,1:DA),X=$P(^DGCR(399,DA,"M"),"^",11) G:X']"" MAILINQ G:'$D(^DIC(4,X,0)) MAILINQ
  1. S IB01=^DIC(4,X,0),IB02=$S($D(^(1)):^(1),1:"")
  1. S $P(^DGCR(399,IBIFN,"M"),"^",4,9)=$P(IB01,U,1)_"^"_$P(IB02,U,1)_"^"_$P(IB02,U,2)_"^"_$P(IB02,U,3)_"^"_$P(IB01,U,2)_"^"_$TR($P(IB02,U,4),"-")
  1. S $P(^DGCR(399,IBIFN,"M1"),"^",1)=""
  1. MAILINQ K IB01,IB02,IB03 Q
  1. ;
  1. MAILP ;Store Patient Mailing address
  1. N DFN,VAPA,DGNAM,IBCONF
  1. S DA=$S('$D(DA):IBIFN,DA']"":IBIFN,1:DA)
  1. S DFN=$P(^DGCR(399,DA,0),"^",2),VAPA("P")="" D DEM^VADPT,ADD^VADPT
  1. S IBCONF=$S('$G(VAPA(12)):0,$P($G(VAPA(22,3)),U,3)'="Y":0,1:1) ; Confidential Address
  1. S DGNAM=$P(VADM(1),",",2)_" "_$P(VADM(1),",",1)
  1. S DGNAM=$S($E(VADM(5))'="F":"MR.",'$D(^DIC(11,+$P(^DPT(DFN,0),"^",5),0)):"MS.","DMW"[$E(^DIC(11,$P(^DPT(DFN,0),"^",5),0)):"MRS.",1:"MS.")_DGNAM
  1. S $P(^DGCR(399,DA,"M"),"^",4)=DGNAM
  1. I IBCONF D ; use conf. address for mailing
  1. . S $P(^DGCR(399,DA,"M"),"^",5,9)=VAPA(13)_"^"_VAPA(14)_"^"_VAPA(16)_"^"_+VAPA(17)_"^"_$P(VAPA(18),U,1)
  1. . S $P(^DGCR(399,DA,"M1"),"^",1)=VAPA(15)
  1. I 'IBCONF D
  1. . S $P(^DGCR(399,DA,"M"),"^",5,9)=VAPA(1)_"^"_VAPA(2)_"^"_VAPA(4)_"^"_+VAPA(5)_"^"_$P(VAPA(11),U,1)
  1. . S $P(^DGCR(399,DA,"M1"),"^",1)=VAPA(3)
  1. MAILPQ Q
  1. ;
  1. INSUR ;
  1. Q
  1. DEL S $P(^DGCR(399,DA,"M"),"^",4,9)="^^^^^",$P(^("M1"),"^",1)=""
  1. Q