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

IBCNSM2.m

Go to the documentation of this file. 
  1. IBCNSM2 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT ROUTINE ;22-OCT-92
  1.  ;;2.0;INTEGRATED BILLING;**28,103,139,516,528,668**;21-MAR-94;Build 28
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;/vd-IB*2*668 - Removed the SSVI logic introduced with IB*2*528 in its entirety within VistA.
  1.  ;
  1. % S U="^"
  1.  ;
  1. BU ; -- Enter Edit benefits already used
  1.  D FULL^VALM1
  1.  N I,J,IBXX,VALMY,IBCNS,IBCPOL,IBCDFN
  1.  D EN^VALM2($G(XQORNOD(0)))
  1.  I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D
  1.  .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1.  .Q:IBPPOL=""
  1.  .S IBCNS=+$P(IBPPOL,"^",5),IBCPOL=+$P(IBPPOL,"^",22),IBCDFN=+$P(IBPPOL,"^",4)
  1.  .D EN^VALM("IBCNS BENEFITS USED BY DATE")
  1.  .Q
  1.  S VALMBCK="R" Q
  1.  ;
  1. EP ; -- Enter Edit Patient Insurance Policy Information
  1.  ;
  1.  S VALMBCK="R" Q
  1.  ;
  1. EI ;  -- Enter Edit Insurance Company Information
  1.  ; -- if coming from benefit screen
  1.  ;    ibcns=insurance co number
  1.  D FULL^VALM1
  1.  I $G(IBCNS)>0 D EN^VALM("IBCNS INSURANCE COMPANY") G EIQ
  1.  ;
  1.  ; -- if coming from list of policies, allow selection
  1.  N I,J,IBXX,IBCNS,VALMY
  1.  D EN^VALM2($G(XQORNOD(0)))
  1.  I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D
  1.  .S I=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1.  .S IBCNS=$P(I,"^",5)
  1.  .D EN^VALM("IBCNS INSURANCE COMPANY")
  1. EIQ S VALMBCK="R" Q
  1.  ;
  1. VC ; -- Verify Insurance Coverage
  1.  D FULL^VALM1
  1.  N I,J,IBXX,VALMY,CON
  1.  ;
  1.  ; -- If no effective policies ask to verify no coverage
  1.  I '$$EPOL(DFN) D VCN G EXIT
  1.  ;
  1.  D EN^VALM2($G(XQORNOD(0)))
  1.  I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D
  1.  .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1.  .Q:IBPPOL=""
  1.  .D VFY
  1.  ;
  1. EXIT ; -- Kill variables, refresh screen
  1.  ;
  1.  D BLD^IBCNSM
  1.  K I,J,IBXX,DA,DR,IBDUZZ
  1.  S VALMBCK="R" Q
  1.  ;
  1. VFY ; -- Display most recent verification
  1.  ;
  1.  N DA,DR,IBDUZ,IB0,IBWNR
  1.  D FULL^VALM1
  1.  S IBCH=$P(IBPPOL,U,1)
  1.  S IBWNR=$$GETWNR^IBCNSMM1()
  1.  ;
  1.  ;  -- If Medicare WNR and Name of Insured is different from Pt. Name
  1.  ;     display Warning message.
  1.  ;S IB0=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0))  ; 516 - baa
  1.  S IB0=$$ZND^IBCNS1(DFN,$P(IBPPOL,U,4))  ; 516 - baa
  1.  I +IBWNR=+IB0 D
  1.  .I $P(IB0,U,17)="" Q
  1.  .I $P(IB0,U,17)=$P($G(^DPT(DFN,0)),U,1) Q
  1.  .W !!,"WARNING: Patient Name: '"_$P($G(^DPT(DFN,0)),U,1)_"'  DOES NOT MATCH"
  1.  .W !,"      Name of Insured: '"_$P(IB0,U,17)_"' for this "_$P(IBWNR,U,2)_" policy."
  1.  ;
  1.  S IBDUZ=$P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,4)
  1.  I 'IBDUZ D REVASK Q
  1.  W !!," "_IBCH_" LAST VERIFIED BY "_$P($G(^VA(200,+IBDUZ,0)),U)_" ON "_$$DAT1^IBOUTL($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3))_". . ."
  1.  I $P($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3),".")=DT W !,"COVERAGE VERIFIED TODAY, "_$$DAT1^IBOUTL(DT) H 3
  1.  E  D REVASK
  1.  Q
  1.  ;
  1. REVASK ; -- Determine whether user wishes to re-verify
  1.  ;
  1.  N Y
  1.  W:'IBDUZ !
  1.  S DIR("B")="No",DIR(0)="YO",DIR("A")=$S('IBDUZ:" "_IBCH_" NEVER PREVIOUSLY VERIFIED.  DO YOU WISH TO VERIFY COVERAGE",1:"ARE YOU RE-VERIFYING COVERAGE TODAY")
  1.  D ^DIR K DIR Q:$D(DIRUT)
  1.  I Y D REVFY
  1.  Q
  1.  ;
  1. REVFY ; -- Re-verify
  1.  ;
  1.  S DA(1)=DFN,DA=$P(IBPPOL,U,4),DIE="^DPT(DFN,.312,",DR="1.03////"_DT_";1.04////"_DUZ D ^DIE K DIE
  1.  S IBDUZ=$P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,4)
  1.  W !," "_IBCH_" VERIFIED BY "_$P($G(^VA(200,+DUZ,0)),U)_" ON "_$$DAT1^IBOUTL($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3))
  1.  D PAUSE^VALM1
  1.  Q
  1.  ;
  1. VCN ; -- Ask to verifiy patient has no coverage
  1.  ;
  1.  N DA,DLAYGO,DIE,DIR,DR,DIRUT,DUOUT,DIOUT,DTOUT,IBADD,IBEXERR,IBWHER,X,Y
  1.  W !!,?5,"Patient has no effective insurance coverage on file."
  1.  S DIR("B")="No",DIR(0)="Y"
  1.  S DIR("A")=$S(+$G(^IBA(354,DFN,60)):"Re-v",1:"V")_"erify that patient has No Insurance Coverage "
  1.  S DIR("?")="Enter 'Yes' to enter a Verification of No Coverage Date"
  1.  D ^DIR
  1.  I Y D
  1.  .I '$D(^IBA(354,DFN)) D ADDP^IBAUTL6 I '$G(IBADD) W "   <Try again Later>" Q
  1.  .S DA=DFN,DIE="^IBA(354,",DR=60 D ^DIE I $D(Y)=0 N IBX S IBX=$P($G(^DPT(DFN,.31)),"^",11) D
  1.  ..I X]""&(IBX'="N") S IBX="N",$P(^DPT(DFN,.31),"^",11)="N" D MSG
  1.  ..I X']""&(IBX'="U") S IBX="U",$P(^DPT(DFN,.31),"^",11)="U" D MSG
  1.  ..Q
  1.  Q
  1.  ;
  1. EPOL(DFN) ; Does the patient have any effective policies?
  1.  ;  Input:  DFN  --  Pointer to the patient in file #2
  1.  ; Output:    0  --  The patient has no effective policies
  1.  ;            1  --  The patient has at least one effective policy
  1.  ;
  1.  N J,X,Y S Y=0
  1.  S J=0 F  S J=$O(^DPT(DFN,.312,J)) Q:'J  S X=$G(^(J,0)) D  Q:Y
  1.  .I '$P(X,"^",4) S Y=1 Q
  1.  .I $P(X,"^",4)>DT S Y=1
  1.  Q Y
  1.  ;
  1. MSG ;If there is a change in the status of the covered by health insurance 
  1.  ;field #11 in the Patient file #2, The user is notified of the change.
  1.  I '$D(ZTQUEUED) S VALMSG="COVERED BY HEALTH INSURANCE changed to '"_IBX_$S(IBX="U":"NKNOWN'",1:"O'")
  1.  Q