PSOBORP2 ;ALBANY/BLD - TRICARE-CHAMPVA BYPASS/OVERRIDE AUDIT REPORT ;7/1/2010
;;7.0;OUTPATIENT PHARMACY;**358,385,427,528**;DEC 1997;Build 10
;
;
Q
;
EN(RX,RFL,RESP) ;
;entry point to insert an entry in to the TRICARE-CHAMPVA Audit Report
; Passed In:
; RX = Prescription file (52) IEN
; RFL = Prescription refill number
; RESP = response back from ECME billing (from ECMESND^PSOBPSU1)
;
;
N REFILNBR,TRITXT
S TRITXT=$P(RESP,"^",2)
D AUDIT^PSOTRI(RX,RFL,,TRITXT,"N",$P(RESP,"^",3))
;
Q
;
RUNRPT(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.
;
D EN^PSOBORP3(.PSOSEL)
Q
;
PROCESS(PSOSEL,PSOAUD) ;this will process file 52.87, the PSO AUDIT LOG
;
N ACTDT,BEGDT,ENDDT,DIVISION,ELTCTYP,ELTYPE,I,PHAMCST,PROVIDER
N PSOFILL,PSOD0,PSOD1,PSOARRAY,PSORX,REJCODE,REJIEN,TCTYPE
;
S BEGDT=PSOSEL("BEGIN DATE"),ENDDT=PSOSEL("END DATE")
S ACTDT=BEGDT,PSOD0=0
D PSOARRAY(.PSOARRAY)
F S ACTDT=$O(^PS(52.87,"E",ACTDT)) Q:ACTDT=""!(ACTDT\1>ENDDT) D
.F S PSOD0=$O(^PS(52.87,"E",ACTDT,PSOD0)) Q:PSOD0="" D
..;
..;quit if duplicate prescription
..S PSORX=$P(^PS(52.87,PSOD0,0),"^",2)
..S PSOFILL=$P(^PS(52.87,PSOD0,0),"^",3)
..S PSOD1=PSOARRAY(PSORX,PSOFILL)
..;if they are different entries in File #52.87, and if ACTDT is the same as the
..; DATE OF ACTION (#15), then quit it's a duplicate entry
..I PSOD0'=PSOD1 I ACTDT=$P(^PS(52.87,PSOD1,1),"^",5) Q
..;
..;quit if division not selected or not all
..S DIVISION=$P(^PS(52.87,PSOD0,0),"^",5)
..I PSOSEL("DIVISION")'="A" Q:'$D(PSOSEL("DIVISION",DIVISION))
..S DIVISION=$P(^PS(59,DIVISION,0),"^",1)
..;
..;quit if eligibility type not selected or not all
..S ELTYPE=$P(^PS(52.87,PSOD0,1),"^",3)
..Q:'$D(PSOSEL("ELIG_TYPE",ELTYPE))
..S ELTYPE=$S(ELTYPE="T":"TRICARE",ELTYPE="C":"CHAMPVA",1:"ALL")
..;
..;quit if audit type not selected or not all
..S TCTYPE=$P(^PS(52.87,PSOD0,1),"^",2)
..Q:'$D(PSOSEL("REJECT CODES",TCTYPE))
..S TCTYPE=$S(TCTYPE="I":"INPATIENT",TCTYPE="N":"NON-BILLABLE",TCTYPE="R":"REJECT OVERRIDE",TCTYPE="P":"PARTIAL FILL",1:"ALL")
..S ELTCTYP=ELTYPE_" "_TCTYPE
..;
..;quit if specific pharmacist not selected or not all
..S PHAMCST=$P(^PS(52.87,PSOD0,1),"^",4)
..I PHAMCST'="",PSOSEL("PHARMACIST")'="A" Q:'$D(PSOSEL("PHARMACIST",PHAMCST))
..S PHAMCST=$P(^VA(200,PHAMCST,0),"^",1)
..;
..;quit if specific provider not selected or not all
..S PROVIDER=$P(^PS(52.87,PSOD0,0),"^",6)
..I PSOSEL("PROVIDER")'="A" Q:'$D(PSOSEL("PROVIDER",PROVIDER))
..S PROVIDER=$P(^VA(200,PROVIDER,0),"^",1)
..;
..;summary report
..I PSOSEL("SUM_DETAIL")="D"!(PSOSEL("SUM_DETAIL")="S") D
...;totals by provider
...I PSOSEL("TOTALS BY")="P" D Q
....S PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,0)=^PS(52.87,PSOD0,0)
....S PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,1)=^PS(52.87,PSOD0,1)
....S PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,2)=^PS(52.87,PSOD0,2)
...;
...;totals by pharmacist and Division
...I PSOSEL("TOTALS BY")="R" D Q
....S PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,0)=^PS(52.87,PSOD0,0)
....S PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,1)=^PS(52.87,PSOD0,1)
....S PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,2)=^PS(52.87,PSOD0,2)
..;
..S REJIEN=0,REJCODE=""
..F S REJIEN=$O(^PS(52.87,PSOD0,3,REJIEN)) Q:'REJIEN D
...I PSOSEL("TOTALS BY")="P" S PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,3,REJIEN)=^PS(52.87,PSOD0,3,REJIEN,0)
...I PSOSEL("TOTALS BY")="R" S PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,3,REJIEN)=^PS(52.87,PSOD0,3,REJIEN,0)
;
Q
;
END ;
I 'PSOEXCEL W !!!!,"REPORT HAS FINISHED"
K DIVRXTOT,DIVTOT,GRDRXTOT,GROUPCNT,GRDTOT,PAGE,PROV,PSODIV,PSOCNT,PSORPTNM,PSORTYPE,PSOTOTAL,TC,TCT
Q
;
GETPARAM(PSOFLDNO,PSODUZ) ;
Q $$GET^XPAR(PSODUZ_";VA(200,","PSOS USRSCR",PSOFLDNO,"I")
;
;
UP(PSVAR) ;converts to upper case
Q $TR(PSVAR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
;
;will build an of array of RX's to eliminate duplicates.
PSOARRAY(PSOARRAY) ;
N ACTDT,BEGDT,ENDDT,DIVISION,I,PHAMCST,PROVIDER,PSOD0,PSOFILL,REJCODE,TCTYPE,REJIEN,TCTYPE
S BEGDT=PSOSEL("BEGIN DATE"),ENDDT=PSOSEL("END DATE")
S ACTDT=BEGDT,PSOD0=0
F S ACTDT=$O(^PS(52.87,"E",ACTDT)) Q:ACTDT=""!(ACTDT\1>ENDDT) D
.F S PSOD0=$O(^PS(52.87,"E",ACTDT,PSOD0)) Q:PSOD0="" D
..S PSOFILL=$P(^PS(52.87,PSOD0,0),"^",3)
..S PSOARRAY($P(^PS(52.87,PSOD0,0),"^",2),PSOFILL)=PSOD0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBORP2 4615 printed Sep 23, 2025@20:01:10 Page 2
PSOBORP2 ;ALBANY/BLD - TRICARE-CHAMPVA BYPASS/OVERRIDE AUDIT REPORT ;7/1/2010
+1 ;;7.0;OUTPATIENT PHARMACY;**358,385,427,528**;DEC 1997;Build 10
+2 ;
+3 ;
+4 QUIT
+5 ;
EN(RX,RFL,RESP) ;
+1 ;entry point to insert an entry in to the TRICARE-CHAMPVA Audit Report
+2 ; Passed In:
+3 ; RX = Prescription file (52) IEN
+4 ; RFL = Prescription refill number
+5 ; RESP = response back from ECME billing (from ECMESND^PSOBPSU1)
+6 ;
+7 ;
+8 NEW REFILNBR,TRITXT
+9 SET TRITXT=$PIECE(RESP,"^",2)
+10 DO AUDIT^PSOTRI(RX,RFL,,TRITXT,"N",$PIECE(RESP,"^",3))
+11 ;
+12 QUIT
+13 ;
RUNRPT(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 DO EN^PSOBORP3(.PSOSEL)
+7 QUIT
+8 ;
PROCESS(PSOSEL,PSOAUD) ;this will process file 52.87, the PSO AUDIT LOG
+1 ;
+2 NEW ACTDT,BEGDT,ENDDT,DIVISION,ELTCTYP,ELTYPE,I,PHAMCST,PROVIDER
+3 NEW PSOFILL,PSOD0,PSOD1,PSOARRAY,PSORX,REJCODE,REJIEN,TCTYPE
+4 ;
+5 SET BEGDT=PSOSEL("BEGIN DATE")
SET ENDDT=PSOSEL("END DATE")
+6 SET ACTDT=BEGDT
SET PSOD0=0
+7 DO PSOARRAY(.PSOARRAY)
+8 FOR
SET ACTDT=$ORDER(^PS(52.87,"E",ACTDT))
if ACTDT=""!(ACTDT\1>ENDDT)
QUIT
Begin DoDot:1
+9 FOR
SET PSOD0=$ORDER(^PS(52.87,"E",ACTDT,PSOD0))
if PSOD0=""
QUIT
Begin DoDot:2
+10 ;
+11 ;quit if duplicate prescription
+12 SET PSORX=$PIECE(^PS(52.87,PSOD0,0),"^",2)
+13 SET PSOFILL=$PIECE(^PS(52.87,PSOD0,0),"^",3)
+14 SET PSOD1=PSOARRAY(PSORX,PSOFILL)
+15 ;if they are different entries in File #52.87, and if ACTDT is the same as the
+16 ; DATE OF ACTION (#15), then quit it's a duplicate entry
+17 IF PSOD0'=PSOD1
IF ACTDT=$PIECE(^PS(52.87,PSOD1,1),"^",5)
QUIT
+18 ;
+19 ;quit if division not selected or not all
+20 SET DIVISION=$PIECE(^PS(52.87,PSOD0,0),"^",5)
+21 IF PSOSEL("DIVISION")'="A"
if '$DATA(PSOSEL("DIVISION",DIVISION))
QUIT
+22 SET DIVISION=$PIECE(^PS(59,DIVISION,0),"^",1)
+23 ;
+24 ;quit if eligibility type not selected or not all
+25 SET ELTYPE=$PIECE(^PS(52.87,PSOD0,1),"^",3)
+26 if '$DATA(PSOSEL("ELIG_TYPE",ELTYPE))
QUIT
+27 SET ELTYPE=$SELECT(ELTYPE="T":"TRICARE",ELTYPE="C":"CHAMPVA",1:"ALL")
+28 ;
+29 ;quit if audit type not selected or not all
+30 SET TCTYPE=$PIECE(^PS(52.87,PSOD0,1),"^",2)
+31 if '$DATA(PSOSEL("REJECT CODES",TCTYPE))
QUIT
+32 SET TCTYPE=$SELECT(TCTYPE="I":"INPATIENT",TCTYPE="N":"NON-BILLABLE",TCTYPE="R":"REJECT OVERRIDE",TCTYPE="P":"PARTIAL FILL",1:"ALL")
+33 SET ELTCTYP=ELTYPE_" "_TCTYPE
+34 ;
+35 ;quit if specific pharmacist not selected or not all
+36 SET PHAMCST=$PIECE(^PS(52.87,PSOD0,1),"^",4)
+37 IF PHAMCST'=""
IF PSOSEL("PHARMACIST")'="A"
if '$DATA(PSOSEL("PHARMACIST",PHAMCST))
QUIT
+38 SET PHAMCST=$PIECE(^VA(200,PHAMCST,0),"^",1)
+39 ;
+40 ;quit if specific provider not selected or not all
+41 SET PROVIDER=$PIECE(^PS(52.87,PSOD0,0),"^",6)
+42 IF PSOSEL("PROVIDER")'="A"
if '$DATA(PSOSEL("PROVIDER",PROVIDER))
QUIT
+43 SET PROVIDER=$PIECE(^VA(200,PROVIDER,0),"^",1)
+44 ;
+45 ;summary report
+46 IF PSOSEL("SUM_DETAIL")="D"!(PSOSEL("SUM_DETAIL")="S")
Begin DoDot:3
+47 ;totals by provider
+48 IF PSOSEL("TOTALS BY")="P"
Begin DoDot:4
+49 SET PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,0)=^PS(52.87,PSOD0,0)
+50 SET PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,1)=^PS(52.87,PSOD0,1)
+51 SET PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,2)=^PS(52.87,PSOD0,2)
End DoDot:4
QUIT
+52 ;
+53 ;totals by pharmacist and Division
+54 IF PSOSEL("TOTALS BY")="R"
Begin DoDot:4
+55 SET PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,0)=^PS(52.87,PSOD0,0)
+56 SET PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,1)=^PS(52.87,PSOD0,1)
+57 SET PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,2)=^PS(52.87,PSOD0,2)
End DoDot:4
QUIT
End DoDot:3
+58 ;
+59 SET REJIEN=0
SET REJCODE=""
+60 FOR
SET REJIEN=$ORDER(^PS(52.87,PSOD0,3,REJIEN))
if 'REJIEN
QUIT
Begin DoDot:3
+61 IF PSOSEL("TOTALS BY")="P"
SET PSOAUD(DIVISION,ELTCTYP,PROVIDER,ACTDT,3,REJIEN)=^PS(52.87,PSOD0,3,REJIEN,0)
+62 IF PSOSEL("TOTALS BY")="R"
SET PSOAUD(DIVISION,ELTCTYP,PHAMCST,ACTDT,3,REJIEN)=^PS(52.87,PSOD0,3,REJIEN,0)
End DoDot:3
End DoDot:2
End DoDot:1
+63 ;
+64 QUIT
+65 ;
END ;
+1 IF 'PSOEXCEL
WRITE !!!!,"REPORT HAS FINISHED"
+2 KILL DIVRXTOT,DIVTOT,GRDRXTOT,GROUPCNT,GRDTOT,PAGE,PROV,PSODIV,PSOCNT,PSORPTNM,PSORTYPE,PSOTOTAL,TC,TCT
+3 QUIT
+4 ;
GETPARAM(PSOFLDNO,PSODUZ) ;
+1 QUIT $$GET^XPAR(PSODUZ_";VA(200,","PSOS USRSCR",PSOFLDNO,"I")
+2 ;
+3 ;
UP(PSVAR) ;converts to upper case
+1 QUIT $TRANSLATE(PSVAR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 ;
+3 ;
+4 ;will build an of array of RX's to eliminate duplicates.
PSOARRAY(PSOARRAY) ;
+1 NEW ACTDT,BEGDT,ENDDT,DIVISION,I,PHAMCST,PROVIDER,PSOD0,PSOFILL,REJCODE,TCTYPE,REJIEN,TCTYPE
+2 SET BEGDT=PSOSEL("BEGIN DATE")
SET ENDDT=PSOSEL("END DATE")
+3 SET ACTDT=BEGDT
SET PSOD0=0
+4 FOR
SET ACTDT=$ORDER(^PS(52.87,"E",ACTDT))
if ACTDT=""!(ACTDT\1>ENDDT)
QUIT
Begin DoDot:1
+5 FOR
SET PSOD0=$ORDER(^PS(52.87,"E",ACTDT,PSOD0))
if PSOD0=""
QUIT
Begin DoDot:2
+6 SET PSOFILL=$PIECE(^PS(52.87,PSOD0,0),"^",3)
+7 SET PSOARRAY($PIECE(^PS(52.87,PSOD0,0),"^",2),PSOFILL)=PSOD0
End DoDot:2
End DoDot:1
+8 QUIT
