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

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1IBCOMC2 ;ALB/CMS - IDENTIFY PT BY AGE WITH OR WITHOUT INSURANCE (CON'T); 10-09-98
2 ;;2.0;INTEGRATED BILLING;**103,153**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5ENH ; Sort help Text
6 W !!,?5,"Enter 1 to search by a Patient Name Range. (i.e. ADAMS to ADAMSZ)"
7 W !,?5,"Enter 2 to search by Terminal Digit. The output will be sorted"
8 W !,?5,"by the 8th and 9th digits and then the 6th and 7th digits of the"
9 W !,?5,"Patient's SSN.",!
10 Q
11 ;
12INSH ; Search criteria help Text
13 W !!,?5,"Enter 1 to List patients covered by policies in Insurance Co. Name Range"
14 W !,?15,"(i.e. Sort By: MEDICARE To: MEDICAREZZZ)"
15 W !,?5,"Enter 2 to List patients covered by policies of the selected Insurance Co."
16 W !,?15,"(User may enter up to six Companies.)"
17 W !,?5,"Enter 3 to list patients with NO Coverage on file."
18 Q
19 ;
20AGEH ; Sort AGE help text
21 W !!,?5,"Enter an Age Range to sort by (1-250). Or press return at the Start Age"
22 W !,?5,"prompt to not include Age range in search criteria."
23 Q
24 ;
25HD ;Write Heading
26 N IBX S IBPAGE=IBPAGE+1
27 W @IOF,!,"Patients "_$S(IBSIN=3:"Without",1:"With")_" Insurance Report",?50,$$FMTE^XLFDT($$NOW^XLFDT,"Z"),?70," Page ",IBPAGE
28 I IBPAGE=1 D
29 .W !,?5,"Sorted by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$S(IBRF="A":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
30 .W !,?5,"Date Last Treated Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z")
31 .I IBSIN=1 W !,?5,"Insurance Company Range: "_$S(IBSINF="A":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL)
32 .I IBSIN=3 W !,?5,"Patients with no Insurance on File"
33 .I IBAGEF W !,?5,"Age Range: "_IBAGEF_" to "_IBAGEL
34 .W !,?5,"* - Patient Deceased"
35 .I IBSIN=2 W !,?5,"Active Policies with selected Insurance Companies:" F IBX=1:1:6 Q:'$D(IBSIN(IBX)) W !,?10,$P(IBSIN(IBX),U,2)
36 W !!?58,"Means",!,"Patient Name (SSN)",?39,"Age",?44,"DOB",?58,"Test?",?70,"Last Visit"
37 W ! F IBX=1:1:80 W "="
38 Q
39 ;
40WRT ;Write data lines
41 N IBCDA,IBDA,IBDFN,IBINS,IBNA,IBPOL,IBPT,X,Y S IBQUIT=0
42 S IBNA="" F S IBNA=$O(^TMP("IBCOMC",$J,1,IBNA)) Q:(IBNA="")!(IBQUIT=1) D
43 .S IBDFN=0 F S IBDFN=$O(^TMP("IBCOMC",$J,1,IBNA,IBDFN)) Q:('IBDFN)!(IBQUIT=1) D
44 ..S IBPT=$G(^TMP("IBCOMC",$J,1,IBNA,IBDFN))
45 ..;
46 ..I ($Y+5)>IOSL D I IBQUIT=1 Q
47 ...D ASK I IBQUIT=1 Q
48 ...D HD
49 ..;
50 ..W !!,$E($P(IBPT,U,1),1,30)_" "_$P(IBPT,U,2),?39,$P(IBPT,U,3),?44,$P(IBPT,U,4),?58,$P(IBPT,U,5),?65,$P(IBPT,U,6)
51 ..;
52 ..S IBDA=0 F S IBDA=$O(^TMP("IBCOMC",$J,1,IBNA,IBDFN,IBDA)) Q:('IBDA)!(IBQUIT=1) D
53 ...S IBINS=$G(^TMP("IBCOMC",$J,1,IBNA,IBDFN,IBDA))
54 ...I IBSIN=3 W !,IBINS Q
55 ...W !?3,$E($P(IBINS,U,1),1,30),?35,"Reimb VA? ",$P(IBINS,U,2),?50,"Plan Name: ",$E($P(IBINS,U,3),1,20)
56 ...;
57 Q
58 ;
59ASK ; Ask to Continue with display
60 ; also called from IBCNSUR1 and IBCOMA1
61 I $E(IOST,1,2)'["C-" Q
62 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
63 S DIR(0)="E" D ^DIR
64 I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1
65 Q
66 ;IBCOMC2
Note: See TracBrowser for help on using the repository browser.