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

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1IBCOMA ;ALB/CMS - IDENTIFY ACTIVE POLICIES W/NO EFFECTIVE DATE; 08-03-98
2 ;;2.0;INTEGRATED BILLING;**103**;21-MAR-94
3 Q
4EN ;Entry point from option
5 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
6 N IBAIB,IBBDT,IBEDT,IBRF,IBRL,IBQUIT,IBSIN,IBSTR,X,Y
7 S (IBAIB,IBBDT,IBEDT,IBRF,IBRL,IBSIN,IBSTR)=""
8 W !!,?10,"Identify Active Policies with NO Effective Date",!
9 S DIR("A",1)="Sort report by"
10 S DIR("A",2)=" 1 - Patient Name Range"
11 S DIR("A",3)=" 2 - Terminal Digit Range"
12 S DIR("A",4)=" "
13 S DIR(0)="SAXB^1:Patient Name;2:Terminal Digit"
14 S DIR("A")=" Select Number: ",DIR("B")="1",DIR("??")="^D ENH^IBCOMA" D ^DIR
15 I +Y'>0 S IBQUIT=1 G EXIT
16 S IBAIB=+Y
17 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
18 W !! D @$S(IBAIB=1:"NR",1:"TR")
19 I $G(IBQUIT)=1 G EXIT
20 ;
21VER W !!
22 S DIR("A",1)=" Within "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Include:"
23 S DIR("A",2)=" 1 - Verified Policies"
24 S DIR("A",3)=" 2 - Non-Verified Policies"
25 S DIR("A",4)=" 3 - Both"
26 S DIR("A",5)=" "
27 S DIR(0)="SAXB^1:Verified Policies;2:Non-Verified Policies;3:Both"
28 S DIR("A")=" Select Number: ",DIR("B")="1",DIR("??")="^D ICH^IBCOMA" D ^DIR
29 I +Y'>0 S IBQUIT=1 G EXIT
30 S IBSIN=+Y
31 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
32 I IBSIN'=2 D VR I IBBDT=""!(IBEDT="") W " <Date Range not entered>" G VER
33 I $G(IBQUIT)=1 G EXIT
34 ;
35 W !! D QUE
36 ;
37EXIT Q
38 ;
39NR ; Ask Name Range
40 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
41NRR S DIR(0)="FO",DIR("B")="FIRST",DIR("A")=" START WITH PATIENT NAME"
42 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
43 S:Y="FIRST" Y="A" S IBRF=Y
44 S DIR(0)="FO",DIR("B")="LAST",DIR("A")=" GO TO PATIENT NAME"
45 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
46 S:Y="LAST" Y="zzzzzz" S IBRL=Y
47 I $G(IBRL)']$G(IBRF) W !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",! G NRR
48 Q
49 ;
50TR ; Ask Terminal Digit Range
51 N DIR,DIRUT,DUOUT,DTOUT,X,Y
52 S DIR(0)="FO^1:9^K:X'?1.9N X"
53 S DIR("?")="Enter up to 9 digits of the Terminal Digit to include in Report"
54 S DIR("B")="0000",DIR("A")=" Start with Terminal Digit"
55 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
56 S IBRF=$E((Y_"000000000"),1,9)
57 S DIR("B")="9999",DIR("A")=" GO to Terminal Digit"
58 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
59 S IBRL=$E((Y_"999999999"),1,9)
60 I IBRF>IBRL W !!,?5,"* The Go to Terminal Digit must follow after the Start with Digit. *",! G TR
61 Q
62 ;
63VR ; Ask Verification Date Range
64 N %DT,X,Y
65 W !!," Please enter Policy Verification Dates:"
66 ;
67VRBDT ; - get begin date
68 S (IBBDT,IBEDT)=""
69 S %DT="AEX",%DT("A")=" Start with DATE: " D ^%DT K %DT G VRQ:Y<0 S IBBDT=Y
70 ;
71VREDT ; - get ending date
72 S %DT="EX" R !," Go to DATE: ",X:DTIME S:X=" " X=IBBDT G VRQ:(X="")!(X["^") D ^%DT G VREDT:Y<0 S IBEDT=Y I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G VRBDT
73 ;
74VRQ Q
75 ;
76ENH ; Sort help Text
77 W !!,?5,"Enter 1 to search by a Patient Name Range. (i.e. ADAMS to ADAMSZ)"
78 W !!,?5,"Enter 2 to search by Terminal Digit. The output will be sorted"
79 W !?5,"by the 8th and 9th digits and then the 6th and 7th digits"
80 W !?5,"of the Patient's SSN.",!
81 Q
82 ;
83ICH ; Search criteria help Text
84 W !!,?5,"Enter 1 to list active policies by Verification Date Range"
85 W !,?15,"(i.e. Sort Date By: 10-1-96 Go to Date: 01-1-97)"
86 W !,?5,"Enter 2 to list active policies with no Verification Date."
87 W !,?5,"Enter 3 to include active policies with or without a Verification Date."
88 Q
89QUE ; Ask Device
90 N %ZIS,ZTRTN,ZTSAVE,ZTDESC
91 W !,?10,"You may want to queue this report!",!
92 S %ZIS="QM" D ^%ZIS G:POP QUEQ
93 I $D(IO("Q")) K IO("Q") D G QUEQ
94 .S ZTRTN="BEG^IBCOMA1",ZTSAVE("IBRF")="",ZTSAVE("IBRL")=""
95 .S ZTSAVE("IBAIB")="",ZTSAVE("IBBDT")="",ZTSAVE("IBEDT")="",ZTSAVE("IBSIN")=""
96 .S ZTDESC="IB - Identify Active Policies w/no Effective Date"
97 .D ^%ZTLOAD K ZTSK D HOME^%ZIS
98 ;
99 U IO
100 I $E(IOST,1,2)["C-" W !!,?15,"... One Moment Please ..."
101 D BEG^IBCOMA1
102 ;
103QUEQ ; EXIT CLEAN-UP
104 W ! D ^%ZISC K IBAIB,IBRF,IBRL,IBSIN,IBSTR,^TMP("IBCOMA",$J)
105 Q
106 ;IBCOMA
Note: See TracBrowser for help on using the repository browser.