source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJD.m@ 677

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

initial load of FOIAVistA 6/30/08 version

File size: 8.8 KB
Line 
1IBJD ;ALB/CPM - DIAGNOSTIC MEASURES UTILITIES ; 16-DEC-96
2 ;;2.0;INTEGRATED BILLING;**69,123**;21-MAR-94
3 ;
4DS ; Print a (S)ummary or (D)etail Report?
5 S DIR(0)="SA^S:SUMMARY;D:DETAILED;"
6 S DIR("A")="Do you wish to print a (S)ummary or (D)etailed Report? "
7 S DIR("?")="^D HDS^IBJD"
8 W ! D ^DIR K DIR S IBRPT=Y
9 Q
10 ;
11SDIV() ; - Sort by division.
12 ; Output: SDIV = 1 - Sort by Division / 0 - Do not sort by Division
13 ; or "^" - User selected "^"
14 ; VAUTD = 1 - All divisions selected / 0 - Specific divisions
15 ; VAUTD(DIV) = Divsions selected
16 ;
17 N SDIV,DIR,J
18 ;
19 K DIR,VAUTD S DIR(0)="Y",DIR("B")="NO" W !
20 S DIR("A")="Do you wish to sort this report by division"
21 S DIR("T")=DTIME,DIR("?")="^D HDIV^IBJD"
22 D ^DIR K DIR
23 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S SDIV="^" G QDIV
24 S SDIV=+Y K DIROUT,DTOUT,DUOUT,DIRUT
25 I SDIV D PSDR^IBODIV I Y<0 S SDIV="^"
26 ;
27 ; - Set VAUTD when ALL divisions have been selected
28 I SDIV,VAUTD S J=0 F S J=$O(^DG(40.8,J)) Q:'J S VAUTD(J)=""
29 ;
30QDIV Q SDIV
31 ;
32MLTP(PRPT,OPT,ALL) ; Function for multiple value selection
33 ; Input: PRPT - String to be prompted to the user, before listing options
34 ; OPT - Array containing the possible entries (indexed by code)
35 ; Obs: Code must be sequential starting with 1
36 ; ALL - Flag indicating if the last option is ALL OF THE ABOVE
37 ;
38 ; Output: MLTP - User selection, i.e. "1,2,3," or "1," or 0 (nothing
39 ; was selected)
40 ;
41 N A,DIR,DIRUT,DTOUT,DUOUT,DIROUT,I,IX,LST,MLTP
42 ;
43PRPT S MLTP=0,ALL=+$G(ALL)
44 S LST=$O(OPT(""),-1)
45 S DIR(0)="LO^1:"_LST_"^K:+$P(X,""-"",2)>"_LST_" X"
46 S DIR("A",1)=$G(PRPT),DIR("A",2)=""
47 S A="",IX=3
48 F S A=$O(OPT(A)) Q:A="" D
49 . S DIR("A",IX)=" "_A_" - "_$G(OPT(A)),IX=IX+1
50 S DIR("A",IX)="",DIR("A")="Select",DIR("B")=LST,DIR("T")=DTIME W !
51 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G QT
52 S MLTP=Y K DIROUT,DTOUT,DUOUT,DIRUT
53 ;
54 I ALL,MLTP[LST S MLTP=LST_","
55 ;
56 S DIR(0)="Y",DIR("A",1)="You have selected",DIR("A",2)=""
57 S A="",IX=3
58 F I=1:1:($L(MLTP,",")-1) D
59 . S DIR("A",IX)=" "_$P(MLTP,",",I)_" - "_$G(OPT($P(MLTP,",",I)))
60 . S IX=IX+1
61 S DIR("A",IX)=""
62 S DIR("A")="Are you sure",DIR("B")="NO",DIR("T")=DTIME W !
63 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S MLTP=0 G QT
64 K DIROUT,DTOUT,DUOUT,DIRUT I 'Y K DIR G PRPT
65 ;
66 I ALL,MLTP[LST D
67 . S MLTP="" F I=(LST-1):-1:1 S MLTP=I_","_MLTP
68 ;
69QT Q MLTP
70 ;
71SNL() ; - Determine the sorting of the patient (By Name or Last 4 SSN)
72 ; Output: SNL = "N" (Name)/"L" (Last 4 SSN) ^ "NAME" or "LAST 4"
73 ;
74 N DIR,DIRUT,DTOUT,DUOUT,DIROUT,SNL
75 S SNL=""
76 S DIR(0)="SA^N:NAME;L:LAST 4"
77 S DIR("A")="Sort Patients by (N)AME or (L)AST 4 of the SSN: "
78 S DIR("B")="NAME",DIR("T")=DTIME,DIR("?")="^D HNL^IBJD"
79 W ! D ^DIR K DIR I Y=""!(X="^") Q "^"
80 S SNL=Y
81 ;
82 Q SNL
83 ;
84INTV(SORT) ; Selects the interval
85 ; Output: First value ^ Last Value ^ "ALL"/"NULL"/""
86 ;
87 N ALNU,FRST,LAST,X
88 ;
89 S (ALNU,FRST,LAST)=""
90FRST W !!?3,"START WITH "_SORT_": FIRST// " R X:DTIME I '$T!(X["^") Q "^"
91 I $E(X)="?" D HFST G FRST
92 S FRST=X
93LAST W !?8,"GO TO "_SORT_": LAST// " R X:DTIME I '$T!(X["^") Q "^"
94 I $E(X)="?" D HLST G LAST
95 I X="" S LAST="zzzzz" S:FRST="" ALNU="ALL" G QINT
96 I X="@",FRST="@" S LAST="@",ALNU="NULL" G QINT
97 I FRST'="@",FRST]X D G LAST
98 .W *7,!!?7,"The LAST value must follow the FIRST.",!
99 S LAST=X
100 ;
101QINT Q (FRST_"^"_LAST_"^"_ALNU)
102 ;
103EXCEL() ; - Returns whether to catpture data for Excel report.
104 ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
105 ;
106 N EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
107 ;
108 S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
109 S DIR("A")="Do you want to capture report data for an Excel document"
110 S DIR("?")="^D HEXC^IBJD"
111 D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
112 K DIROUT,DTOUT,DUOUT,DIRUT
113 S EXCEL=0 I Y S EXCEL=1
114 ;
115 Q EXCEL
116 ;
117CLMACT(X,Y) ; - Check if AR has a corresponding claim or IB action.
118 ; Input: X=Claim/AR pointer to file #399/#430
119 ; Y=AR category pointer to file #430.2
120 ; Output: Z=1-IB action, 2-Claim, 3-No IB action or claim
121 ; ^ IB action IEN (if 1) or AR/claim IEN (if 2 or 3)
122 ; OR null=Invalid IB action or claim
123 N ACT,BILL,NODE,NODE1,Z S Z="" G:'$G(X)!('$G(Y)) CLACQ
124 S BILL=$P($G(^PRCA(430,X,0)),U) G:BILL="" CLACQ
125 ;
126 ; - Check for most recent IB action.
127 S ACT=+$O(^IB("ABIL",BILL,9999999),-1) G:'ACT CLAC1
128 S NODE=$G(^IB(ACT,0)) G:NODE="" CLAC1
129 I $P(NODE,U,5)'=3!($P(NODE,U,10)) G CLACQ ; Not billed/cancelled.
130 I $P($G(^IBE(350.1,+$P(NODE,U,3),0)),U,3)=Y S Z=1_U_ACT G CLACQ
131 ;
132CLAC1 ; - Check for IB claim.
133 I '$D(^DGCR(399,X,0)) S Z=3_U_X G CLACQ ; No IB action/claim.
134 S NODE=$G(^DGCR(399,X,0)) G:$P(NODE,U,13)=7 CLACQ ; Cancelled claim.
135 S NODE1=$G(^DGCR(399.3,+$P(NODE,U,7),0)) G:NODE1="" CLACQ
136 I '$P(NODE1,U,3),$P(NODE1,U,6)=Y S Z=2_U_X
137CLACQ Q Z
138 ;
139ALSP(PRPT,FILE,ARR) ; Selection of (A)LL or (S)pecific values from a given file
140 ; Input: PRPT - Piece 1: Label for the PROMPT to be asked for the
141 ; selection (in the plural) - e.g. "Providers"
142 ; Piece 2: Singular of piece 1 - e.g. "Provider"
143 ; Exaple: "Specialties^Specialty"
144 ; FILE - File global root (e.g., "^IBE(356.8," ) that the values
145 ; will be selected from
146 ; ARR - Name of the array that will contain the specific values
147 ; (must be passed as a refernce value ".ARR")
148 ; Output: ARR - "A" - ALL values OR "S" - Specific values OR "^"
149 ; The values will be returned in the array indicated in
150 ; ARR parameter
151 ;
152 N DIC,PRL,SNG,X
153 K ARR S PRL=$P(PRPT,"^"),SNG=$P(PRPT,"^",2) S:SNG="" SNG=PRL
154ALSP1 W !!,"Run report for (A)LL or (S)PECIFIC "_PRL_": A// "
155 R X:DTIME I '$T!(X["^") S ARR="^" G QALSP
156 S X=$S(X="":"A",1:$E(X)) I "AaSs"'[X D HALSP G ALSP1
157 W " ",$S("Ss"[X:"SPECIFIC",1:"ALL") I "Aa"[X K ARR S ARR="A" G QALSP
158 S ARR="S"
159ALSP2 S DIC=FILE,DIC(0)="AEQMZ"
160 S DIC("A")=" Select a"_$S($O(ARR(""))'="":"nother",1:"")_" "
161 S DIC("A")=DIC("A")_SNG_": "
162 D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) K ARR S ARR="^" G QALSP
163 I Y'>0 G ALSP1:$O(ARR(""))="" G QALSP
164 I $D(ARR(+Y)) D G ALSP2
165 . W !!?3,"Already selected. Choose another "_SNG,*7,!
166 S ARR(+Y)="" G ALSP2
167 ;
168QALSP Q
169 ;
170HDS ; Help for Summary/Detail prompt.
171 W !,"Please enter 'S' for 'Summary' or 'D' for a Detailed Report."
172 W !,"Note that if you select the Detailed report, the Summary will also print."
173 Q
174 ;
175HDIV ; - 'Sort by division...' prompt
176 W !!," Enter: '<CR>' - To print the report without regard to division"
177 W !!," 'Y' - To select those divisions for which a separate"
178 W !," report should be created"
179 W !," '^' - To quit this option"
180 Q
181 ;
182HNL ; - 'Sort Patients by (N)AME... ' prompt
183 W !!," Enter: '<CR>' - To select and sort patients by name"
184 W !!," 'L' - To select and sort patients by the last 4"
185 W !," of the SSN"
186 W !," '^' - To quit this option"
187 Q
188 ;
189HFST ; - 'START WITH PATIENT/DEBTOR...' prompt
190 W !!," Enter a valid field value, or"
191 W !!," '@' - To include null values"
192 W !," '<CR>' - To start from the 'first' value for this field"
193 W !," '^' - To quit this option"
194 Q
195 ;
196HLST ; - 'GO TO PATIENT/DEBTOR' prompt
197 W !!," Enter a valid field value, or"
198 W !!," '@' - To include only null values, if 'Start with'"
199 W !," value is @"
200 W !," '<CR>' - To go to the 'last' value for this field"
201 W !," '^' - To quit this option",!
202 Q
203 ;
204HEXC ; - 'Do you want to capture data...' prompt
205 W !!," Enter: 'Y' - To capture detail report data to transfer"
206 W !," to an Excel document"
207 W !," '<CR>' - To skip this option"
208 W !," '^' - To quit this option"
209 Q
210 ;
211HALSP ; - 'Run report for (A)LL or (S)pecific...' prompt.
212 W !!?6,"Enter: '<CR>' - To select all "_PRL
213 W !?16,"'S' - To select one or more "_PRL
214 W !?16,"'^' - To quit this option"
215 Q
216 ;
217EXMSG ; - Displays the message about capturing to an Excel file format
218 ;
219 W !!?5,"Before continuing, please set up your terminal to capture the"
220 W !?5,"detail report data. On some terminals, this can be done by"
221 W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
222 W !?5,"Incoming Data' to save to Desktop. This report may take a"
223 W !?5,"while to run."
224 W !!?5,"Note: To avoid undesired wrapping of the data saved to the"
225 W !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
226 Q
227 ;
228EXPAND(FILE,FIELD,VALUE) ; Resolve coded data.
229 N Y,C S Y=VALUE
230 I 'FILE!('FIELD)!(VALUE="") G EXPQ
231 S Y=VALUE,C=$P(^DD(FILE,FIELD,0),"^",2) D Y^DIQ
232EXPQ Q Y
233 ;
234DT(X,Y) ; - Return date.
235 ; Input: X=Date in Fileman format
236 ; Output: Z=Date in MMM DD,YYYY format or MMDDYY format if Y=1
237 N Z S Z="" G:'$G(X) DTQ
238 I $G(Y) S Z=$E(X,4,7)_$E(X,2,3) G DTQ
239 N Y S Y=X X ^DD("DD") S Z=$P(Y,"@")
240DTQ Q Z
Note: See TracBrowser for help on using the repository browser.