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

PSOREJU3.m

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