227 lines
9.4 KiB
Mathematica
227 lines
9.4 KiB
Mathematica
PSOREJU1 ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities (1) ;10/15/04
|
|
;;7.0;OUTPATIENT PHARMACY;**148,247,260**;DEC 1997;Build 84
|
|
;Reference to File 9002313.21 - BPS NCPDP PROFESSIONAL SERVICE CODE supported by IA 4712
|
|
;Reference to File 9002313.22 - BPS NCPDP RESULT OF SERVICE CODE supported by IA 4713
|
|
;Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE supported by IA 4714
|
|
;Reference to File 200 - NEW PERSON supported by IA 10060
|
|
;Reference to SIG^XUSESIG supported by IA 10050
|
|
;
|
|
ACTION(RX,REJ,OPTS,DEF) ;
|
|
; Input: (r) RX - Rx IEN (#52)
|
|
; (r) REJ - REJECT ID (IEN)
|
|
; (r) OPTS - Available options ("QIO" for QUIT/IGNORE/OVERRIDE)
|
|
; (o) DEF - Default Option ("O", "I" or "Q")
|
|
; Output: ACTION: "I^Comments" - Ignore Reject
|
|
; "O^COD1^COD2^COD3" - Override with the Override codes COD1(Prof.),COD2(Reason) and COD3(Result)
|
|
; "Q" - Quit
|
|
; "^" - Up-arrow entered or timed out
|
|
;
|
|
N ACTION,COM,OVR,X,DIR,DIRUT,Y
|
|
;
|
|
I '$G(RX)!'$G(REJ) Q
|
|
I '$D(^PSRX(RX,"REJ",REJ)) Q
|
|
;
|
|
; - Display DUR/79 REJECT information
|
|
D DISPLAY(RX,REJ)
|
|
;
|
|
ASK K ACTION,DIR,DIRUT
|
|
S DIR(0)="SO^",DIR("A")=""
|
|
S:(OPTS["O") DIR(0)=DIR(0)_"O:(O)VERRIDE - RESUBMIT WITH OVERRIDE CODES;",DIR("A")=DIR("A")_"(O)verride,"
|
|
S:(OPTS["I") DIR(0)=DIR(0)_"I:(I)GNORE - FILL Rx WITHOUT CLAIM SUBMISSION;",DIR("A")=DIR("A")_"(I)gnore,"
|
|
S:(OPTS["Q") DIR(0)=DIR(0)_"Q:(Q)UIT - SEND TO WORKLIST (REQUIRES INTERVENTION);",DIR("A")=DIR("A")_"(Q)uit,"
|
|
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) W ! Q "Q"
|
|
;
|
|
; - STOP/QUIT Action
|
|
S ACTION=Y I ACTION="Q" Q ACTION
|
|
;
|
|
; - IGNORE Action
|
|
K DIR,DIRUT,X
|
|
I ACTION="I" S COM=$$COM() G ASK:COM="^" G ASK:'$$SIG() S ACTION=ACTION_"^"_COM
|
|
;
|
|
; - OVERRIDE Action
|
|
I ACTION="O" D G ASK:OVR="^"
|
|
. S OVR=$$OVR() S ACTION=ACTION_"^"_OVR
|
|
;
|
|
Q ACTION
|
|
;
|
|
SIG() ; - Get electronic signature
|
|
N CODE,X,X1,Y
|
|
S CODE=$P($G(^VA(200,DUZ,20)),U,4),Y=0 I '$L(CODE) D Q Y
|
|
. W $C(7),!,"You do not have an electronic signature code."
|
|
. W !,"Please contact your IRM office." H 2
|
|
D SIG^XUSESIG S Y=(X1'="")
|
|
Q Y
|
|
;
|
|
COM() ; - Ask for CLOSE comments
|
|
K COM,DIR,DIRUT,X
|
|
W ! S DIR(0)="F^3:100" S DIR("A")="Comments" D ^DIR
|
|
S COM=X I $D(DIRUT) S COM="^"
|
|
Q COM
|
|
;
|
|
OVR() ; - Ask for OVERRIDE codes
|
|
N COD1,COD2,COD3,DIR,DIRUT W !
|
|
S COD1=$$OVRCOD(1,$$GET1^DIQ(52.25,REJ_","_RX,14)) I COD1="^" Q "^"
|
|
S COD2=$$OVRCOD(2) I COD2="^" Q "^"
|
|
S COD3=$$OVRCOD(3) I COD3="^" Q "^"
|
|
;
|
|
D OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3) W !
|
|
;
|
|
S DIR(0)="Y",DIR("A")=" Confirm? ",DIR("B")="YES"
|
|
D ^DIR I $G(Y)=0!$D(DIRUT) Q "^"
|
|
;
|
|
Q (COD2_"^"_COD1_"^"_COD3)
|
|
;
|
|
OVRDSP(LST) ; - Display the Override Codes
|
|
N I W !
|
|
F I=1:1:3 D
|
|
. W !?5,$S(I=1:"Reason for Service Code : ",I=2:"Professional Service Code: ",1:"Result of Service Code : ")
|
|
. W $E($$OVRX(I,$P(LST,"^",I)),1,48)
|
|
Q
|
|
;
|
|
CLA() ; - Ask for Clarification Code
|
|
N DIR,Y,DIRUT,DIROUT
|
|
S DIR(0)="52.25,24",DIR("A")="Clarification Code" D ^DIR
|
|
I $D(DIRUT)!$D(DIROUT) Q "^"
|
|
Q Y
|
|
;
|
|
DISPLAY(RX,REJ,KEY) ; - 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)
|
|
;
|
|
I '$G(RX)!'$G(REJ) Q
|
|
I '$D(^PSRX(RX,"REJ",REJ)) Q
|
|
;
|
|
N DATA,RFL,LINE,%
|
|
S RFL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
|
|
D GET^PSOREJU2(RX,RFL,.DATA,REJ) I '$D(DATA(REJ)) Q
|
|
;
|
|
W !!?16,"*** REJECT RECEIVED FROM THIRD PARTY PAYER ***"
|
|
S $P(LINE,"-",74)="" W !?3,LINE
|
|
W !?3,$$DVINFO^PSOREJU2(RX,RFL)
|
|
W !?3,$$PTINFO^PSOREJU2(RX)
|
|
W !?3,"Prescription : ",$$GET1^DIQ(52,RX,.01),"/",RFL," - ",$E($$GET1^DIQ(52,RX,6),1,20),?54,"ECME#: ",$E(RX+10000000,2,8)
|
|
W !?3,"Reject Type : ",DATA(REJ,"CODE")," - ",$S(DATA(REJ,"CODE")=79:"REFILL TOO SOON",1:"DUR REJECT")
|
|
W " received on "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME")))
|
|
I $G(DATA(REJ,"PAYER MESSAGE"))'="" W !?3,"Payer Message: " D PRT^PSOREJU2("PAYER MESSAGE",18,58)
|
|
I $G(DATA(REJ,"REASON"))'="" W !?3,"Reason : " D PRT^PSOREJU2("REASON",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 : ",DATA(REJ,"GROUP NAME"),?45,"Group Number: ",DATA(REJ,"GROUP NUMBER")
|
|
I $G(DATA(REJ,"CARDHOLDER ID"))'="" W !?3,"Cardholder ID: ",DATA(REJ,"CARDHOLDER ID")
|
|
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)"
|
|
W !?3,LINE,$C(7) I $G(KEY) W !?3,"Press <RETURN> to continue..." R %:DTIME W !
|
|
Q
|
|
;
|
|
HDLG(RX,RFL,CODES,FROM,OPTS,DEF) ; - REJECT Handling
|
|
;Input: (r) RX - Rx IEN (#52)
|
|
; (o) RFL - Refill # (Default: most recent)
|
|
; (r) CODES - List of REJECT CODES to be handled separated by commas (e.g. "79,88")
|
|
; (r) FROM - Same values as BWHERE param. in the EN^BPSNCPDP api
|
|
; (r) OPTS - Available options ("IOQ" for IGNORE/OVERRIDE/QUIT)
|
|
; (o) DEF - Default Option ("O", "I" or "Q")
|
|
;Output: ACTION - "O"-Override, "I"-Ignore,"Q"-Quit,"^"-Up-arrow entered
|
|
;
|
|
N REJDATA,NEWDATA,CODE,ACTION,REJ,RESP,REJCDI S CODE=""
|
|
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
|
|
F REJCDI=1:1 S CODE=$P(CODES,",",REJCDI) Q:CODE="" D I ACTION="Q"!(ACTION="^") Q
|
|
. S ACTION=""
|
|
. I $$FIND^PSOREJUT(RX,RFL,.REJDATA,CODE) D
|
|
. . S REJ=$O(REJDATA(""))
|
|
. . S ACTION=$$ACTION(RX,REJ,OPTS,$G(DEF)) I ACTION="Q"!(ACTION="^") Q
|
|
. . I $P(ACTION,"^")="I" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,6,$P(ACTION,"^",2)) Q
|
|
. . I $P(ACTION,"^")="O" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,1,,$P(ACTION,"^",3),$P(ACTION,"^",2),$P(ACTION,"^",4))
|
|
. . D ECMESND^PSOBPSU1(RX,RFL,,FROM,$$GETNDC^PSONDCUT(RX,RFL),,,$P(ACTION,"^",2,4),,.RESP)
|
|
. . I $G(RESP) D Q
|
|
. . . W !!?10,"Claim could not be submitted. Please try again later!"
|
|
. . . W !,?10,"Reason: ",$S($P(RESP,"^",2)="":"UNKNOWN",1:$P(RESP,"^",2)),$C(7)
|
|
. . K NEWDATA I $$FIND^PSOREJUT(RX,RFL,.NEWDATA,CODE) D I ACTION="Q"!(ACTION="^") Q
|
|
. . . S ACTION=$$ACTION(RX,$O(NEWDATA("")),OPTS,$G(DEF)) I ACTION="Q"!(ACTION="^") Q
|
|
. . . I $P(ACTION,"^")="I" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,6,$P(ACTION,"^",2))
|
|
. . . I $P(ACTION,"^")="O" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,1,,$P(ACTION,"^",3),$P(ACTION,"^",2),$P(ACTION,"^",4))
|
|
Q ACTION
|
|
;
|
|
OVRX(TYPE,CODE) ; - Returns the extentend code/description of the NCPDP DUR override codes
|
|
; Input: (r) TYPE - 1 (REASON FOR SERVICE), 2 (PROFESSIONAL SERVICE) or 3 (RESULT OF SERVICE)
|
|
; (r) CODE - Table IEN
|
|
; Output: "CODE - DESCRIPTION"
|
|
N FILE,DIC,X,Y
|
|
S FILE=9002313+$S(TYPE=1:.23,TYPE=2:.21,1:.22)
|
|
S DIC=FILE,X=CODE D ^DIC
|
|
I TYPE=1 Q CODE_" - "_$$GET1^DIQ(9002313.23,+Y,1)
|
|
I TYPE=2 Q CODE_" - "_$$GET1^DIQ(9002313.21,+Y,1)
|
|
I TYPE=3 Q CODE_" - "_$$GET1^DIQ(9002313.22,+Y,1)
|
|
Q ""
|
|
;
|
|
;
|
|
OVRCOD(TYPE,VALUE) ; - Prompt for NCPDP Override Codes
|
|
N DIC,X,Y,FILE,PRPT
|
|
;
|
|
I TYPE=1 S FILE=9002313.23,PRPT="Reason for Service Code : "
|
|
I TYPE=2 S FILE=9002313.21,PRPT="Professional Service Code: "
|
|
I TYPE=3 S FILE=9002313.22,PRPT="Result of Service Code : "
|
|
S DIC=FILE,DIC(0)="Z"
|
|
I $G(VALUE)'="" S X=VALUE D ^DIC I Y>0 W !,PRPT,VALUE," ",$P(Y(0),"^",2) Q VALUE
|
|
S DIC=FILE,DIC(0)="AQE",DIC("A")=PRPT
|
|
D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) Q "^"
|
|
Q $P(Y,"^",2)
|
|
;
|
|
SEL(FIELD,FILE,ARRAY,DEFAULT) ; - Provides field selection (one, multiple or ALL)
|
|
N DIC,DTOUT,DUOUT,QT,Y,X
|
|
W !!,"You may select a single or multiple "_FIELD_"S,"
|
|
W !,"or enter ^ALL to select all "_FIELD_"S.",!
|
|
K ARRAY S DIC=FILE,DIC(0)="QEZAM",DIC("A")=FIELD_": "
|
|
I $G(DEFAULT)'="" S DIC("B")=DEFAULT
|
|
F D ^DIC Q:X="" D Q:$G(QT)
|
|
. I $$UP^XLFSTR(X)="^ALL" K ARRAY S ARRAY="ALL",QT=1 Q
|
|
. I $D(DTOUT)!$D(DUOUT) K ARRAY S ARRAY="^",QT=1 Q
|
|
. W " ",$P(Y,"^",2),$S($D(ARRAY(+Y)):" (already selected)",1:"")
|
|
. W ! S ARRAY(+Y)="",DIC("A")="ANOTHER ONE: " K DIC("B")
|
|
I '$D(ARRAY) S ARRAY="^"
|
|
Q
|
|
;
|
|
LMREJ(RX,RFL,MSG,BCK) ; Used by ListManager hidden actions to detect unresolved 3rd Party Rejects
|
|
;Input: (r) RX - Rx IEN (#52)
|
|
; (o) RFL - Refill # (Default: most recent)
|
|
;Output: (o) MSG - Usually this will be used to set VALMSG variable, which shoud be passed in by ref.
|
|
; (o) BCK - This will be used to set VALMBCK variable, which shoud be passed in by ref.
|
|
;
|
|
I '$D(^PSRX(+RX)) Q 0
|
|
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
|
|
I $$FIND^PSOREJUT(RX,RFL) D Q 1
|
|
. S MSG="NOT ALLOWED! Rx has OPEN 3rd Party Payer Reject.",BCK="R" W $C(7),$C(7)
|
|
Q 0
|
|
;
|
|
DUP(RX,RSP) ; Checks if REJECT has already been logged in the PRESCRIPTION file
|
|
; Input: (r) RX - Rx IEN (#52)
|
|
; (o) RSP - Response IEN
|
|
; Output: DUP - 1: Already logged (duplicate)
|
|
; 0: Not yet logged on PRESCRIPTION file
|
|
N DUP,IDX S (DUP,IDX)=0
|
|
F S IDX=$O(^PSRX(RX,"REJ",IDX)) Q:'IDX D Q:DUP
|
|
. I +RSP=+$$GET1^DIQ(52.25,IDX_","_RX,16,"I") S DUP=1
|
|
Q DUP
|
|
;
|
|
OTH(CODE,LST) ; Removes the current Reject code from the list
|
|
; Input: (r) CODE - Current Reject Code (79 or 88)
|
|
; (o) LST - List of all Reject codes with response (comma separated)
|
|
; Output: OTH - List of OTHER Reject codes (w/out 79 or 88)
|
|
;
|
|
N I,OTH
|
|
F I=1:1:$L(LST,",") D
|
|
. I $P(LST,",",I),$P(LST,",",I)'=CODE S OTH=$G(OTH)_","_$P(LST,",",I)
|
|
S $E(OTH)=""
|
|
Q OTH
|
|
;
|
|
DAT(DAT) ; - External Date
|
|
S X=$$HL7TFM^XLFDT(DAT) I X<0 Q ""
|
|
Q X
|
|
;
|
|
CLEAN(STR) ; Remove blanks from the end of a string and replaces ";" with ","
|
|
N LEN F LEN=$L(STR):-1:1 Q:$E(STR,LEN)'=" "
|
|
S STR=$TR(STR,";",",")
|
|
Q $E(STR,1,LEN)
|