- 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 Mar 13, 2025@21:22:36 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
