IBCNSMM2 ;ALB/CMS -MEDICARE INSURANCE INTAKE (CONT) ; 18-MAY-99
;;2.0;INTEGRATED BILLING;**103,133,602**;21-MAR-94;Build 22
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
MII ; -- Ask Medicare Insurance Card questions
;
; Output Variables:
; IBNAME = Name of Insured
; IBHICN = Subscriber ID as of IB*601 could also be a MBI Number
; IBAEFF = Effective Date for Part A
; IBBEFF = Effective Date for Part B
; IBCOB/IBCOBI = Coordination of Benefits
; IBQUIT=1 User timed-out or entered ^
;
N DIR,DTOUT,DUOUT,DIROUT,DIRUT,X,Y,IBX
;
MIIA ; -- Ask user for Information
;
W ! S DIR("A")="NAME OF BENEFICIARY"
S IBX=$P($G(IBARR("A",1)),"^",18) I IBX="" S IBX=$P($G(IBARR("B",1)),"^",18)
S DIR("B")=$S($G(IBNAME)'="":IBNAME,IBX'="":IBX,1:$P(^DPT(DFN,0),U))
S DIR(0)="F^3:30^K:X'?1E.E1"","".1E.E X"
S DIR("?")="Enter the Name of Beneficiary (Last name, First) from the Medicare Insurance Card. This name should be 3 to 30 characters in length."
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
S IBNAME=Y
;
S DIR("A")="MEDICARE CLAIM NUMBER"
S IBX=$P($G(IBARR("A",1)),"^",3) I IBX="" S IBX=$P($G(IBARR("B",1)),"^",3)
I $G(IBHICN)'="" S DIR("B")=IBHICN
I IBX'="",'$D(DIR("B")) S DIR("B")=IBX
;S DIR(0)="F^7:15^I '$$VALHIC^IBCNSMM($TR(X,""-"")) K X" ; IB*602
S DIR(0)="F^3:20" ;IB*602
S DIR("?")="^D HICH^IBCNSMM2"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
S IBHICN=$TR(Y,"-") ; Strip off any '-'
;
; - don't allow editing Part A date if more than one policy
I IBPOLA,'$D(IBARR("A",1)) G MIIPB
S DIR("A")="HOSPITAL INSURANCE (PART A) EFFECTIVE DATE"
S IBX=$P($G(IBARR("A",1)),"^",9)
I $G(IBAEFF) S Y=IBAEFF D D^DIQ S DIR("B")=Y
I IBX'="",'$D(DIR("B")) S Y=IBX D D^DIQ S DIR("B")=Y
S DIR(0)="DO^::E"
S DIR("?")="Enter PART A Effective Date if shown on Medicare Insurance Card."
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
S IBAEFF=Y
;
MIIPB ; - don't allow editing Part B date if more than one policy
I IBPOLB,'$D(IBARR("B",1)) G MIIC
S DIR("A")="MEDICAL INSURANCE (PART B) EFFECTIVE DATE"
S IBX=$P($G(IBARR("B",1)),"^",9)
I $G(IBBEFF) S Y=IBBEFF D D^DIQ S DIR("B")=Y
I IBX'="",'$D(DIR("B")) S Y=IBX D D^DIQ S DIR("B")=Y
S DIR(0)="DO^::E"
S DIR("?")="Enter PART B Effective Date if shown on Medicare Insurance Card."
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
S IBBEFF=Y
;
MIIC ; - check effective dates before COB prompt
I '$G(IBAEFF),'$G(IBBEFF) S IBQUIT=1 D G MIIQ
.W !!,*7,?5,"No data can be filed without Part A or B Effective Dates."
;
; - Coordination of Benefits prompt
S DIR("A")="COORDINATION OF BENEFITS: "
S IBX=$P($G(IBARR("A",1)),"^",21) I 'IBX S IBX=$P($G(IBARR("B",1)),"^",21)
I IBX S IBX=$S(IBX=1:"PRIMARY",IBX=2:"SECONDARY",3:"TERTIARY",1:"")
S DIR("B")=$S($G(IBCOB)'="":IBCOB,IBX'="":IBX,1:"PRIMARY")
S DIR(0)="SA^1:PRIMARY;2:SECONDARY;3:TERTIARY"
S DIR("?")="Enter the Coordination of Benefits as Primary, Secondary, or Tertiary."
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
S IBCOBI=Y,IBCOB=$S(Y=3:"TERTIARY",Y=2:"SECONDARY",1:"PRIMARY")
;
; -- Ask if Data Okay
S IBOK=0 K DIR D OK^IBCNSMM1 I IBOK=0 K DIR,Y G MIIA
I IBOK["^" S IBQUIT=1
MIIQ Q
;
;
HICH ; Help text for the HIC number prompt.
W !,"Enter the Medicare Claim Number (Subscriber ID) exactly as it appears" ; IB*602
W !,"on the Medicare Insurance Card, excluding special characters."
W !,"Entry must be 3-20 characters."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSMM2 3677 printed Sep 23, 2025@19:53:52 Page 2
IBCNSMM2 ;ALB/CMS -MEDICARE INSURANCE INTAKE (CONT) ; 18-MAY-99
+1 ;;2.0;INTEGRATED BILLING;**103,133,602**;21-MAR-94;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
MII ; -- Ask Medicare Insurance Card questions
+1 ;
+2 ; Output Variables:
+3 ; IBNAME = Name of Insured
+4 ; IBHICN = Subscriber ID as of IB*601 could also be a MBI Number
+5 ; IBAEFF = Effective Date for Part A
+6 ; IBBEFF = Effective Date for Part B
+7 ; IBCOB/IBCOBI = Coordination of Benefits
+8 ; IBQUIT=1 User timed-out or entered ^
+9 ;
+10 NEW DIR,DTOUT,DUOUT,DIROUT,DIRUT,X,Y,IBX
+11 ;
MIIA ; -- Ask user for Information
+1 ;
+2 WRITE !
SET DIR("A")="NAME OF BENEFICIARY"
+3 SET IBX=$PIECE($GET(IBARR("A",1)),"^",18)
IF IBX=""
SET IBX=$PIECE($GET(IBARR("B",1)),"^",18)
+4 SET DIR("B")=$SELECT($GET(IBNAME)'="":IBNAME,IBX'="":IBX,1:$PIECE(^DPT(DFN,0),U))
+5 SET DIR(0)="F^3:30^K:X'?1E.E1"","".1E.E X"
+6 SET DIR("?")="Enter the Name of Beneficiary (Last name, First) from the Medicare Insurance Card. This name should be 3 to 30 characters in length."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL DUOUT,DTOUT,DIROUT,DIRUT
SET IBQUIT=1
GOTO MIIQ
+9 SET IBNAME=Y
+10 ;
+11 SET DIR("A")="MEDICARE CLAIM NUMBER"
+12 SET IBX=$PIECE($GET(IBARR("A",1)),"^",3)
IF IBX=""
SET IBX=$PIECE($GET(IBARR("B",1)),"^",3)
+13 IF $GET(IBHICN)'=""
SET DIR("B")=IBHICN
+14 IF IBX'=""
IF '$DATA(DIR("B"))
SET DIR("B")=IBX
+15 ;S DIR(0)="F^7:15^I '$$VALHIC^IBCNSMM($TR(X,""-"")) K X" ; IB*602
+16 ;IB*602
SET DIR(0)="F^3:20"
+17 SET DIR("?")="^D HICH^IBCNSMM2"
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL DUOUT,DTOUT,DIROUT,DIRUT
SET IBQUIT=1
GOTO MIIQ
+20 ; Strip off any '-'
SET IBHICN=$TRANSLATE(Y,"-")
+21 ;
+22 ; - don't allow editing Part A date if more than one policy
+23 IF IBPOLA
IF '$DATA(IBARR("A",1))
GOTO MIIPB
+24 SET DIR("A")="HOSPITAL INSURANCE (PART A) EFFECTIVE DATE"
+25 SET IBX=$PIECE($GET(IBARR("A",1)),"^",9)
+26 IF $GET(IBAEFF)
SET Y=IBAEFF
DO D^DIQ
SET DIR("B")=Y
+27 IF IBX'=""
IF '$DATA(DIR("B"))
SET Y=IBX
DO D^DIQ
SET DIR("B")=Y
+28 SET DIR(0)="DO^::E"
+29 SET DIR("?")="Enter PART A Effective Date if shown on Medicare Insurance Card."
+30 DO ^DIR
KILL DIR
+31 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL DUOUT,DTOUT,DIROUT,DIRUT
SET IBQUIT=1
GOTO MIIQ
+32 SET IBAEFF=Y
+33 ;
MIIPB ; - don't allow editing Part B date if more than one policy
+1 IF IBPOLB
IF '$DATA(IBARR("B",1))
GOTO MIIC
+2 SET DIR("A")="MEDICAL INSURANCE (PART B) EFFECTIVE DATE"
+3 SET IBX=$PIECE($GET(IBARR("B",1)),"^",9)
+4 IF $GET(IBBEFF)
SET Y=IBBEFF
DO D^DIQ
SET DIR("B")=Y
+5 IF IBX'=""
IF '$DATA(DIR("B"))
SET Y=IBX
DO D^DIQ
SET DIR("B")=Y
+6 SET DIR(0)="DO^::E"
+7 SET DIR("?")="Enter PART B Effective Date if shown on Medicare Insurance Card."
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL DUOUT,DTOUT,DIROUT,DIRUT
SET IBQUIT=1
GOTO MIIQ
+10 SET IBBEFF=Y
+11 ;
MIIC ; - check effective dates before COB prompt
+1 IF '$GET(IBAEFF)
IF '$GET(IBBEFF)
SET IBQUIT=1
Begin DoDot:1
+2 WRITE !!,*7,?5,"No data can be filed without Part A or B Effective Dates."
End DoDot:1
GOTO MIIQ
+3 ;
+4 ; - Coordination of Benefits prompt
+5 SET DIR("A")="COORDINATION OF BENEFITS: "
+6 SET IBX=$PIECE($GET(IBARR("A",1)),"^",21)
IF 'IBX
SET IBX=$PIECE($GET(IBARR("B",1)),"^",21)
+7 IF IBX
SET IBX=$SELECT(IBX=1:"PRIMARY",IBX=2:"SECONDARY",3:"TERTIARY",1:"")
+8 SET DIR("B")=$SELECT($GET(IBCOB)'="":IBCOB,IBX'="":IBX,1:"PRIMARY")
+9 SET DIR(0)="SA^1:PRIMARY;2:SECONDARY;3:TERTIARY"
+10 SET DIR("?")="Enter the Coordination of Benefits as Primary, Secondary, or Tertiary."
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL DUOUT,DTOUT,DIROUT,DIRUT
SET IBQUIT=1
GOTO MIIQ
+13 SET IBCOBI=Y
SET IBCOB=$SELECT(Y=3:"TERTIARY",Y=2:"SECONDARY",1:"PRIMARY")
+14 ;
+15 ; -- Ask if Data Okay
+16 SET IBOK=0
KILL DIR
DO OK^IBCNSMM1
IF IBOK=0
KILL DIR,Y
GOTO MIIA
+17 IF IBOK["^"
SET IBQUIT=1
MIIQ QUIT
+1 ;
+2 ;
HICH ; Help text for the HIC number prompt.
+1 ; IB*602
WRITE !,"Enter the Medicare Claim Number (Subscriber ID) exactly as it appears"
+2 WRITE !,"on the Medicare Insurance Card, excluding special characters."
+3 WRITE !,"Entry must be 3-20 characters."
+4 QUIT
