source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOREJUT.m@ 1614

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1PSOREJUT ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities ;06/07/05
2 ;;7.0;OUTPATIENT PHARMACY;**148,247,260**;DEC 1997;Build 84
3 ;Reference to DUR1^BPSNCPD3 supported by IA 4560
4 ;Reference to $$ADDCOMM^BPSBUTL supported by IA 4719
5 ;
6SAVE(RX,RFL,REJ) ; - Saves DUR Information in the PRESCRIPTION file
7 ; Input: (r) RX - Rx IEN (#52)
8 ; (o) RFL - Refill # (Default: most recent)
9 ; (r) REJ - Array containing information about the REJECT on the following
10 ; subscripts:
11 ; "CODE" - Reject Code (79 or 88)
12 ; "DATE/TIME" - Date/Time Reject Detected
13 ; "PAYER MESSAGE" - Message returned by Payer (up to 140 chars long)
14 ; "REASON" - Reject Reason (up to 100 chars long)
15 ; "DUR TEXT" - Payer's DUR description
16 ; "INSURANCE NAME" - Patient's Insurance Company Name
17 ; "GROUP NAME" - Patient's Insurance Group Name
18 ; "GROUP NUMBER" - Patient's Insurance Group Number
19 ; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
20 ; "PLAN CONTACT" - Patient's Insurance Plan Contact (1-800)
21 ; "PREVIOUS FILL" - Plan's Previous Fill Date
22 ; "OTHER REJECTS" - Other Rejects with same Response
23 ; "PHARMACIST" - Pharmacist DUZ
24 ; "RESPONSE IEN" - Pointer to the RESPONSE file in ECME
25 ; "REASON SVC CODE" - Reason for Service Code (pointer to BPS NCPDP REASON FOR SERVICE CODE)
26 ; "RE-OPENED" - Re-Open Flag
27 ;Output: REJ("REJECT IEN")
28 ;
29 N %,DIC,DR,DA,X,DINUM,DD,DO,DLAYGO
30 ;
31 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
32 ;
33 ; - If Reject Code different than 79 or 88, Quit
34 S REJ("CODE")=+$G(REJ("CODE")) I REJ("CODE")'=79,REJ("CODE")'=88 Q
35 ;
36 S REJ("PAYER MESSAGE")=$E($G(REJ("PAYER MESSAGE")),1,140),REJ("REASON")=$E($G(REJ("REASON")),1,100)
37 S REJ("DUR TEXT")=$E($G(REJ("DUR TEXT")),1,100),REJ("GROUP NAME")=$E($G(REJ("GROUP NAME")),1,30)
38 S REJ("INSURANCE NAME")=$E($G(REJ("INSURANCE NAME")),1,30),REJ("PLAN CONTACT")=$E($G(REJ("PLAN CONTACT")),1,30)
39 S REJ("GROUP NUMBER")=$E($G(REJ("GROUP NUMBER")),1,30),REJ("OTHER REJECTS")=$E($G(REJ("OTHER REJECTS")),1,15)
40 S REJ("CARDHOLDER ID")=$E($G(REJ("CARDHOLDER ID")),1,20)
41 I $G(REJ("DATE/TIME"))="" D NOW^%DTC S REJ("DATE/TIME")=%
42 ;
43 S DIC="^PSRX("_RX_",""REJ"",",DA(1)=RX,DIC(0)=""
44 S X=+$G(REJ("CODE")),DINUM=$O(^PSRX(RX,"REJ",9999),-1)+1
45 S DIC("DR")="1///"_$G(REJ("DATE/TIME"))_";2///"_REJ("PAYER MESSAGE")_";3///"_REJ("REASON")_";4////"_$G(REJ("PHARMACIST"))_";5///"_RFL
46 S DIC("DR")=DIC("DR")_";6///"_REJ("GROUP NAME")_";7///"_REJ("PLAN CONTACT")_";8///"_$G(REJ("PREVIOUS FILL"))
47 S DIC("DR")=DIC("DR")_";9///0;14///"_$G(REJ("REASON SVC CODE"))_";16///"_$G(REJ("RESPONSE IEN"))
48 S DIC("DR")=DIC("DR")_";17///"_$G(REJ("OTHER REJECTS"))_";18///"_REJ("DUR TEXT")_";20///"_REJ("INSURANCE NAME")
49 S DIC("DR")=DIC("DR")_";21///"_REJ("GROUP NUMBER")_";22///"_REJ("CARDHOLDER ID")_";23///"_$G(REJ("RE-OPENED"))
50 ;
51 F L +^PSRX(RX):5 Q:$T H 15
52 K DD,DO D FILE^DICN K DD,DO S REJ("REJECT IEN")=+Y
53 L -^PSRX(RX)
54 Q
55 ;
56CLSALL(RX,RFL,USR,REA,COM,COD1,COD2,COD3,CLA,PA) ; Close/Resolve All Rejects
57 ;Input: (r) RX - Rx IEN (#52)
58 ; (o) RFL - Refill # (Default: most recent)
59 ; (r) REA - Close REASON code
60 ; (o) COM - Close COMMENTS
61 ; (o) USR - User DUZ responsible for closing all rejects
62 ; (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
63 ; (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
64 ; (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
65 ; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
66 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
67 N REJ,REJDATA,DIE,DR,DA
68 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
69 ;
70 ; - Closing OPEN/UNRESOLVED rejects
71 I $$FIND(RX,RFL,.REJDATA) D
72 . S REJ="" F S REJ=$O(REJDATA(REJ)) Q:'REJ D
73 . . D CLOSE(RX,RFL,REJ,USR,REA,$G(COM),$G(COD1),$G(COD2),$G(COD3),$G(CLA),$G(PA))
74 Q
75 ;
76CLOSE(RX,RFL,REJ,USR,REA,COM,COD1,COD2,COD3,CLA,PA) ; - Mark a DUR/REFILL TOO SOON reject RESOLVED
77 ; Input: (r) RX - Rx IEN (#52)
78 ; (o) RFL - Refill # (Default: most recent)
79 ; (r) REJ - REJECT ID (IEN)
80 ; (o) USR - User (file #200 IEN) responsible for closing the REJECT
81 ; (r) REA - Reason for closing the REJECT:
82 ; 1:CLAIM RE-SUBMITTED
83 ; 2:RX ON HOLD
84 ; 3:RX SUSPENDED
85 ; 4:RX RETURNED TO STOCK
86 ; 5:RX DELETED
87 ; 6:OVERRIDEN W/OUT RE-SUBMISSION
88 ; 99:OTHER
89 ; (o) COM - Close comments manually entered by the user
90 ; (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
91 ; (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
92 ; (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
93 ; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
94 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
95 ;
96 I '$G(RX)!'$G(REJ) Q
97 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
98 I '$D(^PSRX(RX,"REJ",REJ)) Q
99 I $$GET1^DIQ(52.25,REJ_","_RX,5)'=+$G(RFL) Q
100 S:'$G(REA) REA=99 S COM=$TR($G(COM),";^",",,")
101 ;
102 N DQ,DA,DIE,DR,X,Y,REJCOM
103 D NOW^%DTC
104 S REJCOM="AUTOMATICALLY CLOSED" I REA'=1 S REJCOM=COM
105 S DA(1)=RX,DA=REJ,DIE="^PSRX("_RX_",""REJ"","
106 S DR="9///1;10///"_%_";11////"_$G(USR)_";12///"_REA_";13///"_REJCOM_";14///"_$G(COD1)_";15///"_$G(COD2)
107 S DR=DR_";19///"_$G(COD3)_";24///"_$G(CLA)_";25///"_$P($G(PA),"^")_";26///"_$P($G(PA),"^",2)
108 ;
109 D ^DIE S X=$$ADDCOMM^BPSBUTL(RX,RFL,COM)
110 Q
111 ;
112FIND(RX,RFL,REJDATA,CODE) ; - Returns whether a prescription/fill contains UNRESOLVED rejects
113 ; Input: (r) RX - Rx IEN (#52)
114 ; (o) RFL - Refill # (If not passed, look original and all refills)
115 ; (o) CODE - Specific Reject Code to be checked
116 ;
117 ; Output: 1 - Rx contains unresoveld Rejects
118 ; 0 - Rx does not contain unresolved Rejects
119 ; .REJDATA - Array containing the Reject(s) data (see
120 ; GET^PSOREJU2 for fields documentation)
121 ;
122 I $G(RFL),$$STATUS^PSOBPSUT(RX,RFL)="" Q 0
123 ;
124 K REJDATA
125 I $G(RFL) D
126 . D GET^PSOREJU2(RX,RFL,.REJDATA,,,$G(CODE))
127 E S RFL=0 D I '$D(REJDATA) F S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL D Q:$D(REJDATA)
128 . D GET^PSOREJU2(RX,RFL,.REJDATA,,,$G(CODE))
129 ;
130 Q $S($D(REJDATA):1,1:0)
131 ;
132SYNC(RX,RFL,USR) ;
133 ; Input: (r) RX - Rx IEN (#52)
134 ; (o) RFL - Refill # (Default: most recent)
135 ; (o) USR - User using the system when this routine is called
136 ;
137 N REJ,REJS,I,IDX,CODE,DATA,TXT
138 L +^PSRX("REJ",RX):0 Q:'$T
139 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
140 D DUR1^BPSNCPD3(RX,RFL,.REJ)
141 K REJS S IDX=""
142 F S IDX=$O(REJ(IDX)) Q:IDX="" D
143 . S TXT=$G(REJ(IDX,"REJ CODE LST"))
144 . F I=1:1:$L(TXT,",") D
145 . . S CODE=+$P(TXT,",",I) I CODE'=79,CODE'=88 Q
146 . . I $$DUP^PSOREJU1(RX,+$$CLEAN^PSOREJU1($G(REJ(IDX,"RESPONSE IEN")))) Q
147 . . S REJS(IDX,CODE)=""
148 I '$D(REJS) L -^PSRX("REJ",RX) Q
149 ;
150 S (IDX,CODE)=""
151 F S IDX=$O(REJS(IDX)) Q:IDX="" D
152 . F S CODE=$O(REJS(IDX,CODE)) Q:CODE="" D
153 . . K DATA
154 . . S DATA("DUR TEXT")=$$CLEAN^PSOREJU1($G(REJ(IDX,"DUR FREE TEXT DESC")))
155 . . S DATA("PAYER MESSAGE")=$$CLEAN^PSOREJU1($G(REJ(IDX,"PAYER MESSAGE")))
156 . . S DATA("CODE")=CODE
157 . . S DATA("REASON")=$$CLEAN^PSOREJU1($G(REJ(IDX,"REASON")))
158 . . S DATA("PHARMACIST")=$G(USR)
159 . . S DATA("INSURANCE NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"INSURANCE NAME")))
160 . . S DATA("GROUP NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NAME")))
161 . . S DATA("GROUP NUMBER")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NUMBER")))
162 . . S DATA("CARDHOLDER ID")=$$CLEAN^PSOREJU1($G(REJ(IDX,"CARDHOLDER ID")))
163 . . S DATA("PLAN CONTACT")=$$CLEAN^PSOREJU1($G(REJ(IDX,"PLAN CONTACT")))
164 . . S DATA("PREVIOUS FILL")=$$CLEAN^PSOREJU1($$DAT^PSOREJU1($G(REJ(IDX,"PREVIOUS FILL DATE"))))
165 . . S DATA("OTHER REJECTS")=$$CLEAN^PSOREJU1($$OTH^PSOREJU1(CODE,$G(REJ(IDX,"REJ CODE LST"))))
166 . . S DATA("RESPONSE IEN")=+$$CLEAN^PSOREJU1($G(REJ(IDX,"RESPONSE IEN")))
167 . . S DATA("REASON SVC CODE")=$$REASON^PSOREJU2($G(REJ(IDX,"REASON")))
168 . . D SAVE(RX,RFL,.DATA)
169 L -^PSRX("REJ",RX)
170 Q
Note: See TracBrowser for help on using the repository browser.