PSOREJP0 ;BIRM/MFR - Third Party Rejects Processing Screen ;04/28/05
;;7.0;OUTPATIENT PHARMACY;**148,260,287,289**;DEC 1997;Build 107
;
N PSOREJST,PSORJSRT,PSORJASC,PSOSTFLT,PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSOINGRP,PSOTRITG
N INSLN,HIGHLN,LASTLN,PSOEKEY
;
; - Division/Site selection
D SEL^PSOREJU1("DIVISION","^PS(59,",.PSOREJST,$$GET1^DIQ(59,+$G(PSOSITE),.01)) I $G(PSOREJST)="^" G EXIT
;
; - Initializing global variables
S PSORJSRT="PA",PSORJASC=1,PSOSTFLT="U",(PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT)="ALL"
S PSOINGRP=0,PSOTRITG=1
;
D LST("W")
G EXIT
;
LST(PSOMENU) ; - Invokes Listmanager
W !,"Please wait..."
I PSOMENU="W" D EN^VALM("PSO REJECTS WORKLIST")
I PSOMENU="VP" D EN^VALM("PSO REJECTS VIEW/PROCESS")
D FULL^VALM1
Q
;
HDR ; - Header code
N LINE1,LINE2,LINE3
S LINE1=$$SITES() I $L(LINE1)>80 S $E(LINE1,78,999)="..."
;
S LINE2="Selection : ALL "_$S(PSOSTFLT="U":"UNRESOLVED ",PSOSTFLT="R":"RESOLVED ",1:"")_"REJECTS"
I $G(PSOPTFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("P")
I $G(PSODRFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("D")
I $G(PSOINFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("I")
I $G(PSOINGRP) S LINE2=LINE2_" GROUPED BY INSURANCE"
S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2
I PSOMENU="VP" D
. I $G(PSORXFLT) S LINE3="Rx# : "_$$NAME("R")
. E D
. . S LINE3="Date Range: "_$$FMTE^XLFDT(+PSODTRNG,2)
. . I +PSODTRNG'=$P(PSODTRNG,"^",2) S LINE3=LINE3_" THRU "_$$FMTE^XLFDT($P(PSODTRNG,"^",2),2)
. S VALMHDR(3)=LINE3
;
D SETHDR()
Q
;
SETHDR() ; - Displays the Header Line
N HDR,ORD
;
S HDR=" #",$E(HDR,5)="Rx#",$E(HDR,18)="PATIENT(ID)",$E(HDR,43)="DRUG",$E(HDR,64)="REASON"
S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,$S(PSOMENU="W":4,1:5))
S ORD=$S(PSORJASC=1:"[^]",1:"[v]")
S:PSORJSRT="RX" POS=9 S:PSORJSRT="PA" POS=30 S:PSORJSRT="DR" POS=48 S:PSORJSRT="RE" POS=71
D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,$S(PSOMENU="W":4,1:5))
Q
;
INIT ; - Populates the Body section for ListMan
K ^TMP("PSOREJP0",$J)
D SETSORT(PSORJSRT),SETLINE
S VALMSG="Select the entry # to view or ?? for more actions"
Q
;
SETLINE ; - Sets the line to be displayed in ListMan
N INS,SUB,SEQ,SORTA,LINE,Z,I,X,X1,X2
I '$D(^TMP("PSOREJSR",$J)) D Q
. F I=1:1:7 S ^TMP("PSOREJP0",$J,I,0)=""
. S ^TMP("PSOREJP0",$J,8,0)=" No Clinical Third Party Payer Rejects found."
. S VALMCNT=1
;
F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
K INSLN,HIGHLN
;
S (SORTA,INS,SUB)="",LINE=0 K ^TMP("PSOREJP0",$J)
F S SORTA=$O(^TMP("PSOREJSR",$J,SORTA)) Q:SORTA="" D
. F S INS=$O(^TMP("PSOREJSR",$J,SORTA,INS)) Q:INS="" D
.. I INS'="<NULL>" D
... D GROUP(INS,.LINE)
.. F S SUB=$O(^TMP("PSOREJSR",$J,SORTA,INS,SUB),PSORJASC) Q:SUB="" D
... S Z=$G(^TMP("PSOREJSR",$J,SORTA,INS,SUB))
... S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3)
... S $E(X1,5)=$P(Z,"^",3),$E(X1,18)=$P(Z,"^",4),$E(X1,43)=$P(Z,"^",5),$E(X1,64)=$P(Z,"^",6)
... S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X1,HIGHLN(LINE)=""
... S X2="",$E(X2,5)="Payer Message: "_$P(Z,"^",7)
... S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X2
... S ^TMP("PSOREJP0",$J,SEQ,"RX")=$P(Z,"^",1,2)
;
I LINE>$G(LASTLN) D
. F I=($G(LASTLN)+1):1:LINE D SAVE^VALM10(I)
. S LASTLN=LINE
;
; - Highlighting the prescription/insurance line
F LN=1:1:LINE D
. I $D(HIGHLN(LN)) D Q
. . D CNTRL^VALM10(LN,1,80,IOINHI,IOINORM)
. . D CNTRL^VALM10(LN,64,3,IOUON,IOINORM)
. . D CNTRL^VALM10(LN,67,80,IOINHI,IOINORM)
. I $D(INSLN(LN)) D
. . S LBL=INSLN(LN),POS=41-($L(LBL)/2+.5\1)
. . D CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
. . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
. . D CNTRL^VALM10(LN,POS+$L(LBL),(81-POS-$L(LBL)),IOUON_IOINHI,IOINORM)
;
S VALMCNT=+$G(LINE)
Q
;
GROUP(LBL,LINE) ; Sets an insurance delimiter line
N X,POS
S POS=41-($L(LBL)/2+.5\1)
S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X,INSLN(LINE)=LBL
Q
;
SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified
N RX,REJ,STS,DAT
K ^TMP("PSOREJSR",$J)
;
; - Worklist
I PSOMENU="W" D
. S RX=0 F S RX=$O(^PSRX("REJSTS",0,RX)) Q:'RX D
. . S REJ=0 F S REJ=$O(^PSRX("REJSTS",0,RX,REJ)) Q:'REJ D
. . . D SETTMP(RX,REJ,FIELD)
;
; - View/Process
I PSOMENU="VP" D
. I $G(PSORXFLT)'="ALL" D Q
. . S REJ=0 F S REJ=$O(^PSRX(+PSORXFLT,"REJ",REJ)) Q:'REJ D
. . . I $$FLTSTS(+PSORXFLT,REJ) Q
. . . D SETTMP(+PSORXFLT,REJ,FIELD)
. S DAT=$P(PSODTRNG,"^")-0.0000001,(RX,REJ)=0
. F S DAT=$O(^PSRX("REJDAT",DAT)) Q:'DAT!(DAT>$$ENDT()) D
. . F S RX=$O(^PSRX("REJDAT",DAT,RX)) Q:'RX D
. . . I $$FILTER(RX) Q
. . . F S REJ=$O(^PSRX("REJDAT",DAT,RX,REJ)) Q:'REJ D
. . . . I $$FLTSTS(RX,REJ) Q
. . . . D SETTMP(RX,REJ,FIELD)
Q
;
SETTMP(RX,REJ,FIELD) ; - Sets ^TMP global that will be displayed in the body section
N REJLST,FILL,CODE,RXNUM,PTNAME,DRNAME,MSG,REASON,MSG,X,Z,SORT,I,INS,OREJ,PSOTRIC,SORTA
I $G(PSORXFLT)="ALL",$$CLOSED^PSOREJP1(RX,REJ),$$REOPN^PSOREJP1(RX,REJ) Q
S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5),SORTA=1
I '$$DIV(RX,FILL) Q
K REJLST D GET^PSOREJU2(RX,FILL,.REJLST,,1) I '$D(REJLST) Q
I $$FILTER(,REJLST(REJ,"INSURANCE NAME")) Q
S CODE=$G(REJLST(REJ,"CODE"))
S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC)
Q:$G(PSOTRIC)&('$G(PSOTRITG))&(CODE'="79")&(CODE'="88") ;show/hide non-DUR/RTS Tricare
S PTNAME=$$PTNAME(RX)
S DRNAME=$$GET1^DIQ(52,RX,6)
S RXNUM=$$GET1^DIQ(52,RX,.01)
S MSG=$G(REJLST(REJ,"PAYER MESSAGE")) I $L(MSG)>60 S MSG=$E(MSG,1,58)_"..."
S REASON=$S(CODE=88:"DUR:"_$G(REJLST(REJ,"REASON")),CODE=79:"79 :REFILL TOO SOON",1:CODE)
I CODE'=79&(CODE'=88) S REASON=CODE_" :"_$$EXP^PSOREJP1(CODE)
S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=REJ,$P(Z,"^",3)=RXNUM,$P(Z,"^",4)=PTNAME
S $P(Z,"^",5)=$E(DRNAME,1,20),$P(Z,"^",6)=$E(REASON,1,17),$P(Z,"^",7)=MSG
S SORT=$S(FIELD="PA":PTNAME,FIELD="DR":DRNAME,FIELD="RX":RXNUM_" ",1:REASON)_RX_REJ
S INS="<NULL>"
I $G(PSOINGRP) S INS=REJLST(REJ,"INSURANCE NAME") S:INS="" INS="***UNKNOWN***"
S:$G(PSOTRIC)&(CODE'=79)&(CODE'=88) INS="TRICARE"_" - Non-DUR/RTS",SORTA=2
S:'$G(PSOTRIC)&(CODE'=79)&(CODE'=88) INS="OTHER REJECTS",SORTA=3
S ^TMP("PSOREJSR",$J,SORTA,INS,SORT)=Z
Q
;
PAT ; - Sort by Patient
D SORT("PA")
Q
DRG ; - Sort by Drug
D SORT("DR")
Q
RX ; - Sort by Rx
D SORT("RX")
Q
REA ; - Sort by Reason
D SORT("RE")
Q
SORT(FIELD) ; - Sort entries by FIELD
I PSORJSRT=FIELD S PSORJASC=$S(PSORJASC=1:-1,1:1)
E S PSORJSRT=FIELD,PSORJASC=1
D REF
Q
;
REF ; - Screen Refresh
W ?52,"Please wait..." D INIT S VALMBCK="R"
Q
GI ; - Group by Insurance
W ?52,"Please wait..." S PSOINGRP=$S($G(PSOINGRP):0,1:1) D INIT,HDR S VALMBCK="R"
Q
TRICTOG ; - Toggle Tricare display
W ?52,"Please wait..." S PSOTRITG=$S($G(PSOTRITG):0,1:1) D INIT,HDR S VALMBCK="R"
Q
;
SEL ; - Process selection of one entry
N PSOSEL,XQORM,Z,RX,REJ,PSOCHNG
S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
S Z=$G(^TMP("PSOREJP0",$J,PSOSEL,"RX"))
S RX=$P(Z,"^"),REJ=$P(Z,"^",2) I 'RX!'REJ S VALMSG="Invalid selection!",VALMBCK="R" Q
S PSOCHNG=0 D EN^PSOREJP1(RX,REJ,.PSOCHNG) I $G(PSOCHNG) D REF
Q
;
EXIT ;
K ^TMP("PSOREJP0",$J),^TMP("PSOREJSR",$J)
Q
;
HELP Q
;
SITES() ; - Returns the list of sites along with their NCPDP #s
N CNT,SITE,SITES,NAME
I '$D(PSOREJST) Q ""
I $G(PSOREJST)="ALL" Q "Divisions : ALL"
S SITE=0 F S SITE=$O(PSOREJST(SITE)) Q:'SITE D
. S NAME=$$GET1^DIQ(59,SITE,.01)
. S SITES=$G(SITES)_", "_NAME
S $E(SITES,1,2)="",SITES="Division"_$S($L(SITES,",")>1:"s",1:" ")_" : "_SITES
Q SITES
;
DIV(RX,FILL) ; - Check if the Division for the Prescription/Fill was selected by the user
;
I $G(PSOREJST)="ALL" Q 1
I $D(PSOREJST($$RXSITE^PSOBPSUT(RX,FILL))) Q 1
Q 0
;
PTNAME(RX) ; - Returns header displayable - Patient Name (Last 4 SSN)
N DFN,VADM,PTNAME
S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT
S PTNAME=$E($G(VADM(1)),1,18)_"("_$P($P($G(VADM(2)),"^",2),"-",3)_")"
Q PTNAME
;
FILTER(RX,INS) ; - Filter entries based on user's selection
N FILTER,NAME
S FILTER=1
I $G(PSOPTFLT)'="ALL",$D(RX),'$D(PSOPTFLT($$GET1^DIQ(52,RX,2,"I"))) Q FILTER
I $G(PSODRFLT)'="ALL",$D(RX),'$D(PSODRFLT($$GET1^DIQ(52,RX,6,"I"))) Q FILTER
I $G(PSOINFLT)'="ALL",$D(INS) D Q FILTER
. S NAME="" F S NAME=$O(PSOINFLT(NAME)) Q:NAME="" I $$UP^XLFSTR(INS)[$$UP^XLFSTR(NAME) S FILTER=0 Q
Q 0
;
FLTSTS(RX,REJ) ; - Filter for the Reject Status
N STS
S STS=$$GET1^DIQ(52.25,REJ_","_RX,9,"I")
I PSOSTFLT="U",STS=1 Q 1
I PSOSTFLT="R",STS=0 Q 1
Q 0
;
NAME(TYPE) ; - Returns the name if ONE was selected or "MULTIPLE ..."
N I,CNT
;
I TYPE="P",$O(PSOPTFLT($O(PSOPTFLT(""))))="" Q $$GET1^DIQ(2,$O(PSOPTFLT("")),.01)
I TYPE="D",$O(PSODRFLT($O(PSODRFLT(""))))="" Q $$GET1^DIQ(50,$O(PSODRFLT("")),.01)
I TYPE="I",$O(PSOINFLT($O(PSOINFLT(""))))="" Q $O(PSOINFLT(""))
I TYPE="R" Q $$GET1^DIQ(52,PSORXFLT,.01)
Q "MULTIPLE "_$S(TYPE="P":"PATIENTS",TYPE="D":"DRUGS",1:"INSURANCE COMPANIES")
;
ENDT() ; Returns the upper limit for the date range
N ENDT
S ENDT=$P(PSODTRNG,"^",2)
I '$E(ENDT,4,7) Q (ENDT+10000)
I '$E(ENDT,6,7) Q (ENDT+100)
I $P(ENDT,"^",2) Q (ENDT+0.0000001)
Q (ENDT+.25)
PSOREJP0 ;BIRM/MFR - Third Party Rejects Processing Screen ;04/28/05
+1 ;;7.0;OUTPATIENT PHARMACY;**148,260,287,289**;DEC 1997;Build 107
+2 ;
+3 NEW PSOREJST,PSORJSRT,PSORJASC,PSOSTFLT,PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSOINGRP,PSOTRITG
+4 NEW INSLN,HIGHLN,LASTLN,PSOEKEY
+5 ;
+6 ; - Division/Site selection
+7 DO SEL^PSOREJU1("DIVISION","^PS(59,",.PSOREJST,$$GET1^DIQ(59,+$GET(PSOSITE),.01))
IF $GET(PSOREJST)="^"
GOTO EXIT
+8 ;
+9 ; - Initializing global variables
+10 SET PSORJSRT="PA"
SET PSORJASC=1
SET PSOSTFLT="U"
SET (PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT)="ALL"
+11 SET PSOINGRP=0
SET PSOTRITG=1
+12 ;
+13 DO LST("W")
+14 GOTO EXIT
+15 ;
LST(PSOMENU) ; - Invokes Listmanager
+1 WRITE !,"Please wait..."
+2 IF PSOMENU="W"
DO EN^VALM("PSO REJECTS WORKLIST")
+3 IF PSOMENU="VP"
DO EN^VALM("PSO REJECTS VIEW/PROCESS")
+4 DO FULL^VALM1
+5 QUIT
+6 ;
HDR ; - Header code
+1 NEW LINE1,LINE2,LINE3
+2 SET LINE1=$$SITES()
IF $LENGTH(LINE1)>80
SET $EXTRACT(LINE1,78,999)="..."
+3 ;
+4 SET LINE2="Selection : ALL "_$SELECT(PSOSTFLT="U":"UNRESOLVED ",PSOSTFLT="R":"RESOLVED ",1:"")_"REJECTS"
+5 IF $GET(PSOPTFLT)'="ALL"
SET LINE2=LINE2_" FOR "_$$NAME("P")
+6 IF $GET(PSODRFLT)'="ALL"
SET LINE2=LINE2_" FOR "_$$NAME("D")
+7 IF $GET(PSOINFLT)'="ALL"
SET LINE2=LINE2_" FOR "_$$NAME("I")
+8 IF $GET(PSOINGRP)
SET LINE2=LINE2_" GROUPED BY INSURANCE"
+9 SET VALMHDR(1)=LINE1
SET VALMHDR(2)=LINE2
+10 IF PSOMENU="VP"
Begin DoDot:1
+11 IF $GET(PSORXFLT)
SET LINE3="Rx# : "_$$NAME("R")
+12 IF '$TEST
Begin DoDot:2
+13 SET LINE3="Date Range: "_$$FMTE^XLFDT(+PSODTRNG,2)
+14 IF +PSODTRNG'=$PIECE(PSODTRNG,"^",2)
SET LINE3=LINE3_" THRU "_$$FMTE^XLFDT($PIECE(PSODTRNG,"^",2),2)
End DoDot:2
+15 SET VALMHDR(3)=LINE3
End DoDot:1
+16 ;
+17 DO SETHDR()
+18 QUIT
+19 ;
SETHDR() ; - Displays the Header Line
+1 NEW HDR,ORD
+2 ;
+3 SET HDR=" #"
SET $EXTRACT(HDR,5)="Rx#"
SET $EXTRACT(HDR,18)="PATIENT(ID)"
SET $EXTRACT(HDR,43)="DRUG"
SET $EXTRACT(HDR,64)="REASON"
+4 SET $EXTRACT(HDR,81)=""
DO INSTR^VALM1(IORVON_HDR_IOINORM,1,$SELECT(PSOMENU="W":4,1:5))
+5 SET ORD=$SELECT(PSORJASC=1:"[^]",1:"[v]")
+6 IF PSORJSRT="RX"
SET POS=9
IF PSORJSRT="PA"
SET POS=30
IF PSORJSRT="DR"
SET POS=48
IF PSORJSRT="RE"
SET POS=71
+7 DO INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,$SELECT(PSOMENU="W":4,1:5))
+8 QUIT
+9 ;
INIT ; - Populates the Body section for ListMan
+1 KILL ^TMP("PSOREJP0",$JOB)
+2 DO SETSORT(PSORJSRT)
DO SETLINE
+3 SET VALMSG="Select the entry # to view or ?? for more actions"
+4 QUIT
+5 ;
SETLINE ; - Sets the line to be displayed in ListMan
+1 NEW INS,SUB,SEQ,SORTA,LINE,Z,I,X,X1,X2
+2 IF '$DATA(^TMP("PSOREJSR",$JOB))
Begin DoDot:1
+3 FOR I=1:1:7
SET ^TMP("PSOREJP0",$JOB,I,0)=""
+4 SET ^TMP("PSOREJP0",$JOB,8,0)=" No Clinical Third Party Payer Rejects found."
+5 SET VALMCNT=1
End DoDot:1
QUIT
+6 ;
+7 FOR I=1:1:$GET(LASTLN)
DO RESTORE^VALM10(I)
+8 KILL INSLN,HIGHLN
+9 ;
+10 SET (SORTA,INS,SUB)=""
SET LINE=0
KILL ^TMP("PSOREJP0",$JOB)
+11 FOR
SET SORTA=$ORDER(^TMP("PSOREJSR",$JOB,SORTA))
IF SORTA=""
QUIT
Begin DoDot:1
+12 FOR
SET INS=$ORDER(^TMP("PSOREJSR",$JOB,SORTA,INS))
IF INS=""
QUIT
Begin DoDot:2
+13 IF INS'="<NULL>"
Begin DoDot:3
+14 DO GROUP(INS,.LINE)
End DoDot:3
+15 FOR
SET SUB=$ORDER(^TMP("PSOREJSR",$JOB,SORTA,INS,SUB),PSORJASC)
IF SUB=""
QUIT
Begin DoDot:3
+16 SET Z=$GET(^TMP("PSOREJSR",$JOB,SORTA,INS,SUB))
+17 SET X1=""
SET SEQ=$GET(SEQ)+1
SET X1=$JUSTIFY(SEQ,3)
+18 SET $EXTRACT(X1,5)=$PIECE(Z,"^",3)
SET $EXTRACT(X1,18)=$PIECE(Z,"^",4)
SET $EXTRACT(X1,43)=$PIECE(Z,"^",5)
SET $EXTRACT(X1,64)=$PIECE(Z,"^",6)
+19 SET LINE=LINE+1
SET ^TMP("PSOREJP0",$JOB,LINE,0)=X1
SET HIGHLN(LINE)=""
+20 SET X2=""
SET $EXTRACT(X2,5)="Payer Message: "_$PIECE(Z,"^",7)
+21 SET LINE=LINE+1
SET ^TMP("PSOREJP0",$JOB,LINE,0)=X2
+22 SET ^TMP("PSOREJP0",$JOB,SEQ,"RX")=$PIECE(Z,"^",1,2)
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 IF LINE>$GET(LASTLN)
Begin DoDot:1
+25 FOR I=($GET(LASTLN)+1):1:LINE
DO SAVE^VALM10(I)
+26 SET LASTLN=LINE
End DoDot:1
+27 ;
+28 ; - Highlighting the prescription/insurance line
+29 FOR LN=1:1:LINE
Begin DoDot:1
+30 IF $DATA(HIGHLN(LN))
Begin DoDot:2
+31 DO CNTRL^VALM10(LN,1,80,IOINHI,IOINORM)
+32 DO CNTRL^VALM10(LN,64,3,IOUON,IOINORM)
+33 DO CNTRL^VALM10(LN,67,80,IOINHI,IOINORM)
End DoDot:2
QUIT
+34 IF $DATA(INSLN(LN))
Begin DoDot:2
+35 SET LBL=INSLN(LN)
SET POS=41-($LENGTH(LBL)/2+.5\1)
+36 DO CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
+37 DO CNTRL^VALM10(LN,POS,$LENGTH(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
+38 DO CNTRL^VALM10(LN,POS+$LENGTH(LBL),(81-POS-$LENGTH(LBL)),IOUON_IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+39 ;
+40 SET VALMCNT=+$GET(LINE)
+41 QUIT
+42 ;
GROUP(LBL,LINE) ; Sets an insurance delimiter line
+1 NEW X,POS
+2 SET POS=41-($LENGTH(LBL)/2+.5\1)
+3 SET X=""
SET $PIECE(X," ",81)=""
SET $EXTRACT(X,POS,POS-1+$LENGTH(LBL))=LBL
+4 SET LINE=LINE+1
SET ^TMP("PSOREJP0",$JOB,LINE,0)=X
SET INSLN(LINE)=LBL
+5 QUIT
+6 ;
SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified
+1 NEW RX,REJ,STS,DAT
+2 KILL ^TMP("PSOREJSR",$JOB)
+3 ;
+4 ; - Worklist
+5 IF PSOMENU="W"
Begin DoDot:1
+6 SET RX=0
FOR
SET RX=$ORDER(^PSRX("REJSTS",0,RX))
IF 'RX
QUIT
Begin DoDot:2
+7 SET REJ=0
FOR
SET REJ=$ORDER(^PSRX("REJSTS",0,RX,REJ))
IF 'REJ
QUIT
Begin DoDot:3
+8 DO SETTMP(RX,REJ,FIELD)
End DoDot:3
End DoDot:2
End DoDot:1
+9 ;
+10 ; - View/Process
+11 IF PSOMENU="VP"
Begin DoDot:1
+12 IF $GET(PSORXFLT)'="ALL"
Begin DoDot:2
+13 SET REJ=0
FOR
SET REJ=$ORDER(^PSRX(+PSORXFLT,"REJ",REJ))
IF 'REJ
QUIT
Begin DoDot:3
+14 IF $$FLTSTS(+PSORXFLT,REJ)
QUIT
+15 DO SETTMP(+PSORXFLT,REJ,FIELD)
End DoDot:3
End DoDot:2
QUIT
+16 SET DAT=$PIECE(PSODTRNG,"^")-0.0000001
SET (RX,REJ)=0
+17 FOR
SET DAT=$ORDER(^PSRX("REJDAT",DAT))
IF 'DAT!(DAT>$$ENDT())
QUIT
Begin DoDot:2
+18 FOR
SET RX=$ORDER(^PSRX("REJDAT",DAT,RX))
IF 'RX
QUIT
Begin DoDot:3
+19 IF $$FILTER(RX)
QUIT
+20 FOR
SET REJ=$ORDER(^PSRX("REJDAT",DAT,RX,REJ))
IF 'REJ
QUIT
Begin DoDot:4
+21 IF $$FLTSTS(RX,REJ)
QUIT
+22 DO SETTMP(RX,REJ,FIELD)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
SETTMP(RX,REJ,FIELD) ; - Sets ^TMP global that will be displayed in the body section
+1 NEW REJLST,FILL,CODE,RXNUM,PTNAME,DRNAME,MSG,REASON,MSG,X,Z,SORT,I,INS,OREJ,PSOTRIC,SORTA
+2 IF $GET(PSORXFLT)="ALL"
IF $$CLOSED^PSOREJP1(RX,REJ)
IF $$REOPN^PSOREJP1(RX,REJ)
QUIT
+3 SET FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
SET SORTA=1
+4 IF '$$DIV(RX,FILL)
QUIT
+5 KILL REJLST
DO GET^PSOREJU2(RX,FILL,.REJLST,,1)
IF '$DATA(REJLST)
QUIT
+6 IF $$FILTER(,REJLST(REJ,"INSURANCE NAME"))
QUIT
+7 SET CODE=$GET(REJLST(REJ,"CODE"))
+8 SET PSOTRIC=""
SET PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC)
+9 ;show/hide non-DUR/RTS Tricare
IF $GET(PSOTRIC)&('$GET(PSOTRITG))&(CODE'="79")&(CODE'="88")
QUIT
+10 SET PTNAME=$$PTNAME(RX)
+11 SET DRNAME=$$GET1^DIQ(52,RX,6)
+12 SET RXNUM=$$GET1^DIQ(52,RX,.01)
+13 SET MSG=$GET(REJLST(REJ,"PAYER MESSAGE"))
IF $LENGTH(MSG)>60
SET MSG=$EXTRACT(MSG,1,58)_"..."
+14 SET REASON=$SELECT(CODE=88:"DUR:"_$GET(REJLST(REJ,"REASON")),CODE=79:"79 :REFILL TOO SOON",1:CODE)
+15 IF CODE'=79&(CODE'=88)
SET REASON=CODE_" :"_$$EXP^PSOREJP1(CODE)
+16 SET Z=""
SET $PIECE(Z,"^")=RX
SET $PIECE(Z,"^",2)=REJ
SET $PIECE(Z,"^",3)=RXNUM
SET $PIECE(Z,"^",4)=PTNAME
+17 SET $PIECE(Z,"^",5)=$EXTRACT(DRNAME,1,20)
SET $PIECE(Z,"^",6)=$EXTRACT(REASON,1,17)
SET $PIECE(Z,"^",7)=MSG
+18 SET SORT=$SELECT(FIELD="PA":PTNAME,FIELD="DR":DRNAME,FIELD="RX":RXNUM_" ",1:REASON)_RX_REJ
+19 SET INS="<NULL>"
+20 IF $GET(PSOINGRP)
SET INS=REJLST(REJ,"INSURANCE NAME")
IF INS=""
SET INS="***UNKNOWN***"
+21 IF $GET(PSOTRIC)&(CODE'=79)&(CODE'=88)
SET INS="TRICARE"_" - Non-DUR/RTS"
SET SORTA=2
+22 IF '$GET(PSOTRIC)&(CODE'=79)&(CODE'=88)
SET INS="OTHER REJECTS"
SET SORTA=3
+23 SET ^TMP("PSOREJSR",$JOB,SORTA,INS,SORT)=Z
+24 QUIT
+25 ;
PAT ; - Sort by Patient
+1 DO SORT("PA")
+2 QUIT
DRG ; - Sort by Drug
+1 DO SORT("DR")
+2 QUIT
RX ; - Sort by Rx
+1 DO SORT("RX")
+2 QUIT
REA ; - Sort by Reason
+1 DO SORT("RE")
+2 QUIT
SORT(FIELD) ; - Sort entries by FIELD
+1 IF PSORJSRT=FIELD
SET PSORJASC=$SELECT(PSORJASC=1:-1,1:1)
+2 IF '$TEST
SET PSORJSRT=FIELD
SET PSORJASC=1
+3 DO REF
+4 QUIT
+5 ;
REF ; - Screen Refresh
+1 WRITE ?52,"Please wait..."
DO INIT
SET VALMBCK="R"
+2 QUIT
GI ; - Group by Insurance
+1 WRITE ?52,"Please wait..."
SET PSOINGRP=$SELECT($GET(PSOINGRP):0,1:1)
DO INIT
DO HDR
SET VALMBCK="R"
+2 QUIT
TRICTOG ; - Toggle Tricare display
+1 WRITE ?52,"Please wait..."
SET PSOTRITG=$SELECT($GET(PSOTRITG):0,1:1)
DO INIT
DO HDR
SET VALMBCK="R"
+2 QUIT
+3 ;
SEL ; - Process selection of one entry
+1 NEW PSOSEL,XQORM,Z,RX,REJ,PSOCHNG
+2 SET PSOSEL=+$PIECE($PIECE(Y(1),"^",4),"=",2)
IF 'PSOSEL
SET VALMSG="Invalid selection!"
SET VALMBCK="R"
QUIT
+3 SET Z=$GET(^TMP("PSOREJP0",$JOB,PSOSEL,"RX"))
+4 SET RX=$PIECE(Z,"^")
SET REJ=$PIECE(Z,"^",2)
IF 'RX!'REJ
SET VALMSG="Invalid selection!"
SET VALMBCK="R"
QUIT
+5 SET PSOCHNG=0
DO EN^PSOREJP1(RX,REJ,.PSOCHNG)
IF $GET(PSOCHNG)
DO REF
+6 QUIT
+7 ;
EXIT ;
+1 KILL ^TMP("PSOREJP0",$JOB),^TMP("PSOREJSR",$JOB)
+2 QUIT
+3 ;
HELP QUIT
+1 ;
SITES() ; - Returns the list of sites along with their NCPDP #s
+1 NEW CNT,SITE,SITES,NAME
+2 IF '$DATA(PSOREJST)
QUIT ""
+3 IF $GET(PSOREJST)="ALL"
QUIT "Divisions : ALL"
+4 SET SITE=0
FOR
SET SITE=$ORDER(PSOREJST(SITE))
IF 'SITE
QUIT
Begin DoDot:1
+5 SET NAME=$$GET1^DIQ(59,SITE,.01)
+6 SET SITES=$GET(SITES)_", "_NAME
End DoDot:1
+7 SET $EXTRACT(SITES,1,2)=""
SET SITES="Division"_$SELECT($LENGTH(SITES,",")>1:"s",1:" ")_" : "_SITES
+8 QUIT SITES
+9 ;
DIV(RX,FILL) ; - Check if the Division for the Prescription/Fill was selected by the user
+1 ;
+2 IF $GET(PSOREJST)="ALL"
QUIT 1
+3 IF $DATA(PSOREJST($$RXSITE^PSOBPSUT(RX,FILL)))
QUIT 1
+4 QUIT 0
+5 ;
PTNAME(RX) ; - Returns header displayable - Patient Name (Last 4 SSN)
+1 NEW DFN,VADM,PTNAME
+2 SET DFN=$$GET1^DIQ(52,RX,2,"I")
DO DEM^VADPT
+3 SET PTNAME=$EXTRACT($GET(VADM(1)),1,18)_"("_$PIECE($PIECE($GET(VADM(2)),"^",2),"-",3)_")"
+4 QUIT PTNAME
+5 ;
FILTER(RX,INS) ; - Filter entries based on user's selection
+1 NEW FILTER,NAME
+2 SET FILTER=1
+3 IF $GET(PSOPTFLT)'="ALL"
IF $DATA(RX)
IF '$DATA(PSOPTFLT($$GET1^DIQ(52,RX,2,"I")))
QUIT FILTER
+4 IF $GET(PSODRFLT)'="ALL"
IF $DATA(RX)
IF '$DATA(PSODRFLT($$GET1^DIQ(52,RX,6,"I")))
QUIT FILTER
+5 IF $GET(PSOINFLT)'="ALL"
IF $DATA(INS)
Begin DoDot:1
+6 SET NAME=""
FOR
SET NAME=$ORDER(PSOINFLT(NAME))
IF NAME=""
QUIT
IF $$UP^XLFSTR(INS)[$$UP^XLFSTR(NAME)
SET FILTER=0
QUIT
End DoDot:1
QUIT FILTER
+7 QUIT 0
+8 ;
FLTSTS(RX,REJ) ; - Filter for the Reject Status
+1 NEW STS
+2 SET STS=$$GET1^DIQ(52.25,REJ_","_RX,9,"I")
+3 IF PSOSTFLT="U"
IF STS=1
QUIT 1
+4 IF PSOSTFLT="R"
IF STS=0
QUIT 1
+5 QUIT 0
+6 ;
NAME(TYPE) ; - Returns the name if ONE was selected or "MULTIPLE ..."
+1 NEW I,CNT
+2 ;
+3 IF TYPE="P"
IF $ORDER(PSOPTFLT($ORDER(PSOPTFLT(""))))=""
QUIT $$GET1^DIQ(2,$ORDER(PSOPTFLT("")),.01)
+4 IF TYPE="D"
IF $ORDER(PSODRFLT($ORDER(PSODRFLT(""))))=""
QUIT $$GET1^DIQ(50,$ORDER(PSODRFLT("")),.01)
+5 IF TYPE="I"
IF $ORDER(PSOINFLT($ORDER(PSOINFLT(""))))=""
QUIT $ORDER(PSOINFLT(""))
+6 IF TYPE="R"
QUIT $$GET1^DIQ(52,PSORXFLT,.01)
+7 QUIT "MULTIPLE "_$SELECT(TYPE="P":"PATIENTS",TYPE="D":"DRUGS",1:"INSURANCE COMPANIES")
+8 ;
ENDT() ; Returns the upper limit for the date range
+1 NEW ENDT
+2 SET ENDT=$PIECE(PSODTRNG,"^",2)
+3 IF '$EXTRACT(ENDT,4,7)
QUIT (ENDT+10000)
+4 IF '$EXTRACT(ENDT,6,7)
QUIT (ENDT+100)
+5 IF $PIECE(ENDT,"^",2)
QUIT (ENDT+0.0000001)
+6 QUIT (ENDT+.25)
