1 | IBCOMA ;ALB/CMS - IDENTIFY ACTIVE POLICIES W/NO EFFECTIVE DATE; 08-03-98
|
---|
2 | ;;2.0;INTEGRATED BILLING;**103**;21-MAR-94
|
---|
3 | Q
|
---|
4 | EN ;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 | ;
|
---|
21 | VER 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 | ;
|
---|
37 | EXIT Q
|
---|
38 | ;
|
---|
39 | NR ; Ask Name Range
|
---|
40 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
---|
41 | NRR 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 | ;
|
---|
50 | TR ; 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 | ;
|
---|
63 | VR ; Ask Verification Date Range
|
---|
64 | N %DT,X,Y
|
---|
65 | W !!," Please enter Policy Verification Dates:"
|
---|
66 | ;
|
---|
67 | VRBDT ; - 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 | ;
|
---|
71 | VREDT ; - 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 | ;
|
---|
74 | VRQ Q
|
---|
75 | ;
|
---|
76 | ENH ; 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 | ;
|
---|
83 | ICH ; 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
|
---|
89 | QUE ; 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 | ;
|
---|
103 | QUEQ ; EXIT CLEAN-UP
|
---|
104 | W ! D ^%ZISC K IBAIB,IBRF,IBRL,IBSIN,IBSTR,^TMP("IBCOMA",$J)
|
---|
105 | Q
|
---|
106 | ;IBCOMA
|
---|