- PSOREJU3 ;BIRM/LJE - BPS (ECME) - Clinical Rejects Utilities (3) ;04/25/08
- ;;7.0;OUTPATIENT PHARMACY;**287,290,358,359,385,421,427,448,478,513,482,528,561,562,680,704**;DEC 1997;Build 16
- ; Reference to 9002313.99 in ICR #4305
- ; Reference to $$CLAIM^BPSBUTL in ICR #4719
- ; Reference to LOG^BPSOSL in ICR #6764
- ; Reference to IEN59^BPSOSRX in ICR #4412
- ; Reference to $$CSNPI^BPSUTIL in ICR #4146
- ;
- Q
- ;
- TRICCHK(RX,RFL,RESP,FROM,RVTX) ;check to see if Rx is non-billable or in an "In Progress" state on ECME
- ; Input: (r) RX - Rx IEN (#52)
- ; (r) RFL - REFILL
- ; (o) RESP - Response from $$EN^BPSNCPDP api
- ; TRICCHK assumes that the calling routine has validated that the fill is TRICARE or CHAMPVA.
- ;
- ; - \Need to be mindful of foreground and background processing.
- ;
- N ESTAT,ETOUT,NFROM,PSOBEI
- I '$D(FROM) S FROM=""
- S ESTAT=$P(RESP,"^",4)
- S NFROM=0
- I FROM="PL"!(FROM="PC") S NFROM=1
- Q:ESTAT["PAYABLE"!(ESTAT["REJECTED")
- S PSOBEI=$$ELIGDISP^PSOREJP1(RX,RFL)
- ;
- D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRICCHK, RESP="_RESP) ; ICR#s 4412,6764
- D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRICCHK, FROM="_FROM_" ESTAT="_ESTAT)
- I ESTAT["IN PROGRESS",FROM="PC" D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-Would have noted in Activity Log that Rx was left in CMOP suspense") Q ; ICR#s 4412,6764
- ;
- I ESTAT["IN PROGRESS",FROM="RRL"!($G(RVTX)="RX RELEASE-NDC CHANGE") D Q
- . I 'NFROM D
- . . W !!,PSOBEI_" Prescription "_$$GET1^DIQ(52,RX,".01")_" cannot be released until ECME 'IN PROGRESS'"
- . . W !,"status is resolved payable.",!!
- ;
- I $D(RESP) D Q
- . I +RESP=6 W:'NFROM&('$G(CMOP)) !!,"Inactive ECME "_PSOBEI,!! D Q
- . . S ACT="Inactive ECME "_PSOBEI D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
- . I +RESP=2!(+RESP=3) N PSONBILL S PSONBILL=1 D TRIC2 Q
- . I +RESP=4!(ESTAT["IN PROGRESS") D Q
- . . ;
- . . ; Do not put the Rx into the suspense queue if this claim activity
- . . ; was triggered by a release message from OPAI or CMOP.
- . . ;
- . . I $E(FROM,1,2)="CR" Q
- . . ;
- . . ; Put the Rx into the suspense queue.
- . . ;
- . . N PSONPROG S PSONPROG=1 D TRIC2
- ;
- Q
- ;
- TRIC2 ;
- N ACTION,DA,DIR,DIRUT,PSCAN,PSOIT,PSORESP,PSOTRIC
- N REA,REJ,REJCOD,REJDATA,X,ZZZ
- S PSOTRIC=1,REJ=9999999999
- D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRIC2, CMOP="_$G(CMOP)_" PSONPROG="_$G(PSONPROG))
- I $G(CMOP)&($G(PSONPROG)) D TACT Q
- ;
- ; If the prescription is non-billable, put the eT/eC reject on the
- ; Prescription (WRKLST^PSOREJU4), then determine the reject number.
- ;
- I +RESP=2 D
- . D WRKLST^PSOREJU4(RX,RFL,,DUZ,DT,1,"",RESP)
- . S X=$$FIND^PSOREJUT(RX,RFL,.REJDATA,"eT,eC",1)
- . S REJ=0
- . F S REJ=$O(REJDATA(REJ)) Q:'REJ I "eT,eC"[REJDATA(REJ,"CODE") Q
- . Q
- ;
- Q:$G(CMOP)
- D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRIC2, NFROM="_NFROM)
- I 'NFROM D DISPLAY(RX,REJ)
- I 'NFROM&($G(PSONPROG)) D D SUSP Q
- . W !!,"This prescription will be suspended. After the third party claim is resolved,"
- . W !,"it may be printed or pulled early from suspense.",!
- . R !!,"Press <RETURN> to continue...",ZZZ:60,!
- I NFROM&($G(PSONPROG)) D TACT Q
- Q:NFROM
- TRIC3 ;
- D MSG
- I FROM="PL"!(FROM="PC") D SUSP Q
- ;cnf, PSO*7*358, add code for options
- N ACTION,COM,DEF,DIR,DIRUT,OPTS
- TRIC4 S DIR(0)="SO^",DIR("A")="",OPTS="DQ",DEF="D"
- S PSORESP=$P($G(RESP),U,2)
- I PSORESP["NO ACTIVE/VALID ROI" S DEF="Q" ;IB routine IBNCPDP1 contains this text.
- I PSORESP="NOT INSURED" S DEF="Q"
- ;reference to ^XUSEC( supported by IA 10076
- I $D(^XUSEC("PSO TRICARE/CHAMPVA",DUZ)) S OPTS=OPTS_"I" ;PSO*7.0*358, if user has security key, include IGNORE in TRICARE/CHAMPVA options
- S:(OPTS["D") DIR(0)=DIR(0)_"D:(D)iscontinue - DO NOT FILL PRESCRIPTION;",DIR("A")=DIR("A")_"(D)iscontinue,"
- S:(OPTS["Q") DIR(0)=DIR(0)_"Q:(Q)UIT - SEND TO WORKLIST (REQUIRES INTERVENTION);",DIR("A")=DIR("A")_"(Q)uit,"
- S:(OPTS["I") DIR(0)=DIR(0)_"I:(I)GNORE - FILL Rx WITHOUT CLAIM SUBMISSION;",DIR("A")=DIR("A")_"(I)gnore,"
- S $E(DIR(0),$L(DIR(0)))="",$E(DIR("A"),$L(DIR("A")))="",DIR("??")="^D HELP^PSOREJU2("""_OPTS_""")"
- S:$G(DEF)'="" DIR("B")=DEF D ^DIR I $D(DIRUT) S Y="Q" W !
- ;
- S ACTION=Y
- I ACTION="D" S ACTION=$$DC^PSOREJU1(RX,ACTION) ;cnf, PSO*7*358
- S PSOIT=""
- I ACTION="I" S PSOIT=$$IGNORE^PSOREJU1(RX,RFL)
- I $P(PSOIT,"^")=0 D G TRIC4
- . I $P(PSOIT,"^",2)'="" D
- . . W $C(7),!,"Gross Amount Due is $"_$P(PSOIT,"^",2)_". IGNORE requires EPHARMACY SITE MANAGER key."
- I ACTION="I" G TRIC4:'$$CONT^PSOREJU1() S COM=$$TCOM^PSOREJP3(RX,RFL) G TRIC4:COM="^" G TRIC4:'$$SIG^PSOREJU1() D
- . D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,6,COM,"","","","","",1) ;TRICARE/CHAMPVA non-billable should have only 1 reject - eT/eC
- . D AUDIT^PSOTRI(RX,RFL,,COM,$S($$PSOETEC^PSOREJP5(RX,RFL):"N",1:"R"),$P(RESP,"^",3))
- Q
- ;
- MSG ;
- W !!,"This is a non-billable "_$$ELIGDISP^PSOREJP1(RX,RFL)_" prescription." ;cnf, PSO*7*358
- Q
- SUSP ;Suspense Rx due to IN PROGRESS status in ECME
- D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-SUSP")
- N DA,ACT,RX0,SD,RXS,PSOWFLG,DIK,RXN,XFLAG,RXP,DD,DO,X,Y,DIC,VALMSG,COMM,LFD,DFLG,RXCMOP
- N PSOQFLAG,PSORXZD,PSOQFLAG,PSOKSPPL,PSOZXPPL,PSOZXPI,RXLTOP
- S DA=RX D SUS^PSORXL1
- TACT ;
- D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TACT, PSONPROG="_$G(PSONPROG)_" PSONBILL="_$G(PSONBILL))
- S ACT=$$ELIGDISP^PSOREJP1(RX,RFL)_"-Rx placed on Suspense due to"_$S($G(PSONPROG):" ECME IN PROGRESS status",$G(PSONBILL):"the Rx being Non-billable",1:"")
- I '$G(DUZ) N DUZ S DUZ=.5
- D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
- Q
- ;
- DISPLAY(RX,REJ,KEY,RRR) ; - Displays REJECT information
- ; Input: (r) RX - Rx IEN (#52)
- ; (r) REJ - REJECT ID (IEN)
- ; (o) KEY - Display "Press any KEY to continue..." (1-YES/0-NO) (Default: 0)
- ; (o) RRR - Reject Resolution Required information Flag(0/1)^Threshold Amt^Gross Amt Due (Default: 0)
- ; If Flag = 0, there is no Reject Resolution Required reject code. Parameter added with PSO*421
- ;
- Q:$G(NFROM)
- I '$G(RX)!'$G(REJ) Q
- I '$D(^PSRX(RX,"REJ",REJ))&('$G(PSONBILL))&('$G(PSONPROG)) Q
- ;
- N DATA,PTINFO,RFL,LINE,%
- S RFL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- I '$G(PSONBILL)&('$G(PSONPROG)) D GET^PSOREJU2(RX,RFL,.DATA,REJ) I '$D(DATA(REJ)) Q
- ;
- D HDR
- S $P(LINE,"-",74)="" W !?3,LINE
- W !?3,$$DVINFO(RX,RFL)
- S PTINFO=$$PTINFO^PSOREJU2(RX)
- W !?3,$P(PTINFO,U,1)
- W !?3,$P(PTINFO,U,2)
- W !?3,"Rx/Drug : ",$$GET1^DIQ(52,RX,.01),"/",RFL," - ",$E($$GET1^DIQ(52,RX,6),1,20),?54
- W:'$G(PSONBILL)&('$G(PSONPROG)) "ECME#: ",$P($$CLAIM^BPSBUTL(RX,RFL),U,6)
- D TYPE G DISP2:$G(PSONBILL)!($G(PSONPROG))
- I $G(DATA(REJ,"PAYER MESSAGE"))'="" W !?3,"Payer Message: " D PRT^PSOREJU2("PAYER MESSAGE",18,58)
- I $G(DATA(REJ,"DUR TEXT"))'="" W !?3,"DUR Text : ",DATA(REJ,"DUR TEXT")
- W !?3,"Insurance : ",DATA(REJ,"INSURANCE NAME"),?50,"Contact: ",DATA(REJ,"PLAN CONTACT")
- W !?3,"Group Name : ",$E(DATA(REJ,"GROUP NAME"),1,26)
- W ?45,"Group Number: ",$E(DATA(REJ,"GROUP NUMBER"),1,15)
- I $G(DATA(REJ,"CARDHOLDER ID"))'="" W !?3,"Cardholder ID: ",$E(DATA(REJ,"CARDHOLDER ID"),1,20)
- I DATA(REJ,"PLAN PREVIOUS FILL DATE")'="" D
- . W !?3,"Last Fill Dt.: ",DATA(REJ,"PLAN PREVIOUS FILL DATE")
- . W:DATA(REJ,"PLAN PREVIOUS FILL DATE")'="" " (from payer)"
- ;
- N PSOAR,PSOCNT,PSOCOMMENT,PSODATA,PSODATE,PSODATE1
- N PSODFN,PSOPC,PSOSTATUS,PSOSTR,PSOUSER
- ;
- ; Get Patient ID
- S PSODFN=$$GET1^DIQ(52,RX,2,"I")
- ;
- ; Loop through Patient Comments - Add ACTIVE Comments to PSOAR array
- S PSODATE=""
- S PSOCNT=0
- K PSOAR
- F S PSODATE=$O(^PS(55,PSODFN,"PC","B",PSODATE)) Q:PSODATE="" D
- . S PSOPC=""
- . F S PSOPC=$O(^PS(55,PSODFN,"PC","B",PSODATE,PSOPC)) Q:PSOPC="" D
- . . K PSODATA
- . . D GETS^DIQ(55.17,PSOPC_","_PSODFN_",",".01;1;2;3","IE","PSODATA")
- . . ;
- . . ; Only display ACTIVE Patient Comments
- . . S PSOSTATUS=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",2,"I"))
- . . I PSOSTATUS'="Y" Q
- . . ;
- . . S PSODATE1=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",.01,"E"))
- . . S PSOUSER=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",1,"E"))
- . . S PSOCOMMENT=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",3,"E"))
- . . S PSOSTR=PSODATE1_" - "_PSOCOMMENT_" ("_PSOUSER_")"
- . . S PSOCNT=PSOCNT+1
- . . S PSOAR(PSOCNT)=PSOSTR
- ;
- ; If PSOAR array exists, display Active Patient Comments
- I $D(PSOAR) D
- . W !?3,"Patient Billing Comment(s):"
- . ;
- . ; Loop through PSOAR in reverse order to display Patient
- . ; Comments in reverse chronological order
- . S PSOCNT=""
- . F S PSOCNT=$O(PSOAR(PSOCNT),-1) Q:PSOCNT="" D
- . . ;
- . . ; Use ^DIWP to display Patient Comments with proper
- . . ; line breaking
- . . N %,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,I,Z
- . . K ^UTILITY($J,"W")
- . . S X=PSOAR(PSOCNT)
- . . S DIWL=1
- . . S DIWR=78
- . . D ^DIWP
- . . ;
- . . S PSOLAST=0
- . . F PSOY=1:1 Q:('$D(^UTILITY($J,"W",1,PSOY,0))) D
- . . . S PSOCOM=$G(^UTILITY($J,"W",1,PSOY,0))
- . . . W !?3,PSOCOM
- . K ^UTILITY($J,"W")
- ;
- I $G(RRR) D ;added with PSO*421
- . W !!?3,"Reject Resolution Required"
- . W !?3,"Gross Amount Due ($"_$J($P(RRR,U,3)*100\1/100,0,2)_") is greater than or equal to"
- . W !?3,"Threshold Dollar Amount ($"_$P(RRR,U,2)_")"
- . W !?3,"Please select Quit to resolve this reject on the Reject Worklist."
- DISP2 ;
- W !?3,LINE,$C(7) I $G(KEY) W !?3,"Press <RETURN> to continue..." R %:DTIME W !
- Q
- ;
- TYPE ;
- I $G(PSONBILL)!($G(PSONPROG)) D Q
- . D NOW^%DTC S Y=% D DD^%DT
- . W !?3,"Date/Time: "_$$FMTE^XLFDT(Y)
- . W !?3,"Reason : ",$S($G(PSONBILL):"Not Billable.",$G(PSONPROG):"ECME Status is in an 'IN PROGRESS' state and cannot be filled",1:"")
- ;
- I $G(DATA(REJ,"REASON"))'="" W !?3,"Reason : " D PRT^PSOREJU2("REASON",14,62)
- N RTXT,OCODE,OTXT,I
- S (OTXT,RTXT,OCODE)="",RTXT=$S(DATA(REJ,"CODE")=79:"REFILL TOO SOON",DATA(REJ,"CODE")=88!(DATA(REJ,"CODE")=943):"DUR REJECT",1:$$EXP^PSOREJP1(DATA(REJ,"CODE")))_" ("_DATA(REJ,"CODE")_")"
- F I=1:1 S OCODE=$P(DATA(REJ,"OTHER REJECTS"),",",I) Q:OCODE="" D
- . S OTXT=OTXT_", "_$S(OCODE=79:"REFILL TOO SOON",OCODE=88!(OCODE=943):"DUR REJECT",1:$$EXP^PSOREJP1(OCODE))_" ("_OCODE_")"
- S RTXT=RTXT_OTXT_". Received on "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME")))_"."
- S OTXT=""
- W !?3,"Reject(s): " D WRAP(RTXT,14)
- Q
- ;
- WRAP(PSOTXT,INDENT) ;
- N I,K,PSOWRAP,PSOMARG
- S PSOWRAP=1,PSOMARG=$S('$G(PSORM):80,$D(IOM):IOM,1:80)-(INDENT+5)
- W1 S:$L(PSOTXT)<PSOMARG PSOWRAP(PSOWRAP)=PSOTXT I $L(PSOTXT)'<PSOMARG F I=PSOMARG:-1:0 I $E(PSOTXT,I)?1P S PSOWRAP(PSOWRAP)=$E(PSOTXT,1,I),PSOTXT=$E(PSOTXT,I+1,999),PSOWRAP=PSOWRAP+1 G W1
- F K=1:1:PSOWRAP W ?INDENT,PSOWRAP(K),!
- Q
- ;
- HDR ; Display the reject notification screen header
- N ELDSP,TAB
- S ELDSP=$$ELIGTCV^PSOREJP1(RX,RFL,1) ; returns TRICARE, CHAMPVA or VETERAN
- I $L(ELDSP) S ELDSP=ELDSP_" - " ; Add the " - " for CVA/TRI only
- ;
- I $G(PSONBILL) S TAB=$S($L(ELDSP):24,1:29) W !!?TAB,"*** "_ELDSP_"NON-BILLABLE ***" Q
- I $G(PSONPROG) S TAB=$S($L(ELDSP):18,1:23) W !!?TAB,"*** "_ELDSP_"'IN PROGRESS' ECME status ***" Q
- S TAB=$S($L(ELDSP):11,1:16) W !!?TAB,"*** "_ELDSP_"REJECT RECEIVED FROM THIRD PARTY PAYER ***"
- Q
- ;
- SUBMIT(RXIEN,RFCNT,PSOTRIC) ;called from PSOCAN2 (routine size exceeded)
- N SUBMITE S SUBMITE=$$SUBMIT^PSOBPSUT(RXIEN)
- I SUBMITE D
- . N ACTION
- . D ECMESND^PSOBPSU1(RXIEN,,,$S($O(^PSRX(RXIEN,1,0)):"RF",1:"OF"))
- . ; Quit if there is an unresolved TRICARE or CHAMPVA non-billable reject code, PSO*7*358
- . I $$PSOET^PSOREJP3(RXIEN) S ACTION="Q" Q
- . I $$FIND^PSOREJUT(RXIEN) S ACTION=$$HDLG^PSOREJU1(RXIEN,,"79,88,943","OF","IOQ","Q")
- I 'SUBMITE&(PSOTRIC) D
- . I $$STATUS^PSOBPSUT(RXIEN,RFCNT'["PAYABLE") D TRICCHK(RXIEN,RFCNT)
- Q
- ;
- TRISTA(RX,RFL,RESP,FROM,RVTX) ;called from suspense
- N ETOUT,ESTAT,TRESP,TSTAT,PSOTRIC
- S:'$D(RESP) RESP=""
- S (ESTAT,PSOTRIC)="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
- Q:'PSOTRIC 0
- S TRESP=RESP,ESTAT=$P(TRESP,"^",4) S:ESTAT="" ESTAT=$$STATUS^PSOBPSUT(RX,RFL)
- Q:ESTAT["E PAYABLE" 0
- I $$TRIAUD(RX,RFL) D Q 0 ;if TRICARE or CHAMPVA Rx is in audit due to override or bypass, allow to print from suspense, cnf
- . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRISTA, $$TRIAUD returned 1, $$TRISTA is Quitting with 0") ; ICR#s 4412,6764
- I +RESP=2,$$BYPASS^PSOBPSU1($P(RESP,"^",3),$P(RESP,"^",2)) D Q 0 ;if 'Bypass' RX, allow to print from suspense, cnf
- . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRISTA, $$BYPASS returned 1, $$TRISTA is Quitting with 0") ; ICR#s 4412,6764
- Q:ESTAT["E REJECTED" 1 ;rejected TRICARE or CHAMPVA is not allowed to print from suspense
- ;if 'in progress' (4) or not billable (2,3) don't allow to print from suspense (IA 4415 Values)
- I '$D(RESP)!($P(RESP,"^",1)="")!($G(RESP)="") D
- . S TSTAT=$$STATUS^PSOBPSUT(RX,RFL) S TRESP=$S(TSTAT["IN PROGRESS":4,TSTAT["NOT BILLABLE":2,1:0)
- . S $P(TRESP,"^",4)=TSTAT
- ;
- I +TRESP=2!(+TRESP=3) D Q 1
- . D WRKLST^PSOREJU4(RX,RFL,"",DUZ,DT,1,"",RESP) ;send TRICARE or CHAMPVA non billable to worklist (pseudo reject), cnf
- . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRISTA, calling WRKLST~PSOREJU4, $$TRISTA is Quitting with 1") ; ICR#s 4412,6764
- I +TRESP=4!(ESTAT["IN PROGRESS") D Q 1
- . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-TRISTA, TRESP="_TRESP_", ESTAT="_ESTAT_", $$TRISTA is Quitting with 1") ; ICR#s 4412,6764
- Q 0
- ;
- TRIAUD(RXIEN,RXFILL) ;is RXIEN in the TRICARE/CHAMPVA audit and no open rejects ;cnf
- ; RXIEN will only be in TRICARE/CHAMPVA audit if a bypass or override has occurred and rejects are closed
- ; returns 0 if RXIEN is not in TRICARE/CHAMPVA audit at all or not in audit for right fill number
- ; rejects must be closed for 0 to be returned
- ; 1 if RXIEN is in TRICARE/CHAMPVA audit for the right fill number and rejects are closed
- ;
- N X,AUDIEN,REJIEN
- S X=0,AUDIEN=""
- I '$D(^PS(52.87,"C",RXIEN)) Q X ;RXIEN is not in the TRICARE/CHAMPVA audit
- ;
- I $G(RXFILL)="" S RXFILL=$$LSTRFL^PSOBPSU1(RXIEN) ;Get latest fill if not passed in
- ;
- ;check audit entries for right fill number
- F S AUDIEN=$O(^PS(52.87,"C",RXIEN,AUDIEN)) Q:AUDIEN="" I RXFILL=$$GET1^DIQ(52.87,AUDIEN,2) S X=1 Q
- I 'X Q X
- ;
- ;make sure rejects are closed
- S REJIEN=0
- F S REJIEN=$O(^PSRX(RXIEN,"REJ",REJIEN)) Q:'+REJIEN D I 'X Q ;I 'X, then the reject is not closed
- . S X=$$CLOSED^PSOREJP1(RXIEN,REJIEN,0)
- ;
- Q X
- ;
- ECMECHK(RX,FILL) ;
- ; This function returns a '1' if any of the conditions below are met:
- ; - RX has an unresolved DUR or Refill Too Soon reject
- ; - RX has an unresolved Reject Resolution Required (RRR) reject (only for Veteran and original fill)
- ; - RX is TRICARE/CHAMPVA and has any unresolved reject
- ; - RX is TRICARE/CHAMPVA and IN PROGRESS
- ; This is used by functions such as PPLADD^PSOSUPOE to determine if
- ; a label should be printed (we do not want a label for the conditions)
- ;
- ; Incoming Parameters:
- ; RX - Internal IEN of the Prescription File (required)
- ; FILL - Fill Number (optional, defaults to last fill if not passed in)
- ; Returns:
- ; 0 - None of the conditions exists
- ; 1 - One of the conditions above is met
- ;
- I '$G(RX) Q 0
- I $G(FILL)="" S FILL=$$LSTRFL^PSOBPSU1(RX)
- ;
- ; DUR or Refill Too Soon or RRR rejects
- I $$FIND^PSOREJUT(RX,FILL,"","79,88,943",,1) Q 1
- ;
- ; If not TRICARE/CHAMPVA, quit with 0 as the rest of the checks
- ; are all TRICARE/CHAMPVA dependent
- I '$$TRIC^PSOREJP1(RX,FILL) Q 0
- ;
- ; No label for TRICARE/CHAMPVA with unresolved rejects
- I $$FIND^PSOREJUT(RX,FILL,,,1) Q 1 ; 5th parameter to $$FIND also finds non-billable TRI/CVA rejects
- ;
- ;No label for TRICARE/CHAMPVA claims that are IN PROGRESS
- I $P($$STATUS^PSOBPSUT(RX,FILL),U)="IN PROGRESS" Q 1
- Q 0
- ;
- DVINFO(RX,RFL,LM) ; Returns header displayable Division Information
- ;Input: (r) RX - Rx IEN (#52)
- ; (o) RFL - Refill # (Default: most recent)
- ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
- N DVIEN,DVINFO,NCPNPI,TXT
- S DVIEN=+$$RXSITE^PSOBPSUT(RX,RFL)
- S DVINFO="Division : "_$$GET1^DIQ(59,DVIEN,.01)
- ;
- ; Check for Controlled Substance Drug and if a BPS Pharmacy for CS has
- ; been defined. If so, use NCPDP# & NPI for the CS Pharmacy.
- S NCPNPI=$$CSNPI^BPSUTIL(RX,RFL)
- ;
- ; If not a Controlled Substance, use NCPDP# & NPI info based on Division.
- ; Display both NPI and NCPDP numbers - PSO*7.0*421
- I +NCPNPI=-1 S NCPNPI=$$DIVNCPDP^BPSBUTL(DVIEN)
- S $E(DVINFO,33)="NPI: "_$P(NCPNPI,U,2)
- S $E(DVINFO,$S($G(LM):59,1:52))="NCPDP: "_$P(NCPNPI,U)
- Q DVINFO
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREJU3 16573 printed Feb 19, 2025@00:00:05 Page 2
- PSOREJU3 ;BIRM/LJE - BPS (ECME) - Clinical Rejects Utilities (3) ;04/25/08
- +1 ;;7.0;OUTPATIENT PHARMACY;**287,290,358,359,385,421,427,448,478,513,482,528,561,562,680,704**;DEC 1997;Build 16
- +2 ; Reference to 9002313.99 in ICR #4305
- +3 ; Reference to $$CLAIM^BPSBUTL in ICR #4719
- +4 ; Reference to LOG^BPSOSL in ICR #6764
- +5 ; Reference to IEN59^BPSOSRX in ICR #4412
- +6 ; Reference to $$CSNPI^BPSUTIL in ICR #4146
- +7 ;
- +8 QUIT
- +9 ;
- TRICCHK(RX,RFL,RESP,FROM,RVTX) ;check to see if Rx is non-billable or in an "In Progress" state on ECME
- +1 ; Input: (r) RX - Rx IEN (#52)
- +2 ; (r) RFL - REFILL
- +3 ; (o) RESP - Response from $$EN^BPSNCPDP api
- +4 ; TRICCHK assumes that the calling routine has validated that the fill is TRICARE or CHAMPVA.
- +5 ;
- +6 ; - \Need to be mindful of foreground and background processing.
- +7 ;
- +8 NEW ESTAT,ETOUT,NFROM,PSOBEI
- +9 IF '$DATA(FROM)
- SET FROM=""
- +10 SET ESTAT=$PIECE(RESP,"^",4)
- +11 SET NFROM=0
- +12 IF FROM="PL"!(FROM="PC")
- SET NFROM=1
- +13 if ESTAT["PAYABLE"!(ESTAT["REJECTED")
- QUIT
- +14 SET PSOBEI=$$ELIGDISP^PSOREJP1(RX,RFL)
- +15 ;
- +16 ; ICR#s 4412,6764
- DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRICCHK, RESP="_RESP)
- +17 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRICCHK, FROM="_FROM_" ESTAT="_ESTAT)
- +18 ; ICR#s 4412,6764
- IF ESTAT["IN PROGRESS"
- IF FROM="PC"
- DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-Would have noted in Activity Log that Rx was left in CMOP suspense")
- QUIT
- +19 ;
- +20 IF ESTAT["IN PROGRESS"
- IF FROM="RRL"!($GET(RVTX)="RX RELEASE-NDC CHANGE")
- Begin DoDot:1
- +21 IF 'NFROM
- Begin DoDot:2
- +22 WRITE !!,PSOBEI_" Prescription "_$$GET1^DIQ(52,RX,".01")_" cannot be released until ECME 'IN PROGRESS'"
- +23 WRITE !,"status is resolved payable.",!!
- End DoDot:2
- End DoDot:1
- QUIT
- +24 ;
- +25 IF $DATA(RESP)
- Begin DoDot:1
- +26 IF +RESP=6
- if 'NFROM&('$GET(CMOP))
- WRITE !!,"Inactive ECME "_PSOBEI,!!
- Begin DoDot:2
- +27 SET ACT="Inactive ECME "_PSOBEI
- DO RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
- End DoDot:2
- QUIT
- +28 IF +RESP=2!(+RESP=3)
- NEW PSONBILL
- SET PSONBILL=1
- DO TRIC2
- QUIT
- +29 IF +RESP=4!(ESTAT["IN PROGRESS")
- Begin DoDot:2
- +30 ;
- +31 ; Do not put the Rx into the suspense queue if this claim activity
- +32 ; was triggered by a release message from OPAI or CMOP.
- +33 ;
- +34 IF $EXTRACT(FROM,1,2)="CR"
- QUIT
- +35 ;
- +36 ; Put the Rx into the suspense queue.
- +37 ;
- +38 NEW PSONPROG
- SET PSONPROG=1
- DO TRIC2
- End DoDot:2
- QUIT
- End DoDot:1
- QUIT
- +39 ;
- +40 QUIT
- +41 ;
- TRIC2 ;
- +1 NEW ACTION,DA,DIR,DIRUT,PSCAN,PSOIT,PSORESP,PSOTRIC
- +2 NEW REA,REJ,REJCOD,REJDATA,X,ZZZ
- +3 SET PSOTRIC=1
- SET REJ=9999999999
- +4 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRIC2, CMOP="_$GET(CMOP)_" PSONPROG="_$GET(PSONPROG))
- +5 IF $GET(CMOP)&($GET(PSONPROG))
- DO TACT
- QUIT
- +6 ;
- +7 ; If the prescription is non-billable, put the eT/eC reject on the
- +8 ; Prescription (WRKLST^PSOREJU4), then determine the reject number.
- +9 ;
- +10 IF +RESP=2
- Begin DoDot:1
- +11 DO WRKLST^PSOREJU4(RX,RFL,,DUZ,DT,1,"",RESP)
- +12 SET X=$$FIND^PSOREJUT(RX,RFL,.REJDATA,"eT,eC",1)
- +13 SET REJ=0
- +14 FOR
- SET REJ=$ORDER(REJDATA(REJ))
- if 'REJ
- QUIT
- IF "eT,eC"[REJDATA(REJ,"CODE")
- QUIT
- +15 QUIT
- End DoDot:1
- +16 ;
- +17 if $GET(CMOP)
- QUIT
- +18 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRIC2, NFROM="_NFROM)
- +19 IF 'NFROM
- DO DISPLAY(RX,REJ)
- +20 IF 'NFROM&($GET(PSONPROG))
- Begin DoDot:1
- +21 WRITE !!,"This prescription will be suspended. After the third party claim is resolved,"
- +22 WRITE !,"it may be printed or pulled early from suspense.",!
- +23 READ !!,"Press <RETURN> to continue...",ZZZ:60,!
- End DoDot:1
- DO SUSP
- QUIT
- +24 IF NFROM&($GET(PSONPROG))
- DO TACT
- QUIT
- +25 if NFROM
- QUIT
- TRIC3 ;
- +1 DO MSG
- +2 IF FROM="PL"!(FROM="PC")
- DO SUSP
- QUIT
- +3 ;cnf, PSO*7*358, add code for options
- +4 NEW ACTION,COM,DEF,DIR,DIRUT,OPTS
- TRIC4 SET DIR(0)="SO^"
- SET DIR("A")=""
- SET OPTS="DQ"
- SET DEF="D"
- +1 SET PSORESP=$PIECE($GET(RESP),U,2)
- +2 ;IB routine IBNCPDP1 contains this text.
- IF PSORESP["NO ACTIVE/VALID ROI"
- SET DEF="Q"
- +3 IF PSORESP="NOT INSURED"
- SET DEF="Q"
- +4 ;reference to ^XUSEC( supported by IA 10076
- +5 ;PSO*7.0*358, if user has security key, include IGNORE in TRICARE/CHAMPVA options
- IF $DATA(^XUSEC("PSO TRICARE/CHAMPVA",DUZ))
- SET OPTS=OPTS_"I"
- +6 if (OPTS["D")
- SET DIR(0)=DIR(0)_"D:(D)iscontinue - DO NOT FILL PRESCRIPTION;"
- SET DIR("A")=DIR("A")_"(D)iscontinue,"
- +7 if (OPTS["Q")
- SET DIR(0)=DIR(0)_"Q:(Q)UIT - SEND TO WORKLIST (REQUIRES INTERVENTION);"
- SET DIR("A")=DIR("A")_"(Q)uit,"
- +8 if (OPTS["I")
- SET DIR(0)=DIR(0)_"I:(I)GNORE - FILL Rx WITHOUT CLAIM SUBMISSION;"
- SET DIR("A")=DIR("A")_"(I)gnore,"
- +9 SET $EXTRACT(DIR(0),$LENGTH(DIR(0)))=""
- SET $EXTRACT(DIR("A"),$LENGTH(DIR("A")))=""
- SET DIR("??")="^D HELP^PSOREJU2("""_OPTS_""")"
- +10 if $GET(DEF)'=""
- SET DIR("B")=DEF
- DO ^DIR
- IF $DATA(DIRUT)
- SET Y="Q"
- WRITE !
- +11 ;
- +12 SET ACTION=Y
- +13 ;cnf, PSO*7*358
- IF ACTION="D"
- SET ACTION=$$DC^PSOREJU1(RX,ACTION)
- +14 SET PSOIT=""
- +15 IF ACTION="I"
- SET PSOIT=$$IGNORE^PSOREJU1(RX,RFL)
- +16 IF $PIECE(PSOIT,"^")=0
- Begin DoDot:1
- +17 IF $PIECE(PSOIT,"^",2)'=""
- Begin DoDot:2
- +18 WRITE $CHAR(7),!,"Gross Amount Due is $"_$PIECE(PSOIT,"^",2)_". IGNORE requires EPHARMACY SITE MANAGER key."
- End DoDot:2
- End DoDot:1
- GOTO TRIC4
- +19 IF ACTION="I"
- if '$$CONT^PSOREJU1()
- GOTO TRIC4
- SET COM=$$TCOM^PSOREJP3(RX,RFL)
- if COM="^"
- GOTO TRIC4
- if '$$SIG^PSOREJU1()
- GOTO TRIC4
- Begin DoDot:1
- +20 ;TRICARE/CHAMPVA non-billable should have only 1 reject - eT/eC
- DO CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,6,COM,"","","","","",1)
- +21 DO AUDIT^PSOTRI(RX,RFL,,COM,$SELECT($$PSOETEC^PSOREJP5(RX,RFL):"N",1:"R"),$PIECE(RESP,"^",3))
- End DoDot:1
- +22 QUIT
- +23 ;
- MSG ;
- +1 ;cnf, PSO*7*358
- WRITE !!,"This is a non-billable "_$$ELIGDISP^PSOREJP1(RX,RFL)_" prescription."
- +2 QUIT
- SUSP ;Suspense Rx due to IN PROGRESS status in ECME
- +1 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-SUSP")
- +2 NEW DA,ACT,RX0,SD,RXS,PSOWFLG,DIK,RXN,XFLAG,RXP,DD,DO,X,Y,DIC,VALMSG,COMM,LFD,DFLG,RXCMOP
- +3 NEW PSOQFLAG,PSORXZD,PSOQFLAG,PSOKSPPL,PSOZXPPL,PSOZXPI,RXLTOP
- +4 SET DA=RX
- DO SUS^PSORXL1
- TACT ;
- +1 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TACT, PSONPROG="_$GET(PSONPROG)_" PSONBILL="_$GET(PSONBILL))
- +2 SET ACT=$$ELIGDISP^PSOREJP1(RX,RFL)_"-Rx placed on Suspense due to"_$SELECT($GET(PSONPROG):" ECME IN PROGRESS status",$GET(PSONBILL):"the Rx being Non-billable",1:"")
- +3 IF '$GET(DUZ)
- NEW DUZ
- SET DUZ=.5
- +4 DO RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
- +5 QUIT
- +6 ;
- DISPLAY(RX,REJ,KEY,RRR) ; - Displays REJECT information
- +1 ; Input: (r) RX - Rx IEN (#52)
- +2 ; (r) REJ - REJECT ID (IEN)
- +3 ; (o) KEY - Display "Press any KEY to continue..." (1-YES/0-NO) (Default: 0)
- +4 ; (o) RRR - Reject Resolution Required information Flag(0/1)^Threshold Amt^Gross Amt Due (Default: 0)
- +5 ; If Flag = 0, there is no Reject Resolution Required reject code. Parameter added with PSO*421
- +6 ;
- +7 if $GET(NFROM)
- QUIT
- +8 IF '$GET(RX)!'$GET(REJ)
- QUIT
- +9 IF '$DATA(^PSRX(RX,"REJ",REJ))&('$GET(PSONBILL))&('$GET(PSONPROG))
- QUIT
- +10 ;
- +11 NEW DATA,PTINFO,RFL,LINE,%
- +12 SET RFL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- +13 IF '$GET(PSONBILL)&('$GET(PSONPROG))
- DO GET^PSOREJU2(RX,RFL,.DATA,REJ)
- IF '$DATA(DATA(REJ))
- QUIT
- +14 ;
- +15 DO HDR
- +16 SET $PIECE(LINE,"-",74)=""
- WRITE !?3,LINE
- +17 WRITE !?3,$$DVINFO(RX,RFL)
- +18 SET PTINFO=$$PTINFO^PSOREJU2(RX)
- +19 WRITE !?3,$PIECE(PTINFO,U,1)
- +20 WRITE !?3,$PIECE(PTINFO,U,2)
- +21 WRITE !?3,"Rx/Drug : ",$$GET1^DIQ(52,RX,.01),"/",RFL," - ",$EXTRACT($$GET1^DIQ(52,RX,6),1,20),?54
- +22 if '$GET(PSONBILL)&('$GET(PSONPROG))
- WRITE "ECME#: ",$PIECE($$CLAIM^BPSBUTL(RX,RFL),U,6)
- +23 DO TYPE
- if $GET(PSONBILL)!($GET(PSONPROG))
- GOTO DISP2
- +24 IF $GET(DATA(REJ,"PAYER MESSAGE"))'=""
- WRITE !?3,"Payer Message: "
- DO PRT^PSOREJU2("PAYER MESSAGE",18,58)
- +25 IF $GET(DATA(REJ,"DUR TEXT"))'=""
- WRITE !?3,"DUR Text : ",DATA(REJ,"DUR TEXT")
- +26 WRITE !?3,"Insurance : ",DATA(REJ,"INSURANCE NAME"),?50,"Contact: ",DATA(REJ,"PLAN CONTACT")
- +27 WRITE !?3,"Group Name : ",$EXTRACT(DATA(REJ,"GROUP NAME"),1,26)
- +28 WRITE ?45,"Group Number: ",$EXTRACT(DATA(REJ,"GROUP NUMBER"),1,15)
- +29 IF $GET(DATA(REJ,"CARDHOLDER ID"))'=""
- WRITE !?3,"Cardholder ID: ",$EXTRACT(DATA(REJ,"CARDHOLDER ID"),1,20)
- +30 IF DATA(REJ,"PLAN PREVIOUS FILL DATE")'=""
- Begin DoDot:1
- +31 WRITE !?3,"Last Fill Dt.: ",DATA(REJ,"PLAN PREVIOUS FILL DATE")
- +32 if DATA(REJ,"PLAN PREVIOUS FILL DATE")'=""
- WRITE " (from payer)"
- End DoDot:1
- +33 ;
- +34 NEW PSOAR,PSOCNT,PSOCOMMENT,PSODATA,PSODATE,PSODATE1
- +35 NEW PSODFN,PSOPC,PSOSTATUS,PSOSTR,PSOUSER
- +36 ;
- +37 ; Get Patient ID
- +38 SET PSODFN=$$GET1^DIQ(52,RX,2,"I")
- +39 ;
- +40 ; Loop through Patient Comments - Add ACTIVE Comments to PSOAR array
- +41 SET PSODATE=""
- +42 SET PSOCNT=0
- +43 KILL PSOAR
- +44 FOR
- SET PSODATE=$ORDER(^PS(55,PSODFN,"PC","B",PSODATE))
- if PSODATE=""
- QUIT
- Begin DoDot:1
- +45 SET PSOPC=""
- +46 FOR
- SET PSOPC=$ORDER(^PS(55,PSODFN,"PC","B",PSODATE,PSOPC))
- if PSOPC=""
- QUIT
- Begin DoDot:2
- +47 KILL PSODATA
- +48 DO GETS^DIQ(55.17,PSOPC_","_PSODFN_",",".01;1;2;3","IE","PSODATA")
- +49 ;
- +50 ; Only display ACTIVE Patient Comments
- +51 SET PSOSTATUS=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",2,"I"))
- +52 IF PSOSTATUS'="Y"
- QUIT
- +53 ;
- +54 SET PSODATE1=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",.01,"E"))
- +55 SET PSOUSER=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",1,"E"))
- +56 SET PSOCOMMENT=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",3,"E"))
- +57 SET PSOSTR=PSODATE1_" - "_PSOCOMMENT_" ("_PSOUSER_")"
- +58 SET PSOCNT=PSOCNT+1
- +59 SET PSOAR(PSOCNT)=PSOSTR
- End DoDot:2
- End DoDot:1
- +60 ;
- +61 ; If PSOAR array exists, display Active Patient Comments
- +62 IF $DATA(PSOAR)
- Begin DoDot:1
- +63 WRITE !?3,"Patient Billing Comment(s):"
- +64 ;
- +65 ; Loop through PSOAR in reverse order to display Patient
- +66 ; Comments in reverse chronological order
- +67 SET PSOCNT=""
- +68 FOR
- SET PSOCNT=$ORDER(PSOAR(PSOCNT),-1)
- if PSOCNT=""
- QUIT
- Begin DoDot:2
- +69 ;
- +70 ; Use ^DIWP to display Patient Comments with proper
- +71 ; line breaking
- +72 NEW %,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,I,Z
- +73 KILL ^UTILITY($JOB,"W")
- +74 SET X=PSOAR(PSOCNT)
- +75 SET DIWL=1
- +76 SET DIWR=78
- +77 DO ^DIWP
- +78 ;
- +79 SET PSOLAST=0
- +80 FOR PSOY=1:1
- if ('$DATA(^UTILITY($JOB,"W",1,PSOY,0)))
- QUIT
- Begin DoDot:3
- +81 SET PSOCOM=$GET(^UTILITY($JOB,"W",1,PSOY,0))
- +82 WRITE !?3,PSOCOM
- End DoDot:3
- End DoDot:2
- +83 KILL ^UTILITY($JOB,"W")
- End DoDot:1
- +84 ;
- +85 ;added with PSO*421
- IF $GET(RRR)
- Begin DoDot:1
- +86 WRITE !!?3,"Reject Resolution Required"
- +87 WRITE !?3,"Gross Amount Due ($"_$JUSTIFY($PIECE(RRR,U,3)*100\1/100,0,2)_") is greater than or equal to"
- +88 WRITE !?3,"Threshold Dollar Amount ($"_$PIECE(RRR,U,2)_")"
- +89 WRITE !?3,"Please select Quit to resolve this reject on the Reject Worklist."
- End DoDot:1
- DISP2 ;
- +1 WRITE !?3,LINE,$CHAR(7)
- IF $GET(KEY)
- WRITE !?3,"Press <RETURN> to continue..."
- READ %:DTIME
- WRITE !
- +2 QUIT
- +3 ;
- TYPE ;
- +1 IF $GET(PSONBILL)!($GET(PSONPROG))
- Begin DoDot:1
- +2 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +3 WRITE !?3,"Date/Time: "_$$FMTE^XLFDT(Y)
- +4 WRITE !?3,"Reason : ",$SELECT($GET(PSONBILL):"Not Billable.",$GET(PSONPROG):"ECME Status is in an 'IN PROGRESS' state and cannot be filled",1:"")
- End DoDot:1
- QUIT
- +5 ;
- +6 IF $GET(DATA(REJ,"REASON"))'=""
- WRITE !?3,"Reason : "
- DO PRT^PSOREJU2("REASON",14,62)
- +7 NEW RTXT,OCODE,OTXT,I
- +8 SET (OTXT,RTXT,OCODE)=""
- SET RTXT=$SELECT(DATA(REJ,"CODE")=79:"REFILL TOO SOON",DATA(REJ,"CODE")=88!(DATA(REJ,"CODE")=943):"DUR REJECT",1:$$EXP^PSOREJP1(DATA(REJ,"CODE")))_" ("_DATA(REJ,"CODE")_")"
- +9 FOR I=1:1
- SET OCODE=$PIECE(DATA(REJ,"OTHER REJECTS"),",",I)
- if OCODE=""
- QUIT
- Begin DoDot:1
- +10 SET OTXT=OTXT_", "_$SELECT(OCODE=79:"REFILL TOO SOON",OCODE=88!(OCODE=943):"DUR REJECT",1:$$EXP^PSOREJP1(OCODE))_" ("_OCODE_")"
- End DoDot:1
- +11 SET RTXT=RTXT_OTXT_". Received on "_$$FMTE^XLFDT($GET(DATA(REJ,"DATE/TIME")))_"."
- +12 SET OTXT=""
- +13 WRITE !?3,"Reject(s): "
- DO WRAP(RTXT,14)
- +14 QUIT
- +15 ;
- WRAP(PSOTXT,INDENT) ;
- +1 NEW I,K,PSOWRAP,PSOMARG
- +2 SET PSOWRAP=1
- SET PSOMARG=$SELECT('$GET(PSORM):80,$DATA(IOM):IOM,1:80)-(INDENT+5)
- W1 if $LENGTH(PSOTXT)<PSOMARG
- SET PSOWRAP(PSOWRAP)=PSOTXT
- IF $LENGTH(PSOTXT)'<PSOMARG
- FOR I=PSOMARG:-1:0
- IF $EXTRACT(PSOTXT,I)?1P
- SET PSOWRAP(PSOWRAP)=$EXTRACT(PSOTXT,1,I)
- SET PSOTXT=$EXTRACT(PSOTXT,I+1,999)
- SET PSOWRAP=PSOWRAP+1
- GOTO W1
- +1 FOR K=1:1:PSOWRAP
- WRITE ?INDENT,PSOWRAP(K),!
- +2 QUIT
- +3 ;
- HDR ; Display the reject notification screen header
- +1 NEW ELDSP,TAB
- +2 ; returns TRICARE, CHAMPVA or VETERAN
- SET ELDSP=$$ELIGTCV^PSOREJP1(RX,RFL,1)
- +3 ; Add the " - " for CVA/TRI only
- IF $LENGTH(ELDSP)
- SET ELDSP=ELDSP_" - "
- +4 ;
- +5 IF $GET(PSONBILL)
- SET TAB=$SELECT($LENGTH(ELDSP):24,1:29)
- WRITE !!?TAB,"*** "_ELDSP_"NON-BILLABLE ***"
- QUIT
- +6 IF $GET(PSONPROG)
- SET TAB=$SELECT($LENGTH(ELDSP):18,1:23)
- WRITE !!?TAB,"*** "_ELDSP_"'IN PROGRESS' ECME status ***"
- QUIT
- +7 SET TAB=$SELECT($LENGTH(ELDSP):11,1:16)
- WRITE !!?TAB,"*** "_ELDSP_"REJECT RECEIVED FROM THIRD PARTY PAYER ***"
- +8 QUIT
- +9 ;
- SUBMIT(RXIEN,RFCNT,PSOTRIC) ;called from PSOCAN2 (routine size exceeded)
- +1 NEW SUBMITE
- SET SUBMITE=$$SUBMIT^PSOBPSUT(RXIEN)
- +2 IF SUBMITE
- Begin DoDot:1
- +3 NEW ACTION
- +4 DO ECMESND^PSOBPSU1(RXIEN,,,$SELECT($ORDER(^PSRX(RXIEN,1,0)):"RF",1:"OF"))
- +5 ; Quit if there is an unresolved TRICARE or CHAMPVA non-billable reject code, PSO*7*358
- +6 IF $$PSOET^PSOREJP3(RXIEN)
- SET ACTION="Q"
- QUIT
- +7 IF $$FIND^PSOREJUT(RXIEN)
- SET ACTION=$$HDLG^PSOREJU1(RXIEN,,"79,88,943","OF","IOQ","Q")
- End DoDot:1
- +8 IF 'SUBMITE&(PSOTRIC)
- Begin DoDot:1
- +9 IF $$STATUS^PSOBPSUT(RXIEN,RFCNT'["PAYABLE")
- DO TRICCHK(RXIEN,RFCNT)
- End DoDot:1
- +10 QUIT
- +11 ;
- TRISTA(RX,RFL,RESP,FROM,RVTX) ;called from suspense
- +1 NEW ETOUT,ESTAT,TRESP,TSTAT,PSOTRIC
- +2 if '$DATA(RESP)
- SET RESP=""
- +3 SET (ESTAT,PSOTRIC)=""
- SET PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
- +4 if 'PSOTRIC
- QUIT 0
- +5 SET TRESP=RESP
- SET ESTAT=$PIECE(TRESP,"^",4)
- if ESTAT=""
- SET ESTAT=$$STATUS^PSOBPSUT(RX,RFL)
- +6 if ESTAT["E PAYABLE"
- QUIT 0
- +7 ;if TRICARE or CHAMPVA Rx is in audit due to override or bypass, allow to print from suspense, cnf
- IF $$TRIAUD(RX,RFL)
- Begin DoDot:1
- +8 ; ICR#s 4412,6764
- DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRISTA, $$TRIAUD returned 1, $$TRISTA is Quitting with 0")
- End DoDot:1
- QUIT 0
- +9 ;if 'Bypass' RX, allow to print from suspense, cnf
- IF +RESP=2
- IF $$BYPASS^PSOBPSU1($PIECE(RESP,"^",3),$PIECE(RESP,"^",2))
- Begin DoDot:1
- +10 ; ICR#s 4412,6764
- DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRISTA, $$BYPASS returned 1, $$TRISTA is Quitting with 0")
- End DoDot:1
- QUIT 0
- +11 ;rejected TRICARE or CHAMPVA is not allowed to print from suspense
- if ESTAT["E REJECTED"
- QUIT 1
- +12 ;if 'in progress' (4) or not billable (2,3) don't allow to print from suspense (IA 4415 Values)
- +13 IF '$DATA(RESP)!($PIECE(RESP,"^",1)="")!($GET(RESP)="")
- Begin DoDot:1
- +14 SET TSTAT=$$STATUS^PSOBPSUT(RX,RFL)
- SET TRESP=$SELECT(TSTAT["IN PROGRESS":4,TSTAT["NOT BILLABLE":2,1:0)
- +15 SET $PIECE(TRESP,"^",4)=TSTAT
- End DoDot:1
- +16 ;
- +17 IF +TRESP=2!(+TRESP=3)
- Begin DoDot:1
- +18 ;send TRICARE or CHAMPVA non billable to worklist (pseudo reject), cnf
- DO WRKLST^PSOREJU4(RX,RFL,"",DUZ,DT,1,"",RESP)
- +19 ; ICR#s 4412,6764
- DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRISTA, calling WRKLST~PSOREJU4, $$TRISTA is Quitting with 1")
- End DoDot:1
- QUIT 1
- +20 IF +TRESP=4!(ESTAT["IN PROGRESS")
- Begin DoDot:1
- +21 ; ICR#s 4412,6764
- DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-TRISTA, TRESP="_TRESP_", ESTAT="_ESTAT_", $$TRISTA is Quitting with 1")
- End DoDot:1
- QUIT 1
- +22 QUIT 0
- +23 ;
- TRIAUD(RXIEN,RXFILL) ;is RXIEN in the TRICARE/CHAMPVA audit and no open rejects ;cnf
- +1 ; RXIEN will only be in TRICARE/CHAMPVA audit if a bypass or override has occurred and rejects are closed
- +2 ; returns 0 if RXIEN is not in TRICARE/CHAMPVA audit at all or not in audit for right fill number
- +3 ; rejects must be closed for 0 to be returned
- +4 ; 1 if RXIEN is in TRICARE/CHAMPVA audit for the right fill number and rejects are closed
- +5 ;
- +6 NEW X,AUDIEN,REJIEN
- +7 SET X=0
- SET AUDIEN=""
- +8 ;RXIEN is not in the TRICARE/CHAMPVA audit
- IF '$DATA(^PS(52.87,"C",RXIEN))
- QUIT X
- +9 ;
- +10 ;Get latest fill if not passed in
- IF $GET(RXFILL)=""
- SET RXFILL=$$LSTRFL^PSOBPSU1(RXIEN)
- +11 ;
- +12 ;check audit entries for right fill number
- +13 FOR
- SET AUDIEN=$ORDER(^PS(52.87,"C",RXIEN,AUDIEN))
- if AUDIEN=""
- QUIT
- IF RXFILL=$$GET1^DIQ(52.87,AUDIEN,2)
- SET X=1
- QUIT
- +14 IF 'X
- QUIT X
- +15 ;
- +16 ;make sure rejects are closed
- +17 SET REJIEN=0
- +18 ;I 'X, then the reject is not closed
- FOR
- SET REJIEN=$ORDER(^PSRX(RXIEN,"REJ",REJIEN))
- if '+REJIEN
- QUIT
- Begin DoDot:1
- +19 SET X=$$CLOSED^PSOREJP1(RXIEN,REJIEN,0)
- End DoDot:1
- IF 'X
- QUIT
- +20 ;
- +21 QUIT X
- +22 ;
- ECMECHK(RX,FILL) ;
- +1 ; This function returns a '1' if any of the conditions below are met:
- +2 ; - RX has an unresolved DUR or Refill Too Soon reject
- +3 ; - RX has an unresolved Reject Resolution Required (RRR) reject (only for Veteran and original fill)
- +4 ; - RX is TRICARE/CHAMPVA and has any unresolved reject
- +5 ; - RX is TRICARE/CHAMPVA and IN PROGRESS
- +6 ; This is used by functions such as PPLADD^PSOSUPOE to determine if
- +7 ; a label should be printed (we do not want a label for the conditions)
- +8 ;
- +9 ; Incoming Parameters:
- +10 ; RX - Internal IEN of the Prescription File (required)
- +11 ; FILL - Fill Number (optional, defaults to last fill if not passed in)
- +12 ; Returns:
- +13 ; 0 - None of the conditions exists
- +14 ; 1 - One of the conditions above is met
- +15 ;
- +16 IF '$GET(RX)
- QUIT 0
- +17 IF $GET(FILL)=""
- SET FILL=$$LSTRFL^PSOBPSU1(RX)
- +18 ;
- +19 ; DUR or Refill Too Soon or RRR rejects
- +20 IF $$FIND^PSOREJUT(RX,FILL,"","79,88,943",,1)
- QUIT 1
- +21 ;
- +22 ; If not TRICARE/CHAMPVA, quit with 0 as the rest of the checks
- +23 ; are all TRICARE/CHAMPVA dependent
- +24 IF '$$TRIC^PSOREJP1(RX,FILL)
- QUIT 0
- +25 ;
- +26 ; No label for TRICARE/CHAMPVA with unresolved rejects
- +27 ; 5th parameter to $$FIND also finds non-billable TRI/CVA rejects
- IF $$FIND^PSOREJUT(RX,FILL,,,1)
- QUIT 1
- +28 ;
- +29 ;No label for TRICARE/CHAMPVA claims that are IN PROGRESS
- +30 IF $PIECE($$STATUS^PSOBPSUT(RX,FILL),U)="IN PROGRESS"
- QUIT 1
- +31 QUIT 0
- +32 ;
- DVINFO(RX,RFL,LM) ; Returns header displayable Division Information
- +1 ;Input: (r) RX - Rx IEN (#52)
- +2 ; (o) RFL - Refill # (Default: most recent)
- +3 ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
- +4 NEW DVIEN,DVINFO,NCPNPI,TXT
- +5 SET DVIEN=+$$RXSITE^PSOBPSUT(RX,RFL)
- +6 SET DVINFO="Division : "_$$GET1^DIQ(59,DVIEN,.01)
- +7 ;
- +8 ; Check for Controlled Substance Drug and if a BPS Pharmacy for CS has
- +9 ; been defined. If so, use NCPDP# & NPI for the CS Pharmacy.
- +10 SET NCPNPI=$$CSNPI^BPSUTIL(RX,RFL)
- +11 ;
- +12 ; If not a Controlled Substance, use NCPDP# & NPI info based on Division.
- +13 ; Display both NPI and NCPDP numbers - PSO*7.0*421
- +14 IF +NCPNPI=-1
- SET NCPNPI=$$DIVNCPDP^BPSBUTL(DVIEN)
- +15 SET $EXTRACT(DVINFO,33)="NPI: "_$PIECE(NCPNPI,U,2)
- +16 SET $EXTRACT(DVINFO,$SELECT($GET(LM):59,1:52))="NCPDP: "_$PIECE(NCPNPI,U)
- +17 QUIT DVINFO