source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRU4.m@ 701

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

initial load of WorldVistAEHR

File size: 8.0 KB
Line 
1BPSSCRU4 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,3**;JUN 2004;Build 20
3 ;; Per VHA Directive 10-93-142, this routine should not be modified.
4 ;USER SCREEN
5 Q
6 ;
7 ;repeatedly prompts the user for line#
8 ;the user should "^" to quit or enter a correct line #
9 ;input:
10 ; BPROMPT - prompt string
11 ; BPTYPE expected user's selection on level
12 ; of P-patient or C-claim or PC - both
13 ; BPERRMES - optional - the message to display when the user
14 ; tries to make multi line selection
15 ; BPDFLT - default value for the prompt (optional)
16 ;output:
17 ; piece 1:
18 ; 1 - okay
19 ; <0 - errors
20 ; 0 - user wants to quit
21 ; piece 2: patient ien #2
22 ; piece 3: insurance ien #36
23 ; piece 4: ptr to #9002313.59
24 ; piece 5: 1st line for index(es) in LM "VALM" array
25 ; piece 6: patient's index
26 ; piece 7: claim's index
27ASKLINE(BPROMPT,BPTYPE,BPERRMES,BPDFLT) ;
28 N BPRET,BPCNT
29 S BPRET="",BPCNT=0
30 F S BPRET=$$SELLINE(BPROMPT,BPTYPE,VALMAR,$G(BPDFLT)) Q:BPRET'<0 D
31 . ;D RE^VALM4
32 . ;
33 . I BPCNT<1 S BPCNT=BPCNT+1 W !
34 . E S BPCNT=0 D RE^VALM4
35 . I BPRET=-1 W " - Invalid line number" ; (invalid Patient summary line)"
36 . I BPRET=-8 W " - ",$S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number")
37 . I BPRET=-4 W " - Invalid line number" ; (invalid RX line)"
38 . I BPRET=-2 W " - Please select Patient's summary line."
39 . I BPRET=-3 W " - Please specify RX line."
40 . I BPRET<-4 W " - Incorrect format." ; Corrupted array (",BPRET,")"
41 Q BPRET
42 ;/**
43 ;prompts the user for line# for various menu option of the User Screen
44 ;input:
45 ; BPROMPT - prompt string
46 ; BPTYPE - expected user's selection on level
47 ; of P-patient or C-claim or PC - both
48 ; BPTMP1 - temporary global (VALMAR)
49 ; BPDFLT - default value for the prompt (optional)
50 ;output:
51 ; piece 1:
52 ; 1 - okay
53 ; <0 - errors
54 ; 0 - user wants to quit
55 ; piece 2: patient ien #2
56 ; piece 3: insurance ien #36
57 ; piece 4: ptr to #9002313.59
58 ; piece 5: 1st line for index(es) in LM "VALM" array
59 ; piece 6: patient's index
60 ; piece 7: claim's index
61SELLINE(BPROMPT,BPTYPE,BPTMP1,BPDFLT) ;*/
62 N BPX,BPLINE,BPPATIND,BPCLMIND
63 N BPDFN,BPSINSUR,BP59,BP1LN
64 S BPLINE=$$PROMPT(BPROMPT,$G(BPDFLT))
65 I BPLINE="^" Q 0
66 S BPPATIND=+$P(BPLINE,".")
67 I (BPLINE["-")!(BPLINE[",") Q -8 ;multiple line input in not allowed
68 I '$D(@BPTMP1@("LMIND",BPPATIND)) Q -1 ;the patient level doesn't exist
69 S BPCLMIND=+$P(BPLINE,".",2)
70 I BPTYPE="P",BPCLMIND>0 Q -2 ;P was requested but claim portion was provided
71 I BPTYPE="C",BPCLMIND=0 Q -3 ;C was requested but claim portion was not provided
72 I '$D(@BPTMP1@("LMIND",BPPATIND,BPCLMIND)) Q -4 ;the claim level doesn't exist
73 S BPDFN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
74 I +BPDFN=0 Q -5 ;error
75 S BPSINSUR=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
76 I BPSINSUR="" Q -6 ;error
77 ;if fractional part was entered
78 I BPCLMIND>0 D I +BP59=0 Q -7 ;error
79 . S BP59=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
80 I BPCLMIND=0 S BP59=0
81 S BP1LN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
82 I +BP1LN=0 Q -7 ;error
83 Q "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
84 ;
85 ;input:
86 ;BPSPROM - prompt text
87 ;BPSDFVL - default value (optional)
88 ;returns:
89 ; "response^"
90PROMPT(BPSPROM,BPSDFVL) ;
91 N BPRET,DIR,X,Y,DIRUT
92 S BPRET="^"
93 S DIR(0)="F^::2",DIR("A")=BPSPROM
94 I $L($G(BPSDFVL))>0 S DIR("B")=$G(BPSDFVL)
95 D ^DIR I $D(DIRUT) Q "^"
96 S $P(BPRET,U)=Y
97 Q BPRET
98 ;
99 ;/**
100 ;check and process user input
101 ;input:
102 ; BPLINE - input string
103 ; BPTYPE - expected user's selection on level
104 ; of P-patient or C-claim or PC - both
105 ; BPTMP1 - temporary global (VALMAR)
106 ;output:
107 ; piece 1:
108 ; 1 - okay
109 ; <0 - errors
110 ; 0 - user wants to quit
111 ; piece 2: patient ien #2
112 ; piece 3: insurance ien #36
113 ; piece 4: ptr to #9002313.59
114 ; piece 5: 1st line for index(es) in LM "VALM" array
115 ; piece 6: patient's index
116 ; piece 7: claim's index
117CHECKLN(BPLINE,BPTYPE,BPTMP1) ;*/
118 N BPX,BPPATIND,BPCLMIND
119 N BPDFN,BPSINSUR,BP59,BP1LN
120 I BPLINE="^" Q 0
121 S BPPATIND=+$P(BPLINE,".")
122 I '$D(@BPTMP1@("LMIND",BPPATIND)) Q -1 ;the patient level doesn't exist
123 S BPCLMIND=+$P(BPLINE,".",2)
124 I BPTYPE="P",BPCLMIND>0 Q -2 ;P was requested but claim portion was provided
125 I BPTYPE="C",BPCLMIND=0 Q -3 ;C was requested but claim portion was not provided
126 I '$D(@BPTMP1@("LMIND",BPPATIND,BPCLMIND)) Q -4 ;the claim level doesn't exist
127 S BPDFN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
128 I +BPDFN=0 Q -5 ;error
129 S BPSINSUR=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
130 I BPSINSUR="" Q -6 ;error
131 ;if fractional part was entered
132 I BPCLMIND>0 D I +BP59=0 Q -7 ;error
133 . S BP59=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
134 I BPCLMIND=0 S BP59=0
135 S BP1LN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
136 I +BP1LN=0 Q -7 ;error
137 Q "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
138 ;
139 ;
140 ;BPTMP = VALMAR
141 ;input:
142 ; BPROMPT - prompt text
143 ; BPTYPE - expected user's selection on level
144 ; of P-patient or C-claim or PC - both
145 ; BPTMP - temporary global (like VALMAR)
146 ; BPARRLN2 - to return results
147 ;output :
148 ; 1 if okay
149 ; -1 -invalid format
150 ; ^ - quit
151 ; BPARRLN2 - Array(B59)="line# in VALM"^"PatientIndex.ClaimIndex"
152 ;example:
153 ; BPARR(30045.00001)=134^2.34
154ASKLINES(BPROMPT,BPTYPE,BPARRLN2,BPTMP) ;
155 N BPQ,BPXLN,BPN,BPLN,BPZ
156 N BPL,BPCLM
157 N BPARRLN1,BPX1
158 S BPSPROM="Select item(s)"
159 S BPLN=$$PROMPT(BPSPROM,"")
160 I BPLN="^" Q "^"
161 S BPLN=$P(BPLN,U)
162 S BPQ=0
163 F BPN=1:1 S BPX1=$P(BPLN,",",BPN) Q:$L(BPX1)=0 D Q:BPQ'=0
164 . S BPZ=$$MKINDEXS(BPX1,BPTMP,.BPARRLN1)
165 . I BPZ<1 S BPQ=-1
166 . I (BPZ=-1)!(BPZ=-2) W !,"Invalid format.",!
167 . I (BPZ=-3) W !,"Not a valid selection.",!
168 Q:BPQ=-1 -1
169 ;
170 N BPPAT,BPCLM
171 S BPPAT=0 F S BPPAT=$O(BPARRLN1(BPPAT)) Q:BPPAT="" D
172 . S BPCLM=0 F S BPCLM=$O(BPARRLN1(BPPAT,BPCLM)) Q:BPCLM="" D
173 . . S BP1=$G(BPARRLN1(BPPAT,BPCLM))
174 . . Q:$L(BP1)=0
175 . . S BPARRLN2(+$P(BP1,U,4))=+$P(BP1,U,5)_U_BPPAT_"."_BPCLM
176 Q 1
177 ;
178 ;/**
179 ;checks for dashes and if so then create a number of indexes for the range
180 ;i.e. convert all "1.2-2.3" to "1.2,1.3,1.4,2.1,2.2,2.3"
181 ;AND create entries in BPARR for all "right" indexes
182 ;input:
183 ;BPVAL - value to check (exmpl: "1.2-2.4")
184 ;BPTMP1 - global ref with data (exmpl: VALMAR)
185 ;BPARR - array with parsed line indexes
186 ;output:
187 ;Exmpl:
188 ; BPARR(1.2)=""
189 ; BPARR(1.3)=""
190 ; ...
191 ; returns:
192 ; 1 - okay
193 ; <0 invalid format
194MKINDEXS(BPVAL,BPTMP1,BPARR) ;
195 N BPFR,BPTO,BPQ,BPRET
196 N BPPAT,BPCLM,BPCLSTRT,BPCLEND,BPQ2
197 N BPFRPAT,BPTOPAT,BPFRCLM,BPTOCLM,BP1
198 S BPQ=0
199 S BPRET=1
200 I BPVAL'["-" D Q BPRET
201 . S BPPAT=$P(BPVAL,".",1)
202 . I BPPAT'=+BPPAT S BPRET=-1 Q ;invalid format, patient part is not numeric
203 . S BPCLM=$P(BPVAL,".",2)
204 . ;if only patient index
205 . I $L(BPCLM)=0 D Q
206 . . S BPQ2=0
207 . . F BPCLM=1:1 D Q:BPQ2'=0
208 . . . ;quit if there are no more claims for the patient
209 . . . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
210 . . . I BP1<1 S BPQ2=1 Q
211 . . . S BPARR(+BPPAT,+BPCLM)=BP1
212 . ;if only patient+claim index
213 . I BPCLM'=+BPCLM S BPRET=-2 Q ;invalid format, claim portion is not numeric
214 . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
215 . I BP1<1 S BPRET=-3 Q ;not found
216 . S BPARR(+BPPAT,+BPCLM)=BP1
217 ;********* if contains "-"
218 S BPFR=$P(BPVAL,"-",1)
219 S BPTO=$P(BPVAL,"-",2)
220 I BPTO["-" Q -3 ;invalid format (to many dashes)
221 S BPFRPAT=$P(BPFR,".",1)
222 S BPTOPAT=$P(BPTO,".",1)
223 S BPFRCLM=$P(BPFR,".",2)
224 I $L(BPFRCLM)=0 S BPFRCLM=1
225 S BPTOCLM=$P(BPTO,".",2)
226 I $L(BPTOCLM)=0 S BPTOCLM=999999
227 I BPFRPAT'=+BPFRPAT Q -1 ;invalid format, patient part is not numeric
228 I BPTOPAT'=+BPTOPAT Q -1 ;invalid format, patient part is not numeric
229 I BPFRCLM'=+BPFRCLM Q -2 ;invalid format, claim portion is not numeric
230 I BPTOCLM'=+BPTOCLM Q -2 ;invalid format, claim portion is not numeric
231 F BPPAT=BPFRPAT:1:BPTOPAT D
232 . I BPPAT=BPFRPAT S BPCLSTRT=BPFRCLM
233 . E S BPCLSTRT=1
234 . I BPPAT=BPTOPAT S BPCLEND=BPTOCLM
235 . E S BPCLEND=999999
236 . S BPQ2=0
237 . F BPCLM=BPCLSTRT:1:BPCLEND D Q:BPQ2'=0
238 . . ;quit if there are no more claims for the patient
239 . . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
240 . . I BP1<1 S BPQ2=1 Q
241 . . S BPARR(+BPPAT,+BPCLM)=BP1
242 Q 1
243 ;
Note: See TracBrowser for help on using the repository browser.