source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSMM2.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1IBCNSMM2 ;ALB/CMS -MEDICARE INSURANCE INTAKE (CONT) ; 18-MAY-99
2 ;;2.0;INTEGRATED BILLING;**103,133**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7MII ; -- Ask Medicare Insurance Card questions
8 ;
9 ; Output Variables:
10 ; IBNAME = Name of Insured
11 ; IBHICN = Subscriber ID
12 ; IBAEFF = Effective Date for Part A
13 ; IBBEFF = Effective Date for Part B
14 ; IBCOB/IBCOBI = Coordination of Benefits
15 ; IBQUIT=1 User timed-out or entered ^
16 ;
17 N DIR,DTOUT,DUOUT,DIROUT,DIRUT,X,Y,IBX
18 ;
19MIIA ; -- Ask user for Information
20 ;
21 W ! S DIR("A")="NAME OF BENEFICIARY"
22 S IBX=$P($G(IBARR("A",1)),"^",18) I IBX="" S IBX=$P($G(IBARR("B",1)),"^",18)
23 S DIR("B")=$S($G(IBNAME)'="":IBNAME,IBX'="":IBX,1:$P(^DPT(DFN,0),U))
24 S DIR(0)="F^3:30^K:X'?1E.E1"","".1E.E X"
25 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."
26 D ^DIR K DIR
27 I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
28 S IBNAME=Y
29 ;
30 S DIR("A")="MEDICARE CLAIM NUMBER"
31 S IBX=$P($G(IBARR("A",1)),"^",3) I IBX="" S IBX=$P($G(IBARR("B",1)),"^",3)
32 I $G(IBHICN)'="" S DIR("B")=IBHICN
33 I IBX'="",'$D(DIR("B")) S DIR("B")=IBX
34 S DIR(0)="F^7:15^I '$$VALHIC^IBCNSMM($TR(X,""-"")) K X"
35 S DIR("?")="^D HICH^IBCNSMM2"
36 D ^DIR K DIR
37 I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
38 S IBHICN=$TR(Y,"-") ; Strip off any '-'
39 ;
40 ; - don't allow editing Part A date if more than one policy
41 I IBPOLA,'$D(IBARR("A",1)) G MIIPB
42 S DIR("A")="HOSPITAL INSURANCE (PART A) EFFECTIVE DATE"
43 S IBX=$P($G(IBARR("A",1)),"^",9)
44 I $G(IBAEFF) S Y=IBAEFF D D^DIQ S DIR("B")=Y
45 I IBX'="",'$D(DIR("B")) S Y=IBX D D^DIQ S DIR("B")=Y
46 S DIR(0)="DO^::E"
47 S DIR("?")="Enter PART A Effective Date if shown on Medicare Insurance Card."
48 D ^DIR K DIR
49 I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
50 S IBAEFF=Y
51 ;
52MIIPB ; - don't allow editing Part B date if more than one policy
53 I IBPOLB,'$D(IBARR("B",1)) G MIIC
54 S DIR("A")="MEDICAL INSURANCE (PART B) EFFECTIVE DATE"
55 S IBX=$P($G(IBARR("B",1)),"^",9)
56 I $G(IBBEFF) S Y=IBBEFF D D^DIQ S DIR("B")=Y
57 I IBX'="",'$D(DIR("B")) S Y=IBX D D^DIQ S DIR("B")=Y
58 S DIR(0)="DO^::E"
59 S DIR("?")="Enter PART B Effective Date if shown on Medicare Insurance Card."
60 D ^DIR K DIR
61 I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
62 S IBBEFF=Y
63 ;
64MIIC ; - check effective dates before COB prompt
65 I '$G(IBAEFF),'$G(IBBEFF) S IBQUIT=1 D G MIIQ
66 .W !!,*7,?5,"No data can be filed without Part A or B Effective Dates."
67 ;
68 ; - Coordination of Benefits prompt
69 S DIR("A")="COORDINATION OF BENEFITS: "
70 S IBX=$P($G(IBARR("A",1)),"^",21) I 'IBX S IBX=$P($G(IBARR("B",1)),"^",21)
71 I IBX S IBX=$S(IBX=1:"PRIMARY",IBX=2:"SECONDARY",3:"TERTIARY",1:"")
72 S DIR("B")=$S($G(IBCOB)'="":IBCOB,IBX'="":IBX,1:"PRIMARY")
73 S DIR(0)="SA^1:PRIMARY;2:SECONDARY;3:TERTIARY"
74 S DIR("?")="Enter the Coordination of Benefits as Primary, Secondary, or Tertiary."
75 D ^DIR K DIR
76 I $D(DTOUT)!$D(DUOUT) K DUOUT,DTOUT,DIROUT,DIRUT S IBQUIT=1 G MIIQ
77 S IBCOBI=Y,IBCOB=$S(Y=3:"TERTIARY",Y=2:"SECONDARY",1:"PRIMARY")
78 ;
79 ; -- Ask if Data Okay
80 S IBOK=0 K DIR D OK^IBCNSMM1 I IBOK=0 K DIR,Y G MIIA
81 I IBOK["^" S IBQUIT=1
82MIIQ Q
83 ;
84 ;
85HICH ; Help text for the HIC number prompt.
86 W !,"Enter the Medicare Claim Number (Subscriber ID) exactly as it appears"
87 W !,"on the Medicare Insurance Card, including ALL characters. Valid HICN "
88 W !,"formats are: 1-3 alpha characters followed by 6 or 9 digits, or "
89 W !,"9 digits followed by 1 alpha character optionally followed by another "
90 W !,"alpha character or 1 digit."
91 Q
Note: See TracBrowser for help on using the repository browser.