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

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

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1IBCOMC ;ALB/CMS - IDENTIFY PT BY AGE WITH OR WITHOUT INSURANCE; 10-09-98
2 ;;2.0;INTEGRATED BILLING;**103**;21-MAR-94
3 Q
4EN ;Entry point from option
5 N DA,DIC,DIE,DIR,DIROUT,DIRUT,DTOUT,DR,DUOUT,X,Y
6 N IBAIB,IBBDT,IBEDT,IBRF,IBRL,IBSIN,IBSINF,IBSINL,IBAGEF,IBAGEL,IBQUIT
7 S (IBAIB,IBBDT,IBEDT,IBRF,IBRL,IBSIN,IBSINF,IBSINL,IBAGEF,IBAGEL,IBQUIT)=""
8 ;
9 W !!,"This report will identify patients who were treated within a specified"
10 W !,"date range who do or do not have insurance coverage."
11 ;
12INS ; -- sort by Insurance Company or no Insurance
13 W !!,"Sort by Insurance Company or No Insurance"
14 S DIR("A",1)="1 - Insurance Company Range"
15 S DIR("A",2)="2 - Selected Insurance Companies"
16 S DIR("A",3)="3 - Patients with No Insurance"
17 S DIR("A",4)=" "
18 S DIR(0)="SAXB^1:Insurance Range;2:Specific Companies;3:No Insurance"
19 S DIR("A")=" Select Number: ",DIR("B")="1",DIR("??")="^D INSH^IBCOMC2" D ^DIR
20 I +Y'>0 S IBQUIT=1 G EXIT
21 S IBSIN=+Y
22 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
23 I IBSIN=1 D INSR
24 I IBSIN=2 D INSS
25 I $G(IBQUIT)=1 G EXIT
26 ;
27VISIT ; -- sort by Treated Date Range
28 W !!,"Sort by Date Last Treated Range."
29 D DATE^IBOUTL
30 I IBBDT="" W *7," <Date Last Treated Range not entered>" G EXIT
31 I IBBDT,IBEDT="" S IBEDT=DT_".2400"
32 ;
33 W !! S DIR("A",1)="Sort report by"
34 S DIR("A",2)="1 - Patient Name Range"
35 S DIR("A",3)="2 - Terminal Digit Range"
36 S DIR("A",4)=" "
37 S DIR(0)="SAXB^1:Patient Name;2:Terminal Digit"
38 S DIR("A")=" Select Number: ",DIR("B")="1",DIR("??")="^D ENH^IBCOMC2" D ^DIR
39 I +Y'>0 S IBQUIT=1 G EXIT
40 S IBAIB=+Y
41 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
42 W !! D @$S(IBAIB=1:"NR",1:"TR")
43 I $G(IBQUIT)=1 G EXIT
44 ;
45AGE ; -- sort by AGE optional
46 W !!,"Sort by Patient Age Range. (Optional)"
47 S DIR("A")="Start AGE: ",DIR(0)="NAO^1:250",DIR("??")="^D AGEH^IBCOMC2" D ^DIR
48 I X["^" S IBQUIT=1 G EXIT
49 I +Y'>0 G AGEQ
50 S IBAGEF=+Y,DIR(0)="NO^"_+IBAGEF_":250",DIR("B")="250",DIR("A")="To AGE" D ^DIR
51 I X["^" S IBQUIT=1 G EXIT
52 S IBAGEL=+Y
53AGEQ K DIR,DIROUT,DTOUT,DUOUT,DIRUT
54 ;
55 W !! D QUE
56 ;
57EXIT Q
58 ;
59NR ; Ask Name Range
60 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
61NRR S DIR(0)="FO",DIR("B")="FIRST",DIR("A")="START WITH PATIENT NAME"
62 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
63 S:Y="FIRST" Y="A" S IBRF=Y
64 S DIR(0)="FO",DIR("B")="LAST",DIR("A")="GO TO PATIENT NAME"
65 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
66 S:Y="LAST" Y="zzzzzz" S IBRL=Y
67 I $G(IBRL)']$G(IBRF) W !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",! G NRR
68 Q
69 ;
70TR ; Ask Terminal Digit Range
71 N DIR,DIRUT,DUOUT,DTOUT,X,Y
72 S DIR(0)="FO^1:9^K:X'?1.9N X"
73 S DIR("?")="Enter up to 9 digits of the Terminal Digit to include in Report"
74 S DIR("B")="0000",DIR("A")="Start with Terminal Digit"
75 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
76 S IBRF=$E((Y_"000000000"),1,9)
77 S DIR("B")="9999",DIR("A")="GO to Terminal Digit"
78 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
79 S IBRL=$E((Y_"999999999"),1,9)
80 I IBRF>IBRL W !!,?5,"* The Go to Terminal Digit must follow after the Start with Digit. *",! G TR
81 Q
82 ;
83INSR ; -- sort by Insurance Company Range
84 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
85INSR1 S DIR(0)="FO",DIR("B")="FIRST",DIR("A")="START WITH INSURANCE COMPANY"
86 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
87 S:Y="FIRST" Y="A" S IBSINF=Y
88 S DIR(0)="FO",DIR("B")="LAST",DIR("A")="GO TO INSURANCE COMPANY"
89 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
90 S:Y="LAST" Y="zzzzzz" S IBSINL=Y
91 I $G(IBSINL)']$G(IBSINF) W !!,?5,"* The Go to Insurance Company must follow after the Start with Company Name. *",! G INSR1
92 Q
93 ;
94INSS ; -- select up to six Insurance Companies
95 N DIC,DA,IBX,X,Y S IBX=1
96 S DIC(0)="AEQMZ",DIC="^DIC(36,",DIC("S")="I $$ANYGP^IBCNSJ(+Y,0,1),'$P($G(^DIC(36,+Y,0)),U,5)"
97 S DIC("A")="Select INSURANCE COMPANY: " D ^DIC
98 I Y<0 W " <No Insurance Companies selected>" S IBQUIT=1 G INSSQ
99 S IBSIN(IBX)=+Y_U_Y(0),DIC("A")="Select Another INSURANCE COMPANY: "
100 F IBX=IBX+1:1:6 D Q:(Y<0)
101 .D ^DIC Q:Y<0
102 .S IBSIN(IBX)=+Y_U_Y(0)
103INSSQ Q
104 ;
105QUE ; Ask Device
106 N %ZIS,ZTRTN,ZTSAVE,ZTDESC
107 W !,?10,"You may want to queue this report!",!
108 S %ZIS="QM" D ^%ZIS G:POP QUEQ
109 I $D(IO("Q")) K IO("Q") D G QUEQ
110 .S ZTRTN="BEG^IBCOMC1"
111 .F IBX="IBAIB","IBBDT","IBEDT","IBRF","IBRL","IBSIN","IBSIN(","IBSINF","IBSINL","IBAGEF","IBAGEL","IBQUIT" S ZTSAVE(IBX)=""
112 .S ZTDESC="IB - Identify Patients with/without Insurance"
113 .D ^%ZTLOAD K ZTSK D HOME^%ZIS
114 ;
115 U IO
116 I $E(IOST,1,2)["C-" W !!,?15,"... One Moment Please ..."
117 D BEG^IBCOMC1
118 ;
119QUEQ ; Exit clean-UP
120 W ! D ^%ZISC K IBTMP,IBAIB,IBRF,IBRL,IBSIN,IBSTR,VA,VAERR,VADM,VAPA,^TMP("IBCOMC",$J)
121 Q
122 ;IBCOMC
Note: See TracBrowser for help on using the repository browser.