Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOREJP1

PSOREJP1.m

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