PSOBPSR1 ;BHM/LE - continued Ignored Claims Report ;03/01/07
;;7.0;OUTPATIENT PHARMACY;**260,448,512**;DEC 1997;Build 44
;External reference to File ^PS(55 supported by DBIA 2228
;External reference to $$GET1^DIQ is supported by DBIA 2056
;External reference to ^VADPT is supported by DBIA 10061
;External reference to ^XLFDT is supported by DBIA 10103
;External reference to ^%ZISC is supported by DBIA 10089
;Reference to $$GETBAMT^BPSBUTL supported by DBIA #4719.
;
EN N CLOSE,CDATE,DFN,DRG,RXIEN,PAG,PCNT,PRTD,PNAM,I,II,J,Y,X,XX,S1,S2,S3,S4,S5,FCNT,CBYI
N SP1,SP2,SEQ2,CINFO,RDATE,RSEQ,PSORX,RXINFO,DNAMI,CDIV,CDIVN,OCDIV,RXNUMB,PSORXN,RXE
N EXTRALINES,LINES,RXLN
U IO K ^TMP("PSOBPSRP",$J),^TMP("PSOBPSRC",$J)
S (SP1,SP2)="",$P(SP1,"=",81)="",$P(SP2,"-",81)=""
;
; - Loop through reject dates xref
S (RXIEN,PCNT,FCNT,PRTD)=0 K DIRUT
S RDATE=PSOSD
;
DATE ;
S RDATE=$O(^PSRX("REJDAT",RDATE)) G NEXT:RDATE=""!(RDATE>PSOED)
RX ;
S RXIEN=$O(^PSRX("REJDAT",RDATE,RXIEN)) G DATE:RXIEN=""
S (DFN,DRG,PNAM,DNAM,DNAMI,RXE)=""
K RXINFO D GETS^DIQ(52,RXIEN_",",".01;2;6","IE","RXINFO")
S PNAM=$G(RXINFO(52,RXIEN_",",2,"E")),DNAM=$G(RXINFO(52,RXIEN_",",6,"E"))
S DFN=$G(RXINFO(52,RXIEN_",",2,"I")),DNAMI=$G(RXINFO(52,RXIEN_",",6,"I"))
S RXE=$G(RXINFO(52,RXIEN_",",.01,"E"))_" "
I '$G(PSOAPT),'$D(PSOPT(DFN)) G RX ;user selected specific patients
I '$G(PSODRUG),'$D(PSODRG(DNAMI)) G RX
;
;look for ignored rejects
S SEQ2=0 F S SEQ2=$O(^PSRX(RXIEN,"REJ",SEQ2)) Q:'SEQ2&(SEQ2'?1N.N) D
. S (CDATE,CBY,CBYI,CFILL,CDIV)=""
. K CLOSE D GETS^DIQ(52.25,SEQ2_","_RXIEN_",","5;10;11;12","IE","CLOSE")
. S CDATE=$G(CLOSE(52.25,SEQ2_","_RXIEN_",",10,"I"))
. S CFILL=$G(CLOSE(52.25,SEQ2_","_RXIEN_",",5,"I"))
. S CDIV=$$RXSITE^PSOBPSUT(RXIEN,CFILL)
. I '$G(PSOSIT)&'$D(PSODIV(CDIV)) Q
. ; Field #12-CLOSE REASON must be 6=IGNORED - NO RESUBMISSION
. ; CDATE = Field #10-CLOSE DATE/TIME. It will only be set if field #9-STATUS equals 1=CLOSED/RESOLVED
. ; Compare CDATE against the Beginning (PSOSD) and Ending (PSOED) Reject Dates
. I $G(CLOSE(52.25,SEQ2_","_RXIEN_",",12,"I"))=6,(CDATE'<PSOSD&(CDATE'>PSOED)) D
. . S CBY=$G(CLOSE(52.25,SEQ2_","_RXIEN_",",11,"E"))
. . S CBYI=$G(CLOSE(52.25,SEQ2_","_RXIEN_",",11,"I"))
. . I '$G(PSOUSER),'$D(PSOU(CBYI)) Q ;user selected specific user for "ignored by" column in report
. . D SET
G RX
;
NEXT ; - If not Sorting (already printed), SKIP, otherwise, print the report
I '$D(^TMP("PSOBPSRP")) G NDTP
;
I $E(IOST)="C" S EXTRALINES=3
E S EXTRALINES=8
;
S (S1,S2,S3,DFN,RSEQ,PSORX,PSORXN,RXNUMB,CDIV,OCDIV,CDIVN)=""
F S CDIV=$O(^TMP("PSOBPSRP",$J,CDIV)) Q:CDIV="" D Q:$D(DIRUT)
. F S S1=$O(^TMP("PSOBPSRP",$J,CDIV,S1)) Q:S1="" D Q:$D(DIRUT)
. . F S S2=$O(^TMP("PSOBPSRP",$J,CDIV,S1,S2)) Q:S2="" D Q:$D(DIRUT)
. . . F S S3=$O(^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3)) Q:S3="" D Q:$D(DIRUT)
. . . . F S DFN=$O(^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN)) Q:DFN="" D Q:$D(DIRUT)
. . . . . F S PSORXN=$O(^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN)) Q:PSORXN="" D Q:$D(DIRUT)
. . . . . . F S RSEQ=$O(^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ)) Q:RSEQ="" D Q:$D(DIRUT)
. . . . . . . S (RXNUMB,PSORX)="",RXNUMB=$E(PSORXN,1,$L(PSORXN)-1),PSORX=$O(^PSRX("B",RXNUMB,PSORX))
. . . . . . . S LINES=$$COMPILE(DFN,PSORX)
. . . . . . . I $Y>(IOSL-(LINES+EXTRALINES)) D HDR I $D(DIRUT) Q
. . . . . . . D PRINT(DFN,PSORX)
. . . I '$D(DIRUT),S2'=0,$O(^TMP("PSOBPSRP",$J,CDIV,S1,S2))'="" W SP2
. . ; Write SP1 after the first SORT field selected (Patient,Drug,User)
. . I '$D(DIRUT),$O(^TMP("PSOBPSRP",$J,CDIV,S1))'="" W !,SP1
G CLOSE:$D(DIRUT)
;
NDTP I 'PRTD D HDR W !!?18,"********** NO DATA TO PRINT **********"
I $G(PCNT) D
. W !,SP1
. W !,"Total: ",PCNT," patient",$S(PCNT>1:"s",1:"")
. W " and ",FCNT," prescription fill",$S(FCNT>1:"s",1:""),"."
;
CLOSE ;
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
END K ^TMP("PSOBPSRP",$J),^TMP("PSOBPSRC",$J)
K PSOAPT,PSODRUG,PSOUSER,PSOU,PSODRG,PSOPT,PSOSRT,PSOED,PSOSD,PSODIV,PSOSIT
Q
;
SET ;
S (S1,S2,S3)=0
F I=1:1:$L(PSOSRT,",") D
. S Y=$P(PSOSRT,",",I)
. S @("S"_I)=$S(Y=1:PNAM,Y=2:DNAM,Y=3:CBY)
S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,RXE,SEQ2)=""
Q
;
COMPILE(DFN,RXIEN) ;
; Gather data for report and determine the number of lines for the Rx
;Input: DFN-Patient
; RXIEN=Prescription IEN
;Output: LINE=number of lines for Rx
;
N BILLED,CBY,CCOM,CDAT,CFILL,CINFO,COB,CREAS,DNAM,II,J,K,LINE,PMES,PNAM,PSSN,RXNUM,STR,X,XX
S (BILLED,CBY,CCOM,CDAT,CINFO,COB,CREAS,DNAM,PMES,PNAM,PSSN,RXNUM)=""
;
D DEM^VADPT S PSSN=$P($G(VADM(2)),"^",2) K VADM
K RXINFO D GETS^DIQ(52,RXIEN_",",".01;2;6","EI","RXINFO")
S PNAM=RXINFO(52,RXIEN_",",2,"E"),DNAM=RXINFO(52,RXIEN_",",6,"E")
D GETS^DIQ(52.25,RSEQ_","_RXIEN_",",".01;2;5;10;11;12;13;17;20;27","IE","CINFO")
S:$D(RXINFO(52,RXIEN_",",.01,"E")) RXNUM=RXINFO(52,RXIEN_",",.01,"E")
S:$D(CINFO(52.25,RSEQ_","_RXIEN_",",10,"I")) CDAT=CINFO(52.25,RSEQ_","_RXIEN_",",10,"I")
S CDAT=$$DT(CDAT)
S:$D(CINFO(52.25,RSEQ_","_RXIEN_",",12,"I")) CREAS=CINFO(52.25,RSEQ_","_RXIEN_",",12,"E")
S:$D(CINFO(52.25,RSEQ_","_RXIEN_",",11,"E")) CBY=CINFO(52.25,RSEQ_","_RXIEN_",",11,"E")
S:$D(CINFO(52.25,RSEQ_","_RXIEN_",",2,"E")) PMES=CINFO(52.25,RSEQ_","_RXIEN_",",2,"E")
D TEXT(.PMES,PMES,65)
S:$D(CINFO(52.25,RSEQ_","_RXIEN_",",13,"E")) CCOM=CINFO(52.25,RSEQ_","_RXIEN_",",13,"E")
D TEXT(.CCOM,CCOM,65)
S:$D(CINFO(52.25,RSEQ_","_RXIEN_",",5,"I")) CFILL=CINFO(52.25,RSEQ_","_RXIEN_",",5,"I")
S COB=$G(CINFO(52.25,RSEQ_","_RXIEN_",",27,"I"))
;
; Get Insurance Name and Reject Code(s)
N I,OTHREJS,PSOINS,RCARR,RCEXPL,RCEXPLS,RCIEN,RCIENS,REJCD,REJCDS
S (OTHREJS,PSOINS,RCARR,RCEXPL,RCEXPLS,RCIEN,RCIENS,REJCD,REJCDS)=""
;
S PSOINS=$G(CINFO(52.25,RSEQ_","_RXIEN_",",20,"I"))
S REJCD=$G(CINFO(52.25,RSEQ_","_RXIEN_",",.01,"I"))
I REJCD'="" D
. ; get Reject Code Explanation from File #9002313.93
. S RCIEN=$O(^BPSF(9002313.93,"B",REJCD,""))
. S RCEXPL=$$GET1^DIQ(9002313.93,RCIEN_",",.02,"E")
. ; create a rejects array RCARR
. S RCARR(0)=REJCD_":"_RCEXPL
. Q
;
S BILLED=$$GETBAMT^BPSBUTL(RXIEN,$G(CFILL),COB) ; DBIA #4719
;
S LINE=1
S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=RXNUM_"/"_CFILL_U_$E(DNAM,1,21)_U_$E(PNAM,1,13)_"("_$P(PSSN,"-",3)_")"_U_CDAT_U_$E(CBY,1,14)
S LINE=LINE+1
S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Insurance: "_PSOINS
S LINE=LINE+1
;
S II="" F S II=$O(RCARR(II)) Q:II="" D
. I II=0 S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Reject: "_$G(RCARR(II))
. E S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" "_$E($G(RCARR(II)),1,69)
. S LINE=LINE+1
;
S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Billed Amount: "_"$"_BILLED
S LINE=LINE+1
;
S II="" F S II=$O(CCOM(II)) Q:II="" D
. I II=1 S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" Comments: "_$G(CCOM(II))
. E S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" "_$G(CCOM(II))
. S LINE=LINE+1
;
S II="" F S II=$O(PMES(II)) Q:II="" D
. I II=1 S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Payer Message: "_$G(PMES(II))
. E S ^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" "_$G(PMES(II))
. S LINE=LINE+1
;
Q LINE
;
PRINT(DFN,RXIEN) ; - Print
;Input: DFN-Patient
; RXIEN=Prescription IEN
;
N RXLN,RXREC
;
I OCDIV'=CDIV!(OCDIV="") D HDR I $D(DIRUT) Q
S OCDIV=CDIV
;
S RXLN="" F S RXLN=$O(^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,RXLN)) Q:RXLN="" D
. S RXREC=^TMP("PSOBPSRP",$J,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,RXLN)
. ; Write Rx Info.
. I RXLN=1 W !,$P(RXREC,U),?15,$P(RXREC,U,2),?37,$P(RXREC,U,3),?57,$P(RXREC,U,4),?66,$P(RXREC,U,5)
. ; Write Insurance Name, Rejects, Billed Amount, Comments and Payer Message.
. E W !,RXREC
W !
;
S:'$D(^TMP("PSOBPSRC",$J,DFN)) PCNT=PCNT+1 S ^TMP("PSOBPSRC",$J,DFN)=""
;
S PRTD=1,FCNT=FCNT+1
Q
;
TEXT(TEXT,STR,L) ; Formats STR into TEXT array, lines lenght = L
N J,WORD,K S K=+$O(TEXT(""),-1) S:'K K=1
F J=1:1:$L(STR," ") D
. S WORD=$P(STR," ",J) I ($L($G(TEXT(K))_WORD))>L S K=K+1
. S TEXT(K)=$G(TEXT(K))_WORD_" "
Q
;
HDR ; - Prints the Header
N X,DIR,CDIVN S PAG=$G(PAG)+1
S CDIVN=$$GET1^DIQ(59,$G(CDIV)_",",".01")
I PAG>1,$E(IOST)="C" D Q:$D(DIRUT)
. S DIR(0)="E",DIR("A")=" Press ENTER to Continue or ^ to Exit" D ^DIR
;
W @IOF,"Ignored Rejects Report",?71,"Page: ",$J(PAG,3)
W !,"Sorted by",$$SRT(PSOSRT),?48,"Division: ",CDIVN
W !,"Date Range: "_$$DT(PSOSD+1\1)_" - "_$$DT(PSOED\1)
W ?48,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT())
I PAG=1 D
. W !!,?19,"Note: Billed amount is what was billed and"
. W !,?17,"cannot be used to determine potential revenue."
S X="",$P(X,"-",81)="" W !,X
W !,"RX#/FILL",?15,"DRUG",?37,"PATIENT",?56,"IGNORE DT",?66,"IGNORED BY"
W !,"--------------",?15,"---------------------",?37,"------------------",?56,"---------",?66,"--------------"
Q
;
SRT(ST) ; - Convert the "2,1" (example) to "DRUG,PATIENT"
;Input: ST-String with the Sorting fields by number
;Output: ST-String with the Sorting fields by name
N I,X,STR,FLD
S STR="PATIENT^DRUG^USER"
F I=1:1:$L(ST,",") D
. S FLD=+$P(ST,",",I),X=$P(STR,"^",FLD)
. S $P(ST,",",I)=" "_X
Q ST
;
DT(DT) ; - Convert FM Date to MM/DD/YYYY
I 'DT Q ""
I '(DT#10000) Q (1700+$E(DT,1,3))
I '(DT#100) Q $E(DT,4,5)_"/"_(1700+$E(DT,1,3))
Q $E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E((1700+$E(DT,1,3)),3,4)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBPSR1 9663 printed Apr 09, 2024@21:36:43 Page 2
PSOBPSR1 ;BHM/LE - continued Ignored Claims Report ;03/01/07
+1 ;;7.0;OUTPATIENT PHARMACY;**260,448,512**;DEC 1997;Build 44
+2 ;External reference to File ^PS(55 supported by DBIA 2228
+3 ;External reference to $$GET1^DIQ is supported by DBIA 2056
+4 ;External reference to ^VADPT is supported by DBIA 10061
+5 ;External reference to ^XLFDT is supported by DBIA 10103
+6 ;External reference to ^%ZISC is supported by DBIA 10089
+7 ;Reference to $$GETBAMT^BPSBUTL supported by DBIA #4719.
+8 ;
EN NEW CLOSE,CDATE,DFN,DRG,RXIEN,PAG,PCNT,PRTD,PNAM,I,II,J,Y,X,XX,S1,S2,S3,S4,S5,FCNT,CBYI
+1 NEW SP1,SP2,SEQ2,CINFO,RDATE,RSEQ,PSORX,RXINFO,DNAMI,CDIV,CDIVN,OCDIV,RXNUMB,PSORXN,RXE
+2 NEW EXTRALINES,LINES,RXLN
+3 USE IO
KILL ^TMP("PSOBPSRP",$JOB),^TMP("PSOBPSRC",$JOB)
+4 SET (SP1,SP2)=""
SET $PIECE(SP1,"=",81)=""
SET $PIECE(SP2,"-",81)=""
+5 ;
+6 ; - Loop through reject dates xref
+7 SET (RXIEN,PCNT,FCNT,PRTD)=0
KILL DIRUT
+8 SET RDATE=PSOSD
+9 ;
DATE ;
+1 SET RDATE=$ORDER(^PSRX("REJDAT",RDATE))
if RDATE=""!(RDATE>PSOED)
GOTO NEXT
RX ;
+1 SET RXIEN=$ORDER(^PSRX("REJDAT",RDATE,RXIEN))
if RXIEN=""
GOTO DATE
+2 SET (DFN,DRG,PNAM,DNAM,DNAMI,RXE)=""
+3 KILL RXINFO
DO GETS^DIQ(52,RXIEN_",",".01;2;6","IE","RXINFO")
+4 SET PNAM=$GET(RXINFO(52,RXIEN_",",2,"E"))
SET DNAM=$GET(RXINFO(52,RXIEN_",",6,"E"))
+5 SET DFN=$GET(RXINFO(52,RXIEN_",",2,"I"))
SET DNAMI=$GET(RXINFO(52,RXIEN_",",6,"I"))
+6 SET RXE=$GET(RXINFO(52,RXIEN_",",.01,"E"))_" "
+7 ;user selected specific patients
IF '$GET(PSOAPT)
IF '$DATA(PSOPT(DFN))
GOTO RX
+8 IF '$GET(PSODRUG)
IF '$DATA(PSODRG(DNAMI))
GOTO RX
+9 ;
+10 ;look for ignored rejects
+11 SET SEQ2=0
FOR
SET SEQ2=$ORDER(^PSRX(RXIEN,"REJ",SEQ2))
if 'SEQ2&(SEQ2'?1N.N)
QUIT
Begin DoDot:1
+12 SET (CDATE,CBY,CBYI,CFILL,CDIV)=""
+13 KILL CLOSE
DO GETS^DIQ(52.25,SEQ2_","_RXIEN_",","5;10;11;12","IE","CLOSE")
+14 SET CDATE=$GET(CLOSE(52.25,SEQ2_","_RXIEN_",",10,"I"))
+15 SET CFILL=$GET(CLOSE(52.25,SEQ2_","_RXIEN_",",5,"I"))
+16 SET CDIV=$$RXSITE^PSOBPSUT(RXIEN,CFILL)
+17 IF '$GET(PSOSIT)&'$DATA(PSODIV(CDIV))
QUIT
+18 ; Field #12-CLOSE REASON must be 6=IGNORED - NO RESUBMISSION
+19 ; CDATE = Field #10-CLOSE DATE/TIME. It will only be set if field #9-STATUS equals 1=CLOSED/RESOLVED
+20 ; Compare CDATE against the Beginning (PSOSD) and Ending (PSOED) Reject Dates
+21 IF $GET(CLOSE(52.25,SEQ2_","_RXIEN_",",12,"I"))=6
IF (CDATE'<PSOSD&(CDATE'>PSOED))
Begin DoDot:2
+22 SET CBY=$GET(CLOSE(52.25,SEQ2_","_RXIEN_",",11,"E"))
+23 SET CBYI=$GET(CLOSE(52.25,SEQ2_","_RXIEN_",",11,"I"))
+24 ;user selected specific user for "ignored by" column in report
IF '$GET(PSOUSER)
IF '$DATA(PSOU(CBYI))
QUIT
+25 DO SET
End DoDot:2
End DoDot:1
+26 GOTO RX
+27 ;
NEXT ; - If not Sorting (already printed), SKIP, otherwise, print the report
+1 IF '$DATA(^TMP("PSOBPSRP"))
GOTO NDTP
+2 ;
+3 IF $EXTRACT(IOST)="C"
SET EXTRALINES=3
+4 IF '$TEST
SET EXTRALINES=8
+5 ;
+6 SET (S1,S2,S3,DFN,RSEQ,PSORX,PSORXN,RXNUMB,CDIV,OCDIV,CDIVN)=""
+7 FOR
SET CDIV=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV))
if CDIV=""
QUIT
Begin DoDot:1
+8 FOR
SET S1=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1))
if S1=""
QUIT
Begin DoDot:2
+9 FOR
SET S2=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1,S2))
if S2=""
QUIT
Begin DoDot:3
+10 FOR
SET S3=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3))
if S3=""
QUIT
Begin DoDot:4
+11 FOR
SET DFN=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN))
if DFN=""
QUIT
Begin DoDot:5
+12 FOR
SET PSORXN=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN))
if PSORXN=""
QUIT
Begin DoDot:6
+13 FOR
SET RSEQ=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ))
if RSEQ=""
QUIT
Begin DoDot:7
+14 SET (RXNUMB,PSORX)=""
SET RXNUMB=$EXTRACT(PSORXN,1,$LENGTH(PSORXN)-1)
SET PSORX=$ORDER(^PSRX("B",RXNUMB,PSORX))
+15 SET LINES=$$COMPILE(DFN,PSORX)
+16 IF $Y>(IOSL-(LINES+EXTRALINES))
DO HDR
IF $DATA(DIRUT)
QUIT
+17 DO PRINT(DFN,PSORX)
End DoDot:7
if $DATA(DIRUT)
QUIT
End DoDot:6
if $DATA(DIRUT)
QUIT
End DoDot:5
if $DATA(DIRUT)
QUIT
End DoDot:4
if $DATA(DIRUT)
QUIT
+18 IF '$DATA(DIRUT)
IF S2'=0
IF $ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1,S2))'=""
WRITE SP2
End DoDot:3
if $DATA(DIRUT)
QUIT
+19 ; Write SP1 after the first SORT field selected (Patient,Drug,User)
+20 IF '$DATA(DIRUT)
IF $ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1))'=""
WRITE !,SP1
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+21 if $DATA(DIRUT)
GOTO CLOSE
+22 ;
NDTP IF 'PRTD
DO HDR
WRITE !!?18,"********** NO DATA TO PRINT **********"
+1 IF $GET(PCNT)
Begin DoDot:1
+2 WRITE !,SP1
+3 WRITE !,"Total: ",PCNT," patient",$SELECT(PCNT>1:"s",1:"")
+4 WRITE " and ",FCNT," prescription fill",$SELECT(FCNT>1:"s",1:""),"."
End DoDot:1
+5 ;
CLOSE ;
+1 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
END KILL ^TMP("PSOBPSRP",$JOB),^TMP("PSOBPSRC",$JOB)
+1 KILL PSOAPT,PSODRUG,PSOUSER,PSOU,PSODRG,PSOPT,PSOSRT,PSOED,PSOSD,PSODIV,PSOSIT
+2 QUIT
+3 ;
SET ;
+1 SET (S1,S2,S3)=0
+2 FOR I=1:1:$LENGTH(PSOSRT,",")
Begin DoDot:1
+3 SET Y=$PIECE(PSOSRT,",",I)
+4 SET @("S"_I)=$SELECT(Y=1:PNAM,Y=2:DNAM,Y=3:CBY)
End DoDot:1
+5 SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,RXE,SEQ2)=""
+6 QUIT
+7 ;
COMPILE(DFN,RXIEN) ;
+1 ; Gather data for report and determine the number of lines for the Rx
+2 ;Input: DFN-Patient
+3 ; RXIEN=Prescription IEN
+4 ;Output: LINE=number of lines for Rx
+5 ;
+6 NEW BILLED,CBY,CCOM,CDAT,CFILL,CINFO,COB,CREAS,DNAM,II,J,K,LINE,PMES,PNAM,PSSN,RXNUM,STR,X,XX
+7 SET (BILLED,CBY,CCOM,CDAT,CINFO,COB,CREAS,DNAM,PMES,PNAM,PSSN,RXNUM)=""
+8 ;
+9 DO DEM^VADPT
SET PSSN=$PIECE($GET(VADM(2)),"^",2)
KILL VADM
+10 KILL RXINFO
DO GETS^DIQ(52,RXIEN_",",".01;2;6","EI","RXINFO")
+11 SET PNAM=RXINFO(52,RXIEN_",",2,"E")
SET DNAM=RXINFO(52,RXIEN_",",6,"E")
+12 DO GETS^DIQ(52.25,RSEQ_","_RXIEN_",",".01;2;5;10;11;12;13;17;20;27","IE","CINFO")
+13 if $DATA(RXINFO(52,RXIEN_",",.01,"E"))
SET RXNUM=RXINFO(52,RXIEN_",",.01,"E")
+14 if $DATA(CINFO(52.25,RSEQ_","_RXIEN_",",10,"I"))
SET CDAT=CINFO(52.25,RSEQ_","_RXIEN_",",10,"I")
+15 SET CDAT=$$DT(CDAT)
+16 if $DATA(CINFO(52.25,RSEQ_","_RXIEN_",",12,"I"))
SET CREAS=CINFO(52.25,RSEQ_","_RXIEN_",",12,"E")
+17 if $DATA(CINFO(52.25,RSEQ_","_RXIEN_",",11,"E"))
SET CBY=CINFO(52.25,RSEQ_","_RXIEN_",",11,"E")
+18 if $DATA(CINFO(52.25,RSEQ_","_RXIEN_",",2,"E"))
SET PMES=CINFO(52.25,RSEQ_","_RXIEN_",",2,"E")
+19 DO TEXT(.PMES,PMES,65)
+20 if $DATA(CINFO(52.25,RSEQ_","_RXIEN_",",13,"E"))
SET CCOM=CINFO(52.25,RSEQ_","_RXIEN_",",13,"E")
+21 DO TEXT(.CCOM,CCOM,65)
+22 if $DATA(CINFO(52.25,RSEQ_","_RXIEN_",",5,"I"))
SET CFILL=CINFO(52.25,RSEQ_","_RXIEN_",",5,"I")
+23 SET COB=$GET(CINFO(52.25,RSEQ_","_RXIEN_",",27,"I"))
+24 ;
+25 ; Get Insurance Name and Reject Code(s)
+26 NEW I,OTHREJS,PSOINS,RCARR,RCEXPL,RCEXPLS,RCIEN,RCIENS,REJCD,REJCDS
+27 SET (OTHREJS,PSOINS,RCARR,RCEXPL,RCEXPLS,RCIEN,RCIENS,REJCD,REJCDS)=""
+28 ;
+29 SET PSOINS=$GET(CINFO(52.25,RSEQ_","_RXIEN_",",20,"I"))
+30 SET REJCD=$GET(CINFO(52.25,RSEQ_","_RXIEN_",",.01,"I"))
+31 IF REJCD'=""
Begin DoDot:1
+32 ; get Reject Code Explanation from File #9002313.93
+33 SET RCIEN=$ORDER(^BPSF(9002313.93,"B",REJCD,""))
+34 SET RCEXPL=$$GET1^DIQ(9002313.93,RCIEN_",",.02,"E")
+35 ; create a rejects array RCARR
+36 SET RCARR(0)=REJCD_":"_RCEXPL
+37 QUIT
End DoDot:1
+38 ;
+39 ; DBIA #4719
SET BILLED=$$GETBAMT^BPSBUTL(RXIEN,$GET(CFILL),COB)
+40 ;
+41 SET LINE=1
+42 SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=RXNUM_"/"_CFILL_U_$EXTRACT(DNAM,1,21)_U_$EXTRACT(PNAM,1,13)_"("_$PIECE(PSSN,"-",3)_")"_U_CDAT_U_$EXTRACT(CBY,1,14)
+43 SET LINE=LINE+1
+44 SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Insurance: "_PSOINS
+45 SET LINE=LINE+1
+46 ;
+47 SET II=""
FOR
SET II=$ORDER(RCARR(II))
if II=""
QUIT
Begin DoDot:1
+48 IF II=0
SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Reject: "_$GET(RCARR(II))
+49 IF '$TEST
SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" "_$EXTRACT($GET(RCARR(II)),1,69)
+50 SET LINE=LINE+1
End DoDot:1
+51 ;
+52 SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Billed Amount: "_"$"_BILLED
+53 SET LINE=LINE+1
+54 ;
+55 SET II=""
FOR
SET II=$ORDER(CCOM(II))
if II=""
QUIT
Begin DoDot:1
+56 IF II=1
SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" Comments: "_$GET(CCOM(II))
+57 IF '$TEST
SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" "_$GET(CCOM(II))
+58 SET LINE=LINE+1
End DoDot:1
+59 ;
+60 SET II=""
FOR
SET II=$ORDER(PMES(II))
if II=""
QUIT
Begin DoDot:1
+61 IF II=1
SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)="Payer Message: "_$GET(PMES(II))
+62 IF '$TEST
SET ^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,LINE)=" "_$GET(PMES(II))
+63 SET LINE=LINE+1
End DoDot:1
+64 ;
+65 QUIT LINE
+66 ;
PRINT(DFN,RXIEN) ; - Print
+1 ;Input: DFN-Patient
+2 ; RXIEN=Prescription IEN
+3 ;
+4 NEW RXLN,RXREC
+5 ;
+6 IF OCDIV'=CDIV!(OCDIV="")
DO HDR
IF $DATA(DIRUT)
QUIT
+7 SET OCDIV=CDIV
+8 ;
+9 SET RXLN=""
FOR
SET RXLN=$ORDER(^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,RXLN))
if RXLN=""
QUIT
Begin DoDot:1
+10 SET RXREC=^TMP("PSOBPSRP",$JOB,CDIV,S1,S2,S3,DFN,PSORXN,RSEQ,RXLN)
+11 ; Write Rx Info.
+12 IF RXLN=1
WRITE !,$PIECE(RXREC,U),?15,$PIECE(RXREC,U,2),?37,$PIECE(RXREC,U,3),?57,$PIECE(RXREC,U,4),?66,$PIECE(RXREC,U,5)
+13 ; Write Insurance Name, Rejects, Billed Amount, Comments and Payer Message.
+14 IF '$TEST
WRITE !,RXREC
End DoDot:1
+15 WRITE !
+16 ;
+17 if '$DATA(^TMP("PSOBPSRC",$JOB,DFN))
SET PCNT=PCNT+1
SET ^TMP("PSOBPSRC",$JOB,DFN)=""
+18 ;
+19 SET PRTD=1
SET FCNT=FCNT+1
+20 QUIT
+21 ;
TEXT(TEXT,STR,L) ; Formats STR into TEXT array, lines lenght = L
+1 NEW J,WORD,K
SET K=+$ORDER(TEXT(""),-1)
if 'K
SET K=1
+2 FOR J=1:1:$LENGTH(STR," ")
Begin DoDot:1
+3 SET WORD=$PIECE(STR," ",J)
IF ($LENGTH($GET(TEXT(K))_WORD))>L
SET K=K+1
+4 SET TEXT(K)=$GET(TEXT(K))_WORD_" "
End DoDot:1
+5 QUIT
+6 ;
HDR ; - Prints the Header
+1 NEW X,DIR,CDIVN
SET PAG=$GET(PAG)+1
+2 SET CDIVN=$$GET1^DIQ(59,$GET(CDIV)_",",".01")
+3 IF PAG>1
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+4 SET DIR(0)="E"
SET DIR("A")=" Press ENTER to Continue or ^ to Exit"
DO ^DIR
End DoDot:1
if $DATA(DIRUT)
QUIT
+5 ;
+6 WRITE @IOF,"Ignored Rejects Report",?71,"Page: ",$JUSTIFY(PAG,3)
+7 WRITE !,"Sorted by",$$SRT(PSOSRT),?48,"Division: ",CDIVN
+8 WRITE !,"Date Range: "_$$DT(PSOSD+1\1)_" - "_$$DT(PSOED\1)
+9 WRITE ?48,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT())
+10 IF PAG=1
Begin DoDot:1
+11 WRITE !!,?19,"Note: Billed amount is what was billed and"
+12 WRITE !,?17,"cannot be used to determine potential revenue."
End DoDot:1
+13 SET X=""
SET $PIECE(X,"-",81)=""
WRITE !,X
+14 WRITE !,"RX#/FILL",?15,"DRUG",?37,"PATIENT",?56,"IGNORE DT",?66,"IGNORED BY"
+15 WRITE !,"--------------",?15,"---------------------",?37,"------------------",?56,"---------",?66,"--------------"
+16 QUIT
+17 ;
SRT(ST) ; - Convert the "2,1" (example) to "DRUG,PATIENT"
+1 ;Input: ST-String with the Sorting fields by number
+2 ;Output: ST-String with the Sorting fields by name
+3 NEW I,X,STR,FLD
+4 SET STR="PATIENT^DRUG^USER"
+5 FOR I=1:1:$LENGTH(ST,",")
Begin DoDot:1
+6 SET FLD=+$PIECE(ST,",",I)
SET X=$PIECE(STR,"^",FLD)
+7 SET $PIECE(ST,",",I)=" "_X
End DoDot:1
+8 QUIT ST
+9 ;
DT(DT) ; - Convert FM Date to MM/DD/YYYY
+1 IF 'DT
QUIT ""
+2 IF '(DT#10000)
QUIT (1700+$EXTRACT(DT,1,3))
+3 IF '(DT#100)
QUIT $EXTRACT(DT,4,5)_"/"_(1700+$EXTRACT(DT,1,3))
+4 QUIT $EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT((1700+$EXTRACT(DT,1,3)),3,4)
+5 ;
