source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOREJP0.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1PSOREJP0 ;BIRM/MFR - Third Party Rejects Processing Screen ;04/28/05
2 ;;7.0;OUTPATIENT PHARMACY;**148,260**;DEC 1997;Build 84
3 ;
4 N PSOREJST,PSORJSRT,PSORJASC,PSOSTFLT,PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSOINGRP
5 N INSLN,HIGHLN,LASTLN
6 ;
7 ; - Division/Site selection
8 D SEL^PSOREJU1("DIVISION","^PS(59,",.PSOREJST,$$GET1^DIQ(59,+$G(PSOSITE),.01)) I $G(PSOREJST)="^" G EXIT
9 ;
10 ; - Initializing global variables
11 S PSORJSRT="PA",PSORJASC=1,PSOSTFLT="U",(PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT)="ALL"
12 S PSOINGRP=0
13 ;
14 D LST("W")
15 G EXIT
16 ;
17LST(PSOMENU) ; - Invokes Listmanager
18 W !,"Please wait..."
19 I PSOMENU="W" D EN^VALM("PSO REJECTS WORKLIST")
20 I PSOMENU="VP" D EN^VALM("PSO REJECTS VIEW/PROCESS")
21 D FULL^VALM1
22 Q
23 ;
24HDR ; - Header code
25 N LINE1,LINE2,LINE3
26 S LINE1=$$SITES() I $L(LINE1)>80 S $E(LINE1,78,999)="..."
27 ;
28 S LINE2="Selection : ALL "_$S(PSOSTFLT="U":"UNRESOLVED ",PSOSTFLT="R":"RESOLVED ",1:"")_"REJECTS"
29 I $G(PSOPTFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("P")
30 I $G(PSODRFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("D")
31 I $G(PSOINFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("I")
32 I $G(PSOINGRP) S LINE2=LINE2_" GROUPED BY INSURANCE"
33 S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2
34 I PSOMENU="VP" D
35 . I $G(PSORXFLT) S LINE3="Rx# : "_$$NAME("R")
36 . E D
37 . . S LINE3="Date Range: "_$$FMTE^XLFDT(+PSODTRNG,2)
38 . . I +PSODTRNG'=$P(PSODTRNG,"^",2) S LINE3=LINE3_" THRU "_$$FMTE^XLFDT($P(PSODTRNG,"^",2),2)
39 . S VALMHDR(3)=LINE3
40 ;
41 D SETHDR()
42 Q
43 ;
44SETHDR() ; - Displays the Header Line
45 N HDR,ORD
46 ;
47 S HDR=" #",$E(HDR,5)="Rx#",$E(HDR,18)="PATIENT(ID)",$E(HDR,43)="DRUG",$E(HDR,64)="REASON"
48 S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,$S(PSOMENU="W":4,1:5))
49 S ORD=$S(PSORJASC=1:"[^]",1:"[v]")
50 S:PSORJSRT="RX" POS=9 S:PSORJSRT="PA" POS=30 S:PSORJSRT="DR" POS=48 S:PSORJSRT="RE" POS=71
51 D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,$S(PSOMENU="W":4,1:5))
52 Q
53 ;
54INIT ; - Populates the Body section for ListMan
55 K ^TMP("PSOREJP0",$J)
56 D SETSORT(PSORJSRT),SETLINE
57 S VALMSG="Select the entry # to view or ?? for more actions"
58 Q
59 ;
60SETLINE ; - Sets the line to be displayed in ListMan
61 N INS,SUB,SEQ,LINE,Z,I,X,X1,X2
62 I '$D(^TMP("PSOREJSR",$J)) D Q
63 . F I=1:1:7 S ^TMP("PSOREJP0",$J,I,0)=""
64 . S ^TMP("PSOREJP0",$J,8,0)=" No Clinical Third Party Payer Rejects found."
65 . S VALMCNT=1
66 ;
67 F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
68 K INSLN,HIGHLN
69 ;
70 S (INS,SUB)="",LINE=0 K ^TMP("PSOREJP0",$J)
71 F S INS=$O(^TMP("PSOREJSR",$J,INS)) Q:INS="" D
72 . I INS'="<NULL>" D
73 . . D GROUP(INS,.LINE)
74 . F S SUB=$O(^TMP("PSOREJSR",$J,INS,SUB),PSORJASC) Q:SUB="" D
75 . . S Z=$G(^TMP("PSOREJSR",$J,INS,SUB))
76 . . S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3)
77 . . S $E(X1,5)=$P(Z,"^",3),$E(X1,18)=$P(Z,"^",4),$E(X1,43)=$P(Z,"^",5),$E(X1,64)=$P(Z,"^",6)
78 . . S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X1,HIGHLN(LINE)=""
79 . . S X2="",$E(X2,5)="Payer Message: "_$P(Z,"^",7)
80 . . S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X2
81 . . S ^TMP("PSOREJP0",$J,SEQ,"RX")=$P(Z,"^",1,2)
82 ;
83 I LINE>$G(LASTLN) D
84 . F I=($G(LASTLN)+1):1:LINE D SAVE^VALM10(I)
85 . S LASTLN=LINE
86 ;
87 ; - Highlighting the prescription/insurance line
88 F LN=1:1:LINE D
89 . I $D(HIGHLN(LN)) D Q
90 . . D CNTRL^VALM10(LN,1,80,IOINHI,IOINORM)
91 . . D CNTRL^VALM10(LN,64,3,IOUON,IOINORM)
92 . . D CNTRL^VALM10(LN,67,80,IOINHI,IOINORM)
93 . I $D(INSLN(LN)) D
94 . . S LBL=INSLN(LN),POS=41-($L(LBL)/2+.5\1)
95 . . D CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
96 . . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IOINORM)
97 . . D CNTRL^VALM10(LN,POS+$L(LBL),81-POS-$L(LBL),IOUON_IOINHI,IOINORM)
98 ;
99 S VALMCNT=+$G(LINE)
100 Q
101 ;
102GROUP(LBL,LINE) ; Sets an insurance delimiter line
103 N X,POS
104 S POS=41-($L(LBL)/2+.5\1)
105 S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
106 S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X,INSLN(LINE)=LBL
107 Q
108 ;
109SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified
110 N RX,REJ,STS,DAT
111 K ^TMP("PSOREJSR",$J)
112 ;
113 ; - Worklist
114 I PSOMENU="W" D
115 . S RX=0 F S RX=$O(^PSRX("REJSTS",0,RX)) Q:'RX D
116 . . S REJ=0 F S REJ=$O(^PSRX("REJSTS",0,RX,REJ)) Q:'REJ D
117 . . . D SETTMP(RX,REJ,FIELD)
118 ;
119 ; - View/Process
120 I PSOMENU="VP" D
121 . I $G(PSORXFLT)'="ALL" D Q
122 . . S REJ=0 F S REJ=$O(^PSRX(+PSORXFLT,"REJ",REJ)) Q:'REJ D
123 . . . I $$FLTSTS(+PSORXFLT,REJ) Q
124 . . . D SETTMP(+PSORXFLT,REJ,FIELD)
125 . S DAT=$P(PSODTRNG,"^")-0.0000001,(RX,REJ)=0
126 . F S DAT=$O(^PSRX("REJDAT",DAT)) Q:'DAT!(DAT>$$ENDT()) D
127 . . F S RX=$O(^PSRX("REJDAT",DAT,RX)) Q:'RX D
128 . . . I $$FILTER(RX) Q
129 . . . F S REJ=$O(^PSRX("REJDAT",DAT,RX,REJ)) Q:'REJ D
130 . . . . I $$FLTSTS(RX,REJ) Q
131 . . . . D SETTMP(RX,REJ,FIELD)
132 Q
133 ;
134SETTMP(RX,REJ,FIELD) ; - Sets ^TMP global that will be displayed in the body section
135 N REJLST,FILL,CODE,RXNUM,PTNAME,DRNAME,MSG,REASON,MSG,X,Z,SORT,I,INS
136 I $G(PSORXFLT)="ALL",$$CLOSED^PSOREJP1(RX,REJ),$$REOPN^PSOREJP1(RX,REJ) Q
137 S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
138 I '$$DIV(RX,FILL) Q
139 K REJLST D GET^PSOREJU2(RX,FILL,.REJLST,,1) I '$D(REJLST) Q
140 I $$FILTER(,REJLST(REJ,"INSURANCE NAME")) Q
141 S PTNAME=$$PTNAME(RX)
142 S DRNAME=$$GET1^DIQ(52,RX,6)
143 S RXNUM=$$GET1^DIQ(52,RX,.01)
144 S CODE=$G(REJLST(REJ,"CODE"))
145 S MSG=$G(REJLST(REJ,"PAYER MESSAGE")) I $L(MSG)>60 S MSG=$E(MSG,1,58)_"..."
146 S REASON=$S(CODE=88:"DUR:"_$G(REJLST(REJ,"REASON")),1:"79 :REFILL TOO SOON")
147 S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=REJ,$P(Z,"^",3)=RXNUM,$P(Z,"^",4)=PTNAME
148 S $P(Z,"^",5)=$E(DRNAME,1,20),$P(Z,"^",6)=$E(REASON,1,17),$P(Z,"^",7)=MSG
149 S SORT=$S(FIELD="PA":PTNAME,FIELD="DR":DRNAME,FIELD="RX":RXNUM_" ",1:REASON)_RX_REJ
150 S INS="<NULL>" I $G(PSOINGRP) S INS=REJLST(REJ,"INSURANCE NAME") S:INS="" INS="***UNKNOWN***"
151 S ^TMP("PSOREJSR",$J,INS,SORT)=Z
152 Q
153 ;
154PAT ; - Sort by Patient
155 D SORT("PA")
156 Q
157DRG ; - Sort by Drug
158 D SORT("DR")
159 Q
160RX ; - Sort by Rx
161 D SORT("RX")
162 Q
163REA ; - Sort by Reason
164 D SORT("RE")
165 Q
166SORT(FIELD) ; - Sort entries by FIELD
167 I PSORJSRT=FIELD S PSORJASC=$S(PSORJASC=1:-1,1:1)
168 E S PSORJSRT=FIELD,PSORJASC=1
169 D REF
170 Q
171 ;
172REF ; - Screen Refresh
173 W ?52,"Please wait..." D INIT S VALMBCK="R"
174 Q
175GI ; - Group by Insurance
176 W ?52,"Please wait..." S PSOINGRP=$S($G(PSOINGRP):0,1:1) D INIT,HDR S VALMBCK="R"
177 Q
178 ;
179SEL ; - Process selection of one entry
180 N PSOSEL,XQORM,Z,RX,REJ,PSOCHNG
181 S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
182 S Z=$G(^TMP("PSOREJP0",$J,PSOSEL,"RX"))
183 S RX=$P(Z,"^"),REJ=$P(Z,"^",2) I 'RX!'REJ S VALMSG="Invalid selection!",VALMBCK="R" Q
184 S PSOCHNG=0 D EN^PSOREJP1(RX,REJ,.PSOCHNG) I $G(PSOCHNG) D REF
185 Q
186 ;
187EXIT ;
188 K ^TMP("PSOREJP0",$J),^TMP("PSOREJSR",$J)
189 Q
190 ;
191HELP Q
192 ;
193SITES() ; - Returns the list of sites along with their NCPDP #s
194 N CNT,SITE,SITES,NAME
195 I '$D(PSOREJST) Q ""
196 I $G(PSOREJST)="ALL" Q "Divisions : ALL"
197 S SITE=0 F S SITE=$O(PSOREJST(SITE)) Q:'SITE D
198 . S NAME=$$GET1^DIQ(59,SITE,.01)
199 . S SITES=$G(SITES)_", "_NAME
200 S $E(SITES,1,2)="",SITES="Division"_$S($L(SITES,",")>1:"s",1:" ")_" : "_SITES
201 Q SITES
202 ;
203DIV(RX,FILL) ; - Check if the Division for the Prescription/Fill was selected by the user
204 ;
205 I $G(PSOREJST)="ALL" Q 1
206 I $D(PSOREJST($$RXSITE^PSOBPSUT(RX,FILL))) Q 1
207 Q 0
208 ;
209PTNAME(RX) ; - Returns header displayable - Patient Name (Last 4 SSN)
210 N DFN,VADM,PTNAME
211 S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT
212 S PTNAME=$E($G(VADM(1)),1,18)_"("_$P($P($G(VADM(2)),"^",2),"-",3)_")"
213 Q PTNAME
214 ;
215FILTER(RX,INS) ; - Filter entries based on user's selection
216 N FILTER,NAME
217 S FILTER=1
218 I $G(PSOPTFLT)'="ALL",$D(RX),'$D(PSOPTFLT($$GET1^DIQ(52,RX,2,"I"))) Q FILTER
219 I $G(PSODRFLT)'="ALL",$D(RX),'$D(PSODRFLT($$GET1^DIQ(52,RX,6,"I"))) Q FILTER
220 I $G(PSOINFLT)'="ALL",$D(INS) D Q FILTER
221 . S NAME="" F S NAME=$O(PSOINFLT(NAME)) Q:NAME="" I $$UP^XLFSTR(INS)[$$UP^XLFSTR(NAME) S FILTER=0 Q
222 Q 0
223 ;
224FLTSTS(RX,REJ) ; - Filter for the Reject Status
225 N STS
226 S STS=$$GET1^DIQ(52.25,REJ_","_RX,9,"I")
227 I PSOSTFLT="U",STS=1 Q 1
228 I PSOSTFLT="R",STS=0 Q 1
229 Q 0
230 ;
231NAME(TYPE) ; - Returns the name if ONE was selected or "MULTIPLE ..."
232 N I,CNT
233 ;
234 I TYPE="P",$O(PSOPTFLT($O(PSOPTFLT(""))))="" Q $$GET1^DIQ(2,$O(PSOPTFLT("")),.01)
235 I TYPE="D",$O(PSODRFLT($O(PSODRFLT(""))))="" Q $$GET1^DIQ(50,$O(PSODRFLT("")),.01)
236 I TYPE="I",$O(PSOINFLT($O(PSOINFLT(""))))="" Q $O(PSOINFLT(""))
237 I TYPE="R" Q $$GET1^DIQ(52,PSORXFLT,.01)
238 Q "MULTIPLE "_$S(TYPE="P":"PATIENTS",TYPE="D":"DRUGS",1:"INSURANCE COMPANIES")
239 ;
240ENDT() ; Returns the upper limit for the date range
241 N ENDT
242 S ENDT=$P(PSODTRNG,"^",2)
243 I '$E(ENDT,4,7) Q (ENDT+10000)
244 I '$E(ENDT,6,7) Q (ENDT+100)
245 I $P(ENDT,"^",2) Q (ENDT+0.0000001)
246 Q (ENDT+.25)
Note: See TracBrowser for help on using the repository browser.