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

IBCNSMM.m

Go to the documentation of this file.
  1. IBCNSMM ;ALB/CMS -MEDICARE INSURANCE INTAKE ; 18-OCT-98
  1. ;;2.0;INTEGRATED BILLING;**103,133,184,516,601,595,602**;21-MAR-94;Build 22
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. EN ; -- Entry point from Medicare Intake Standalone option
  1. N DIC,DIR,DA,%A,DFN,X,Y,IBQUIT,IBCNSP,IBSOURCE
  1. S (IBQUIT,IBCNSP)=0 D GETWNR I IBQUIT G ENQ
  1. ;
  1. ; - allow the user to enter the Source of Information for the policies
  1. W !!,"You may enter the 'Source of Information' that will be filed with all"
  1. W !,"Medicare insurance coverage policies that are created.",!
  1. ;
  1. S DIR(0)="2.312,1.09"
  1. S DIR("A")="Enter Source of Information"
  1. S DIR("B")="INTERVIEW"
  1. D ^DIR K DUOUT,DTOUT,DIRUT,DIROUT,DIR
  1. S IBSOURCE=+Y I Y<1 G ENQ
  1. W !
  1. ;
  1. ; - loop to select patients
  1. ENA S DIC(0)="AEQMN",DIC="^DPT(" D ^DIC
  1. I +Y<1 G ENQ
  1. S DFN=+Y
  1. I $G(^DPT(DFN,.35)) W *7,!!,?10,"Patient Expired on ",$$FMTE^XLFDT($P(^DPT(DFN,.35),U))
  1. W ! D DISP^IBCNS W !,?3 S X="",$P(X,"=",76)="" W X
  1. D ENR(DFN,IBSOURCE,1) K DIC W !! G ENA
  1. ;
  1. ENQ Q
  1. ;
  1. ;
  1. ENR(DFN,IBSOUR,IBOPT) ; -- Entry point from IBCNBME Patient Registration or Pre-Registration
  1. ; Input Variable DFN Required and IBSOUR =Source of Information
  1. ; IBOPT =1 if coming from MII Standalone Option
  1. ;
  1. N D,DIE,DA,DIR,DIC,E,IBCPOL,IBCNSP,IBCDFN,IBQUIT,IBOK,IBC0,IBAD,IBGRP,IBADPOL
  1. N IBNAME,IBHICN,IBAEFF,IBBEFF,IBCOVP,IBGNA,IBGNU,IBBUF,IBNEW,IBP,X,Y
  1. N IBPOLA,IBPOLB,IBARR,IBHIT,IBHITA,IBHITB,IBCOB,IBCOBI
  1. ;
  1. ; IB*602 - IBHICN could also be a Medicare Beneficiary ID
  1. S (IBAEFF,IBBEFF,IBCNSP,IBCDFN,IBNEW,IBQUIT)=0,IBADPOL=1
  1. S (IBNAME,IBHICN)=""
  1. ;
  1. ; -- Get Standard Medicare Insurance Company and plans in IBCNSP
  1. D GETWNR I IBQUIT G ENRQ
  1. ;
  1. ; -- get the patient's Medicare policies
  1. S (IBPOLA,IBPOLB)=0
  1. S IBCDFN=0 F S IBCDFN=$O(^DPT(DFN,.312,"B",+IBCNSP,IBCDFN)) Q:'IBCDFN D
  1. .;IB*2.0*516/TAZ - Retrieve Data from HIPAA compliant fields.
  1. .;S IBCPOL=$G(^DPT(DFN,.312,IBCDFN,0)) ;516 - baa
  1. .S IBCPOL=$$ZND^IBCNS1(DFN,IBCDFN) ;516 - baa
  1. .;
  1. .; - is the policy for Part A?
  1. .I $P(IBCNSP,U,3)=$P(IBCPOL,U,18) D Q
  1. ..S IBPOLA=IBPOLA+1,IBARR("A",IBPOLA)=IBCDFN_"^"_IBCPOL
  1. .;
  1. .; - is the policy for Part B?
  1. .I $P(IBCNSP,U,5)=$P(IBCPOL,U,18) D
  1. ..S IBPOLB=IBPOLB+1,IBARR("B",IBPOLB)=IBCDFN_"^"_IBCPOL
  1. ;
  1. ; - can't edit here if there is more than one policy
  1. I $D(IBARR("A",2)) K IBARR("A") D
  1. .W !!,"This patient has more than one Part A policy. Please edit in Ins Mgmt."
  1. ;
  1. I $D(IBARR("B",2)) K IBARR("B") D
  1. .W !!,"This patient has more than one Part B policy. Please edit in Ins Mgmt."
  1. ;
  1. I (IBPOLA!IBPOLB),'$D(IBARR) G ENRQ
  1. ;
  1. ; -- Ask for Medicare Insurance Card information
  1. ; Return IBNAME, IBHICN, IBAEFF, IBBEFF, IBCOB/IBCOBI
  1. D MII^IBCNSMM2 I IBQUIT G ENRQ
  1. ;
  1. ; - if Part A or B exists, but no changes, quit
  1. I $D(IBARR("A",1)) D COM($P(IBARR("A",1),"^",2,99),"A") I IBHIT D
  1. .S IBHITA=1 W !," * No Part A changes made..."
  1. ;
  1. I $D(IBARR("B",1)) D COM($P(IBARR("B",1),"^",2,99),"B") I IBHIT D
  1. .S IBHITB=1 W !," * No Part B changes made..."
  1. ;
  1. I $G(IBHITA),$G(IBHITB) G ENRQ
  1. I $G(IBHITA),'$G(IBBEFF) G ENRQ
  1. I $G(IBHITB),'$G(IBAEFF) G ENRQ
  1. ;
  1. ;IB*595 Removed ability to file directly into Insurance Type File
  1. I IBAEFF,'$G(IBHITA) D BUFF^IBCNSMM1("A")
  1. I IBBEFF,'$G(IBHITB) D BUFF^IBCNSMM1("B")
  1. ;
  1. ; -- If user not holding key set data in Buffer File
  1. ;I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D G ENRQ
  1. ;.I IBAEFF,'$G(IBHITA) D BUFF^IBCNSMM1("A")
  1. ;.I IBBEFF,'$G(IBHITB) D BUFF^IBCNSMM1("B")
  1. ;
  1. ; -- Otherwise, set data into permanent files
  1. ;I IBAEFF,'$G(IBHITA) D
  1. ;.I IBPOLA,'$D(IBARR("A")) Q ; can't update Part A policy
  1. ;.I '$D(IBARR("A",1)) D ADDP("A") Q
  1. ;.S IBCDFN=+IBARR("A",1) D SETP^IBCNSMM1("A")
  1. ;I IBBEFF,'$G(IBHITB) D
  1. ;.I IBPOLB,'$D(IBARR("B")) Q ; can't update Part B policy
  1. ;.I '$D(IBARR("B",1)) D ADDP("B") Q
  1. ;.S IBCDFN=+IBARR("B",1) D SETP^IBCNSMM1("B")
  1. ;IB*595 END
  1. ;
  1. ENRQ W ! Q
  1. ;
  1. ;
  1. ;
  1. ADDP(IBP) ; -- Create a new patient policy
  1. ; Input: DFN
  1. ; IBCNSP=MED WNR INS IEN^MEDICARE (WNR)
  1. ; ^PART A IEN^PART A
  1. ; ^PART B IEN^PART A
  1. ; IBP = "A" or "B" for medicare part
  1. ; IBSOUR = Source of Information
  1. ; Return: IBCDFN=-1 could not add OR Policy ien
  1. ; IBCOVP= Covered by Health Insurance
  1. ;
  1. N X,Y,DO,DD,DA,DR,DIC,DIE,DIK,DIR,DIRUT,IBSPEC
  1. ; -- Create a New patient policy
  1. S IBCOVP=$P($G(^DPT(DFN,.31)),U,11)
  1. ;
  1. D FIELD^DID(2,.3121,"","SPECIFIER","IBSPEC")
  1. S DIC("DR")="1.09////"_IBSOUR_";1.05///NOW;1.06////"_DUZ,DIC("P")=$G(IBSPEC("SPECIFIER"))
  1. K DD,DO S DA(1)=DFN,DIC="^DPT("_DFN_",.312,",DIC(0)="L",X=+IBCNSP,DLAYGO=2.312
  1. D FILE^DICN K DD,DO,DLAYGO,DIC
  1. S IBCDFN=+Y
  1. I IBCDFN<1 W !!,*7," <Could not create new policy at this time. Try Later!>",! G ADDPQ
  1. ;
  1. ; -- Set Medicare policy data
  1. D SETP^IBCNSMM1(IBP)
  1. ADDPQ Q
  1. ;
  1. ;
  1. GETWNR ;
  1. ; -- Get Medicare (WNR) insurance company and plan data
  1. ; Returns IBCNSP or IBQUIT
  1. ; IBCNSP="Error: Medicare (WNR) ... not setup properly"
  1. ; if Medicare WNR entry or plans not setup properly
  1. ;
  1. ; IBCNSP=INS CO. (36) IEN^"MEDICARE (WNR)"
  1. ; ^PLAN (355.3) PARTA IEN^"PART A"
  1. ; ^PLAN (355.3) PARTB IEN^"PART B"
  1. ;
  1. I 'IBCNSP S IBCNSP=$$GETWNR^IBCNSMM1
  1. I 'IBCNSP W !!,*7,?3,IBCNSP S IBQUIT=1
  1. Q
  1. ;
  1. VALHIC(X) ; Edits for validating HIC #
  1. ; X = the HIC # to be validated
  1. ;IB*2.0*601 JRA Remove special HIC # validation - use existing error messages IB356/IB357/IB358 when the
  1. ; Primary/Secondary/Tertiary insurance subscriber's ID number is missing (as with other insurances).
  1. ;
  1. ;IB*2.0*601 JRA QUIT '1' to remove special validation for HIC #, which will prevent the display of IB Error
  1. ; message IB215 and the HIC # help text at HLP^IBCNSM32.
  1. Q 1 ;IB*2.0*601 JRA
  1. N VAL
  1. S VAL=1
  1. I X'?9N1A.1AN,X'?1.3A6N,X'?1.3A9N S VAL=0
  1. Q VAL
  1. ;
  1. COM(X,Y) ; Compare X with the intake variables.
  1. ; Input: X => 0th node of policy in file #2.312
  1. ; Y => A (Part A) or B (part B)
  1. ; Output: IBHIT=1 (no changes made)
  1. S IBHIT=0
  1. I $P(X,"^",17)'=IBNAME G COMQ
  1. I $P(X,"^",2)'=IBHICN G COMQ
  1. I $P(X,"^",8)'=$S(Y="A":IBAEFF,1:IBBEFF) G COMQ
  1. I $P(X,"^",20)'=IBCOBI G COMQ
  1. ;
  1. S IBHIT=1
  1. COMQ Q