- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOREJP1.m
r613 r623 1 PSOREJP1 ;BIRM/MFR - Third Party Reject Display Screen ;04/29/05 2 ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281**;DEC 1997;Build 41 3 ;Reference to File 9002313.93 - BPS NCPDP REJECT CODES supported by IA 4720 4 ;Reference to ^PS(59.7 supported by IA 694 5 ;Reference to ^PSDRUG("AQ" supported by IA 3165 6 ; 7 EN(RX,REJ,CHANGE) ; Entry point 8 ; 9 ; - DO NOT change the IF logic below as both of them might get executed (intentional) 10 N FILL,LASTLN 11 S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5) 12 I $$CLOSED(RX,REJ) D EN^VALM("PSO REJECT DISPLAY - RESOLVED") 13 I '$$CLOSED(RX,REJ) D EN^VALM("PSO REJECT DISPLAY") 14 D FULL^VALM1 15 Q 16 ; 17 HDR ; - Builds the Header section 18 N LINE1,LINE2,X 19 S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1),VALMHDR(2)=$$PTINFO^PSOREJU2(RX,1) 20 S VALMHDR(3)=$$RXINFO(RX,FILL,1),VALMHDR(4)=$$RXINFO(RX,FILL,2) 21 Q 22 ; 23 INIT ; Builds the Body section 24 N DATA,LINE 25 F I=1:1:$G(LASTLN) D RESTORE^VALM10(I) 26 K ^TMP("PSOREJP1",$J) S VALMCNT=0,LINE=0 27 D GET^PSOREJU2(RX,FILL,.DATA,REJ,1) 28 D REJ ; Display REJECT Info 29 D OTH ; Display Other Rejects Info 30 D COM^PSOREJP3 ; Display Comment 31 D INS ; Display Insurance Info 32 D CLS ; Display Resolution Info 33 S VALMCNT=LINE 34 Q 35 ; 36 REJ ; - DUR Information 37 N TYPE,PFLDT 38 D SETLN("REJECT Information",1,1) 39 S TYPE=$S($G(DATA(REJ,"CODE"))=79:"79 - REFILL TOO SOON",1:"88 - DUR REJECT") 40 D SETLN("Reject Type : "_TYPE_" received on "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME"))),,,18) 41 D SETLN("Reject Status : "_$G(DATA(REJ,"STATUS")),,,18) 42 D SET("PAYER MESSAGE",63) 43 D SET("REASON",63) 44 S PFLDT=$$FMTE^XLFDT($G(DATA(REJ,"PLAN PREVIOUS FILL DATE"))) 45 D SET("DUR TEXT",63,$S(PFLDT="":1,1:0)) 46 I PFLDT'="" D SETLN("Last Fill Date : "_PFLDT_" (from payer)",,1,18) 47 Q 48 ; 49 OTH ; - Other Rejects Information 50 N LST,I,RJC,J,LAST 51 S LST=$G(DATA(REJ,"OTHER REJECTS")) I LST="" Q 52 D SETLN() 53 D SETLN("OTHER REJECTS",1,1) 54 F I=1:1:$L(LST,",") S RJC=$P(LST,",",I) D 55 . S LAST=1 F J=(I+1):1:$L(LST,",") I $P(LST,",",J)'="" S LAST=0 Q 56 . I RJC'="" D SETLN(RJC_" - "_$$EXP(RJC),,$S(LAST:1,1:0),6) 57 Q 58 ; 59 INS ; - Insurance Information 60 D SETLN() 61 D SETLN("INSURANCE Information",1,1) 62 D SETLN("Insurance : "_$G(DATA(REJ,"INSURANCE NAME")),,,18) 63 D SETLN("Contact : "_$G(DATA(REJ,"PLAN CONTACT")),,,18) 64 D SETLN("Group Name : "_$G(DATA(REJ,"GROUP NAME")),,,18) 65 D SETLN("Group Number : "_$G(DATA(REJ,"GROUP NUMBER")),,,18) 66 D SETLN("Cardholder ID : "_$G(DATA(REJ,"CARDHOLDER ID")),,1,18) 67 Q 68 ; 69 CLS ; - Resolution Information 70 N X 71 I '$$CLOSED(RX,REJ) Q 72 D SETLN() 73 D SETLN("RESOLUTION Information",1,1) 74 D SETLN("Resolved By : "_$G(DATA(REJ,"CLOSED BY")),,,18) 75 D SETLN("Date/Time : "_$G(DATA(REJ,"CLOSED DATE/TIME")),,,18) 76 I $G(DATA(REJ,"CLOSE COMMENTS"))'="" D SET("CLOSE COMMENTS",63) 77 I $G(DATA(REJ,"COD1"))'="" D SETLN("Reason for Svc : "_$$OVRX^PSOREJU1(1,$G(DATA(REJ,"COD1"))),,,18) 78 I $G(DATA(REJ,"COD2"))'="" D SETLN("Profes. Svc : "_$$OVRX^PSOREJU1(2,$G(DATA(REJ,"COD2"))),,,18) 79 I $G(DATA(REJ,"COD3"))'="" D SETLN("Result of Svc : "_$$OVRX^PSOREJU1(3,$G(DATA(REJ,"COD3"))),,,18) 80 I $G(DATA(REJ,"CLA CODE"))'="" D 81 . S X=$$GET1^DIQ(52.25,REJ_","_RX,24,"I")_" - "_(DATA(REJ,"CLA CODE")) 82 . D SETLN("Clarific. Code : "_X,,,18) 83 I $G(DATA(REJ,"PRIOR AUTH TYPE"))'="" D 84 . S X=$$GET1^DIQ(52.25,REJ_","_RX,25,"I")_" - "_(DATA(REJ,"PRIOR AUTH TYPE")) 85 . D SETLN("Prior Auth.Type: "_X,,,18),SETLN("Prior Auth. # : "_DATA(REJ,"PRIOR AUTH NUMBER"),,,18) 86 D SETLN("Reason : "_$G(DATA(REJ,"CLOSE REASON")),,1,18) 87 Q 88 ; 89 ; 90 SET(FIELD,L,UND) ; Sets the lines for fields that require text wrapping 91 N TXT,T 92 S TXT=DATA(REJ,FIELD) I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q 93 F I=1:1 Q:TXT="" D 94 . I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q 95 . S T="",$E(T,81-L)=$E(TXT,1,L) D SETLN(T,,$S($E(TXT,L+1,999)=""&$G(UND):1,1:0),80-L) S TXT=$E(TXT,L+1,999) 96 Q 97 ; 98 LABEL(FIELD) ; Sets the label for the field 99 I FIELD="REASON" Q "Reason : " 100 I FIELD="PAYER MESSAGE" Q "Payer Message : " 101 I FIELD="DUR TEXT" Q "DUR Text : " 102 I FIELD="CLOSE COMMENTS" Q "Comments : " 103 Q "" 104 ; 105 VIEW ; - Rx View hidden action 106 N VALMCNT,TITLE 107 I $G(PSOBACK) D Q 108 . S VALMSG="Not available through Backdoor!",VALMBCK="R" 109 S TITLE=VALM("TITLE") 110 ; 111 ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE 112 DO 113 . N PSOVDA,DA,PS 114 . S (PSOVDA,DA)=RX,PS="REJECT" 115 . N RX,REJ,FILL,LINE,TITLE D DP^PSORXVW 116 ; 117 S VALMBCK="R",VALM("TITLE")=TITLE 118 Q 119 ; 120 EDT ; - Rx Edit hidden action 121 N VALMCNT,TITLE 122 I $G(PSOBACK) D Q 123 . S VALMSG="Not available through Backdoor!",VALMBCK="R" 124 S TITLE=VALM("TITLE") 125 ; 126 ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE 127 DO 128 . N PSOSITE,ORN,PSOPAR,PSOLIST 129 . S PSOSITE=$$RXSITE^PSOBPSUT(RX,FILL),ORN=RX 130 . S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_"," 131 . N RX,REJ,FILL,LINE,TITLE D EPH^PSORXEDT 132 ; 133 K VALMBCK I $$CLOSED(RX,REJ),$D(PSOSTFLT),PSOSTFLT="U" S CHANGE=1 Q 134 S VALMBCK="R",VALM("TITLE")=TITLE 135 Q 136 ; 137 OVR ; - Override a REJECT action 138 I $$CLOSED(RX,REJ,1) Q 139 N COD1,COD2,COD3 140 D FULL^VALM1 W ! 141 S COD1=$$OVRCOD^PSOREJU1(1,$$GET1^DIQ(52.25,REJ_","_RX,14)) I COD1="^" S VALMBCK="R" Q 142 S COD2=$$OVRCOD^PSOREJU1(2) I COD2="^" S VALMBCK="R" Q 143 S COD3=$$OVRCOD^PSOREJU1(3) I COD3="^" S VALMBCK="R" Q 144 D OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3) 145 D SEND(COD1,COD2,COD3) 146 Q 147 ; 148 RES ; - Re-submit a claim action 149 I $$CLOSED(RX,REJ,1) Q 150 D FULL^VALM1 W ! 151 D SEND() 152 Q 153 ; 154 CLA ; - Submit Clarification Code 155 N CLA 156 I $$CLOSED(RX,REJ,1) Q 157 D FULL^VALM1 W ! 158 S CLA=$$CLA^PSOREJU1() I CLA="^" S VALMBCK="R" Q 159 W ! D SEND(,,,CLA) 160 Q 161 ; 162 PA ; - Submit Prior Authorization 163 N PA 164 I $$CLOSED(RX,REJ,1) Q 165 D FULL^VALM1 W ! 166 S PA=$$PA^PSOREJU2() I PA="^" S VALMBCK="R" Q 167 W ! D SEND(,,,,PA) 168 Q 169 ; 170 SEND(COD1,COD2,COD3,CLA,PA) ; - Sends Claim to ECME and closes Reject 171 N DIR,OVRC,RESP,ALTXT,COM 172 S DIR(0)="Y",DIR("A")=" Confirm",DIR("B")="YES" 173 S DIR("A",1)=" When you confirm, a new claim will be submitted for" 174 S DIR("A",2)=" the prescription and this REJECT will be marked" 175 S DIR("A",3)=" resolved." 176 S DIR("A",4)=" " 177 W ! D ^DIR I $G(Y)=0!$D(DIRUT) S VALMBCK="R" Q 178 I $G(COD1)'="" S OVRC=$G(COD2)_"^"_$G(COD1)_"^"_$G(COD3) 179 S ALTXT="REJECT WORKLIST" 180 S:$G(OVRC)'="" ALTXT=ALTXT_"-DUR OVERRIDE CODES("_$G(COD1)_"/"_$G(COD2)_"/"_$G(COD3)_")" 181 S:$G(CLA) ALTXT=ALTXT_"(CLARIF. CODE="_CLA_")" 182 S:$G(PA) ALTXT=ALTXT_"(PRIOR AUTH.="_$TR(PA,"^","/")_")" 183 D ECMESND^PSOBPSU1(RX,FILL,,"ED",$$GETNDC^PSONDCUT(RX,FILL),,,$G(OVRC),,.RESP,,ALTXT,$G(CLA),$G(PA)) 184 I $G(RESP) D Q 185 . W !!?10,"Claim could not be submitted. Please try again later!" 186 . W !,?10,"Reason: ",$S($P(RESP,"^",2)="":"UNKNOWN",1:$P(RESP,"^",2)),$C(7) H 2 187 ; 188 I $$PTLBL^PSOREJP2(RX,FILL) D PRINT(RX,FILL) 189 ; 190 I $D(PSOSTFLT),PSOSTFLT'="B" S CHANGE=1 191 Q 192 ; 193 MP ; - Patient Medication Profile 194 I $G(PSOBACK) D Q 195 . S VALMSG="Not available through Backdoor!",VALMBCK="R" 196 N SITE,PATIENT 197 D FULL^VALM1 W ! 198 S SITE=+$$RXSITE^PSOBPSUT(RX,FILL) S:$G(PSOSITE) SITE=PSOSITE 199 S PATIENT=+$$GET1^DIQ(52,RX,2,"I") 200 D LST^PSOPMP0(SITE,PATIENT) S VALMBCK="R" 201 Q 202 ; 203 EXIT ; 204 K ^TMP("PSOREJP1",$J) 205 Q 206 ; 207 SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section 208 N X 209 S:$G(TEXT)="" $E(TEXT,80)="" 210 S:$L(TEXT)>80 TEXT=$E(TEXT,1,80) 211 S LINE=LINE+1,^TMP("PSOREJP1",$J,LINE,0)=$G(TEXT) 212 ; 213 I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE 214 ; 215 I $G(REV) D Q 216 . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM) 217 . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM) 218 I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM) 219 I $G(HIG) D 220 . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM) 221 Q 222 HELP ; 223 Q 224 ; 225 RXINFO(RX,FILL,LINE) ; Returns header displayable Rx Information 226 N TXT,RXINFO,LBL,CMOP,DRG 227 I LINE=1 D 228 . S RXINFO="Rx# : "_$$GET1^DIQ(52,RX,.01)_"/"_FILL 229 . S $E(RXINFO,30)="ECME#: "_$E(10000000+RX,2,8) 230 . S $E(RXINFO,55)="Fill Date: "_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RX,FILL)) 231 I LINE=2 D 232 . S DRG=$$GET1^DIQ(52,RX,6,"I"),CMOP=$S($D(^PSDRUG("AQ",DRG)):1,1:0) 233 . S RXINFO=$S(CMOP:"CMOP ",1:"")_"Drug",$E(RXINFO,10)=": "_$E($$GET1^DIQ(52,RX,6),1,43) 234 . S $E(RXINFO,56)="NDC Code: "_$$GETNDC^PSONDCUT(RX,FILL) 235 Q $G(RXINFO) 236 ; 237 CLOSED(RX,REJ,MSG) ; Returns whether the REJECT is RESOLVED or NOT 238 I $$GET1^DIQ(52.25,REJ_","_RX,10,"I") D:$G(MSG) Q 1 239 . S VALMSG="This Reject is marked resolved!",VALMBCK="R" W $C(7) 240 Q 0 241 ; 242 REOPN(RX,REJ) ; Returns whether the REJECT was RE-OPENED or NOT 243 Q $S($$GET1^DIQ(52.25,REJ_","_RX,23)="":0,1:1) 244 ; 245 EXP(CODE) ; - Returns the explanation field (.02) for a reject code 246 ; Input: (r) CODE - .01 field (Code) value from file 9002313.93 247 ; Output: .02 field (Explanation) value from file 9002313.93 248 N DIC,X,Y 249 S DIC=9002313.93,DIC(0)="Z",X=CODE D ^DIC 250 Q $P($G(Y(0)),"^",2) 251 ; 252 OUT(RX) ; - Supported call by outside PROTOCOLs to act on specific REJECTs 253 N I,RFL,DATA,REJ,PSOBACK,VALMCNT,RXN 254 I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="PSORPH key required to use the REJ action.",VALMBCK="R" Q 255 I $G(PS)="REJECT" D Q 256 . S VALMSG="REJ action is not available at this point.",VALMBCK="R" 257 S PSOBACK=1 258 S (RFL,I)=0 F I=1:1 Q:'$D(^PSRX(RX,1,I)) S RFL=I 259 S X=$$FIND^PSOREJUT(RX,RFL,.DATA) S REJ=$O(DATA("")) 260 I '$G(REJ) S VALMSG="Invalid selection!",VALMBCK="R" Q 261 D EN(RX,REJ) S VALMBCK="R" 262 Q 263 ; 264 PRINT(RX,RFL) ; Print Label for specific Rx/Fill 265 N PPL,PSOSITE,PSOPAR,PSOSYS,PSOLAP,PSOBARS,PSOBAR0,PSOBAR1,PSOIOS,PSOBFLAG 266 N POP,DFN,PDUZ,RXFL 267 ; 268 S PSOSITE=$$RXSITE^PSOBPSUT(RX,RFL),PSOPAR=^PS(59,PSOSITE,1) 269 S DFN=$$GET1^DIQ(52,RX,2,"I"),PDUZ=DUZ,PSOSYS=$G(^PS(59.7,1,40.1)) 270 S PPL=RX I RFL S RXFL(RX)=RFL 271 W ! S PSOBFLAG=1 D LBL^PSOLSET I $G(PSOQUIT) Q 272 ; 273 S IOP=PSOLAP D ^%ZIS,DQ^PSOLBL,^%ZISC 274 Q 1 PSOREJP1 ;BIRM/MFR - Third Party Reject Display Screen ;04/29/05 2 ;;7.0;OUTPATIENT PHARMACY;**148,247,260**;DEC 1997;Build 84 3 ;Reference to File 9002313.93 - BPS NCPDP REJECT CODES supported by IA 4720 4 ;Reference to ^PS(59.7 supported by IA 694 5 ;Reference to ^PSDRUG("AQ" supported by IA 3165 6 ; 7 EN(RX,REJ,CHANGE) ; Entry point 8 ; 9 ; - DO NOT change the IF logic below as both of them might get executed (intentional) 10 N FILL,LASTLN 11 S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5) 12 I $$CLOSED(RX,REJ) D EN^VALM("PSO REJECT DISPLAY - RESOLVED") 13 I '$$CLOSED(RX,REJ) D EN^VALM("PSO REJECT DISPLAY") 14 D FULL^VALM1 15 Q 16 ; 17 HDR ; - Builds the Header section 18 N LINE1,LINE2,X 19 S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1),VALMHDR(2)=$$PTINFO^PSOREJU2(RX,1) 20 S VALMHDR(3)=$$RXINFO(RX,FILL,1),VALMHDR(4)=$$RXINFO(RX,FILL,2) 21 Q 22 ; 23 INIT ; Builds the Body section 24 N DATA,LINE 25 F I=1:1:$G(LASTLN) D RESTORE^VALM10(I) 26 K ^TMP("PSOREJP1",$J) S VALMCNT=0,LINE=0 27 D GET^PSOREJU2(RX,FILL,.DATA,REJ,1) 28 D REJ ; Display the REJECT Information 29 D OTH ; Display the Other Rejects Information 30 D COM^PSOREJP3 ; Display the Comment 31 D INS ; Display the Insurance Information 32 D CLS ; Display the Resolution Information 33 S VALMCNT=LINE 34 Q 35 ; 36 REJ ; - DUR Information 37 N TYPE,PFLDT 38 D SETLN("REJECT Information",1,1) 39 S TYPE=$S($G(DATA(REJ,"CODE"))=79:"79 - REFILL TOO SOON",1:"88 - DUR REJECT") 40 D SETLN("Reject Type : "_TYPE_" received on "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME"))),,,18) 41 D SETLN("Reject Status : "_$G(DATA(REJ,"STATUS")),,,18) 42 D SET("PAYER MESSAGE",63) 43 D SET("REASON",63) 44 S PFLDT=$$FMTE^XLFDT($G(DATA(REJ,"PLAN PREVIOUS FILL DATE"))) 45 D SET("DUR TEXT",63,$S(PFLDT="":1,1:0)) 46 I PFLDT'="" D SETLN("Last Fill Date : "_PFLDT_" (from payer)",,1,18) 47 Q 48 ; 49 OTH ; - Other Rejects Information 50 N LST,I,RJC,J,LAST 51 S LST=$G(DATA(REJ,"OTHER REJECTS")) I LST="" Q 52 D SETLN() 53 D SETLN("OTHER REJECTS",1,1) 54 F I=1:1:$L(LST,",") S RJC=$P(LST,",",I) D 55 . S LAST=1 F J=(I+1):1:$L(LST,",") I $P(LST,",",J)'="" S LAST=0 Q 56 . I RJC'="" D SETLN(RJC_" - "_$$EXP(RJC),,$S(LAST:1,1:0),6) 57 Q 58 ; 59 INS ; - Insurance Information 60 D SETLN() 61 D SETLN("INSURANCE Information",1,1) 62 D SETLN("Insurance : "_$G(DATA(REJ,"INSURANCE NAME")),,,18) 63 D SETLN("Contact : "_$G(DATA(REJ,"PLAN CONTACT")),,,18) 64 D SETLN("Group Name : "_$G(DATA(REJ,"GROUP NAME")),,,18) 65 D SETLN("Group Number : "_$G(DATA(REJ,"GROUP NUMBER")),,,18) 66 D SETLN("Cardholder ID : "_$G(DATA(REJ,"CARDHOLDER ID")),,1,18) 67 Q 68 ; 69 CLS ; - Resolution Information 70 N X 71 I '$$CLOSED(RX,REJ) Q 72 D SETLN() 73 D SETLN("RESOLUTION Information",1,1) 74 D SETLN("Resolved By : "_$G(DATA(REJ,"CLOSED BY")),,,18) 75 D SETLN("Date/Time : "_$G(DATA(REJ,"CLOSED DATE/TIME")),,,18) 76 I $G(DATA(REJ,"CLOSE COMMENTS"))'="" D SET("CLOSE COMMENTS",63) 77 I $G(DATA(REJ,"COD1"))'="" D SETLN("Reason for Svc : "_$$OVRX^PSOREJU1(1,$G(DATA(REJ,"COD1"))),,,18) 78 I $G(DATA(REJ,"COD2"))'="" D SETLN("Profes. Svc : "_$$OVRX^PSOREJU1(2,$G(DATA(REJ,"COD2"))),,,18) 79 I $G(DATA(REJ,"COD3"))'="" D SETLN("Result of Svc : "_$$OVRX^PSOREJU1(3,$G(DATA(REJ,"COD3"))),,,18) 80 I $G(DATA(REJ,"CLA CODE"))'="" D 81 . S X=$$GET1^DIQ(52.25,REJ_","_RX,24,"I")_" - "_(DATA(REJ,"CLA CODE")) 82 . D SETLN("Clarific. Code : "_X,,,18) 83 I $G(DATA(REJ,"PRIOR AUTH TYPE"))'="" D 84 . S X=$$GET1^DIQ(52.25,REJ_","_RX,25,"I")_" - "_(DATA(REJ,"PRIOR AUTH TYPE")) 85 . D SETLN("Prior Auth.Type: "_X,,,18),SETLN("Prior Auth. # : "_DATA(REJ,"PRIOR AUTH NUMBER"),,,18) 86 D SETLN("Reason : "_$G(DATA(REJ,"CLOSE REASON")),,1,18) 87 Q 88 ; 89 ; 90 SET(FIELD,L,UND) ; Sets the lines for fields that require text wrapping 91 N TXT,T 92 S TXT=DATA(REJ,FIELD) I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q 93 F I=1:1 Q:TXT="" D 94 . I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q 95 . S T="",$E(T,81-L)=$E(TXT,1,L) D SETLN(T,,$S($E(TXT,L+1,999)=""&$G(UND):1,1:0),80-L) S TXT=$E(TXT,L+1,999) 96 Q 97 ; 98 LABEL(FIELD) ; Sets the label for the field 99 I FIELD="REASON" Q "Reason : " 100 I FIELD="PAYER MESSAGE" Q "Payer Message : " 101 I FIELD="DUR TEXT" Q "DUR Text : " 102 I FIELD="CLOSE COMMENTS" Q "Comments : " 103 Q "" 104 ; 105 VIEW ; - Rx View hidden action 106 N VALMCNT,TITLE 107 I $G(PSOBACK) D Q 108 . S VALMSG="Not available through Backdoor!",VALMBCK="R" 109 S TITLE=VALM("TITLE") 110 ; 111 ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE 112 DO 113 . N PSOVDA,DA,PS 114 . S (PSOVDA,DA)=RX,PS="REJECT" 115 . N RX,REJ,FILL,LINE,TITLE D DP^PSORXVW 116 ; 117 S VALMBCK="R",VALM("TITLE")=TITLE 118 Q 119 ; 120 EDT ; - Rx Edit hidden action 121 N VALMCNT,TITLE 122 I $G(PSOBACK) D Q 123 . S VALMSG="Not available through Backdoor!",VALMBCK="R" 124 S TITLE=VALM("TITLE") 125 ; 126 ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE 127 DO 128 . N PSOSITE,ORN,PSOPAR,PSOLIST 129 . S PSOSITE=$$RXSITE^PSOBPSUT(RX,FILL),ORN=RX 130 . S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_"," 131 . N RX,REJ,FILL,LINE,TITLE D EPH^PSORXEDT 132 ; 133 K VALMBCK I $$CLOSED(RX,REJ),$D(PSOSTFLT),PSOSTFLT="U" S CHANGE=1 Q 134 S VALMBCK="R",VALM("TITLE")=TITLE 135 Q 136 ; 137 OVR ; - Override a REJECT action 138 I $$CLOSED(RX,REJ,1) Q 139 N COD1,COD2,COD3 140 D FULL^VALM1 W ! 141 S COD1=$$OVRCOD^PSOREJU1(1,$$GET1^DIQ(52.25,REJ_","_RX,14)) I COD1="^" S VALMBCK="R" Q 142 S COD2=$$OVRCOD^PSOREJU1(2) I COD2="^" S VALMBCK="R" Q 143 S COD3=$$OVRCOD^PSOREJU1(3) I COD3="^" S VALMBCK="R" Q 144 D OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3) 145 D SEND(COD1,COD2,COD3) 146 Q 147 ; 148 RES ; - Re-submit a claim action 149 I $$CLOSED(RX,REJ,1) Q 150 D FULL^VALM1 W ! 151 D SEND() 152 Q 153 ; 154 CLA ; - Submit Clarification Code 155 N CLA 156 I $$CLOSED(RX,REJ,1) Q 157 D FULL^VALM1 W ! 158 S CLA=$$CLA^PSOREJU1() I CLA="^" S VALMBCK="R" Q 159 W ! D SEND(,,,CLA) 160 Q 161 ; 162 PA ; - Submit Prior Authorization 163 N PA 164 I $$CLOSED(RX,REJ,1) Q 165 D FULL^VALM1 W ! 166 S PA=$$PA^PSOREJU2() I PA="^" S VALMBCK="R" Q 167 W ! D SEND(,,,,PA) 168 Q 169 ; 170 SEND(COD1,COD2,COD3,CLA,PA) ; - Sends Claim to ECME and closes Reject 171 N DIR,OVRC,RESP,ALTXT,COM 172 S DIR(0)="Y",DIR("A")=" Confirm",DIR("B")="YES" 173 S DIR("A",1)=" When you confirm, a new claim will be submitted for" 174 S DIR("A",2)=" the prescription and this REJECT will be marked" 175 S DIR("A",3)=" resolved." 176 S DIR("A",4)=" " 177 W ! D ^DIR I $G(Y)=0!$D(DIRUT) S VALMBCK="R" Q 178 I $G(COD1)'="" S OVRC=$G(COD2)_"^"_$G(COD1)_"^"_$G(COD3) 179 S ALTXT="REJECT WORKLIST" 180 S:$G(OVRC)'="" ALTXT=ALTXT_"-DUR OVERRIDE CODES("_$G(COD1)_"/"_$G(COD2)_"/"_$G(COD3)_")" 181 S:$G(CLA) ALTXT=ALTXT_"(CLARIF. CODE="_CLA_")" 182 S:$G(PA) ALTXT=ALTXT_"(PRIOR AUTH.="_$TR(PA,"^","/")_")" 183 D ECMESND^PSOBPSU1(RX,FILL,,"ED",$$GETNDC^PSONDCUT(RX,FILL),,,$G(OVRC),,.RESP,,ALTXT,$G(CLA),$G(PA)) 184 I $G(RESP) D Q 185 . W !!?10,"Claim could not be submitted. Please try again later!" 186 . W !,?10,"Reason: ",$S($P(RESP,"^",2)="":"UNKNOWN",1:$P(RESP,"^",2)),$C(7) H 2 187 ; 188 I $$PTLBL^PSOREJP2(RX,FILL) D PRINT(RX,FILL) 189 ; 190 I $D(PSOSTFLT),PSOSTFLT'="B" S CHANGE=1 191 Q 192 ; 193 MP ; - Patient Medication Profile 194 I $G(PSOBACK) D Q 195 . S VALMSG="Not available through Backdoor!",VALMBCK="R" 196 N SITE,PATIENT 197 D FULL^VALM1 W ! 198 S SITE=+$$RXSITE^PSOBPSUT(RX,FILL) S:$G(PSOSITE) SITE=PSOSITE 199 S PATIENT=+$$GET1^DIQ(52,RX,2,"I") 200 D LST^PSOPMP0(SITE,PATIENT) S VALMBCK="R" 201 Q 202 ; 203 EXIT ; 204 K ^TMP("PSOREJP1",$J) 205 Q 206 ; 207 SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section 208 N X 209 S:$G(TEXT)="" $E(TEXT,80)="" 210 S:$L(TEXT)>80 TEXT=$E(TEXT,1,80) 211 S LINE=LINE+1,^TMP("PSOREJP1",$J,LINE,0)=$G(TEXT) 212 ; 213 I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE 214 ; 215 I $G(REV) D Q 216 . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM) 217 . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM) 218 I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM) 219 I $G(HIG) D 220 . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM) 221 Q 222 HELP ; 223 Q 224 ; 225 RXINFO(RX,FILL,LINE) ; Returns header displayable Rx Information 226 N TXT,RXINFO,LBL,CMOP,DRG 227 I LINE=1 D 228 . S RXINFO="Rx# : "_$$GET1^DIQ(52,RX,.01)_"/"_FILL 229 . S $E(RXINFO,30)="ECME#: "_$E(10000000+RX,2,8) 230 . S $E(RXINFO,55)="Fill Date: "_$$FMTE^XLFDT($$RXFLDT^PSOBPSUT(RX,FILL)) 231 I LINE=2 D 232 . S DRG=$$GET1^DIQ(52,RX,6,"I"),CMOP=$S($D(^PSDRUG("AQ",DRG)):1,1:0) 233 . S RXINFO=$S(CMOP:"CMOP ",1:"")_"Drug",$E(RXINFO,10)=": "_$E($$GET1^DIQ(52,RX,6),1,43) 234 . S $E(RXINFO,56)="NDC Code: "_$$GETNDC^PSONDCUT(RX,FILL) 235 Q $G(RXINFO) 236 ; 237 CLOSED(RX,REJ,MSG) ; Returns whether the REJECT is RESOLVED or NOT 238 I $$GET1^DIQ(52.25,REJ_","_RX,10,"I") D:$G(MSG) Q 1 239 . S VALMSG="This Reject is marked resolved!",VALMBCK="R" W $C(7) 240 Q 0 241 ; 242 REOPN(RX,REJ) ; Returns whether the REJECT was RE-OPENED or NOT 243 Q $S($$GET1^DIQ(52.25,REJ_","_RX,23)="":0,1:1) 244 ; 245 EXP(CODE) ; - Returns the explanation field (.02) for a reject code 246 ; Input: (r) CODE - .01 field (Code) value from file 9002313.93 247 ; Output: .02 field (Explanation) value from file 9002313.93 248 N DIC,X,Y 249 S DIC=9002313.93,DIC(0)="Z",X=CODE D ^DIC 250 Q $P($G(Y(0)),"^",2) 251 ; 252 OUT(RX) ; - Supported call by outside PROTOCOLs to act on specific REJECTs 253 N I,RFL,DATA,REJ,PSOBACK,VALMCNT 254 S PSOBACK=1 255 S (RFL,I)=0 F I=1:1 Q:'$D(^PSRX(RX,1,I)) S RFL=I 256 S X=$$FIND^PSOREJUT(RX,RFL,.DATA) S REJ=$O(DATA("")) 257 I '$G(REJ) S VALMSG="Invalid selection!",VALMBCK="R" Q 258 D EN(RX,REJ) S VALMBCK="R" 259 Q 260 ; 261 PRINT(RX,RFL) ; Print Label for specific Rx/Fill 262 N PPL,PSOSITE,PSOPAR,PSOSYS,PSOLAP,PSOBARS,PSOBAR0,PSOBAR1,PSOIOS,PSOBFLAG 263 N POP,DFN,PDUZ,RXFL 264 ; 265 S PSOSITE=$$RXSITE^PSOBPSUT(RX,RFL),PSOPAR=^PS(59,PSOSITE,1) 266 S DFN=$$GET1^DIQ(52,RX,2,"I"),PDUZ=DUZ,PSOSYS=$G(^PS(59.7,1,40.1)) 267 S PPL=RX I RFL S RXFL(RX)=RFL 268 W ! S PSOBFLAG=1 D LBL^PSOLSET I $G(PSOQUIT) Q 269 ; 270 S IOP=PSOLAP D ^%ZIS,DQ^PSOLBL,^%ZISC 271 Q
Note:
See TracChangeset
for help on using the changeset viewer.
