source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRCV.m@ 619

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

initial load of WorldVistAEHR

File size: 8.9 KB
RevLine 
[613]1BPSSCRCV ;BHAM ISC/SS - ECME SCREEN CHANGE VIEW ;05-APR-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;USER SCREEN
5 Q
6 ;****
7 ;This software is using PARAMETER TOOLS (see XT*7.3*26) to store user's settings:
8 ;PARAMETER DEFINITION NAME="BPS USRSCR" (file #8989.51, IA# 2263)
9 ;ENTITY is "USR" , i.e. IEN in ^VA(200 -- see definition for "BPS USRSCR"
10 ;INSTANCEs are as follows:
11 ;1.01 ONE/ALL USERS --'U' ONE USER, 'A' ALL; Display claims for ONE or ALL users
12 ;1.02 ONE/ALL PATIENTS --'P' FOR ONE PATIENT; 'A' FOR ALL; Display claims for ONE/ALL PATIENTS
13 ;1.03 ONE/ALL RX --'R' FOR ONE RX; 'A' FOR ALL; Display claims for ONE or ALL RX
14 ;1.04 HOURS/DAYS -- 'D' FOR DAYS; 'H' FOR HOURS; Use HOURS or DAYS to specify timeframe
15 ;1.05 TIMEFRAME -- NUMBER Depends on the value of the field "USR SCR HOURS/DAYS" this field will
16 ;store the default number of HOURS from NOW or DAYS from TODAY to select claims to display
17 ;1.06 REJECTED/PAYABLE --'R' FOR REJECTS; 'P' FOR PAYABLES 'A' FOR ALL; Display Rejects or Payables or ALL claims
18 ;1.07 RELEASED/NOT RELEASED --'R' FOR RELEASED; 'N' FOR NON-RELEASED; 'A' FOR ALL; Display Released Rxs or Non-Released Rxs or ALL
19 ;1.08 CMOP/MAIL/WINDOW --'C' FOR CMOP; 'M' FOR MAIL;'W' FOR WINDOW;'A' FOR ALL; Display CMOP or Mail or Window or ALL Rxs
20 ;1.09 REALTIME/BACKBILL --'R' FOR REALTIME; 'B' FOR BACKBILLS; 'A' FOR ALL; Display RealTime Fills or Backbills or ALL
21 ;1.1 REJECT CODE/ALL --'R' FOR REJECT CODE; 'A' FOR ALL; Display Specific Reject Code or ALL Reject
22 ;Codes 0 means ALL Reject Codes otherwise - Reject Code value
23 ;1.11 SINGLE/ALL INSURANCES --'I' FOR SINGLE INSURANCE;'A' FOR ALL; Display Single Insurance Company or All null - ALL otherwise - pointer to INSURANCE COMPANY file #36
24 ;1.12 SORT LIST --'T' FOR TRANSACTION DATE;'D' FOR DIVISION; 'I' FOR INSURANCE; 'C' FOR REJECT CODE;
25 ;'P' FOR PATIENT NAME -- 'N' FOR DRUG NAME; 'B' FOR BILL TYPE (BB/RT); 'L' FOR FILL LOCATION;
26 ;'R' FOR RELEASED/NON-RELEASED -- 'A' FOR ACTIVE/DISCONTINUED; the field used to sort claims in the list
27 ;1.13 ALL ECME PHARMACY DIVISIONS --'D' FOR DIVISION; 'A' FOR ALL;
28 ;1.14 SELECTED INSURANCE -- Single insurance to select claims for the User Screen, to store INSURANCE COMPANY pointer (#36)
29 ;1.15 SELECTED REJECTED CODE --POINTER TO BPS NCPDP REJECT CODES FILE (#9002313.93) Reject code selected by the user to filter claims.
30 ;1.16 SELECTED USER -- POINTER TO NEW PERSON FILE (#200) Selected user for the user screen
31 ;1.17 SELECTED PATIENT -- POINTER TO PATIENT FILE (#2) Selected patient for the User Screen
32 ;1.18 SELECTED RX -- POINTER TO PRESCRIPTION FILE (#52) Selected RX
33 ;2 ECME PHARMACY DIVISION -- the list of POINTERs TO BPS PHARMACIES FILE (#9002313.56) separated by "^"
34 ;should start and end with ";", example: ";4;5;"
35 ;
36 ;NOTE: use D ^XPAREDIT to add/edit values
37 ;
38 ;*****
39 ;
40CV ;
41 D FULL^VALM1
42 W @IOF
43 K BPARR
44 I +$G(DUZ)=0 D ERRMSG^BPSSCRCV("Unknown User") Q
45 N BPDUZ7
46 S BPDUZ7=+DUZ
47 ;always get current profile from the file
48 D READPROF^BPSSCRSL(.BPARR,BPDUZ7)
49 D SAVEVIEW^BPSSCR01(.BPARR)
50 ;edit current profile
51 D EDITPROF(.BPARR,.BPDUZ7)
52 ;ask user if need to save everything in USR PROFILE file
53 ;(except SORT LIST field)
54 N BPSRT S BPSRT=BPARR(1.12)
55 K BPARR(1.12)
56 D ENDEDIT^BPSSCRSL(.BPARR,+BPDUZ7)
57 S BPARR(1.12)=BPSRT
58 D SAVEVIEW^BPSSCR01(.BPARR)
59 S VALMBG=1
60 D REDRAW^BPSSCRUD("Updating screen...")
61 Q
62 ;edit user profile for CHANGE VIEW
63EDITPROF(BPARR,BPDUZ7) ;
64 I +$G(DUZ)=0 D ERRMSG("Unknown User") Q
65 N BP1,BPTF,BPQ,BPINP
66 N BPRET
67 N DIR,DR,DIE,DA
68 ;get ONE/ALL USERS?
69 ;EDITFLD(FILENO,FLDNO,RECIEN,CODESET,PRMTMSG,DFLTCODE) ;
70 S BPRET=$$DS^BPSSCRDS(.BPARR,+BPDUZ7) ;get divisions
71 Q:BPRET=-2 ;quit due to timeout or ^
72 S BPQ=0 F D Q:BPQ'=0
73 . S BPINP=$$EDITFLD(1.01,+BPDUZ7,"S^U:ONE USER;A:ALL","Display One ECME (U)ser or (A)LL","ALL",.BPARR)
74 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)="A" BPQ=1 I BPQ'=0 Q
75 . S BPINP=$$EDITFLD(1.16,+BPDUZ7,"P^VA(200,","Select User","",.BPARR)
76 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)'="" BPQ=1 I BPQ'=0 Q
77 Q:BPQ=-1 ;quit due to timeout or ^
78 S BPQ=0 F D Q:BPQ'=0
79 . S BPINP=$$EDITFLD(1.02,+BPDUZ7,"S^P:ONE PATIENT;A:ALL","Display One (P)atient or (A)LL","ALL",.BPARR)
80 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)="A" BPQ=1 I BPQ'=0 Q
81 . S BPINP=$$EDITFLD(1.17,+BPDUZ7,"P^DPT(","Select Patient","",.BPARR)
82 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)'="" BPQ=1 I BPQ'=0 Q
83 Q:BPQ=-1 ;quit due to timeout or ^
84 S BPQ=0 F D Q:BPQ'=0
85 . S BPINP=$$EDITFLD(1.03,+BPDUZ7,"S^R:ONE RX;A:ALL","Display One (R)x or (A)LL","ALL",.BPARR)
86 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)="A" BPQ=1 I BPQ'=0 Q
87 . S BPINP=$$EDITRX^BPSSCRPR(1.18,+BPDUZ7,"Select RX","",.BPARR)
88 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)'="" BPQ=1 I BPQ'=0 Q
89 Q:BPQ=-1 ;quit due to timeout or ^
90 S BPINP=$$EDITFLD(1.04,+BPDUZ7,"S^D:DAYS;H:HOURS","Activity Timeframe (H)ours or (D)ays","DAYS",.BPARR)
91 I BPINP=-1 Q ;quit due to timeout or ^
92 S BPTF=$P(BPINP,U,2)
93 Q:$$EDITFLD(1.05,+BPDUZ7,"N^1:999:0","Activity Timeframe Value",$S(BPTF="H":24,1:7),.BPARR)=-1
94 Q:$$EDITFLD(1.06,+BPDUZ7,"S^R:REJECTS;P:PAYABLES;A:ALL","Display (R)ejects or (P)ayables or (A)LL","REJECTS",.BPARR)=-1
95 Q:$$EDITFLD(1.07,+BPDUZ7,"S^R:RELEASED;N:NON-RELEASED;A:ALL","Display (R)eleased Rxs or (N)on-Released Rxs or (A)LL","RELEASED",.BPARR)=-1
96 Q:$$EDITFLD(1.08,+BPDUZ7,"S^C:CMOP;M:MAIL;W:WINDOW;A:ALL","Display (C)MOP or (M)ail or (W)indow or (A)LL","ALL",.BPARR)=-1
97 Q:$$EDITFLD(1.09,+BPDUZ7,"S^R:REALTIME;B:BACKBILLS;A:ALL","Display (R)ealTime Fills or (B)ackbills or (A)LL","ALL",.BPARR)=-1
98 S BPQ=0 F D Q:BPQ'=0
99 . S BPINP=$$EDITFLD(1.1,+BPDUZ7,"S^R:REJECT CODE;A:ALL","Display Specific (R)eject Code or (A)LL","ALL",.BPARR)
100 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)="A" BPQ=1 I BPQ'=0 Q
101 . S BPINP=$$EDITFLD(1.15,+BPDUZ7,"P^BPSF(9002313.93,","Select Reject Code","",.BPARR)
102 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)'="" BPQ=1 I BPQ'=0 Q
103 Q:BPQ=-1 ;quit due to timeout or ^
104 S BPQ=0 F D Q:BPQ'=0
105 . S BPINP=$$EDITFLD(1.11,+BPDUZ7,"S^I:SINGLE INSURANCE;A:ALL","Display Single (I)nsurance Company or (A)ll","ALL",.BPARR)
106 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)="A" BPQ=1 I BPQ'=0 Q
107 . S BPINP=$$INSURFLD(1.14,+BPDUZ7,"Select Insurance","",.BPARR)
108 . I +BPINP=0 S BPARR(1.11)="A",BPQ=1 D Q ;
109 . . W !,"Your selection will be changed to ALL insurances selected.",!
110 . S:BPINP=-1 BPQ=-1 S:$P(BPINP,U,2)'="" BPQ=1 I BPQ'=0 Q
111 Q
112 ;
113 ;select insurance using IB API
114INSURFLD(FLDNO,RECIEN,PRMTMSG,DFLTVAL,BPARRAY) ;*/
115 N DIR,RETV
116 S RETV=$$GETPARAM^BPSSCRSL(FLDNO,RECIEN)
117 ;if data then use it, otherwise use data from parameter
118 I $L($G(RETV))>0 S DFLTVAL=RETV E S DFLTVAL=$G(DFLTVAL)
119 ;prompt the user
120 S RETV=$$SELINSUR^BPSSCRCU()
121 Q:(+RETV)<1 +RETV
122 ;save it in the database
123 S BPARRAY(FLDNO)=$P(RETV,U,2)
124 Q "1^"_(+RETV)
125 ;
126ERRMSG(BPMSG) ;
127 W !,"***",BPMSG,"***",!
128 D PAUSE^VALM1
129 Q
130 ;/**
131 ;FLDNO - filed #
132 ;RECIEN - ien in file #FILENO
133 ;DIR0 - like DIR(0) node for ^DIR - i.e. field type, etc
134 ;PRMTMSG - user prompt
135 ;DFLTVAL - pass the default value for the case if there is no value in database
136 ;BPARRAY - array to store and change values in profile
137 ;returns:
138 ;as return value:
139 ; "1^value" - if selected
140 ; "-1" if timeout or uparrow
141 ;via BPARRAY
142 ; BPARRAY(filedno)=value
143EDITFLD(FLDNO,RECIEN,DIR0,PRMTMSG,DFLTVAL,BPARRAY) ;*/
144 N DIR,RETV,RETARR
145 N RECIENS,FDA,LCK,ERRARR
146 S RETV=$$GETPARAM^BPSSCRSL(FLDNO,RECIEN)
147 I FLDNO=1.17 S RETV=$P($G(^DPT(+RETV,0)),U)
148 ;if data then use it, otherwise use data from parameter
149 I $L($G(RETV))>0 S DFLTVAL=RETV E S DFLTVAL=$G(DFLTVAL)
150 ;prompt the user
151 S RETV=$$PROMPT(DIR0,PRMTMSG,DFLTVAL)
152 Q:RETV<0 -1
153 ;save it in the database
154 S BPARRAY(FLDNO)=RETV
155 Q "1^"_RETV
156 ;
157 ;
158FILEIT(FILENO,FLDNO,RECIEN,NEWVAL) ;
159 N RECIENS
160 S RECIENS=RECIEN_","
161 S FDA(FILENO,RECIENS,FLDNO)=NEWVAL
162 L +^BPS(FILENO,RECIEN,1):10 S LCK=$T I 'LCK Q "0^"_NEWVAL_"^LOCKED" ;quit
163 D FILE^DIE("","FDA","ERRARR")
164 I LCK L -^BPS(FILENO,RECIEN,1)
165 I $D(ERRARR) Q "0^"_NEWVAL_"^"_ERRARR("DIERR",1,"TEXT",1)
166 Q "1^"_NEWVAL
167 ;
168 ;prompts for selection
169 ;returns selection
170 ;OR -1 when timeout and uparrow
171PROMPT(ZERONODE,PRMTMSG,DFLTVAL) ;
172 N Y,DUOUT,DTOUT,BPQUIT,DIROUT
173 S BPQUIT=0
174 I $E(ZERONODE,1,1)="P" D
175 . N DIC
176 . S DIC="^"_$P(ZERONODE,U,2)
177 . S DIC(0)="AEMNQ"
178 . S:$L($G(DFLTVAL))>0 DIC("B")=DFLTVAL
179 . S DIC("A")=PRMTMSG_": "
180 . D ^DIC
181 . I (Y=-1)!$D(DUOUT)!$D(DTOUT) S BPQUIT=1
182 E D
183 . N DIR
184 . S DIR(0)=ZERONODE
185 . S DIR("A")=PRMTMSG
186 . S:$L($G(DFLTVAL))>0 DIR("B")=DFLTVAL
187 . D ^DIR
188 . I (Y=-1)!$D(DIROUT)!$D(DUOUT)!$D(DTOUT) S BPQUIT=1
189 I BPQUIT=1 Q -1
190 Q $P(Y,U)
191 ;
192GETFLD(FILENO,FLDNO,RECIEN) ;
193 N RETV,RETARR
194 N RECIENS
195 S RECIENS=RECIEN_","
196 ; first try to get the value from file
197 D GETS^DIQ(FILENO,RECIENS,FLDNO,"E","RETARR")
198 S RETV=$G(RETARR(FILENO,RECIENS,FLDNO,"E"))
199 Q $G(RETV)
200 ;
201 ;save all profile array to file
202 ;BPARRAY - arrays with pointers to 9002313.56
203 ;BPDUZ7 - DUZ
204FILEALL(BPARRAY,BPDUZ7) ;
205 N BPFLD,BP2
206 S BPFLD=0
207 F S BPFLD=+$O(BPARRAY(BPFLD)) Q:+BPFLD=0 D
208 . I $$SAVEPAR^BPSSCRSL(BPFLD,+BPDUZ7,$G(BPARRAY(BPFLD)))
209 I $$SAVEPAR^BPSSCRSL(2,BPDUZ7,$G(BPARRAY("DIVS")))
210 Q
211 ;
212 ;
Note: See TracBrowser for help on using the repository browser.