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

IBCNSMM1.m

Go to the documentation of this file. 
  1. IBCNSMM1 ;ALB/CMS -MEDICARE INSURANCE INTAKE (CONT) ; 11/8/06 9:32am
  1.  ;;2.0;INTEGRATED BILLING;**103,359,497,602**;21-MAR-94;Build 22
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;(THIS ROUTINE WAS DEACTIVATED VIA PATCH 497...AND SHOULD BE RESEARCHED
  1.  ;;IF REACTIVATED...REFER TO FIELDS (40.02, 40.03, 60.04, 60.07 OF THE
  1.  ;;355.33 FILE.)
  1.  Q
  1.  ;
  1. SETP(IBP) ; -- Stuff data fields in patient policy
  1.  ;  Required Input:
  1.  ;  IBP =A for Part A, B for Part B
  1.  ;  DFN =pt. ien
  1.  ;  IBCDFN =patient policy ien
  1.  ;  IBNAME =Name of Insured
  1.  ;  IBHICN =Subscriber ID - as of IB*601 could also be a MBI Number
  1.  ;  IBAEFF =Effective Date of Plan A
  1.  ;  IBBEFF =Effective Date of Plan B
  1.  ;  IBCNSP =Medicare (WNR) ien ^Part A ien ^Part B ien
  1.  ;  IBCOBI =Coordination of Benefits (Internal value)
  1.  ;
  1.  N D,DA,DIE,DR,IBBDA,X,Y
  1.  I '$D(^DPT(DFN,.312,+IBCDFN,0)) G SETPQ
  1.  ;
  1.  ; -- Stuff the pt. policy fields
  1.  ;   #2  *Group Number              #.18  Group Plan
  1.  ;   #6  Whose Ins.                 #.2   COB
  1.  ;   #8  Effective Date of Policy   #7.02    Sub. ID
  1.  ;   #15 *Group Name                #7.01   Name of Insured
  1.  ;   #16 Pt. Relationship to Insured
  1.  ;
  1.  S DIE="^DPT("_DFN_",.312,",DA=+IBCDFN,DA(1)=DFN
  1.  S DR="2///"_$S(IBP="A":$P(IBCNSP,U,4),IBP="B":$P(IBCNSP,U,6),1:"")
  1.  S DR=DR_";7.01///"_IBNAME_";7.02///"_IBHICN       ; IB*2.0*497 (vd)
  1.  S DR=DR_";6///v;8///"_$S(IBP="A":$G(IBAEFF),IBP="B":$G(IBBEFF),1:"")
  1.  S DR=DR_";.2////"_IBCOBI_";15///"_$S(IBP="A":"PART A",IBP="B":"PART B",1:"")
  1.  S DR=DR_";16///01;.18////"_$S(IBP="A":+$P(IBCNSP,U,3),IBP="B":+$P(IBCNSP,U,5),1:"")
  1.  D ^DIE
  1.  ;
  1.  ;  -- Update Insurance Event
  1.  S IBCOVP=$P($G(^DPT(DFN,.31)),U,11)
  1.  D BEFORE^IBCNSEVT S IBNEW=1
  1.  ;
  1.  ; -- Ask to Verify at this time
  1.  K DIR S DIR("A")="Verify Medicare (WNR) Part "_IBP_" Coverage Now"
  1.  S DIR("?")="Enter 'No' to not Verify Coverage at this time."
  1.  W ! S IBOK=0 D OK I 'IBOK G SETEV
  1.  ;
  1.  ; -- Check to see if Pt. Name = name of Insured
  1.  I IBNAME'=$P($G(^DPT(DFN,0)),U,1) D
  1.  .W !!,"WARNING: Patient Name: '"_$P($G(^DPT(DFN,0)),U,1)_"'  DOES NOT MATCH"
  1.  .W !,"      Name of Insured: '"_IBNAME_"'.",!
  1.  ;
  1.  ; -- verify policy
  1.  S DIE="^DPT("_DFN_",.312,",DA=IBCDFN,DA(1)=DFN
  1.  S DR="1.03///NOW;1.04////"_DUZ D ^DIE
  1.  W !,"  PART "_IBP_" COVERAGE VERIFIED."
  1.  ;
  1. SETEV ; -- Update Insurance event
  1.  N X,Y
  1.  D COVERED^IBCNSM31(DFN,IBCOVP)
  1.  I $G(IBCDFN)>0,IBNEW=1 D AFTER^IBCNSEVT,^IBCNSEVT
  1.  ;
  1. SETPQ Q
  1.  ;
  1.  ;
  1. BUFF(IBP) ; -- Set IBBUF array with policy info for Buffer File
  1.  ; Return: IBBUF array
  1.  ;    IBBUF(355.33 field #s)=corresponding policy, plan and company data
  1.  ;    i.e.  IBBUF(20.01)=Insurance Company Name
  1.  ;          IBBUF(90.01)=Group Name
  1.  ;          IBBUF(60.01)=DFN
  1.  ;
  1.  ; Input: DFN, IBCNSP, IBNAME, IBHICN, IBAEFF, IBBEFF, IBCOBI
  1.  ;           
  1.  ; Auto stuff other fields
  1.  ;
  1.  N IBP0 K IBBUF S IBBUF=""
  1.  S IBBUF(.03)=$G(IBSOUR)
  1.  S IBBUF(20.01)=$P(IBCNSP,U,2)
  1.  S IBBUF(90.01)=$S(IBP="A":$P(IBCNSP,U,4),IBP="B":$P(IBCNSP,U,6),1:"")   ; IB*2.0*497 (vd)
  1.  S IBBUF(90.02)=IBBUF(90.01)           ; IB*2.0*497 (vd)
  1.  S IBBUF(60.01)=+DFN
  1.  S IBBUF(60.02)=$S(IBP="A":IBAEFF,IBP="B":IBBEFF,1:"")
  1.  S IBBUF(90.03)=IBHICN                 ; IB*2.0*497 (vd)
  1.  S IBBUF(60.05)="v"
  1.  S IBBUF(60.06)="01"
  1.  S IBBUF(91.01)=IBNAME                 ; IB*2.0*497 (vd)
  1.  S IBBUF(60.12)=IBCOBI
  1.  S IBBDA=$$ADDSTF^IBCNBES(1,DFN,.IBBUF)
  1.  I +IBBDA W !,?3,$P(IBCNSP,U,2)," PART "_IBP_" entry #"_+IBBDA_" added to Insurance Buffer File."
  1.  I 'IBBDA W !,*7,?3,"Warning: Could not add new policy Part "_IBP_" in Buffer File.",!,?13,"("_$P(IBBDA,U,2)_")",!
  1.  Q
  1.  ;
  1. OK ; -- ask okay
  1.  N DTOUT,DIROUT,DIRUT,DUOUT,X,Y
  1.  ; Returns:
  1.  ; IBQUIT=1 Exit user timedout
  1.  ;   IBOK=1 Yes
  1.  ;   IBOK=0 No
  1.  S IBQUIT=0,DIR(0)="Y",DIR("B")="YES" W !
  1.  I $G(DIR("A"))="" S DIR("A")="Is this Data Correct"
  1.  I $G(DIR("?"))="" S DIR("?")="Enter 'No' to edit Medicare Card information"
  1.  D ^DIR K DIR
  1.  I $D(DTOUT) S IBQUIT=1
  1.  S IBOK=$G(Y) I IBOK["^" S IBQUIT=1
  1.  Q
  1.  ;
  1. GETWNR() ; -- Find and return the MEDICARE (WNR) ien
  1.  ;         -- Returns Error message or
  1.  ;            DIC(36 IEN ^"MEDICARE (WNR)"^IBA(355.3 PART A IEN ^"PART A"^ IBA(355.3 PART B IEN ^"PART B"
  1.  ;
  1.  N IBWNR,IB0,IBP0,IBQ,IBPQ,IBPX,IBX,IBY,IBPGN
  1.  S IBY="MEDICARE (WNR)",IBQ=0
  1.  S IBX=0 F  S IBX=$O(^DIC(36,"B",IBY,IBX)) Q:('IBX)  D  Q:IBQ
  1.  .S IB0=$G(^DIC(36,IBX,0))
  1.  .K IBWNR("INS")
  1.  .I $P(IB0,U,1)'=IBY Q  ;name
  1.  .I $P(IB0,U,2)'="N" Q  ;Reimb?
  1.  .;I '$P(IB0,U,3) Q  ;Sig Req.  --> removed edit, cm, 5/18/99
  1.  .I $P(IB0,U,5) Q  ;Inactive
  1.  .I $P($G(^IBE(355.2,+$P(IB0,U,13),0)),U)'="MEDICARE" Q  ;Major Cat.
  1.  .S IBWNR("INS")=IBX_U_IBY
  1.  .;
  1.  .; -- Must have Active Group Plan Category Medicare Part A and B
  1.  .;
  1.  .K IBWNR("A"),IBWNR("B")
  1.  .S IBPX=0 F  S IBPX=$O(^IBA(355.3,"B",IBX,IBPX)) Q:('IBPX)!(IBQ)  D
  1.  ..S IBP0=$G(^IBA(355.3,IBPX,0))
  1.  ..I $P(IBP0,U,11) Q  ;Inactive
  1.  ..I $P(IBP0,U,14)'="A",$P(IBP0,U,14)'="B" Q  ;Not Plan Category Part A or B 
  1.  ..S IBPGN=$TR($P(IBP0,U,3),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ..I IBPGN'="PART A",IBPGN'="PART B" Q  ;excludes non PART A and PART B plans
  1.  ..S IBWNR($P(IBP0,U,14))=IBPX_U_$P(IBP0,U,3)
  1.  ..I $G(IBWNR("A")),$G(IBWNR("B")) S IBQ=1
  1.  ;
  1.  S IBX=$G(IBWNR("INS"))_U_$G(IBWNR("A"))_U_$G(IBWNR("B"))
  1.  I 'IBX S IBX="Error: Standard Medicare (WNR) Insurance Company not setup properly." G GETWNRQ
  1.  I '$P(IBX,U,3) S IBX="Error: Standard Medicare (WNR) plan PART A not setup properly." G GETWNRQ
  1.  I '$G(IBWNR("B")) S IBX="Error: Standard Medicare (WNR) plan PART B not setup properly."
  1. GETWNRQ Q IBX