- PSOREJP1 ;BIRM/MFR - Third Party Reject Display Screen ;04/29/05
- ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281,287,289,290,358,359,385,403,421,427,448,478,482,512,562,648,702,704**;DEC 1997;Build 16
- ; Reference to File 9002313.93 - BPS NCPDP REJECT CODES in ICR #4720
- ; Reference to File 9002313.21 - BPS NCPDP PROFESSIONAL SERVICE CODE in ICR #4712
- ; Reference to File 9002313.22 - BPS NCPDP RESULT OF SERVICE CODE in ICR #4713
- ; Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE in ICR #4714
- ; Reference to File 9002313.25 - BPS NCPDP SUBMISSION CLARIFICATION CODE in ICR #5064
- ; Reference to File 9002313.26 - BPS NCPDP PRIOR AUTHORIZATION TYPE CODE in ICR #5585
- ; Reference to DURRESP^BPSNCPD3 in ICR #4560
- ; Reference to ^BPSVRX in ICR #5723
- ; Reference to $$BBILL^BPSBUTL,$$RESUBMIT^BPSBUTL in ICR #4719
- ;
- ;
- EN(RX,REJ,CHANGE) ; Entry point
- ;
- N FILL,LASTLN,PSOCODE,PSOTRIC
- S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- S PSOTRIC=$$TRIC(RX,FILL),PSOCODE=$$GET1^DIQ(52.25,REJ_","_RX,.01)
- I $$CLOSED(RX,REJ) D EN^VALM("PSO REJECT DISPLAY - RESOLVED")
- I '$$CLOSED(RX,REJ)&(PSOTRIC) D EN^VALM("PSO REJECT TRICARE")
- I '$$CLOSED(RX,REJ)&('PSOTRIC) D EN^VALM("PSO REJECT DISPLAY")
- D FULL^VALM1
- Q
- ;
- HDR ; Builds the Header section
- N LINE1,LINE2,PTINFO,X
- S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1)
- S PTINFO=$$PTINFO^PSOREJU2(RX,1)
- S VALMHDR(2)=$P(PTINFO,U,1)
- S VALMHDR(3)=$P(PTINFO,U,2)
- S VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,1)
- S VALMHDR(5)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ)
- Q
- ;
- TRIC(RX,RFL,PSOTRIC) ; Return 1 for TRICARE, 2 for CHAMPVA or 0 (zero) for not TRICARE or CHAMPVA
- I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
- S PSOTRIC=$S(RFL=0&($$GET1^DIQ(52,RX_",",85,"I")="T"):1,$$GET1^DIQ(52.1,RFL_","_RX_",",85,"I")="T":1,RFL=0&($$GET1^DIQ(52,RX_",",85,"I")="C"):2,$$GET1^DIQ(52.1,RFL_","_RX_",",85,"I")="C":2,1:0)
- Q PSOTRIC
- ;
- ELIGDISP(RX,RFL) ; Return either CHAMPVA or TRICARE for display
- ; purposes, or null if neither
- N PSOELIG
- S PSOELIG=$$TRIC(RX,RFL)
- Q $S(PSOELIG=1:"TRICARE",PSOELIG=2:"CHAMPVA",1:"")
- ;
- ELIGTCV(RX,RFL,CAPS) ; Return either CHAMPVA, TRICARE, or Veteran/VETERAN for eligibility display
- ; if CAPS=1 then return "Veteran" in all caps
- ; Note if the requested refill has been deleted, then the message "N/A - Fill Deleted" will be returned
- N PSOELIG,VET,DELMSG
- S DELMSG="N/A - Fill Deleted"
- S PSOELIG=$$TRIC(RX,RFL),VET="Veteran" I $G(CAPS) S VET="VETERAN"
- I RFL>0,'$D(^PSRX(RX,1,RFL,0)) S PSOELIG=3
- Q $S(PSOELIG=1:"TRICARE",PSOELIG=2:"CHAMPVA",PSOELIG=3:DELMSG,1:VET)
- ;
- INIT ; Builds the Body section
- N DATA,LINE
- I '$D(FILL) S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5) ; PSO*7*448 obtain fill# from 52.25 subfile if not defined
- I '$$CLOSED(RX,REJ) S VALM("TITLE")="Reject Information ("_$$ELIGTCV(RX,FILL)_")"
- I $$CLOSED(RX,REJ) S VALM("TITLE")="Reject Information (RESOLVED)"
- F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
- K ^TMP("PSOREJP1",$J) S VALMCNT=0,LINE=0
- D GET^PSOREJU2(RX,FILL,.DATA,REJ,1)
- D REJ ; Display the REJECT Information
- D OTH ; Display the Other Rejects Information
- D COM^PSOREJP3 ; Display the Comment
- D INS ; Display the Insurance Information
- D CLS ; Display the Resolution Information
- S VALMCNT=LINE
- Q
- ;
- REJ ; Reject Information
- N PFLDT,PSOADD,PSOCOB,PSOECME,PSOET,PSONAF,PSOTXT,TREJ,TYPE
- ;
- ; Display 'RESUBMISSION' where 'BACK-BILL' currently displays if the
- ; claim was resubmitted from the ECME User Screen. To facilitate
- ; this, the function $$RESUBMIT^BPSBUTL was created.
- ;
- S PSOTXT=""
- S PSOCOB=$G(DATA(REJ,"COB")),PSOCOB=$S(PSOCOB="SECONDARY":2,PSOCOB="TERTIARY":3,1:1)
- I $$BBILL^BPSBUTL(RX,FILL,PSOCOB) S PSOTXT=" BACK-BILL"
- E I $$RESUBMIT^BPSBUTL(RX,FILL,PSOCOB) S PSOTXT=" RESUBMISSION" ; IA 4719.
- D SETLN("REJECT Information ("_$$ELIGTCV(RX,FILL)_") "_PSOTXT,1,1)
- ;
- S PSOECME=$$STATUS^PSOBPSUT(RX,FILL,PSOCOB)
- I PSOECME="E PAYABLE" D
- . D SETLN("Reject Received: ",,,18)
- . D SETLN("Reject Type : ",,,18)
- . D SETLN("Reject Status : ** E PAYABLE **",,,18)
- . I DATA(REJ,"PAYER MESSAGE")["Not ECME Billable" S DATA(REJ,"PAYER MESSAGE")=""
- . Q
- E D
- . I $G(DATA(REJ,"CODE"))=79 S TYPE="79 - REFILL TOO SOON"
- . E S TYPE=DATA(REJ,"CODE")_" - "_$$EXP(DATA(REJ,"CODE"))
- . I $L(TYPE)>62 S TYPE=$E(TYPE,1,59)_"..."
- . D SETLN("Reject Received: "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME"))),,,18)
- . D SETLN("Reject Type : "_TYPE,,,18)
- . ; If TRICARE/CHAMPVA non-billable then reset Status line
- . S PSOET=$$PSOET^PSOREJP3(RX,FILL)
- . I PSOET D SETLN("Status : NO CLAIM SUBMITTED")
- . I 'PSOET D SETLN("Reject Status : "_$G(DATA(REJ,"STATUS"))_" - "_PSOECME,,,18)
- . Q
- ;
- ; code moved to PSOREJP5
- D REJ^PSOREJP5
- Q
- ;
- OTH ; Other Rejects Information
- N LST,I,RJC,J,LAST
- S LST=$G(DATA(REJ,"OTHER REJECTS")) I LST="" Q
- D SETLN()
- D SETLN("OTHER REJECTS",1,1)
- F I=1:1:$L(LST,",") S RJC=$P(LST,",",I) D
- . S LAST=1 F J=(I+1):1:$L(LST,",") I $P(LST,",",J)'="" S LAST=0 Q
- . I RJC'="" D SETLN(RJC_" - "_$$EXP(RJC),,$S(LAST:1,1:0),6)
- Q
- ;
- INS ; Insurance Information
- D SETLN()
- D SETLN("INSURANCE Information",1,1)
- N PSOINS,PSOINS1,I,PSOBINPCN
- S PSOINS=$G(DATA(REJ,"INSURANCE NAME"))
- F I=1:1:(50-($L(PSOINS)+18)) S PSOINS=PSOINS_" "
- S PSOINS1=$G(DATA(REJ,"COB"))
- I PSOINS1="SECONDARY" S PSOINS=PSOINS_"Coord. Of Benefits: "_PSOINS1
- D SETLN("Insurance : "_PSOINS,,,18)
- D SETLN("Contact : "_$G(DATA(REJ,"PLAN CONTACT")),,,18)
- S PSOBINPCN=$G(DATA(REJ,"BIN"))_"/ "_$G(DATA(REJ,"PCN"))
- D SETLN("BIN/ PCN : "_PSOBINPCN,,,18)
- D SETLN("Group Number : "_$E($G(DATA(REJ,"GROUP NUMBER")),1,15),,,18)
- D SETLN("Cardholder ID : "_$E($G(DATA(REJ,"CARDHOLDER ID")),1,20),,1,18)
- Q
- ;
- CLS ; Resolution Information
- N X
- I '$$CLOSED(RX,REJ) Q
- D SETLN()
- D SETLN("RESOLUTION Information",1,1)
- D SETLN("Resolved By : "_$G(DATA(REJ,"CLOSED BY")),,,18)
- D SETLN("Date/Time : "_$G(DATA(REJ,"CLOSED DATE/TIME")),,,18)
- I $G(DATA(REJ,"CLOSE COMMENTS"))'="" D SET("CLOSE COMMENTS",63)
- I $G(DATA(REJ,"COD1"))'="" D SETLN("Reason for Svc : "_$$OVRX^PSOREJU1(1,$G(DATA(REJ,"COD1"))),,,18)
- I $G(DATA(REJ,"COD2"))'="" D SETLN("Profes. Svc : "_$$OVRX^PSOREJU1(2,$G(DATA(REJ,"COD2"))),,,18)
- I $G(DATA(REJ,"COD3"))'="" D SETLN("Result of Svc : "_$$OVRX^PSOREJU1(3,$G(DATA(REJ,"COD3"))),,,18)
- I $G(DATA(REJ,"CLA CODE"))'="" D
- . N CLAPNTR S CLAPNTR=$O(^BPS(9002313.25,"B",DATA(REJ,"CLA CODE"),""))
- . S X=DATA(REJ,"CLA CODE")_" - "_$$GET1^DIQ(9002313.25,CLAPNTR,".02")
- . D SETLN("Clarific. Code : "_X,,,18)
- I $G(DATA(REJ,"PRIOR AUTH TYPE"))'="" D
- . S X=$$GET1^DIQ(52.25,REJ_","_RX,25,"I")_" - "_(DATA(REJ,"PRIOR AUTH TYPE"))
- . D SETLN("Prior Auth.Type: "_X,,,18),SETLN("Prior Auth. # : "_DATA(REJ,"PRIOR AUTH NUMBER"),,,18)
- D SETLN("Reason : "_$G(DATA(REJ,"CLOSE REASON")),,1,18)
- Q
- ;
- ;
- SET(FIELD,L,UND) ; Sets the lines for fields that require text wrapping
- N TXT,T
- S TXT=DATA(REJ,FIELD) I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q
- F I=1:1 Q:TXT="" D
- . I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q
- . 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)
- Q
- ;
- LABEL(FIELD) ; Sets the label for the field
- I FIELD="REASON" Q "Reason Code : "
- I FIELD="PAYER MESSAGE" Q "Payer Addl Msg : "
- I FIELD="DUR TEXT" Q $S(+$$ISDUR^PSOREJP5(RX,REJ):"+DUR Text : ",1:"DUR Text : ")
- I FIELD="CLOSE COMMENTS" Q "Comments : "
- Q ""
- ;
- VIEW ; Rx View hidden action
- N VALMCNT,TITLE
- I $G(PSOBACK) D Q
- . S VALMSG="Not available through Backdoor!",VALMBCK="R"
- S TITLE=VALM("TITLE")
- ;
- ; DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE
- DO
- . N PSOVDA,DA,PS
- . S (PSOVDA,DA)=RX,PS="REJECT"
- . N RX,REJ,FILL,LINE,TITLE
- . D DP^PSORXVW
- ;
- S VALMBCK="R",VALM("TITLE")=TITLE
- Q
- ;
- EDT ; Rx Edit hidden action
- N VALMCNT,TITLE
- I $G(PSOBACK) D Q
- . S VALMSG="Not available through Backdoor!",VALMBCK="R"
- S TITLE=VALM("TITLE")
- ;
- ; DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE
- DO
- . N PSOSITE,ORN,PSOPAR,PSOLIST,PSOREJCT
- . S PSOSITE=$$RXSITE^PSOBPSUT(RX,FILL),ORN=RX
- . S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_","
- . ; Variable PSOREJCT is used so that EPH^PSORXEDT has the RX 'passed' by this routine
- . S PSOREJCT=RX_U_FILL
- . N RX,REJ,FILL,LINE,TITLE
- . D EPH^PSORXEDT
- ;
- K VALMBCK I $$CLOSED(RX,REJ),$D(PSOSTFLT),PSOSTFLT="U" S CHANGE=1 Q
- S VALMBCK="R",VALM("TITLE")=TITLE
- Q
- ;
- OVR ; Override a REJECT action
- N PSOET
- I $$CLOSED(RX,REJ,1) Q
- S PSOET=$$PSOET^PSOREJP3(RX,FILL)
- I PSOET S VALMSG="OVR not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim.",VALMBCK="R" Q
- N COD1,COD2,COD3
- D FULL^VALM1 W !
- S COD1=$$OVRCOD^PSOREJU1(1,$$GET1^DIQ(52.25,REJ_","_RX,14)) I COD1="^"!(COD1="") S VALMBCK="R" Q
- S COD2=$$OVRCOD^PSOREJU1(2) I COD2="^" S VALMBCK="R" Q
- S COD3=$$OVRCOD^PSOREJU1(3) I COD3="^" S VALMBCK="R" Q
- D OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3)
- D SEND^PSOREJP3(COD1_"^"_COD2_"^"_COD3,,,PSOET)
- Q
- ;
- RES ; Re-submit a claim action
- N PSOET
- I $$CLOSED(RX,REJ,1) Q
- S PSOET=$$PSOET^PSOREJP3(RX,FILL)
- D FULL^VALM1 W !
- D SEND^PSOREJP3(,,,PSOET)
- Q
- ;
- CLA ; Submit Clarification Code
- N CLA,PSOET
- I $$CLOSED(RX,REJ,1) Q
- S PSOET=$$PSOET^PSOREJP3(RX,FILL)
- I PSOET S VALMSG="CLA not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim.",VALMBCK="R" Q
- D FULL^VALM1 W !
- ; Prompt for the Submission Clarification Codes (up to three)
- S CLA=$$CLA^PSOREJU1() I CLA="^"!(CLA="") S VALMBCK="R" Q
- W ! D SEND^PSOREJP3(,CLA,,PSOET)
- Q
- ;
- PA ; Submit Prior Authorization
- N PA,PSOET
- I $$CLOSED(RX,REJ,1) Q
- S PSOET=$$PSOET^PSOREJP3(RX,FILL)
- I PSOET S VALMSG="PA not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim.",VALMBCK="R" Q
- D FULL^VALM1 W !
- ; Prompt for Prior Auth fields
- S PA=$$PA^PSOREJU2() I PA="^" S VALMBCK="R" Q
- W ! D SEND^PSOREJP3(,,PA,PSOET)
- Q
- ;
- MP ; Patient Medication Profile
- I $G(PSOBACK) D Q
- . S VALMSG="Not available through Backdoor!",VALMBCK="R"
- N SITE,PATIENT
- D FULL^VALM1 W !
- S SITE=+$$RXSITE^PSOBPSUT(RX,FILL) S:$G(PSOSITE) SITE=PSOSITE
- S PATIENT=+$$GET1^DIQ(52,RX,2,"I")
- D LST^PSOPMP0(SITE,PATIENT) S VALMBCK="R"
- Q
- ;
- EXIT ;
- K ^TMP("PSOREJP1",$J)
- Q
- ;
- SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section
- N X
- S:$G(TEXT)="" $E(TEXT,80)=""
- S:$L(TEXT)>80 TEXT=$E(TEXT,1,80)
- S LINE=LINE+1,^TMP("PSOREJP1",$J,LINE,0)=$G(TEXT)
- ;
- I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE
- ;
- I $G(REV) D Q
- . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM)
- . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM)
- I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
- I $G(HIG) D
- . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM)
- Q
- HELP ;
- Q
- ;
- CLOSED(RX,REJ,MSG) ; Returns whether the REJECT is RESOLVED or NOT
- I $$GET1^DIQ(52.25,REJ_","_RX,10,"I") D:$G(MSG) Q 1
- . S VALMSG="This Reject is marked resolved!",VALMBCK="R" W $C(7)
- Q 0
- ;
- REOPN(RX,REJ) ; Returns whether the REJECT was RE-OPENED or NOT
- Q $S($$GET1^DIQ(52.25,REJ_","_RX,23)="":0,1:1)
- ;
- EXP(CODE) ; Returns the explanation field (.02) for a reject code
- ; Input: (r) CODE - .01 field (Code) value from file 9002313.93
- ; Output: .02 field (Explanation) value from file 9002313.93
- N DIC,X,Y
- S DIC=9002313.93,DIC(0)="Z",X=CODE D ^DIC
- Q $P($G(Y(0)),"^",2)
- ;
- OUT(RX) ; Supported call by outside PROTOCOLs to act on specific REJECTs
- N I,RFL,DATA,REJ,PSOBACK,VALMCNT,RXN
- I '$D(^XUSEC("PSORPH",DUZ)) D Q
- . S VALMSG="PSORPH key required to use the REJ action.",VALMBCK="R"
- I $G(PS)="REJECT" D
- . S VALMSG="REJ action is not available at this point.",VALMBCK="R"
- S PSOBACK=1
- S (RFL,I)=0 F I=1:1 Q:'$D(^PSRX(RX,1,I)) S RFL=I
- S X=$$FIND^PSOREJUT(RX,RFL,.DATA,,1) S REJ=$O(DATA(""))
- I '$G(REJ) S VALMSG="Invalid selection!",VALMBCK="R" Q
- D EN(RX,REJ) S VALMBCK="R"
- Q
- ;
- SMA ; Submit multiple actions
- N CLA,I,OVR,OVRSTR,PA,REJIEN,DUR,RSC,DURIEN,REQ,RSUB,PSOET
- I $$CLOSED(RX,REJ,1) Q
- S PSOET=$$PSOET^PSOREJP3(RX,FILL)
- I PSOET S VALMSG="SMA not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim.",VALMBCK="R" Q
- D FULL^VALM1 W !
- S DURIEN=$P($G(^PSRX(RX,"REJ",REJ,0)),U,11)
- D DURRESP^BPSNCPD3(DURIEN,.DUR) ; Reference to BPSNCPD3 supported by IA 4560
- ;
- ; Prompt for Prior Auth fields
- S PA=$$PA^PSOREJU2
- I PA="^" S VALMBCK="R" Q ;User terminated or did not answer
- ;
- ; Prompt for submission clarification codes (up to three)
- W !
- S CLA=$$CLA^PSOREJU1
- I CLA="^" S VALMBCK="R" Q ;User terminated or did not answer
- ;
- ; Check if DUR Overrides required - PSO*7*421
- S REQ=$$REQ I REQ="^" S VALMBCK="R" Q
- ;
- ; Prompt for DUR Overrides (up to 3) - option to delete default added - PSO*7*421
- S OVRSTR="",OVR=""
- I REQ S REJIEN=0 F RSUB=1:1:3 D Q:OVR="^"!(OVR="")!(OVR="@") S $P(OVRSTR,"~",RSUB)=OVR
- . I REJIEN]"" S REJIEN=$O(DUR(1,"DUR PPS",REJIEN))
- . S RSC="" I +REJIEN S RSC=$P($G(DUR(1,"DUR PPS",REJIEN,"REASON FOR SERVICE CODE"))," ",1)
- . S OVR=$$SMAOVR^PSOREJU1(RSC,RSUB)
- I OVR="^" S VALMBCK="R" Q ;User exited or timed-out
- ;
- W !!,?6,"RECAP:"
- W !,?6,"Prior Authorization Type : ",$P(PA,"^")," ",$$DSC^PSOREJU1(9002313.26,$P(PA,"^"),.02)
- W !,?6,"Prior Authorization Number : ",$P(PA,"^",2)
- W !,?6,"Submission Clarification Code 1: ",$P(CLA,"~",1)," ",$$DSC^PSOREJU1(9002313.25,$P(CLA,"~",1),.02)
- I $P(CLA,"~",2)]"" W !,?6,"Submission Clarification Code 2: ",$P(CLA,"~",2)," ",$$DSC^PSOREJU1(9002313.25,$P(CLA,"~",2),.02)
- I $P(CLA,"~",3)]"" W !,?6,"Submission Clarification Code 3: ",$P(CLA,"~",3)," ",$$DSC^PSOREJU1(9002313.25,$P(CLA,"~",3),.02)
- W !,?6,"Reason for Service Code 1 : ",$P($P(OVRSTR,"~",1),U,1)," ",$$DSC^PSOREJU1(9002313.23,$P($P(OVRSTR,"~",1),U,1),1)
- W !,?6,"Professional Service Code 1 : ",$P($P(OVRSTR,"~",1),U,2)," ",$$DSC^PSOREJU1(9002313.21,$P($P(OVRSTR,"~",1),U,2),1)
- W !,?6,"Result of Service Code 1 : ",$P($P(OVRSTR,"~",1),U,3)," ",$$DSC^PSOREJU1(9002313.22,$P($P(OVRSTR,"~",1),U,3),1)
- I $P($P(OVRSTR,"~",2),U,1)]"" W !,?6,"Reason for Service Code 2 : ",$P($P(OVRSTR,"~",2),U,1)," ",$$DSC^PSOREJU1(9002313.23,$P($P(OVRSTR,"~",2),U,1),1)
- I $P($P(OVRSTR,"~",2),U,2)]"" W !,?6,"Professional Service Code 2 : ",$P($P(OVRSTR,"~",2),U,2)," ",$$DSC^PSOREJU1(9002313.21,$P($P(OVRSTR,"~",2),U,2),1)
- I $P($P(OVRSTR,"~",2),U,3)]"" W !,?6,"Result of Service Code 2 : ",$P($P(OVRSTR,"~",2),U,3)," ",$$DSC^PSOREJU1(9002313.22,$P($P(OVRSTR,"~",2),U,3),1)
- I $P($P(OVRSTR,"~",3),U,1)]"" W !,?6,"Reason for Service Code 3 : ",$P($P(OVRSTR,"~",3),U,1)," ",$$DSC^PSOREJU1(9002313.23,$P($P(OVRSTR,"~",3),U,1),1)
- I $P($P(OVRSTR,"~",3),U,2)]"" W !,?6,"Professional Service Code 3 : ",$P($P(OVRSTR,"~",3),U,2)," ",$$DSC^PSOREJU1(9002313.21,$P($P(OVRSTR,"~",3),U,2),1)
- I $P($P(OVRSTR,"~",3),U,3)]"" W !,?6,"Result of Service Code 3 : ",$P($P(OVRSTR,"~",3),U,3)," ",$$DSC^PSOREJU1(9002313.22,$P($P(OVRSTR,"~",3),U,3),1)
- W !
- D SEND^PSOREJP3(OVRSTR,CLA,PA,PSOET)
- Q
- ;
- VRX ; View ePharmacy Prescription - invoked from the Reject Information screen
- N BPSVRX
- K ^TMP("BPSVRX1-PSO VIEW RX",$J,"PSOHDR")
- D FULL^VALM1
- ;
- ; save the current header display
- M ^TMP("BPSVRX1-PSO VIEW RX",$J,"PSOHDR")=^TMP("PSOHDR",$J)
- ;
- S BPSVRX("RXIEN")=$G(RX)
- S BPSVRX("FILL#")=$G(FILL)
- D ^BPSVRX ; DBIA #5723
- ;
- ; restore the header display
- I '$D(^TMP("PSOHDR",$J)) M ^TMP("PSOHDR",$J)=^TMP("BPSVRX1-PSO VIEW RX",$J,"PSOHDR")
- ;
- S VALMBCK="R"
- K ^TMP("BPSVRX1-PSO VIEW RX",$J,"PSOHDR")
- Q
- ;
- VER ; View ePharmacy Prescription - invoked from the Rx view hidden action of Medication Profile
- N BPSVRX
- K ^TMP("BPSVRX-PSO VIEW RX",$J)
- D FULL^VALM1
- ;
- ; save the current PSO Rx display array and header
- M ^TMP("BPSVRX-PSO VIEW RX",$J,"PSOHDR")=^TMP("PSOHDR",$J)
- M ^TMP("BPSVRX-PSO VIEW RX",$J,"PSOAL")=^TMP("PSOAL",$J)
- ;
- S BPSVRX("RXIEN")=$G(RXN) ; Rx ien ptr file 52
- D ^BPSVRX ; DBIA #5723
- ;
- ; restore the PSO Rx display array and header upon return
- I '$D(^TMP("PSOHDR",$J)) M ^TMP("PSOHDR",$J)=^TMP("BPSVRX-PSO VIEW RX",$J,"PSOHDR")
- I '$D(^TMP("PSOAL",$J)) M ^TMP("PSOAL",$J)=^TMP("BPSVRX-PSO VIEW RX",$J,"PSOAL")
- ;
- S VALMBCK="R"
- K ^TMP("BPSVRX-PSO VIEW RX",$J)
- Q
- ;
- REQ() ;Prompt if DUR Rejects are required
- N DIR,DTOUT,DTOUT,DIRUT,DIROUT,X,Y
- S DIR("?")="Enter No if Reason Codes are not required. Enter Yes to proceed and enter up to 3 sets of override Reason Codes. To delete default Reason Codes, enter ""@""."
- S DIR("A")="Enter DUR codes",DIR(0)="Y",DIR("B")="YES" W ! D ^DIR
- I $D(DIRUT)!$D(DIROUT) Q "^" ;User exited or timed-out
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREJP1 16944 printed Jan 18, 2025@03:34:40 Page 2
- PSOREJP1 ;BIRM/MFR - Third Party Reject Display Screen ;04/29/05
- +1 ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281,287,289,290,358,359,385,403,421,427,448,478,482,512,562,648,702,704**;DEC 1997;Build 16
- +2 ; Reference to File 9002313.93 - BPS NCPDP REJECT CODES in ICR #4720
- +3 ; Reference to File 9002313.21 - BPS NCPDP PROFESSIONAL SERVICE CODE in ICR #4712
- +4 ; Reference to File 9002313.22 - BPS NCPDP RESULT OF SERVICE CODE in ICR #4713
- +5 ; Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE in ICR #4714
- +6 ; Reference to File 9002313.25 - BPS NCPDP SUBMISSION CLARIFICATION CODE in ICR #5064
- +7 ; Reference to File 9002313.26 - BPS NCPDP PRIOR AUTHORIZATION TYPE CODE in ICR #5585
- +8 ; Reference to DURRESP^BPSNCPD3 in ICR #4560
- +9 ; Reference to ^BPSVRX in ICR #5723
- +10 ; Reference to $$BBILL^BPSBUTL,$$RESUBMIT^BPSBUTL in ICR #4719
- +11 ;
- +12 ;
- EN(RX,REJ,CHANGE) ; Entry point
- +1 ;
- +2 NEW FILL,LASTLN,PSOCODE,PSOTRIC
- +3 SET FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- +4 SET PSOTRIC=$$TRIC(RX,FILL)
- SET PSOCODE=$$GET1^DIQ(52.25,REJ_","_RX,.01)
- +5 IF $$CLOSED(RX,REJ)
- DO EN^VALM("PSO REJECT DISPLAY - RESOLVED")
- +6 IF '$$CLOSED(RX,REJ)&(PSOTRIC)
- DO EN^VALM("PSO REJECT TRICARE")
- +7 IF '$$CLOSED(RX,REJ)&('PSOTRIC)
- DO EN^VALM("PSO REJECT DISPLAY")
- +8 DO FULL^VALM1
- +9 QUIT
- +10 ;
- HDR ; Builds the Header section
- +1 NEW LINE1,LINE2,PTINFO,X
- +2 SET VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1)
- +3 SET PTINFO=$$PTINFO^PSOREJU2(RX,1)
- +4 SET VALMHDR(2)=$PIECE(PTINFO,U,1)
- +5 SET VALMHDR(3)=$PIECE(PTINFO,U,2)
- +6 SET VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,1)
- +7 SET VALMHDR(5)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ)
- +8 QUIT
- +9 ;
- TRIC(RX,RFL,PSOTRIC) ; Return 1 for TRICARE, 2 for CHAMPVA or 0 (zero) for not TRICARE or CHAMPVA
- +1 IF '$DATA(RFL)
- SET RFL=$$LSTRFL^PSOBPSU1(RX)
- +2 SET PSOTRIC=$SELECT(RFL=0&($$GET1^DIQ(52,RX_",",85,"I")="T"):1,$$GET1^DIQ(52.1,RFL_","_RX_",",85,"I")="T":1,RFL=0&($$GET1^DIQ(52,RX_",",85,"I")="C"):2,$$GET1^DIQ(52.1,RFL_","_RX_",",85,"I")="C":2,1:0)
- +3 QUIT PSOTRIC
- +4 ;
- ELIGDISP(RX,RFL) ; Return either CHAMPVA or TRICARE for display
- +1 ; purposes, or null if neither
- +2 NEW PSOELIG
- +3 SET PSOELIG=$$TRIC(RX,RFL)
- +4 QUIT $SELECT(PSOELIG=1:"TRICARE",PSOELIG=2:"CHAMPVA",1:"")
- +5 ;
- ELIGTCV(RX,RFL,CAPS) ; Return either CHAMPVA, TRICARE, or Veteran/VETERAN for eligibility display
- +1 ; if CAPS=1 then return "Veteran" in all caps
- +2 ; Note if the requested refill has been deleted, then the message "N/A - Fill Deleted" will be returned
- +3 NEW PSOELIG,VET,DELMSG
- +4 SET DELMSG="N/A - Fill Deleted"
- +5 SET PSOELIG=$$TRIC(RX,RFL)
- SET VET="Veteran"
- IF $GET(CAPS)
- SET VET="VETERAN"
- +6 IF RFL>0
- IF '$DATA(^PSRX(RX,1,RFL,0))
- SET PSOELIG=3
- +7 QUIT $SELECT(PSOELIG=1:"TRICARE",PSOELIG=2:"CHAMPVA",PSOELIG=3:DELMSG,1:VET)
- +8 ;
- INIT ; Builds the Body section
- +1 NEW DATA,LINE
- +2 ; PSO*7*448 obtain fill# from 52.25 subfile if not defined
- IF '$DATA(FILL)
- SET FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- +3 IF '$$CLOSED(RX,REJ)
- SET VALM("TITLE")="Reject Information ("_$$ELIGTCV(RX,FILL)_")"
- +4 IF $$CLOSED(RX,REJ)
- SET VALM("TITLE")="Reject Information (RESOLVED)"
- +5 FOR I=1:1:$GET(LASTLN)
- DO RESTORE^VALM10(I)
- +6 KILL ^TMP("PSOREJP1",$JOB)
- SET VALMCNT=0
- SET LINE=0
- +7 DO GET^PSOREJU2(RX,FILL,.DATA,REJ,1)
- +8 ; Display the REJECT Information
- DO REJ
- +9 ; Display the Other Rejects Information
- DO OTH
- +10 ; Display the Comment
- DO COM^PSOREJP3
- +11 ; Display the Insurance Information
- DO INS
- +12 ; Display the Resolution Information
- DO CLS
- +13 SET VALMCNT=LINE
- +14 QUIT
- +15 ;
- REJ ; Reject Information
- +1 NEW PFLDT,PSOADD,PSOCOB,PSOECME,PSOET,PSONAF,PSOTXT,TREJ,TYPE
- +2 ;
- +3 ; Display 'RESUBMISSION' where 'BACK-BILL' currently displays if the
- +4 ; claim was resubmitted from the ECME User Screen. To facilitate
- +5 ; this, the function $$RESUBMIT^BPSBUTL was created.
- +6 ;
- +7 SET PSOTXT=""
- +8 SET PSOCOB=$GET(DATA(REJ,"COB"))
- SET PSOCOB=$SELECT(PSOCOB="SECONDARY":2,PSOCOB="TERTIARY":3,1:1)
- +9 IF $$BBILL^BPSBUTL(RX,FILL,PSOCOB)
- SET PSOTXT=" BACK-BILL"
- +10 ; IA 4719.
- IF '$TEST
- IF $$RESUBMIT^BPSBUTL(RX,FILL,PSOCOB)
- SET PSOTXT=" RESUBMISSION"
- +11 DO SETLN("REJECT Information ("_$$ELIGTCV(RX,FILL)_") "_PSOTXT,1,1)
- +12 ;
- +13 SET PSOECME=$$STATUS^PSOBPSUT(RX,FILL,PSOCOB)
- +14 IF PSOECME="E PAYABLE"
- Begin DoDot:1
- +15 DO SETLN("Reject Received: ",,,18)
- +16 DO SETLN("Reject Type : ",,,18)
- +17 DO SETLN("Reject Status : ** E PAYABLE **",,,18)
- +18 IF DATA(REJ,"PAYER MESSAGE")["Not ECME Billable"
- SET DATA(REJ,"PAYER MESSAGE")=""
- +19 QUIT
- End DoDot:1
- +20 IF '$TEST
- Begin DoDot:1
- +21 IF $GET(DATA(REJ,"CODE"))=79
- SET TYPE="79 - REFILL TOO SOON"
- +22 IF '$TEST
- SET TYPE=DATA(REJ,"CODE")_" - "_$$EXP(DATA(REJ,"CODE"))
- +23 IF $LENGTH(TYPE)>62
- SET TYPE=$EXTRACT(TYPE,1,59)_"..."
- +24 DO SETLN("Reject Received: "_$$FMTE^XLFDT($GET(DATA(REJ,"DATE/TIME"))),,,18)
- +25 DO SETLN("Reject Type : "_TYPE,,,18)
- +26 ; If TRICARE/CHAMPVA non-billable then reset Status line
- +27 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
- +28 IF PSOET
- DO SETLN("Status : NO CLAIM SUBMITTED")
- +29 IF 'PSOET
- DO SETLN("Reject Status : "_$GET(DATA(REJ,"STATUS"))_" - "_PSOECME,,,18)
- +30 QUIT
- End DoDot:1
- +31 ;
- +32 ; code moved to PSOREJP5
- +33 DO REJ^PSOREJP5
- +34 QUIT
- +35 ;
- OTH ; Other Rejects Information
- +1 NEW LST,I,RJC,J,LAST
- +2 SET LST=$GET(DATA(REJ,"OTHER REJECTS"))
- IF LST=""
- QUIT
- +3 DO SETLN()
- +4 DO SETLN("OTHER REJECTS",1,1)
- +5 FOR I=1:1:$LENGTH(LST,",")
- SET RJC=$PIECE(LST,",",I)
- Begin DoDot:1
- +6 SET LAST=1
- FOR J=(I+1):1:$LENGTH(LST,",")
- IF $PIECE(LST,",",J)'=""
- SET LAST=0
- QUIT
- +7 IF RJC'=""
- DO SETLN(RJC_" - "_$$EXP(RJC),,$SELECT(LAST:1,1:0),6)
- End DoDot:1
- +8 QUIT
- +9 ;
- INS ; Insurance Information
- +1 DO SETLN()
- +2 DO SETLN("INSURANCE Information",1,1)
- +3 NEW PSOINS,PSOINS1,I,PSOBINPCN
- +4 SET PSOINS=$GET(DATA(REJ,"INSURANCE NAME"))
- +5 FOR I=1:1:(50-($LENGTH(PSOINS)+18))
- SET PSOINS=PSOINS_" "
- +6 SET PSOINS1=$GET(DATA(REJ,"COB"))
- +7 IF PSOINS1="SECONDARY"
- SET PSOINS=PSOINS_"Coord. Of Benefits: "_PSOINS1
- +8 DO SETLN("Insurance : "_PSOINS,,,18)
- +9 DO SETLN("Contact : "_$GET(DATA(REJ,"PLAN CONTACT")),,,18)
- +10 SET PSOBINPCN=$GET(DATA(REJ,"BIN"))_"/ "_$GET(DATA(REJ,"PCN"))
- +11 DO SETLN("BIN/ PCN : "_PSOBINPCN,,,18)
- +12 DO SETLN("Group Number : "_$EXTRACT($GET(DATA(REJ,"GROUP NUMBER")),1,15),,,18)
- +13 DO SETLN("Cardholder ID : "_$EXTRACT($GET(DATA(REJ,"CARDHOLDER ID")),1,20),,1,18)
- +14 QUIT
- +15 ;
- CLS ; Resolution Information
- +1 NEW X
- +2 IF '$$CLOSED(RX,REJ)
- QUIT
- +3 DO SETLN()
- +4 DO SETLN("RESOLUTION Information",1,1)
- +5 DO SETLN("Resolved By : "_$GET(DATA(REJ,"CLOSED BY")),,,18)
- +6 DO SETLN("Date/Time : "_$GET(DATA(REJ,"CLOSED DATE/TIME")),,,18)
- +7 IF $GET(DATA(REJ,"CLOSE COMMENTS"))'=""
- DO SET("CLOSE COMMENTS",63)
- +8 IF $GET(DATA(REJ,"COD1"))'=""
- DO SETLN("Reason for Svc : "_$$OVRX^PSOREJU1(1,$GET(DATA(REJ,"COD1"))),,,18)
- +9 IF $GET(DATA(REJ,"COD2"))'=""
- DO SETLN("Profes. Svc : "_$$OVRX^PSOREJU1(2,$GET(DATA(REJ,"COD2"))),,,18)
- +10 IF $GET(DATA(REJ,"COD3"))'=""
- DO SETLN("Result of Svc : "_$$OVRX^PSOREJU1(3,$GET(DATA(REJ,"COD3"))),,,18)
- +11 IF $GET(DATA(REJ,"CLA CODE"))'=""
- Begin DoDot:1
- +12 NEW CLAPNTR
- SET CLAPNTR=$ORDER(^BPS(9002313.25,"B",DATA(REJ,"CLA CODE"),""))
- +13 SET X=DATA(REJ,"CLA CODE")_" - "_$$GET1^DIQ(9002313.25,CLAPNTR,".02")
- +14 DO SETLN("Clarific. Code : "_X,,,18)
- End DoDot:1
- +15 IF $GET(DATA(REJ,"PRIOR AUTH TYPE"))'=""
- Begin DoDot:1
- +16 SET X=$$GET1^DIQ(52.25,REJ_","_RX,25,"I")_" - "_(DATA(REJ,"PRIOR AUTH TYPE"))
- +17 DO SETLN("Prior Auth.Type: "_X,,,18)
- DO SETLN("Prior Auth. # : "_DATA(REJ,"PRIOR AUTH NUMBER"),,,18)
- End DoDot:1
- +18 DO SETLN("Reason : "_$GET(DATA(REJ,"CLOSE REASON")),,1,18)
- +19 QUIT
- +20 ;
- +21 ;
- SET(FIELD,L,UND) ; Sets the lines for fields that require text wrapping
- +1 NEW TXT,T
- +2 SET TXT=DATA(REJ,FIELD)
- IF $LENGTH(TXT)'>L
- DO SETLN($$LABEL(FIELD)_TXT,,$SELECT($GET(UND):1,1:0),80-L)
- QUIT
- +3 FOR I=1:1
- if TXT=""
- QUIT
- Begin DoDot:1
- +4 IF I=1
- DO SETLN($$LABEL(FIELD)_$EXTRACT(TXT,1,L),,,80-L)
- SET TXT=$EXTRACT(TXT,L+1,999)
- QUIT
- +5 SET T=""
- SET $EXTRACT(T,81-L)=$EXTRACT(TXT,1,L)
- DO SETLN(T,,$SELECT($EXTRACT(TXT,L+1,999)=""&$GET(UND):1,1:0),80-L)
- SET TXT=$EXTRACT(TXT,L+1,999)
- End DoDot:1
- +6 QUIT
- +7 ;
- LABEL(FIELD) ; Sets the label for the field
- +1 IF FIELD="REASON"
- QUIT "Reason Code : "
- +2 IF FIELD="PAYER MESSAGE"
- QUIT "Payer Addl Msg : "
- +3 IF FIELD="DUR TEXT"
- QUIT $SELECT(+$$ISDUR^PSOREJP5(RX,REJ):"+DUR Text : ",1:"DUR Text : ")
- +4 IF FIELD="CLOSE COMMENTS"
- QUIT "Comments : "
- +5 QUIT ""
- +6 ;
- VIEW ; Rx View hidden action
- +1 NEW VALMCNT,TITLE
- +2 IF $GET(PSOBACK)
- Begin DoDot:1
- +3 SET VALMSG="Not available through Backdoor!"
- SET VALMBCK="R"
- End DoDot:1
- QUIT
- +4 SET TITLE=VALM("TITLE")
- +5 ;
- +6 ; DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE
- +7 Begin DoDot:1
- +8 NEW PSOVDA,DA,PS
- +9 SET (PSOVDA,DA)=RX
- SET PS="REJECT"
- +10 NEW RX,REJ,FILL,LINE,TITLE
- +11 DO DP^PSORXVW
- End DoDot:1
- +12 ;
- +13 SET VALMBCK="R"
- SET VALM("TITLE")=TITLE
- +14 QUIT
- +15 ;
- EDT ; Rx Edit hidden action
- +1 NEW VALMCNT,TITLE
- +2 IF $GET(PSOBACK)
- Begin DoDot:1
- +3 SET VALMSG="Not available through Backdoor!"
- SET VALMBCK="R"
- End DoDot:1
- QUIT
- +4 SET TITLE=VALM("TITLE")
- +5 ;
- +6 ; DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE
- +7 Begin DoDot:1
- +8 NEW PSOSITE,ORN,PSOPAR,PSOLIST,PSOREJCT
- +9 SET PSOSITE=$$RXSITE^PSOBPSUT(RX,FILL)
- SET ORN=RX
- +10 SET PSOPAR=$GET(^PS(59,PSOSITE,1))
- SET PSOLIST(1)=ORN_","
- +11 ; Variable PSOREJCT is used so that EPH^PSORXEDT has the RX 'passed' by this routine
- +12 SET PSOREJCT=RX_U_FILL
- +13 NEW RX,REJ,FILL,LINE,TITLE
- +14 DO EPH^PSORXEDT
- End DoDot:1
- +15 ;
- +16 KILL VALMBCK
- IF $$CLOSED(RX,REJ)
- IF $DATA(PSOSTFLT)
- IF PSOSTFLT="U"
- SET CHANGE=1
- QUIT
- +17 SET VALMBCK="R"
- SET VALM("TITLE")=TITLE
- +18 QUIT
- +19 ;
- OVR ; Override a REJECT action
- +1 NEW PSOET
- +2 IF $$CLOSED(RX,REJ,1)
- QUIT
- +3 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
- +4 IF PSOET
- SET VALMSG="OVR not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim."
- SET VALMBCK="R"
- QUIT
- +5 NEW COD1,COD2,COD3
- +6 DO FULL^VALM1
- WRITE !
- +7 SET COD1=$$OVRCOD^PSOREJU1(1,$$GET1^DIQ(52.25,REJ_","_RX,14))
- IF COD1="^"!(COD1="")
- SET VALMBCK="R"
- QUIT
- +8 SET COD2=$$OVRCOD^PSOREJU1(2)
- IF COD2="^"
- SET VALMBCK="R"
- QUIT
- +9 SET COD3=$$OVRCOD^PSOREJU1(3)
- IF COD3="^"
- SET VALMBCK="R"
- QUIT
- +10 DO OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3)
- +11 DO SEND^PSOREJP3(COD1_"^"_COD2_"^"_COD3,,,PSOET)
- +12 QUIT
- +13 ;
- RES ; Re-submit a claim action
- +1 NEW PSOET
- +2 IF $$CLOSED(RX,REJ,1)
- QUIT
- +3 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
- +4 DO FULL^VALM1
- WRITE !
- +5 DO SEND^PSOREJP3(,,,PSOET)
- +6 QUIT
- +7 ;
- CLA ; Submit Clarification Code
- +1 NEW CLA,PSOET
- +2 IF $$CLOSED(RX,REJ,1)
- QUIT
- +3 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
- +4 IF PSOET
- SET VALMSG="CLA not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim."
- SET VALMBCK="R"
- QUIT
- +5 DO FULL^VALM1
- WRITE !
- +6 ; Prompt for the Submission Clarification Codes (up to three)
- +7 SET CLA=$$CLA^PSOREJU1()
- IF CLA="^"!(CLA="")
- SET VALMBCK="R"
- QUIT
- +8 WRITE !
- DO SEND^PSOREJP3(,CLA,,PSOET)
- +9 QUIT
- +10 ;
- PA ; Submit Prior Authorization
- +1 NEW PA,PSOET
- +2 IF $$CLOSED(RX,REJ,1)
- QUIT
- +3 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
- +4 IF PSOET
- SET VALMSG="PA not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim."
- SET VALMBCK="R"
- QUIT
- +5 DO FULL^VALM1
- WRITE !
- +6 ; Prompt for Prior Auth fields
- +7 SET PA=$$PA^PSOREJU2()
- IF PA="^"
- SET VALMBCK="R"
- QUIT
- +8 WRITE !
- DO SEND^PSOREJP3(,,PA,PSOET)
- +9 QUIT
- +10 ;
- MP ; Patient Medication Profile
- +1 IF $GET(PSOBACK)
- Begin DoDot:1
- +2 SET VALMSG="Not available through Backdoor!"
- SET VALMBCK="R"
- End DoDot:1
- QUIT
- +3 NEW SITE,PATIENT
- +4 DO FULL^VALM1
- WRITE !
- +5 SET SITE=+$$RXSITE^PSOBPSUT(RX,FILL)
- if $GET(PSOSITE)
- SET SITE=PSOSITE
- +6 SET PATIENT=+$$GET1^DIQ(52,RX,2,"I")
- +7 DO LST^PSOPMP0(SITE,PATIENT)
- SET VALMBCK="R"
- +8 QUIT
- +9 ;
- EXIT ;
- +1 KILL ^TMP("PSOREJP1",$JOB)
- +2 QUIT
- +3 ;
- SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section
- +1 NEW X
- +2 if $GET(TEXT)=""
- SET $EXTRACT(TEXT,80)=""
- +3 if $LENGTH(TEXT)>80
- SET TEXT=$EXTRACT(TEXT,1,80)
- +4 SET LINE=LINE+1
- SET ^TMP("PSOREJP1",$JOB,LINE,0)=$GET(TEXT)
- +5 ;
- +6 IF LINE>$GET(LASTLN)
- DO SAVE^VALM10(LINE)
- SET LASTLN=LINE
- +7 ;
- +8 IF $GET(REV)
- Begin DoDot:1
- +9 DO CNTRL^VALM10(LINE,1,$LENGTH(TEXT),IORVON,IOINORM)
- +10 IF $GET(UND)
- DO CNTRL^VALM10(LINE,$LENGTH(TEXT)+1,80,IOUON,IOINORM)
- End DoDot:1
- QUIT
- +11 IF $GET(UND)
- DO CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
- +12 IF $GET(HIG)
- Begin DoDot:1
- +13 DO CNTRL^VALM10(LINE,HIG,80,IOINHI_$SELECT($GET(UND):IOUON,1:""),IOINORM)
- End DoDot:1
- +14 QUIT
- HELP ;
- +1 QUIT
- +2 ;
- CLOSED(RX,REJ,MSG) ; Returns whether the REJECT is RESOLVED or NOT
- +1 IF $$GET1^DIQ(52.25,REJ_","_RX,10,"I")
- if $GET(MSG)
- Begin DoDot:1
- +2 SET VALMSG="This Reject is marked resolved!"
- SET VALMBCK="R"
- WRITE $CHAR(7)
- End DoDot:1
- QUIT 1
- +3 QUIT 0
- +4 ;
- REOPN(RX,REJ) ; Returns whether the REJECT was RE-OPENED or NOT
- +1 QUIT $SELECT($$GET1^DIQ(52.25,REJ_","_RX,23)="":0,1:1)
- +2 ;
- EXP(CODE) ; Returns the explanation field (.02) for a reject code
- +1 ; Input: (r) CODE - .01 field (Code) value from file 9002313.93
- +2 ; Output: .02 field (Explanation) value from file 9002313.93
- +3 NEW DIC,X,Y
- +4 SET DIC=9002313.93
- SET DIC(0)="Z"
- SET X=CODE
- DO ^DIC
- +5 QUIT $PIECE($GET(Y(0)),"^",2)
- +6 ;
- OUT(RX) ; Supported call by outside PROTOCOLs to act on specific REJECTs
- +1 NEW I,RFL,DATA,REJ,PSOBACK,VALMCNT,RXN
- +2 IF '$DATA(^XUSEC("PSORPH",DUZ))
- Begin DoDot:1
- +3 SET VALMSG="PSORPH key required to use the REJ action."
- SET VALMBCK="R"
- End DoDot:1
- QUIT
- +4 IF $GET(PS)="REJECT"
- Begin DoDot:1
- +5 SET VALMSG="REJ action is not available at this point."
- SET VALMBCK="R"
- End DoDot:1
- +6 SET PSOBACK=1
- +7 SET (RFL,I)=0
- FOR I=1:1
- if '$DATA(^PSRX(RX,1,I))
- QUIT
- SET RFL=I
- +8 SET X=$$FIND^PSOREJUT(RX,RFL,.DATA,,1)
- SET REJ=$ORDER(DATA(""))
- +9 IF '$GET(REJ)
- SET VALMSG="Invalid selection!"
- SET VALMBCK="R"
- QUIT
- +10 DO EN(RX,REJ)
- SET VALMBCK="R"
- +11 QUIT
- +12 ;
- SMA ; Submit multiple actions
- +1 NEW CLA,I,OVR,OVRSTR,PA,REJIEN,DUR,RSC,DURIEN,REQ,RSUB,PSOET
- +2 IF $$CLOSED(RX,REJ,1)
- QUIT
- +3 SET PSOET=$$PSOET^PSOREJP3(RX,FILL)
- +4 IF PSOET
- SET VALMSG="SMA not allowed for "_$$ELIGDISP(RX,FILL)_" Non-Billable claim."
- SET VALMBCK="R"
- QUIT
- +5 DO FULL^VALM1
- WRITE !
- +6 SET DURIEN=$PIECE($GET(^PSRX(RX,"REJ",REJ,0)),U,11)
- +7 ; Reference to BPSNCPD3 supported by IA 4560
- DO DURRESP^BPSNCPD3(DURIEN,.DUR)
- +8 ;
- +9 ; Prompt for Prior Auth fields
- +10 SET PA=$$PA^PSOREJU2
- +11 ;User terminated or did not answer
- IF PA="^"
- SET VALMBCK="R"
- QUIT
- +12 ;
- +13 ; Prompt for submission clarification codes (up to three)
- +14 WRITE !
- +15 SET CLA=$$CLA^PSOREJU1
- +16 ;User terminated or did not answer
- IF CLA="^"
- SET VALMBCK="R"
- QUIT
- +17 ;
- +18 ; Check if DUR Overrides required - PSO*7*421
- +19 SET REQ=$$REQ
- IF REQ="^"
- SET VALMBCK="R"
- QUIT
- +20 ;
- +21 ; Prompt for DUR Overrides (up to 3) - option to delete default added - PSO*7*421
- +22 SET OVRSTR=""
- SET OVR=""
- +23 IF REQ
- SET REJIEN=0
- FOR RSUB=1:1:3
- Begin DoDot:1
- +24 IF REJIEN]""
- SET REJIEN=$ORDER(DUR(1,"DUR PPS",REJIEN))
- +25 SET RSC=""
- IF +REJIEN
- SET RSC=$PIECE($GET(DUR(1,"DUR PPS",REJIEN,"REASON FOR SERVICE CODE"))," ",1)
- +26 SET OVR=$$SMAOVR^PSOREJU1(RSC,RSUB)
- End DoDot:1
- if OVR="^"!(OVR="")!(OVR="@")
- QUIT
- SET $PIECE(OVRSTR,"~",RSUB)=OVR
- +27 ;User exited or timed-out
- IF OVR="^"
- SET VALMBCK="R"
- QUIT
- +28 ;
- +29 WRITE !!,?6,"RECAP:"
- +30 WRITE !,?6,"Prior Authorization Type : ",$PIECE(PA,"^")," ",$$DSC^PSOREJU1(9002313.26,$PIECE(PA,"^"),.02)
- +31 WRITE !,?6,"Prior Authorization Number : ",$PIECE(PA,"^",2)
- +32 WRITE !,?6,"Submission Clarification Code 1: ",$PIECE(CLA,"~",1)," ",$$DSC^PSOREJU1(9002313.25,$PIECE(CLA,"~",1),.02)
- +33 IF $PIECE(CLA,"~",2)]""
- WRITE !,?6,"Submission Clarification Code 2: ",$PIECE(CLA,"~",2)," ",$$DSC^PSOREJU1(9002313.25,$PIECE(CLA,"~",2),.02)
- +34 IF $PIECE(CLA,"~",3)]""
- WRITE !,?6,"Submission Clarification Code 3: ",$PIECE(CLA,"~",3)," ",$$DSC^PSOREJU1(9002313.25,$PIECE(CLA,"~",3),.02)
- +35 WRITE !,?6,"Reason for Service Code 1 : ",$PIECE($PIECE(OVRSTR,"~",1),U,1)," ",$$DSC^PSOREJU1(9002313.23,$PIECE($PIECE(OVRSTR,"~",1),U,1),1)
- +36 WRITE !,?6,"Professional Service Code 1 : ",$PIECE($PIECE(OVRSTR,"~",1),U,2)," ",$$DSC^PSOREJU1(9002313.21,$PIECE($PIECE(OVRSTR,"~",1),U,2),1)
- +37 WRITE !,?6,"Result of Service Code 1 : ",$PIECE($PIECE(OVRSTR,"~",1),U,3)," ",$$DSC^PSOREJU1(9002313.22,$PIECE($PIECE(OVRSTR,"~",1),U,3),1)
- +38 IF $PIECE($PIECE(OVRSTR,"~",2),U,1)]""
- WRITE !,?6,"Reason for Service Code 2 : ",$PIECE($PIECE(OVRSTR,"~",2),U,1)," ",$$DSC^PSOREJU1(9002313.23,$PIECE($PIECE(OVRSTR,"~",2),U,1),1)
- +39 IF $PIECE($PIECE(OVRSTR,"~",2),U,2)]""
- WRITE !,?6,"Professional Service Code 2 : ",$PIECE($PIECE(OVRSTR,"~",2),U,2)," ",$$DSC^PSOREJU1(9002313.21,$PIECE($PIECE(OVRSTR,"~",2),U,2),1)
- +40 IF $PIECE($PIECE(OVRSTR,"~",2),U,3)]""
- WRITE !,?6,"Result of Service Code 2 : ",$PIECE($PIECE(OVRSTR,"~",2),U,3)," ",$$DSC^PSOREJU1(9002313.22,$PIECE($PIECE(OVRSTR,"~",2),U,3),1)
- +41 IF $PIECE($PIECE(OVRSTR,"~",3),U,1)]""
- WRITE !,?6,"Reason for Service Code 3 : ",$PIECE($PIECE(OVRSTR,"~",3),U,1)," ",$$DSC^PSOREJU1(9002313.23,$PIECE($PIECE(OVRSTR,"~",3),U,1),1)
- +42 IF $PIECE($PIECE(OVRSTR,"~",3),U,2)]""
- WRITE !,?6,"Professional Service Code 3 : ",$PIECE($PIECE(OVRSTR,"~",3),U,2)," ",$$DSC^PSOREJU1(9002313.21,$PIECE($PIECE(OVRSTR,"~",3),U,2),1)
- +43 IF $PIECE($PIECE(OVRSTR,"~",3),U,3)]""
- WRITE !,?6,"Result of Service Code 3 : ",$PIECE($PIECE(OVRSTR,"~",3),U,3)," ",$$DSC^PSOREJU1(9002313.22,$PIECE($PIECE(OVRSTR,"~",3),U,3),1)
- +44 WRITE !
- +45 DO SEND^PSOREJP3(OVRSTR,CLA,PA,PSOET)
- +46 QUIT
- +47 ;
- VRX ; View ePharmacy Prescription - invoked from the Reject Information screen
- +1 NEW BPSVRX
- +2 KILL ^TMP("BPSVRX1-PSO VIEW RX",$JOB,"PSOHDR")
- +3 DO FULL^VALM1
- +4 ;
- +5 ; save the current header display
- +6 MERGE ^TMP("BPSVRX1-PSO VIEW RX",$JOB,"PSOHDR")=^TMP("PSOHDR",$JOB)
- +7 ;
- +8 SET BPSVRX("RXIEN")=$GET(RX)
- +9 SET BPSVRX("FILL#")=$GET(FILL)
- +10 ; DBIA #5723
- DO ^BPSVRX
- +11 ;
- +12 ; restore the header display
- +13 IF '$DATA(^TMP("PSOHDR",$JOB))
- MERGE ^TMP("PSOHDR",$JOB)=^TMP("BPSVRX1-PSO VIEW RX",$JOB,"PSOHDR")
- +14 ;
- +15 SET VALMBCK="R"
- +16 KILL ^TMP("BPSVRX1-PSO VIEW RX",$JOB,"PSOHDR")
- +17 QUIT
- +18 ;
- VER ; View ePharmacy Prescription - invoked from the Rx view hidden action of Medication Profile
- +1 NEW BPSVRX
- +2 KILL ^TMP("BPSVRX-PSO VIEW RX",$JOB)
- +3 DO FULL^VALM1
- +4 ;
- +5 ; save the current PSO Rx display array and header
- +6 MERGE ^TMP("BPSVRX-PSO VIEW RX",$JOB,"PSOHDR")=^TMP("PSOHDR",$JOB)
- +7 MERGE ^TMP("BPSVRX-PSO VIEW RX",$JOB,"PSOAL")=^TMP("PSOAL",$JOB)
- +8 ;
- +9 ; Rx ien ptr file 52
- SET BPSVRX("RXIEN")=$GET(RXN)
- +10 ; DBIA #5723
- DO ^BPSVRX
- +11 ;
- +12 ; restore the PSO Rx display array and header upon return
- +13 IF '$DATA(^TMP("PSOHDR",$JOB))
- MERGE ^TMP("PSOHDR",$JOB)=^TMP("BPSVRX-PSO VIEW RX",$JOB,"PSOHDR")
- +14 IF '$DATA(^TMP("PSOAL",$JOB))
- MERGE ^TMP("PSOAL",$JOB)=^TMP("BPSVRX-PSO VIEW RX",$JOB,"PSOAL")
- +15 ;
- +16 SET VALMBCK="R"
- +17 KILL ^TMP("BPSVRX-PSO VIEW RX",$JOB)
- +18 QUIT
- +19 ;
- REQ() ;Prompt if DUR Rejects are required
- +1 NEW DIR,DTOUT,DTOUT,DIRUT,DIROUT,X,Y
- +2 SET DIR("?")="Enter No if Reason Codes are not required. Enter Yes to proceed and enter up to 3 sets of override Reason Codes. To delete default Reason Codes, enter ""@""."
- +3 SET DIR("A")="Enter DUR codes"
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- WRITE !
- DO ^DIR
- +4 ;User exited or timed-out
- IF $DATA(DIRUT)!$DATA(DIROUT)
- QUIT "^"
- +5 QUIT Y