- 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 Feb 18, 2025@23:51:21 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