PSOBORP3 ;ALBANY/BLD - TRICARE-CHAMPVA BYPASS/OVERRIDE AUDIT REPORT ;7/1/2010
;;7.0;OUTPATIENT PHARMACY;**358,359,385,427,528,561**;DEC 1997;Build 41
;
;Uses API
;this routine will process the TRICARE-CHAMPVA Override Report based on the filtering criteria in routine PSOBORP0
;
;
EN(PSOSEL) ;
;
;THE INFORMATION FOR THE TRICARE-CHAMPVA OVERRIDE REPORT WILL BE GATHERED BY LOOPING THROUGH
;FILE 52.87 (PSO AUDIT LOG FILE) TO RETRIEVE THE INFORMATION BASED UPON THE FILTERING
;REQUIREMENTS IN ROUTINE PSOBORP0.
;
N ACTDT,AMT,BEGDT,DASH,DETSUM,ENDDT,EQUAL,HDR1,HDR2,HDR3,HDR4,HDR5,HDR6,HDR7,MEAN,PAGE,PAGENBR,RXCNT
N PSONOW,RJHDR,SPACE,STAR,PSOAUD,SUBTOTAL,SUBTOT,PROVTOT,PRORXTOT
D INIT
D PROCESS^PSOBORP2(.PSOSEL,.PSOAUD) ;process file 52.87 (Audit File)
W:'PSOEXCEL @IOF D HDR
I PSOSEL("SUM_DETAIL")="S" D SUMMARY(.PSOSEL,.PSOAUD)
I PSOSEL("SUM_DETAIL")="D" D DETAIL(.PSOSEL,.PSOAUD)
;
D END^PSOBORP2
Q
;
DETAIL(PSOSEL,PSOAUD) ;for detail report
;
N PAGELOC,AMT,PROV
N GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL
;
I PSOEXCEL D EDETAIL(.PSOSEL,.PSOAUD) Q ;if Excel format chosen
S PAGENBR=1
D DETHDR
;
S (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,PRORXTOT,PROVTOT,SUBTOTAL)=""
;
I PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R") D Q
.F S DIVISION=$O(PSOAUD(DIVISION)) Q:DIVISION=""!($G(PSOUT)) D
..S (PROVTOT,PRORXTOT,DIVTOT,DIVRXTOT)=""
..I ($Y+8)>IOSL D DETHDR Q:$G(PSOUT)
..W !!,$E(DASH,1,110)
..W !,"DIVISION: ",DIVISION
..F S TCTYPE=$O(PSOAUD(DIVISION,TCTYPE)) Q:TCTYPE=""!($G(PSOUT)) D
...S TCT=TCTYPE,(TCRXTOT,TCTOTAL)="" D TCHDR(TCT)
...F S PROVIDER=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER)) Q:PROVIDER=""!($G(PSOUT)) D
....S (PROVTOT,PRORXTOT)=""
....F S ACTDT=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT)) Q:ACTDT=""!($G(PSOUT)) D
.....S PROV=PROVIDER
.....S AMT=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
.....S PROVTOT=$FN(PROVTOT+AMT,"T",2)
.....S PRORXTOT=PRORXTOT+1
.....S TCTOTAL=$FN(TCTOTAL+AMT,"T",2)
.....S TCRXTOT=TCRXTOT+1
.....S DIVTOT=$FN(DIVTOT+AMT,"T",2)
.....S DIVRXTOT=DIVRXTOT+1
.....S GRDTOTAL=$FN(GRDTOTAL+AMT,"T",2)
.....S GRDRXTOT=GRDRXTOT+1
.....Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D TCDSUMP(TCT,PROV,ACTDT) ;detail print
....Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D PROVTOT(TCT,PROV,PROVTOT,PRORXTOT)
...Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D TCTOT(TCTOTAL,TCRXTOT,TCT)
..Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D DIVTOTP(DIVTOT,DIVRXTOT)
.Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D GRDTOTP(GRDTOTAL,GRDRXTOT)
;
Q
;
EDETAIL(PSOSEL,PSOAUD) ;for detail report
;
N PAGELOC,AMT
N GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL,PROV
;
S PAGENBR=1
D DETHDR
;
S (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL)=""
;
I PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R") D Q
.F S DIVISION=$O(PSOAUD(DIVISION)) Q:DIVISION=""!($G(PSOUT)) D
..F S TCTYPE=$O(PSOAUD(DIVISION,TCTYPE)) Q:TCTYPE=""!($G(PSOUT)) D
...S TCT=TCTYPE
...F S PROVIDER=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER)) Q:PROVIDER=""!($G(PSOUT)) D
....F S ACTDT=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT)) Q:ACTDT=""!($G(PSOUT)) D
.....S PROV=PROVIDER
.....S AMT=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
.....Q:$G(PSOUT) D TCDSUMP(TCTYPE,PROV,ACTDT) ;detail print
....Q:$G(PSOUT)
...Q:$G(PSOUT)
..Q:$G(PSOUT)
.Q:$G(PSOUT)
;
Q
;
SUMMARY(PSOSEL,PSOAUD) ;for summary report
;
N AMT,ACTDT,ACTDATE,DIVISION,PROVIDER,PHAMCST,PAGELOC,PROVIDER,TCTOTAL,TCTYPE,RXTOTAL,RXCNT,GRDTOTAL,SUBTOT,MEAN
;
S PAGENBR=1
D SUMHDR
S (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCRXTOT,TCTYPE,PROVIDER,PROVTOT,PRORXTOT,SUBTOTAL)=""
;
;subtotals by provider
I PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R") D
.F S DIVISION=$O(PSOAUD(DIVISION)) Q:DIVISION=""!($G(PSOUT)) D
..S (PROVTOT,PRORXTOT,RXCNT,DIVTOT,DIVRXTOT)=""
..I ($Y+8)>IOSL D SUMHDR Q:$G(PSOUT)
..W !!,$E(DASH,1,110)
..W !,"DIVISION: ",DIVISION
..F S TCTYPE=$O(PSOAUD(DIVISION,TCTYPE)) Q:TCTYPE=""!($G(PSOUT)) D
...S TCT=TCTYPE,(TCRXTOT,TCTOTAL)="" D TCHDR(TCT)
...F S PROVIDER=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER)) Q:PROVIDER=""!($G(PSOUT)) D
....S (PROVTOT,PRORXTOT)=0
....F S ACTDT=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT)) Q:ACTDT=""!($G(PSOUT)) D
.....S PROV=PROVIDER
.....S AMT=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
.....S PROVTOT=$FN(PROVTOT+AMT,"T",2)
.....S PRORXTOT=PRORXTOT+1
.....S TCTOTAL=$FN(TCTOTAL+AMT,"T",2)
.....S TCRXTOT=TCRXTOT+1
.....S DIVTOT=$FN(DIVTOT+AMT,"T",2)
.....S DIVRXTOT=DIVRXTOT+1
.....S GRDTOTAL=$FN(GRDTOTAL+AMT,"T",2)
.....S GRDRXTOT=GRDRXTOT+1
....Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D TCSSUMP(PROVTOT,PRORXTOT,TCT,PROV) ;summary print
...Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D TCTOT(TCTOTAL,TCRXTOT,TCT)
..Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D DIVTOTP(DIVTOT,DIVRXTOT)
.Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D GRDTOTP(GRDTOTAL,GRDRXTOT)
;
Q
;
SUMHDR ;
;this will print the header and page breaks for summary report.
;
;
I PAGENBR>1 D PAUSE^PSOBORP1 Q:$G(PSOUT) W @IOF
S PAGELOC=132-($L(PAGE)+$L(PAGENBR))
W !,HDR1,?PAGELOC,PAGE,PAGENBR S PAGENBR=PAGENBR+1
W !,HDR2,!,HDR3,!,HDR4,!,HDR5 W !,$E(EQUAL,1,110)
;
Q
;
DETHDR ;
;this will print the header and page breaks for the detail report
;
I PAGENBR>1,PSOEXCEL Q ;if Excel spreadsheet format
;
I PAGENBR>1 D PAUSE^PSOBORP1 Q:$G(PSOUT) W @IOF
S PAGELOC=132-($L(PAGE)+$L(PAGENBR))
I 'PSOEXCEL D
.W !,HDR1,?PAGELOC,PAGE,PAGENBR S PAGENBR=PAGENBR+1
.W !,HDR2,!,HDR3,!,HDR4,!,HDR5,!,$E(EQUAL,1,110),!,HDR6,!,HDR7,!,$E(EQUAL,1,110)
;
I PSOEXCEL D
.W !,"DIVISION"_"^"_"PT ELIG"_"^"_"TYPE"_"^"_"PROVIDER"_"^"_"BENEFICIARY NAME"_"^"_"ID"_"^"_"RX#"_"^"_"REF/ECME#"_"^"_"RX DATE"_"^"_"FILL LOC"_"^"_"STATUS"_"^"_"ACTION DATE"_"^"_"USER NAME"_"^"_"$BILLED"
.W "^"_"QTY"_"^"_"NDC#"_"^"_"DRUG"_"^"_"REJECT CODE(S)"_"^"_"REJECT CODE"_"^"_"REJECT EXPLANATION"_"^"_"JUSTIFICATION"
;
Q
;
PROVTOT(TCT,PROVIDER,PROVTOT,PROVRXT) ;prints totals by provider
;
Q:PSOEXCEL ;if Excel spreadsheet format
;
Q:TCTYPE="TRICARE INPATIENT"!(TCTYPE="CHAMPVA INPATIENT")
W !!,?10,PROV
W !,?10,"SUBTOTALS",?51,PROVTOT
W !,?10,"RX COUNT",?51,PROVRXT
W !,?10,"MEAN",?51,$FN(PROVTOT/PROVRXT,"T",2),!
S (PROVRXT,PROVTOT)=""
;
Q
;
;
TCTOT(TCTOTAL,TCRXTOT,TCTYPE) ;
;print tctypes totals
;
Q:PSOEXCEL ;if Excel spreadsheet format
;
W !!,?5,TCTYPE
W !,?5,"SUBTOTALS",?51,TCTOTAL
W !,?5,"RX COUNT",?51,TCRXTOT
W !,?5,"MEAN",?51,$FN(TCTOTAL/TCRXTOT,"T",2)
;
;
Q
;
DIVTOTP(DIVTOT,DIVRXTOT) ;
;print the totals for a division
;
Q:PSOEXCEL ;if Excel spreadsheet format
;
W !!,"DIVISION ",DIVISION,?51,$E(DASH,1,13)
W !,"SUBTOTALS",?51,DIVTOT
W !,"RX COUNT",?51,DIVRXTOT
W !,"MEAN",?51,$FN(DIVTOT/DIVRXTOT,"T",2)
;
Q
;
GRDTOTP(GRDTOTAL,GRDRXTOT) ;
;
Q:PSOEXCEL ;if Excel spreadsheet format
;
N I
;
I '$D(PSOAUD) W !!,?26,"NO INFORMATION FOUND..." Q
F I=1:1:2 W !,?51,$E(DASH,1,13)
W !!!,"GRAND TOTALS",?51,GRDTOTAL
W !,"RX COUNT",?51,GRDRXTOT
W !,"MEAN",?51,$FN(GRDTOTAL/GRDRXTOT,"T",2)
W !,?51,$E(DASH,1,13)
;
Q
;
;
TCDSUMP(TCTYPE,PROVIDER,ACTDT) ;print the summary
;
N AMTBILL,DFN,NAME,ID,REFILL,RXNBR,RX,ECMENBR,RXDATE,RXINFO,RXQTY,NDCNBR,RXDRUG,VADM,USER,TRIJUST,PTELIG,REJ,RTYPE
S RJHDR=$E(STAR,1,30)_$E(SPACE,1,3)_TCTYPE_$E(SPACE,1,3)_$E(STAR,1,(57-$L(TCTYPE)))
S DFN=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",4)
D DEM^VADPT
S NAME=VADM(1)
S ID=$P(VADM(2),"^",1),ID=$E(ID,$L(ID)-3,999)
S RXNBR=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",2)
S RX=$$GET1^DIQ(52,RXNBR,.01)
S REFILL=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",3)
S ECMENBR=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",10) I ECMENBR="" S ECMENBR="N/A"
S ECMENBR=REFILL_"/"_ECMENBR
S RXDATE=$$DATTIM($P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",6))
S RXINFO=$$RXINFO(RXNBR)
S USER=$P(^VA(200,$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",4),0),"^",1)
S AMTBILL=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
S RXQTY=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",11)
S NDCNBR=$TR($P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",7),"-","")
S RXDRUG=$E($P($G(^PSDRUG($P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",8),0)),"^",1),1,24)
S TRIJUST=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,2)),"^",1)
S PTELIG=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",3)
S REJ=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",2),RTYPE=$S(REJ="I":"INPATIENT",REJ="N":"NON-BILLABLE",REJ="R":"REJECT OVERRIDE",REJ="P":"PARTIAL FILL",1:"")
;
;for standard output
I 'PSOEXCEL D
.W !!,$E(NAME,1,30)_"/"_ID,?36,RX,?54,ECMENBR,?72,RXDATE,?90,RXINFO
.W !,?4,$$DATTIM($P(ACTDT,".",1)),?22,$E(USER,1,20),?58,$FN(AMTBILL,"T",2),?72,RXQTY,?84,NDCNBR,?103,RXDRUG
.I $D(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3)) D NCPDPRC(.PSOAUD)
.;
.;TRICARE justification
.I $E(IOST,1,2)="C-" D
..I $L(TRIJUST)>125 W !,?4,$E(TRIJUST,1,125)_"..."
..I $L(TRIJUST)<125 W !,?4,TRIJUST
;
;if Excel format is selected
I PSOEXCEL D
.N REJIEN,FILE,FIELD,NCPDIEN,RJCDS,REJEXP
.S REJIEN=0,FILE=9002313.93,FIELD=.02,RJCDS="",REJEXP=""
.I $D(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3)) F S REJIEN=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN)) Q:'REJIEN D
..S NCPDIEN=$G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN))
..S RJCDS=$S($G(RJCDS)="":NCPDIEN,1:RJCDS_","_NCPDIEN)
.I RJCDS'="",$P(RJCDS,":",1)'="eT",$P(RJCDS,":",1)'="eC" S REJEXP=$$GET1^DIQ(FILE,+$P(RJCDS,",",1),FIELD)
.I RJCDS'="",$P(RJCDS,":",1)="eT" S REJEXP="TRICARE-NON BILLABLE"
.I RJCDS'="",$P(RJCDS,":",1)="eC" S REJEXP="CHAMPVA-NON BILLABLE"
.W !,DIVISION_"^"_PTELIG_"^"_RTYPE_"^"_PROVIDER_"^"_$E(NAME,1,30)_"^"_ID_"^"_RX_"^"_ECMENBR_"^"_RXDATE_"^"_RXINFO_"^"
.W $$DATTIM($P(ACTDT,".",1))_"^"_$E(USER,1,20)_"^"_$FN(AMTBILL,"T",2)_"^"_RXQTY_"^"_NDCNBR_"^"_RXDRUG_"^"_RJCDS_"^"_$P(RJCDS,",",1)_"^"_REJEXP_"^"_TRIJUST
;
Q
;
NCPDPRC(PSOAUD) ;
;writes the NCPD reject code
;
N REJIEN,FILE,FIELD,NCPDCD,NCPDIEN,REJTXT
S REJIEN=0,FILE=9002313.93,FIELD=.02
F S REJIEN=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN)) Q:'REJIEN D
.S NCPDCD=$G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN))
.I NCPDCD'="eT",NCPDCD'="eC" D
..S NCPDIEN=$O(^BPSF(FILE,"B",NCPDCD,"")),REJTXT=$$GET1^DIQ(FILE,NCPDIEN,FIELD)
.I NCPDCD="eT" S REJTXT="TRICARE-NON BILLABLE"
.I NCPDCD="eC" S REJTXT="CHAMPVA-NON BILLABLE"
.I 'PSOEXCEL W !,?4,NCPDCD_":"_REJTXT
.I PSOEXCEL W !,NCPDCD_":"_REJTXT
;
Q
;
RXINFO(RXNBR) ;
;this will return the data needed for the RX INFO on the Audit Report.
;
;
N RFL,CMOP,RXSTATUS,FILLOC,BILLTYPE,RELDATE,RELSTATUS
S RFL=$$LSTRFL^PSOBPSU1(RXNBR)
S BILLTYPE="**"
S FILLOC=$$MWC^PSOBPSU2(RXNBR,RFL)
S RXSTATUS=$$GET1^DIQ(52,RXNBR,100,"I")
S RXSTATUS=$$RXSTANAM(RXSTATUS)
S RELDATE=$$RXRLDT^PSOBPSUT(RXNBR,RFL)
S RELSTATUS=$S(RELDATE'="":"R",1:"N")
I 'PSOEXCEL Q FILLOC_" "_BILLTYPE_" "_RXSTATUS_"/"_RELSTATUS
I PSOEXCEL Q FILLOC_"^"_RXSTATUS_"/"_RELSTATUS
;
RXSTANAM(BPRXSTAT) ;*/
Q:BPRXSTAT=0 "AC" ; ACTIVE;
Q:BPRXSTAT=1 "NV" ; NON-VERIFIED;
Q:BPRXSTAT=3 "HL" ; HOLD;
Q:BPRXSTAT=5 "SU" ; SUSPENDED;
Q:BPRXSTAT=11 "EX" ; EXPIRED;
Q:BPRXSTAT=12 "DS" ; DISCONTINUED;
Q:BPRXSTAT=13 "DL" ; DELETED;
Q:BPRXSTAT=14 "DS" ; DISCONTINUED BY PROVIDER;
Q:BPRXSTAT=15 "DS" ; DISCONTINUED (EDIT);
Q:BPRXSTAT=16 "HL" ; PROVIDER HOLD;
Q:BPRXSTAT=-1 "??"
Q ""
;
;
TCSSUMP(SUBTOT,RXCNT,TCTYPE,PROVIDER,PHARMCST) ;print the summary
;
I TCTYPE="TRICARE INPATIENT"!(TCTYPE="CHAMPVA INPATIENT") Q
S RJHDR=$E(STAR,1,30)_$E(SPACE,1,3)_TCTYPE_$E(SPACE,1,3)_$E(STAR,1,(57-$L(TCTYPE)))
;
;subtotals by provider
W !!,?7,$S(PSOSEL("TOTALS BY")="P":"PROVIDER: ",1:"PHARMACIST: "),PROVIDER,?44,$E(DASH,1,13)
W !,?7,"SUB-TOTALS",?51,SUBTOT
W !,?7,"RX COUNT",?51,RXCNT
W !,?7,"MEAN",?51,$FN(SUBTOT/RXCNT,"T",2),!
;
Q
;
TCHDR(TCTYPE) ;print report header
;
S (SUBTOT,RXCNT)=""
I 'PSOEXCEL D Q
.S RJHDR=$E(STAR,1,30)_$E(SPACE,1,3)_TCTYPE_$E(SPACE,1,3)_$E(STAR,1,(57-$L(TCTYPE)))
.W !!,RJHDR
;
;
Q
;
HDR ;
S HDR1="TRICARE-CHAMPVA OVERRIDE AUDIT REPORT - "_DETSUM_" Print Date: "_PSONOW
S HDR2="DIVISION(S): "_$$DIVISION()
S HDR3="ELIGIBILITY: "_$$ELIG()
S HDR4="TC TYPES: "_$$HDR4(.PSOSEL)
S HDR5="ALL PRESCRIPTIONS BY AUDIT DATE: From "_BEGDT_" through "_ENDDT
I PSOSEL("SUM_DETAIL")="D" D
.S HDR6="BENEFICIARY NAME/ID"_$E(SPACE,1,17)_"RX#"_$E(SPACE,1,15)_"REF/ECME#"_$E(SPACE,1,9)_"RX DATE"_$E(SPACE,1,11)_"RX INFO"
.S HDR7=$E(SPACE,1,4)_"ACTION DATE"_$E(SPACE,1,8)_"USER NAME"_$E(SPACE,1,26)_"$BILLED "_$E(SPACE,1,6)_"QTY"_$E(SPACE,1,9)_"NDC#"_$E(SPACE,1,15)_"DRUG"
Q
;
HDR4(PSOSEL) ;
;
N TCTYPE,RCODE
S (RCODE,TCTYPE)=""
F S TCTYPE=$O(PSOSEL("REJECT CODES",TCTYPE)) Q:TCTYPE="" D
.I $G(RCODE)="" S RCODE=PSOSEL("REJECT CODES",TCTYPE)
.E S RCODE=RCODE_", "_PSOSEL("REJECT CODES",TCTYPE)
;
Q RCODE
;
;
DIVISION() ;list of divisions for header
;
N DIV,DIVISION
S (DIVISION,DIV)=""
I PSOSEL("DIVISION")="A" Q "ALL"
F S DIV=$O(PSOSEL("DIVISION",DIV)) Q:DIV="" D
.I DIVISION="" S DIVISION=$P(PSOSEL("DIVISION",DIV),"^",2) Q
.S DIVISION=DIVISION_$P(PSOSEL("DIVISION",DIV),"^",2)
Q DIVISION
;
;
REJECTS() ;list the reject types for the header
;
N REJ,REJECTS
S (REJECTS,REJ)=""
F S REJ=$O(PSOSEL("REJECT CODES",REJ)) Q:REJ="" D
.I REJECTS="" S REJECTS=$S(REJ="I":"INPATIENT",REJ="N":"NON-BILLABLE",REJ="R":"REJECT OVERRIDE",REJ="P":"PARTIAL FILL",1:"ALL")
.E S REJECTS=REJECTS_" "_$S(REJ="I":"INPATIENT",REJ="N":"NON-BILLABLE",REJ="R":"REJECT OVERRIDE",REJ="P":"PARTIAL FILL",1:"ALL")
;
Q REJECTS
;
;
INIT ;
;
N %,Y
D NOW^%DTC S Y=% D DD^%DT S PSONOW=Y
S $P(SPACE," ",150)=""
S $P(DASH,"-",150)=""
S $P(EQUAL,"=",150)=""
S $P(STAR,"*",150)=""
S PAGE="PAGE: "
S DETSUM=$S(PSOSEL("SUM_DETAIL")="S":"SUMMARY",1:"DETAIL")
S BEGDT=$$DATTIM(PSOSEL("BEGIN DATE"))
S ENDDT=$$DATTIM(PSOSEL("END DATE"))
S PSOEXCEL=$G(PSOSEL("EXCEL"))
K SUBTOTAL,MEAN,SUBTOT,DIVISION,PROVIDER,TCTYPE,TCTYPE,RXCNT
;
Q
;
;Convert FM date or date.time to displayable (mm/dd/yy HH:MM) format
;
DATTIM(X) ;
N DATE,BPT,BPM,BPH,BPAP
S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT))
S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4)
S BPAP="AM" I BPH>12 S BPH=BPH-12,BPAP="PM" S:$L(BPH)<2 BPH="0"_BPH
I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP
Q $G(DATE)
;
;
ELIG() ; eligibility for header
Q $S(PSOSEL("ELIG_TYPE")="T":"TRICARE",PSOSEL("ELIG_TYPE")="C":"CHAMPVA",1:"ALL")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBORP3 15437 printed Nov 22, 2024@17:34:55 Page 2
PSOBORP3 ;ALBANY/BLD - TRICARE-CHAMPVA BYPASS/OVERRIDE AUDIT REPORT ;7/1/2010
+1 ;;7.0;OUTPATIENT PHARMACY;**358,359,385,427,528,561**;DEC 1997;Build 41
+2 ;
+3 ;Uses API
+4 ;this routine will process the TRICARE-CHAMPVA Override Report based on the filtering criteria in routine PSOBORP0
+5 ;
+6 ;
EN(PSOSEL) ;
+1 ;
+2 ;THE INFORMATION FOR THE TRICARE-CHAMPVA OVERRIDE REPORT WILL BE GATHERED BY LOOPING THROUGH
+3 ;FILE 52.87 (PSO AUDIT LOG FILE) TO RETRIEVE THE INFORMATION BASED UPON THE FILTERING
+4 ;REQUIREMENTS IN ROUTINE PSOBORP0.
+5 ;
+6 NEW ACTDT,AMT,BEGDT,DASH,DETSUM,ENDDT,EQUAL,HDR1,HDR2,HDR3,HDR4,HDR5,HDR6,HDR7,MEAN,PAGE,PAGENBR,RXCNT
+7 NEW PSONOW,RJHDR,SPACE,STAR,PSOAUD,SUBTOTAL,SUBTOT,PROVTOT,PRORXTOT
+8 DO INIT
+9 ;process file 52.87 (Audit File)
DO PROCESS^PSOBORP2(.PSOSEL,.PSOAUD)
+10 if 'PSOEXCEL
WRITE @IOF
DO HDR
+11 IF PSOSEL("SUM_DETAIL")="S"
DO SUMMARY(.PSOSEL,.PSOAUD)
+12 IF PSOSEL("SUM_DETAIL")="D"
DO DETAIL(.PSOSEL,.PSOAUD)
+13 ;
+14 DO END^PSOBORP2
+15 QUIT
+16 ;
DETAIL(PSOSEL,PSOAUD) ;for detail report
+1 ;
+2 NEW PAGELOC,AMT,PROV
+3 NEW GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL
+4 ;
+5 ;if Excel format chosen
IF PSOEXCEL
DO EDETAIL(.PSOSEL,.PSOAUD)
QUIT
+6 SET PAGENBR=1
+7 DO DETHDR
+8 ;
+9 SET (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,PRORXTOT,PROVTOT,SUBTOTAL)=""
+10 ;
+11 IF PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R")
Begin DoDot:1
+12 FOR
SET DIVISION=$ORDER(PSOAUD(DIVISION))
if DIVISION=""!($GET(PSOUT))
QUIT
Begin DoDot:2
+13 SET (PROVTOT,PRORXTOT,DIVTOT,DIVRXTOT)=""
+14 IF ($Y+8)>IOSL
DO DETHDR
if $GET(PSOUT)
QUIT
+15 WRITE !!,$EXTRACT(DASH,1,110)
+16 WRITE !,"DIVISION: ",DIVISION
+17 FOR
SET TCTYPE=$ORDER(PSOAUD(DIVISION,TCTYPE))
if TCTYPE=""!($GET(PSOUT))
QUIT
Begin DoDot:3
+18 SET TCT=TCTYPE
SET (TCRXTOT,TCTOTAL)=""
DO TCHDR(TCT)
+19 FOR
SET PROVIDER=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER))
if PROVIDER=""!($GET(PSOUT))
QUIT
Begin DoDot:4
+20 SET (PROVTOT,PRORXTOT)=""
+21 FOR
SET ACTDT=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT))
if ACTDT=""!($GET(PSOUT))
QUIT
Begin DoDot:5
+22 SET PROV=PROVIDER
+23 SET AMT=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
+24 SET PROVTOT=$FNUMBER(PROVTOT+AMT,"T",2)
+25 SET PRORXTOT=PRORXTOT+1
+26 SET TCTOTAL=$FNUMBER(TCTOTAL+AMT,"T",2)
+27 SET TCRXTOT=TCRXTOT+1
+28 SET DIVTOT=$FNUMBER(DIVTOT+AMT,"T",2)
+29 SET DIVRXTOT=DIVRXTOT+1
+30 SET GRDTOTAL=$FNUMBER(GRDTOTAL+AMT,"T",2)
+31 SET GRDRXTOT=GRDRXTOT+1
+32 ;detail print
if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO DETHDR
if $GET(PSOUT)
QUIT
DO TCDSUMP(TCT,PROV,ACTDT)
End DoDot:5
+33 if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO DETHDR
if $GET(PSOUT)
QUIT
DO PROVTOT(TCT,PROV,PROVTOT,PRORXTOT)
End DoDot:4
+34 if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO DETHDR
if $GET(PSOUT)
QUIT
DO TCTOT(TCTOTAL,TCRXTOT,TCT)
End DoDot:3
+35 if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO DETHDR
if $GET(PSOUT)
QUIT
DO DIVTOTP(DIVTOT,DIVRXTOT)
End DoDot:2
+36 if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO DETHDR
if $GET(PSOUT)
QUIT
DO GRDTOTP(GRDTOTAL,GRDRXTOT)
End DoDot:1
QUIT
+37 ;
+38 QUIT
+39 ;
EDETAIL(PSOSEL,PSOAUD) ;for detail report
+1 ;
+2 NEW PAGELOC,AMT
+3 NEW GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL,PROV
+4 ;
+5 SET PAGENBR=1
+6 DO DETHDR
+7 ;
+8 SET (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL)=""
+9 ;
+10 IF PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R")
Begin DoDot:1
+11 FOR
SET DIVISION=$ORDER(PSOAUD(DIVISION))
if DIVISION=""!($GET(PSOUT))
QUIT
Begin DoDot:2
+12 FOR
SET TCTYPE=$ORDER(PSOAUD(DIVISION,TCTYPE))
if TCTYPE=""!($GET(PSOUT))
QUIT
Begin DoDot:3
+13 SET TCT=TCTYPE
+14 FOR
SET PROVIDER=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER))
if PROVIDER=""!($GET(PSOUT))
QUIT
Begin DoDot:4
+15 FOR
SET ACTDT=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT))
if ACTDT=""!($GET(PSOUT))
QUIT
Begin DoDot:5
+16 SET PROV=PROVIDER
+17 SET AMT=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
+18 ;detail print
if $GET(PSOUT)
QUIT
DO TCDSUMP(TCTYPE,PROV,ACTDT)
End DoDot:5
+19 if $GET(PSOUT)
QUIT
End DoDot:4
+20 if $GET(PSOUT)
QUIT
End DoDot:3
+21 if $GET(PSOUT)
QUIT
End DoDot:2
+22 if $GET(PSOUT)
QUIT
End DoDot:1
QUIT
+23 ;
+24 QUIT
+25 ;
SUMMARY(PSOSEL,PSOAUD) ;for summary report
+1 ;
+2 NEW AMT,ACTDT,ACTDATE,DIVISION,PROVIDER,PHAMCST,PAGELOC,PROVIDER,TCTOTAL,TCTYPE,RXTOTAL,RXCNT,GRDTOTAL,SUBTOT,MEAN
+3 ;
+4 SET PAGENBR=1
+5 DO SUMHDR
+6 SET (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCRXTOT,TCTYPE,PROVIDER,PROVTOT,PRORXTOT,SUBTOTAL)=""
+7 ;
+8 ;subtotals by provider
+9 IF PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R")
Begin DoDot:1
+10 FOR
SET DIVISION=$ORDER(PSOAUD(DIVISION))
if DIVISION=""!($GET(PSOUT))
QUIT
Begin DoDot:2
+11 SET (PROVTOT,PRORXTOT,RXCNT,DIVTOT,DIVRXTOT)=""
+12 IF ($Y+8)>IOSL
DO SUMHDR
if $GET(PSOUT)
QUIT
+13 WRITE !!,$EXTRACT(DASH,1,110)
+14 WRITE !,"DIVISION: ",DIVISION
+15 FOR
SET TCTYPE=$ORDER(PSOAUD(DIVISION,TCTYPE))
if TCTYPE=""!($GET(PSOUT))
QUIT
Begin DoDot:3
+16 SET TCT=TCTYPE
SET (TCRXTOT,TCTOTAL)=""
DO TCHDR(TCT)
+17 FOR
SET PROVIDER=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER))
if PROVIDER=""!($GET(PSOUT))
QUIT
Begin DoDot:4
+18 SET (PROVTOT,PRORXTOT)=0
+19 FOR
SET ACTDT=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT))
if ACTDT=""!($GET(PSOUT))
QUIT
Begin DoDot:5
+20 SET PROV=PROVIDER
+21 SET AMT=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
+22 SET PROVTOT=$FNUMBER(PROVTOT+AMT,"T",2)
+23 SET PRORXTOT=PRORXTOT+1
+24 SET TCTOTAL=$FNUMBER(TCTOTAL+AMT,"T",2)
+25 SET TCRXTOT=TCRXTOT+1
+26 SET DIVTOT=$FNUMBER(DIVTOT+AMT,"T",2)
+27 SET DIVRXTOT=DIVRXTOT+1
+28 SET GRDTOTAL=$FNUMBER(GRDTOTAL+AMT,"T",2)
+29 SET GRDRXTOT=GRDRXTOT+1
End DoDot:5
+30 ;summary print
if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO SUMHDR
if $GET(PSOUT)
QUIT
DO TCSSUMP(PROVTOT,PRORXTOT,TCT,PROV)
End DoDot:4
+31 if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO SUMHDR
if $GET(PSOUT)
QUIT
DO TCTOT(TCTOTAL,TCRXTOT,TCT)
End DoDot:3
+32 if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO SUMHDR
if $GET(PSOUT)
QUIT
DO DIVTOTP(DIVTOT,DIVRXTOT)
End DoDot:2
+33 if $GET(PSOUT)
QUIT
if ($Y+8)>IOSL
DO SUMHDR
if $GET(PSOUT)
QUIT
DO GRDTOTP(GRDTOTAL,GRDRXTOT)
End DoDot:1
+34 ;
+35 QUIT
+36 ;
SUMHDR ;
+1 ;this will print the header and page breaks for summary report.
+2 ;
+3 ;
+4 IF PAGENBR>1
DO PAUSE^PSOBORP1
if $GET(PSOUT)
QUIT
WRITE @IOF
+5 SET PAGELOC=132-($LENGTH(PAGE)+$LENGTH(PAGENBR))
+6 WRITE !,HDR1,?PAGELOC,PAGE,PAGENBR
SET PAGENBR=PAGENBR+1
+7 WRITE !,HDR2,!,HDR3,!,HDR4,!,HDR5
WRITE !,$EXTRACT(EQUAL,1,110)
+8 ;
+9 QUIT
+10 ;
DETHDR ;
+1 ;this will print the header and page breaks for the detail report
+2 ;
+3 ;if Excel spreadsheet format
IF PAGENBR>1
IF PSOEXCEL
QUIT
+4 ;
+5 IF PAGENBR>1
DO PAUSE^PSOBORP1
if $GET(PSOUT)
QUIT
WRITE @IOF
+6 SET PAGELOC=132-($LENGTH(PAGE)+$LENGTH(PAGENBR))
+7 IF 'PSOEXCEL
Begin DoDot:1
+8 WRITE !,HDR1,?PAGELOC,PAGE,PAGENBR
SET PAGENBR=PAGENBR+1
+9 WRITE !,HDR2,!,HDR3,!,HDR4,!,HDR5,!,$EXTRACT(EQUAL,1,110),!,HDR6,!,HDR7,!,$EXTRACT(EQUAL,1,110)
End DoDot:1
+10 ;
+11 IF PSOEXCEL
Begin DoDot:1
+12 WRITE !,"DIVISION"_"^"_"PT ELIG"_"^"_"TYPE"_"^"_"PROVIDER"_"^"_"BENEFICIARY NAME"_"^"_"ID"_"^"_"RX#"_"^"_"REF/ECME#"_"^"_"RX DATE"_"^"_"FILL LOC"_"^"_"STATUS"_"^"_"ACTION DATE"_"^"_"USER NAME"_"^"_"$BILLED"
+13 WRITE "^"_"QTY"_"^"_"NDC#"_"^"_"DRUG"_"^"_"REJECT CODE(S)"_"^"_"REJECT CODE"_"^"_"REJECT EXPLANATION"_"^"_"JUSTIFICATION"
End DoDot:1
+14 ;
+15 QUIT
+16 ;
PROVTOT(TCT,PROVIDER,PROVTOT,PROVRXT) ;prints totals by provider
+1 ;
+2 ;if Excel spreadsheet format
if PSOEXCEL
QUIT
+3 ;
+4 if TCTYPE="TRICARE INPATIENT"!(TCTYPE="CHAMPVA INPATIENT")
QUIT
+5 WRITE !!,?10,PROV
+6 WRITE !,?10,"SUBTOTALS",?51,PROVTOT
+7 WRITE !,?10,"RX COUNT",?51,PROVRXT
+8 WRITE !,?10,"MEAN",?51,$FNUMBER(PROVTOT/PROVRXT,"T",2),!
+9 SET (PROVRXT,PROVTOT)=""
+10 ;
+11 QUIT
+12 ;
+13 ;
TCTOT(TCTOTAL,TCRXTOT,TCTYPE) ;
+1 ;print tctypes totals
+2 ;
+3 ;if Excel spreadsheet format
if PSOEXCEL
QUIT
+4 ;
+5 WRITE !!,?5,TCTYPE
+6 WRITE !,?5,"SUBTOTALS",?51,TCTOTAL
+7 WRITE !,?5,"RX COUNT",?51,TCRXTOT
+8 WRITE !,?5,"MEAN",?51,$FNUMBER(TCTOTAL/TCRXTOT,"T",2)
+9 ;
+10 ;
+11 QUIT
+12 ;
DIVTOTP(DIVTOT,DIVRXTOT) ;
+1 ;print the totals for a division
+2 ;
+3 ;if Excel spreadsheet format
if PSOEXCEL
QUIT
+4 ;
+5 WRITE !!,"DIVISION ",DIVISION,?51,$EXTRACT(DASH,1,13)
+6 WRITE !,"SUBTOTALS",?51,DIVTOT
+7 WRITE !,"RX COUNT",?51,DIVRXTOT
+8 WRITE !,"MEAN",?51,$FNUMBER(DIVTOT/DIVRXTOT,"T",2)
+9 ;
+10 QUIT
+11 ;
GRDTOTP(GRDTOTAL,GRDRXTOT) ;
+1 ;
+2 ;if Excel spreadsheet format
if PSOEXCEL
QUIT
+3 ;
+4 NEW I
+5 ;
+6 IF '$DATA(PSOAUD)
WRITE !!,?26,"NO INFORMATION FOUND..."
QUIT
+7 FOR I=1:1:2
WRITE !,?51,$EXTRACT(DASH,1,13)
+8 WRITE !!!,"GRAND TOTALS",?51,GRDTOTAL
+9 WRITE !,"RX COUNT",?51,GRDRXTOT
+10 WRITE !,"MEAN",?51,$FNUMBER(GRDTOTAL/GRDRXTOT,"T",2)
+11 WRITE !,?51,$EXTRACT(DASH,1,13)
+12 ;
+13 QUIT
+14 ;
+15 ;
TCDSUMP(TCTYPE,PROVIDER,ACTDT) ;print the summary
+1 ;
+2 NEW AMTBILL,DFN,NAME,ID,REFILL,RXNBR,RX,ECMENBR,RXDATE,RXINFO,RXQTY,NDCNBR,RXDRUG,VADM,USER,TRIJUST,PTELIG,REJ,RTYPE
+3 SET RJHDR=$EXTRACT(STAR,1,30)_$EXTRACT(SPACE,1,3)_TCTYPE_$EXTRACT(SPACE,1,3)_$EXTRACT(STAR,1,(57-$LENGTH(TCTYPE)))
+4 SET DFN=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",4)
+5 DO DEM^VADPT
+6 SET NAME=VADM(1)
+7 SET ID=$PIECE(VADM(2),"^",1)
SET ID=$EXTRACT(ID,$LENGTH(ID)-3,999)
+8 SET RXNBR=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",2)
+9 SET RX=$$GET1^DIQ(52,RXNBR,.01)
+10 SET REFILL=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",3)
+11 SET ECMENBR=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",10)
IF ECMENBR=""
SET ECMENBR="N/A"
+12 SET ECMENBR=REFILL_"/"_ECMENBR
+13 SET RXDATE=$$DATTIM($PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",6))
+14 SET RXINFO=$$RXINFO(RXNBR)
+15 SET USER=$PIECE(^VA(200,$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",4),0),"^",1)
+16 SET AMTBILL=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9)
+17 SET RXQTY=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",11)
+18 SET NDCNBR=$TRANSLATE($PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",7),"-","")
+19 SET RXDRUG=$EXTRACT($PIECE($GET(^PSDRUG($PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",8),0)),"^",1),1,24)
+20 SET TRIJUST=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,2)),"^",1)
+21 SET PTELIG=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",3)
+22 SET REJ=$PIECE($GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",2)
SET RTYPE=$SELECT(REJ="I":"INPATIENT",REJ="N":"NON-BILLABLE",REJ="R":"REJECT OVERRIDE",REJ="P":"PARTIAL FILL",1:"")
+23 ;
+24 ;for standard output
+25 IF 'PSOEXCEL
Begin DoDot:1
+26 WRITE !!,$EXTRACT(NAME,1,30)_"/"_ID,?36,RX,?54,ECMENBR,?72,RXDATE,?90,RXINFO
+27 WRITE !,?4,$$DATTIM($PIECE(ACTDT,".",1)),?22,$EXTRACT(USER,1,20),?58,$FNUMBER(AMTBILL,"T",2),?72,RXQTY,?84,NDCNBR,?103,RXDRUG
+28 IF $DATA(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3))
DO NCPDPRC(.PSOAUD)
+29 ;
+30 ;TRICARE justification
+31 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+32 IF $LENGTH(TRIJUST)>125
WRITE !,?4,$EXTRACT(TRIJUST,1,125)_"..."
+33 IF $LENGTH(TRIJUST)<125
WRITE !,?4,TRIJUST
End DoDot:2
End DoDot:1
+34 ;
+35 ;if Excel format is selected
+36 IF PSOEXCEL
Begin DoDot:1
+37 NEW REJIEN,FILE,FIELD,NCPDIEN,RJCDS,REJEXP
+38 SET REJIEN=0
SET FILE=9002313.93
SET FIELD=.02
SET RJCDS=""
SET REJEXP=""
+39 IF $DATA(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3))
FOR
SET REJIEN=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN))
if 'REJIEN
QUIT
Begin DoDot:2
+40 SET NCPDIEN=$GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN))
+41 SET RJCDS=$SELECT($GET(RJCDS)="":NCPDIEN,1:RJCDS_","_NCPDIEN)
End DoDot:2
+42 IF RJCDS'=""
IF $PIECE(RJCDS,":",1)'="eT"
IF $PIECE(RJCDS,":",1)'="eC"
SET REJEXP=$$GET1^DIQ(FILE,+$PIECE(RJCDS,",",1),FIELD)
+43 IF RJCDS'=""
IF $PIECE(RJCDS,":",1)="eT"
SET REJEXP="TRICARE-NON BILLABLE"
+44 IF RJCDS'=""
IF $PIECE(RJCDS,":",1)="eC"
SET REJEXP="CHAMPVA-NON BILLABLE"
+45 WRITE !,DIVISION_"^"_PTELIG_"^"_RTYPE_"^"_PROVIDER_"^"_$EXTRACT(NAME,1,30)_"^"_ID_"^"_RX_"^"_ECMENBR_"^"_RXDATE_"^"_RXINFO_"^"
+46 WRITE $$DATTIM($PIECE(ACTDT,".",1))_"^"_$EXTRACT(USER,1,20)_"^"_$FNUMBER(AMTBILL,"T",2)_"^"_RXQTY_"^"_NDCNBR_"^"_RXDRUG_"^"_RJCDS_"^"_$PIECE(RJCDS,",",1)_"^"_REJEXP_"^"_TRIJUST
End DoDot:1
+47 ;
+48 QUIT
+49 ;
NCPDPRC(PSOAUD) ;
+1 ;writes the NCPD reject code
+2 ;
+3 NEW REJIEN,FILE,FIELD,NCPDCD,NCPDIEN,REJTXT
+4 SET REJIEN=0
SET FILE=9002313.93
SET FIELD=.02
+5 FOR
SET REJIEN=$ORDER(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN))
if 'REJIEN
QUIT
Begin DoDot:1
+6 SET NCPDCD=$GET(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN))
+7 IF NCPDCD'="eT"
IF NCPDCD'="eC"
Begin DoDot:2
+8 SET NCPDIEN=$ORDER(^BPSF(FILE,"B",NCPDCD,""))
SET REJTXT=$$GET1^DIQ(FILE,NCPDIEN,FIELD)
End DoDot:2
+9 IF NCPDCD="eT"
SET REJTXT="TRICARE-NON BILLABLE"
+10 IF NCPDCD="eC"
SET REJTXT="CHAMPVA-NON BILLABLE"
+11 IF 'PSOEXCEL
WRITE !,?4,NCPDCD_":"_REJTXT
+12 IF PSOEXCEL
WRITE !,NCPDCD_":"_REJTXT
End DoDot:1
+13 ;
+14 QUIT
+15 ;
RXINFO(RXNBR) ;
+1 ;this will return the data needed for the RX INFO on the Audit Report.
+2 ;
+3 ;
+4 NEW RFL,CMOP,RXSTATUS,FILLOC,BILLTYPE,RELDATE,RELSTATUS
+5 SET RFL=$$LSTRFL^PSOBPSU1(RXNBR)
+6 SET BILLTYPE="**"
+7 SET FILLOC=$$MWC^PSOBPSU2(RXNBR,RFL)
+8 SET RXSTATUS=$$GET1^DIQ(52,RXNBR,100,"I")
+9 SET RXSTATUS=$$RXSTANAM(RXSTATUS)
+10 SET RELDATE=$$RXRLDT^PSOBPSUT(RXNBR,RFL)
+11 SET RELSTATUS=$SELECT(RELDATE'="":"R",1:"N")
+12 IF 'PSOEXCEL
QUIT FILLOC_" "_BILLTYPE_" "_RXSTATUS_"/"_RELSTATUS
+13 IF PSOEXCEL
QUIT FILLOC_"^"_RXSTATUS_"/"_RELSTATUS
+14 ;
RXSTANAM(BPRXSTAT) ;*/
+1 ; ACTIVE;
if BPRXSTAT=0
QUIT "AC"
+2 ; NON-VERIFIED;
if BPRXSTAT=1
QUIT "NV"
+3 ; HOLD;
if BPRXSTAT=3
QUIT "HL"
+4 ; SUSPENDED;
if BPRXSTAT=5
QUIT "SU"
+5 ; EXPIRED;
if BPRXSTAT=11
QUIT "EX"
+6 ; DISCONTINUED;
if BPRXSTAT=12
QUIT "DS"
+7 ; DELETED;
if BPRXSTAT=13
QUIT "DL"
+8 ; DISCONTINUED BY PROVIDER;
if BPRXSTAT=14
QUIT "DS"
+9 ; DISCONTINUED (EDIT);
if BPRXSTAT=15
QUIT "DS"
+10 ; PROVIDER HOLD;
if BPRXSTAT=16
QUIT "HL"
+11 if BPRXSTAT=-1
QUIT "??"
+12 QUIT ""
+13 ;
+14 ;
TCSSUMP(SUBTOT,RXCNT,TCTYPE,PROVIDER,PHARMCST) ;print the summary
+1 ;
+2 IF TCTYPE="TRICARE INPATIENT"!(TCTYPE="CHAMPVA INPATIENT")
QUIT
+3 SET RJHDR=$EXTRACT(STAR,1,30)_$EXTRACT(SPACE,1,3)_TCTYPE_$EXTRACT(SPACE,1,3)_$EXTRACT(STAR,1,(57-$LENGTH(TCTYPE)))
+4 ;
+5 ;subtotals by provider
+6 WRITE !!,?7,$SELECT(PSOSEL("TOTALS BY")="P":"PROVIDER: ",1:"PHARMACIST: "),PROVIDER,?44,$EXTRACT(DASH,1,13)
+7 WRITE !,?7,"SUB-TOTALS",?51,SUBTOT
+8 WRITE !,?7,"RX COUNT",?51,RXCNT
+9 WRITE !,?7,"MEAN",?51,$FNUMBER(SUBTOT/RXCNT,"T",2),!
+10 ;
+11 QUIT
+12 ;
TCHDR(TCTYPE) ;print report header
+1 ;
+2 SET (SUBTOT,RXCNT)=""
+3 IF 'PSOEXCEL
Begin DoDot:1
+4 SET RJHDR=$EXTRACT(STAR,1,30)_$EXTRACT(SPACE,1,3)_TCTYPE_$EXTRACT(SPACE,1,3)_$EXTRACT(STAR,1,(57-$LENGTH(TCTYPE)))
+5 WRITE !!,RJHDR
End DoDot:1
QUIT
+6 ;
+7 ;
+8 QUIT
+9 ;
HDR ;
+1 SET HDR1="TRICARE-CHAMPVA OVERRIDE AUDIT REPORT - "_DETSUM_" Print Date: "_PSONOW
+2 SET HDR2="DIVISION(S): "_$$DIVISION()
+3 SET HDR3="ELIGIBILITY: "_$$ELIG()
+4 SET HDR4="TC TYPES: "_$$HDR4(.PSOSEL)
+5 SET HDR5="ALL PRESCRIPTIONS BY AUDIT DATE: From "_BEGDT_" through "_ENDDT
+6 IF PSOSEL("SUM_DETAIL")="D"
Begin DoDot:1
+7 SET HDR6="BENEFICIARY NAME/ID"_$EXTRACT(SPACE,1,17)_"RX#"_$EXTRACT(SPACE,1,15)_"REF/ECME#"_$EXTRACT(SPACE,1,9)_"RX DATE"_$EXTRACT(SPACE,1,11)_"RX INFO"
+8 SET HDR7=$EXTRACT(SPACE,1,4)_"ACTION DATE"_$EXTRACT(SPACE,1,8)_"USER NAME"_$EXTRACT(SPACE,1,26)_"$BILLED "_$EXTRACT(SPACE,1,6)_"QTY"_$EXTRACT(SPACE,1,9)_"NDC#"_$EXTRACT(SPACE,1,15)_"DRUG"
End DoDot:1
+9 QUIT
+10 ;
HDR4(PSOSEL) ;
+1 ;
+2 NEW TCTYPE,RCODE
+3 SET (RCODE,TCTYPE)=""
+4 FOR
SET TCTYPE=$ORDER(PSOSEL("REJECT CODES",TCTYPE))
if TCTYPE=""
QUIT
Begin DoDot:1
+5 IF $GET(RCODE)=""
SET RCODE=PSOSEL("REJECT CODES",TCTYPE)
+6 IF '$TEST
SET RCODE=RCODE_", "_PSOSEL("REJECT CODES",TCTYPE)
End DoDot:1
+7 ;
+8 QUIT RCODE
+9 ;
+10 ;
DIVISION() ;list of divisions for header
+1 ;
+2 NEW DIV,DIVISION
+3 SET (DIVISION,DIV)=""
+4 IF PSOSEL("DIVISION")="A"
QUIT "ALL"
+5 FOR
SET DIV=$ORDER(PSOSEL("DIVISION",DIV))
if DIV=""
QUIT
Begin DoDot:1
+6 IF DIVISION=""
SET DIVISION=$PIECE(PSOSEL("DIVISION",DIV),"^",2)
QUIT
+7 SET DIVISION=DIVISION_$PIECE(PSOSEL("DIVISION",DIV),"^",2)
End DoDot:1
+8 QUIT DIVISION
+9 ;
+10 ;
REJECTS() ;list the reject types for the header
+1 ;
+2 NEW REJ,REJECTS
+3 SET (REJECTS,REJ)=""
+4 FOR
SET REJ=$ORDER(PSOSEL("REJECT CODES",REJ))
if REJ=""
QUIT
Begin DoDot:1
+5 IF REJECTS=""
SET REJECTS=$SELECT(REJ="I":"INPATIENT",REJ="N":"NON-BILLABLE",REJ="R":"REJECT OVERRIDE",REJ="P":"PARTIAL FILL",1:"ALL")
+6 IF '$TEST
SET REJECTS=REJECTS_" "_$SELECT(REJ="I":"INPATIENT",REJ="N":"NON-BILLABLE",REJ="R":"REJECT OVERRIDE",REJ="P":"PARTIAL FILL",1:"ALL")
End DoDot:1
+7 ;
+8 QUIT REJECTS
+9 ;
+10 ;
INIT ;
+1 ;
+2 NEW %,Y
+3 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSONOW=Y
+4 SET $PIECE(SPACE," ",150)=""
+5 SET $PIECE(DASH,"-",150)=""
+6 SET $PIECE(EQUAL,"=",150)=""
+7 SET $PIECE(STAR,"*",150)=""
+8 SET PAGE="PAGE: "
+9 SET DETSUM=$SELECT(PSOSEL("SUM_DETAIL")="S":"SUMMARY",1:"DETAIL")
+10 SET BEGDT=$$DATTIM(PSOSEL("BEGIN DATE"))
+11 SET ENDDT=$$DATTIM(PSOSEL("END DATE"))
+12 SET PSOEXCEL=$GET(PSOSEL("EXCEL"))
+13 KILL SUBTOTAL,MEAN,SUBTOT,DIVISION,PROVIDER,TCTYPE,TCTYPE,RXCNT
+14 ;
+15 QUIT
+16 ;
+17 ;Convert FM date or date.time to displayable (mm/dd/yy HH:MM) format
+18 ;
DATTIM(X) ;
+1 NEW DATE,BPT,BPM,BPH,BPAP
+2 SET DATE=$SELECT(X:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3),1:"")
+3 SET BPT=$PIECE(X,".",2)
if $LENGTH(BPT)<4
SET BPT=BPT_$EXTRACT("0000",1,4-$LENGTH(BPT))
+4 SET BPH=$EXTRACT(BPT,1,2)
SET BPM=$EXTRACT(BPT,3,4)
+5 SET BPAP="AM"
IF BPH>12
SET BPH=BPH-12
SET BPAP="PM"
if $LENGTH(BPH)<2
SET BPH="0"_BPH
+6 IF BPT
if 'BPH
SET BPH=12
SET DATE=DATE_" "_BPH_":"_BPM_BPAP
+7 QUIT $GET(DATE)
+8 ;
+9 ;
ELIG() ; eligibility for header
+1 QUIT $SELECT(PSOSEL("ELIG_TYPE")="T":"TRICARE",PSOSEL("ELIG_TYPE")="C":"CHAMPVA",1:"ALL")
+2 ;
