source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOREJU2.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1PSOREJU2 ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities (1) ;10/15/04
2 ;;7.0;OUTPATIENT PHARMACY;**148,260**;DEC 1997;Build 84
3 ;Reference to $$NABP^BPSBUTL supported by IA 4719
4 ;Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE supported by IA 4714
5 ;
6GET(RX,RFL,REJDATA,REJID,OKCL,CODE) ;
7 ; Input: (r) RX - Rx IEN (#52)
8 ; (o) RFL - Refill # (Default: most recent)
9 ; (r) REJDATA(REJECT IEN,FIELD) - Array where these Reject fields will be returned:
10 ; "CODE" - Reject Code (79 or 88)
11 ; "DATE/TIME" - DATE/TIME Reject was detected
12 ; "PAYER MESSAGE" - Message returned by the payer
13 ; "REASON" - Reject Reason description (from payer)
14 ; "INSURANCE NAME" - Patient's Insurance Company Name
15 ; "GROUP NAME" - Patient's Insurance Group Name
16 ; "GROUP NUMBER" - Patient's Insurance Group Number
17 ; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
18 ; "PLAN CONTACT" - Plan's Contact (eg., "1-800-...")
19 ; "PLAN PREVIOUS FILL DATE" - Last time Rx was paid by payer
20 ; "STATUS" - REJECTS status ("OPEN/UNRESOLVED" or "CLOSED/RESOLVED")
21 ; "DUR TEXT" - Payer's DUR description
22 ; "OTHER REJECTS" - Other Rejects on the same response
23 ; "REASON SVC CODE" - Reason for Service Code
24 ; If REJECT is closed, the following fields will be returned:
25 ; "CLA CODE" - Clarification Code submitted
26 ; "PRIOR AUTH TYPE" - Prior Authorization Type
27 ; "PRIOR AUTH NUMBER" - Prior Authorization Type
28 ; "CLOSED DATE/TIME" - DATE/TIME Reject was closed
29 ; "CLOSED BY" - Name of the user responsible for closing Reject
30 ; "CLOSE REASON" - Reason for closing Reject (text)
31 ; "CLOSE COMMENTS" - User entered comments at close
32 ; (o) REJID - REJECT IEN in the PRESCRIPTION file for retrieve this REJECT
33 ; (o) OKCL - If set to 1, CLOSED REJECTs will also be returned
34 ; (o) CODE - Only REJECTs with this CODE should be returned
35 ;
36 N REJS,ARRAY,REJFLD,IDX,COM,Z
37 ;
38 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
39 ;
40 K REJDATA
41 I '$O(^PSRX(RX,"REJ",0)) Q
42 ;
43 K REJS S RFL=+$G(RFL)
44 I $G(REJID) D
45 . I +$P($G(^PSRX(RX,"REJ",REJID,0)),"^",4)'=RFL Q
46 . I '$G(OKCL),$P($G(^PSRX(RX,"REJ",REJID,0)),"^",5) Q
47 . S REJS(REJID)=""
48 E D
49 . S IDX=999
50 . F S IDX=$O(^PSRX(RX,"REJ",IDX),-1) Q:'IDX D
51 . . I +$P($G(^PSRX(RX,"REJ",IDX,0)),"^",4)'=RFL Q
52 . . I '$G(OKCL),$P($G(^PSRX(RX,"REJ",IDX,0)),"^",5) Q
53 . . S REJS(IDX)=""
54 I '$D(REJS) Q
55 ;
56 S IDX=0
57 F S IDX=$O(REJS(IDX)) Q:'IDX D
58 . K ARRAY D GETS^DIQ(52.25,IDX_","_RX_",","*","","ARRAY")
59 . K REJFLD M REJFLD=ARRAY(52.25,IDX_","_RX_",")
60 . I $G(CODE),REJFLD(.01)'=CODE Q
61 . S REJDATA(IDX,"CODE")=$G(REJFLD(.01))
62 . S REJDATA(IDX,"DATE/TIME")=$G(REJFLD(1))
63 . S REJDATA(IDX,"PAYER MESSAGE")=$G(REJFLD(2))
64 . S REJDATA(IDX,"REASON")=$G(REJFLD(3))
65 . S REJDATA(IDX,"PHARMACIST")=$G(REJFLD(4))
66 . S REJDATA(IDX,"INSURANCE NAME")=$G(REJFLD(20))
67 . S REJDATA(IDX,"GROUP NAME")=$G(REJFLD(6))
68 . S REJDATA(IDX,"GROUP NUMBER")=$G(REJFLD(21))
69 . S REJDATA(IDX,"CARDHOLDER ID")=$G(REJFLD(22))
70 . S REJDATA(IDX,"PLAN CONTACT")=$G(REJFLD(7))
71 . S REJDATA(IDX,"PLAN PREVIOUS FILL DATE")=$G(REJFLD(8))
72 . S REJDATA(IDX,"STATUS")=$G(REJFLD(9))
73 . S REJDATA(IDX,"OTHER REJECTS")=$G(REJFLD(17))
74 . S REJDATA(IDX,"DUR TEXT")=$G(REJFLD(18))
75 . S REJDATA(IDX,"REASON SVC CODE")=$G(REJFLD(14))
76 . S REJDATA(IDX,"RESPONSE IEN")=$G(REJFLD(16))
77 . I '$G(OKCL) Q
78 . S REJDATA(IDX,"CLOSED DATE/TIME")=$G(REJFLD(10))
79 . S REJDATA(IDX,"CLOSED BY")=$G(REJFLD(11))
80 . S REJDATA(IDX,"CLOSE REASON")=$G(REJFLD(12))
81 . S REJDATA(IDX,"CLOSE COMMENTS")=$G(REJFLD(13))
82 . S REJDATA(IDX,"COD1")=$G(REJFLD(14))
83 . S REJDATA(IDX,"COD2")=$G(REJFLD(15))
84 . S REJDATA(IDX,"COD3")=$G(REJFLD(19))
85 . S REJDATA(IDX,"CLA CODE")=$G(REJFLD(24))
86 . S REJDATA(IDX,"PRIOR AUTH TYPE")=$G(REJFLD(25))
87 . S REJDATA(IDX,"PRIOR AUTH NUMBER")=$G(REJFLD(26))
88 . S COM=0 F S COM=$O(^PSRX(RX,"REJ",IDX,"COM",COM)) Q:'COM D
89 . . S Z=^PSRX(RX,"REJ",IDX,"COM",COM,0)
90 . . S REJDATA(IDX,"COMMENTS",COM,"DATE/TIME")=$P(Z,"^")
91 . . S REJDATA(IDX,"COMMENTS",COM,"USER")=$P(Z,"^",2)
92 . . S REJDATA(IDX,"COMMENTS",COM,"COMMENTS")=$P(Z,"^",3)
93 Q
94 ;
95HELP(OPTS) ; Display the Help Text for the DUR handling options (OVERRIDE/IGNORE/STOP/QUIT)
96 ;
97 I OPTS["O" D
98 . W !?1,"(O)verride - This option will provide the prompts for the code sets needed to"
99 . W !?1," override this reject and get a payable 3rd party claim. Before"
100 . W !?1," you select this option, you may need to call the 3rd party payer"
101 . W !?1," to determine which code sets are needed to override a particular"
102 . W !?1," reject. Once the proper override is accepted the label will print"
103 . W !?1," and the prescription can be filled."
104 ;
105 I OPTS["I" D
106 . W !?1,"(I)gnore - Choosing Ignore will by-pass 3rd party processing and will allow"
107 . W !?1," you to print a label and fill the prescription. This essentially"
108 . W !?1," ignores the clinical safety issues suggested by the 3rd party"
109 . W !?1," payer and will NOT result in a payable claim."
110 ;
111 I OPTS["Q" D
112 . W !?1,"(Q)uit - Choosing Quit will postpone the processing of this prescription"
113 . W !?1," until this 3rd party reject is resolved. A label will not be"
114 . W !?1," printed for this prescription and it can not be filled/dispensed"
115 . W !?1," until this reject is resolved. Rejects can be resolved through"
116 . W !?1," the Worklist option under the ePharmacy menu."
117 Q
118 ;
119DVINFO(RX,RFL,LM) ; Returns header displayable Division Information
120 ;Input: (r) RX - Rx IEN (#52)
121 ; (o) RFL - Refill # (Default: most recent)
122 ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
123 N TXT,DVINFO,NCPNPI
124 S DVINFO="Division : "_$$GET1^DIQ(59,+$$RXSITE^PSOBPSUT(RX,RFL),.01)
125 S NCPNPI=$P($$NABP^BPSBUTL(RX,RFL)," ")
126 S $E(DVINFO,$S($G(LM):58,1:51))=$S($L(NCPNPI)=7:"NCPDP",1:" NPI")_"#: "_NCPNPI
127 Q DVINFO
128 ;
129PTINFO(RX,LM) ; Returns header displayable Patient Information
130 ;Input: (r) RX - Rx IEN (#52)
131 ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
132 N DFN,VADM,PTINFO
133 S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT
134 S PTINFO="Patient : "_$E($G(VADM(1)),1,$S($G(LM):24,1:20))_"("_$P($G(VADM(2)),"^",2)_")"
135 S PTINFO=PTINFO_" Sex: "_$P($G(VADM(5)),"^")
136 S $E(PTINFO,$S($G(LM):61,1:54))="DOB: "_$P($G(VADM(3)),"^",2)_"("_$P($G(VADM(4)),"^")_")"
137 Q PTINFO
138 ;
139RETRXF(RX,RFL,ONOFF) ; - Set/Reset the Re-transmission flag
140 ;Input: (r) RX - Rx IEN (#52)
141 ; (r) RFL - Refill IEN (#52.1)
142 ; (o) ONOFF - Turn flag ON or OFF (1 - ON / 0 - OFF) (Default: OFF)
143 N DA,DIE,DR
144 S DR="82///"_$S($G(ONOFF):"YES",1:"@")
145 I 'RFL S DA=RX,DIE="^PSRX("
146 I RFL S DA(1)=RX,DA=RFL,DIE="^PSRX("_RX_",1,"
147 D ^DIE
148 Q
149 ;
150REASON(TXT) ; Extracts the Reason for service code from the REASON text field
151 ; Input: (r) TXT - Reason text (e.g., NN Reason for Service Code Text)
152 ;Output: REASON - NN (if on valid and on file (#9002313.23), null otherwise)
153 N REASON,DIC,X,Y
154 S REASON=$P(TXT," ") I $L(REASON)'=2 Q ""
155 S DIC=9002313.23,X=REASON D ^DIC I Y<0 Q ""
156 Q REASON
157 ;
158SETOPN(RX,REJ) ; - Set the Reject RE-OPENED flag to YES
159 ;Input: (r) RX - Rx IEN (#52)
160 ; (r) REJ - Reject IEN (#52.25)
161 ;
162 I '$D(^PSRX(RX,"REJ",REJ)) Q
163 N DIE,DA,DR
164 S DIE="^PSRX("_RX_",""REJ"",",DA(1)=RX,DA=REJ,DR="23///YES" D ^DIE
165 Q
166 ;
167PRT(FIELD,P,L) ; Sets the lines for fields that require text wrapping
168 ;Input: FIELD - Subscript name from the DATA(REJ,FIELD) array
169 ; P - Position where the content should be printed
170 ; L - Lenght of the text on each line
171 N TXT,I
172 S TXT=DATA(REJ,FIELD) I $L(TXT)'>L W ?P,TXT Q
173 F I=1:1 Q:TXT="" D
174 . I I=1 W ?P,$E(TXT,1,L),! S TXT=$E(TXT,L+1,999) Q
175 . W ?P,$E(TXT,1,L) S TXT=$E(TXT,L+1,999) W:TXT'="" !
176 Q
177 ;
178PA() ; - Ask for Prior Authorization Type and Number
179 ;Output:(PAT^PAN) PAT - Prior Authorization Type (See DD File#52,
180 ; Sub-file#52.25,field#25 for possible values)
181 ; PAN - Prior Authorization Number (11 digits)
182 ;
183 N DIR,Y,DIRUT,DIROUT,PAT,PAN
184 S DIR(0)="52.25,25",DIR("A")=" Prior Authorization Type",DIR("B")="0"
185 S (DIR("?"),DIR("??"))="^D PAHLP^PSOREJU2"
186 D ^DIR I $D(DIRUT)!$D(DIROUT) Q "^"
187 S PAT=Y
188 K DIR S DIR(0)="52.25,26",DIR("A")="Prior Authorization Number"
189 S DIR("?")="^D PANHLP^PSOREJU2",DIR("??")=""
190 D ^DIR I (Y["^")!$D(DIROUT) Q "^"
191 S PAN=Y
192 Q (PAT_"^"_PAN)
193 ;
194PAHLP ; Prior Authorization Type Help
195 W !?9,"EPSDT - Early Periodic Screening Diagnosis Treatment"
196 W !?9,"AFDC - Aid to Family with Dependent Children"
197 Q
198 ;
199PANHLP ; Prior Authorization Number Help
200 W "OR you may leave it blank if the claim does not require a number."
201 Q
Note: See TracBrowser for help on using the repository browser.