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