source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCOMD.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: 5.3 KB
Line 
1IBCOMD ;ALB/CMS - GENERATE INSURANCE COMPANY LISTINGS; 03-AUG-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,IBQUIT,IBCASE,IBFLD,IBQ,IBF,IBTY,X,Y
7 W !!,?10,"Generate Insurance Company Listings",!
8 S DIR("A",1)="Sort report by"
9 S DIR("A",2)="1 - Active Insurance Companies"
10 S DIR("A",3)="2 - Inactive Insurance Companies"
11 S DIR("A",4)="3 - Both"
12 S DIR("A",5)=" "
13 S DIR(0)="SAXB^1:Active;2:Inactive;3:Both"
14 S DIR("A")=" Select Number: ",DIR("B")="1",DIR("??")="^D ENH^IBCOMD"
15 D ^DIR K DIR,DIROUT,DTOUT,DUOUT,DIRUT
16 I +Y'>0 G EXIT
17 S IBAIB=+Y
18 ;
19 W !!,"You may search for specific companies to be included in this report by"
20 W !,"'screening' companies based on the company name, street, city, or state."
21 W !,"You may select any combination of these fields and specify a 'range' of"
22 W !,"values that the field must fall between, or a specific value that the"
23 W !,"field must 'contain.'",!
24 ;
25 K IBFLD S IBFLD(1)="NAME",IBFLD(2)="STREET",IBFLD(3)="CITY",IBFLD(4)="STATE"
26 K IBCASE S IBQ=0 F D Q:IBQ W !
27 .;
28 .; - ask for the field
29 .S DIR("A",1)=" Select a"_$S($D(IBCASE):"nother",1:"")_" field to screen Insurance Companies"
30 .S DIR("A",2)=" "
31 .S DIR("A",3)=" 1 - NAME"
32 .S DIR("A",4)=" 2 - STREET"
33 .S DIR("A",5)=" 3 - CITY"
34 .S DIR("A",6)=" 4 - STATE"
35 .S DIR("A",7)=" "
36 .S DIR(0)="SAOXB^1:NAME;2:STREET;3:CITY;4:STATE"
37 .S DIR("A")=" Select a field by Number: ",DIR("??")="^D FLD^IBCOMD"
38 .D ^DIR K DIR,DIROUT,DTOUT,DUOUT,DIRUT I +Y'>0 S IBQ=1 Q
39 .S IBF=+Y
40 .;
41 .; - if state was chosen, select a state and quit
42 .I IBF=4 D Q
43 ..S DIC="^DIC(5,",DIC(0)="QEAMZ",DIC("A")="Select STATE: "
44 ..I $P($G(IBCASE(4)),"^",2) S DIC("B")=$P($G(^DIC(5,$P($G(IBCASE(4)),"^",2),0)),"^")
45 ..D ^DIC K DIC I Y'>0 K IBCASE(4) Q
46 ..S IBCASE(4)="^"_+Y
47 .;
48 .; - ask user to select values by 'range' or 'contains'
49 .S DIR("A")="Allow a (R)ange of values or a value that (C)ontains a specific string: "
50 .S DIR(0)="SAXB^R:RANGE;C:CONTAINS",DIR("??")="^D RAN^IBCOMD"
51 .I $P($G(IBCASE(IBF)),"^")'="" S DIC("B")=$P($G(IBCASE(IBF)),"^")
52 .D ^DIR K DIR,DIROUT,DTOUT,DUOUT,DIRUT I Y'="R",Y'="C" K IBCASE(IBF) Q
53 .S IBTY=Y
54 .;
55 .; - ask user to select value that 'contains'
56 .I IBTY="C" D Q
57 ..S DIR(0)="FAO",DIR("A")=IBFLD(IBF)_" contains the value: "
58 ..I $P($G(IBCASE(IBF)),"^",2)'="" S DIC("B")=$P($G(IBCASE(IBF)),"^",2)
59 ..S DIR("??")="^D CON^IBCOMD" D ^DIR K DIR
60 ..I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K IBCASE(IBF),DIROUT,DTOUT,DUOUT,DIRUT Q
61 ..I Y="" W !!,?5,"Note: Companies will be selected where ",IBFLD(IBF)," is null."
62 ..S IBCASE(IBF)=IBTY_"^"_Y
63 .;
64 .; - ask user to select a range of values
65 .D SELR
66 ;
67 ;
68 I '$D(IBCASE) W !!,"Please note that no screening fields were selected!",!
69 E D W !
70 .N I,H
71 .W !!,"The following conditions were selected:"
72 .S (H,I)=0 F S I=$O(IBCASE(I)) Q:'I D
73 ..W ! I H W ?3,"and"
74 ..S H=1 W ?8,IBFLD(I)
75 ..W ?18,$S(I=4:"Equals ",$P(IBCASE(I),"^")="C":"Contains ",1:"Between ")
76 ..W $S(I=4:$P($G(^DIC(5,+$P(IBCASE(I),"^",2),0)),"^"),$P(IBCASE(I),"^",2)="":"'FIRST'",1:$P(IBCASE(I),"^",2))
77 ..I $P(IBCASE(I),"^")="R" W " and ",$S($P(IBCASE(I),"^",3)="zzzzzz":"'LAST'",1:$P(IBCASE(I),"^",3))
78 ;
79 D QUE
80 ;
81EXIT Q
82 ;
83 ;
84 ;
85SELR ; Select a range of values
86 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,IBRF,IBRL
87SELRR S DIR(0)="FO",DIR("A")="START WITH '"_IBFLD(IBF)_"' VALUE"
88 S DIR("B")=$S($P($G(IBCASE(IBF)),"^",2)'="":$P($G(IBCASE(IBF)),"^",2),1:"FIRST")
89 D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K IBCASE(IBF) Q
90 S:Y="FIRST" Y="" S IBRF=Y
91 ;
92 S DIR(0)="FO",DIR("A")="GO TO '"_IBFLD(IBF)_"' VALUE"
93 S DIR("B")=$S($P($G(IBCASE(IBF)),"^",3)'="":$P($G(IBCASE(IBF)),"^",3),1:"LAST")
94 D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K IBCASE(IBF) Q
95 S:Y="LAST" Y="zzzzzz" S IBRL=Y
96 ;
97 ; - the 'go to' value must follow the 'start with' value
98 I $G(IBRL)']$G(IBRF) W !!,?5,"* The 'Go To' value must follow after the 'Start With' value. *",! G SELRR
99 S IBCASE(IBF)="R^"_IBRF_"^"_IBRL
100 Q
101 ;
102 ;
103ENH ; Active, Inactive or Both help Text
104 W !!,?5,"Enter 1 to search Active Insurance Companies"
105 W !,?5,"Enter 2 to search Inactive Insurance Companies"
106 W !,?5,"Enter 3 to include Active and Inactive Insurance Companies in Report",!
107 Q
108 ;
109FLD ;Field selection help text
110 W !!,?5,"Enter 1 to screen insurance company by Name"
111 W !,?5,"Enter 2 to screen insurance company by Street"
112 W !,?5,"Enter 3 to screen insurance company by City"
113 W !,?5,"Enter 4 to screen insurance company by State"
114 Q
115 ;
116RAN ; Help for the Range/Contains prompt.
117 W !!,?5,"Enter 'R' to enter a 'Start From' and 'Go To' range, or 'C' to enter"
118 W !,?5,"a specific string that the field value must contain. Enter '^' to"
119 W !,?5,"eliminate this screen field and select another field."
120 Q
121 ;
122CON ; Help for the 'Contains' prompt.
123 W !!,?5,"Enter a string that the field value should contain. Enter a <CR> to"
124 W !,?5,"find entries where the field value is null. Enter '^' to eliminate"
125 W !,?5,"this screen field and select another field."
126 Q
127 ;
128 ;
129QUE ; Ask Device
130 N %ZIS,ZTRTN,ZTSAVE,ZTDESC
131 S %ZIS="QM" D ^%ZIS G:POP QUEQ
132 I $D(IO("Q")) K IO("Q") D G QUEQ
133 .S ZTRTN="BEG^IBCOMD1"
134 .S ZTSAVE("IBAIB")="",ZTSAVE("IBFLD(")=""
135 .I $D(IBCASE) S ZTSAVE("IBCASE(")=""
136 .S ZTDESC="IB - Identify Dup Insurance Companies"
137 .D ^%ZTLOAD K ZTSK D HOME^%ZIS
138 ;
139 U IO
140 I $E(IOST,1,2)["C-" W !!,?15,"... One Moment Please ..."
141 D BEG^IBCOMD1
142QUEQ Q
Note: See TracBrowser for help on using the repository browser.