PSOPROD2 ;ALB/MRD - Pharmacy Productivity and Revenue Report ;9/8/15
;;7.0;OUTPATIENT PHARMACY;**448**;DEC 1997;Build 25
;Reference to $$BPSINSCO^BPSUTIL supported by IA 4410
;Reference to $$PAIDAMNT^BPSUTIL supported by IA 4146
;Reference to $$STATUS^BPSOSRX supported by IA 4412
;Reference to File 9002313.93 - BPS NCPDP REJECT CODES supported by IA 4720
;
Q
;
EN ; Main entry point for compile and print.
;
K ^TMP("PSOPRODA",$J),^TMP("PSOPRODB",$J)
;
D COMPILE
D PRINT
;
K ^TMP("PSOPRODA",$J),^TMP("PSOPRODB",$J)
;
I $D(ZTQUEUED) S ZTREQ="@" ; If queued, purge the task after exiting.
;
Q
;
COMPILE ; Compile data for report.
;
; Variables assumed to exist from EN^PSOPROD1:
; PSODIV - Either equal to "ALL", or an array of each Division
; selected by the user to be included.
; PSODTBEGIN - Earliest Date Resolved to include.
; PSODTEND - Latest Date Resolved to include.
; PSOINCLUDE - Populated when user selects which to include.
; The user can selected by PATIENT, DRUG, RX, INSURANCE
; or REJECT CODE. (For more info, see comments in ^PSOPROD1.)
; PSOREPORT - "P" for Productivity report, "R" for Revenue report.
; PSOSORT - D/R/B/N/C to indicate the primary sort (Division, date
; Resolved, resolved By, drug Name, reject Code).
; PSOSTATUS - "P" to include E Payable rejects, "R" to include E
; Rejected rejects, "B" in include both.
;
; The data to be displayed on the report is compiled into the ^TMP
; array in the following format:
; ^TMP("PSOPRODA",$J,SortValue,Rx,Fill,Reject) = Data
; SortValue - Value of the field corresponding to the SortCode,
; such as Division, Drug Name or Reject Code.
; Rx - Prescription Number - file #52, IEN.
; Fill - Refill Number - file #52.25, field #5.
; Reject - Reject Number - file #52.25, IEN.
; Data =
; [1] Release Date - file #52, field #31, or sub-file #52.1, field #17.
; [2] Date Rejected - sub-file #52.25, field #1.
; [3] Date Resolved - sub-file #52.25, field #10.
; [4] Resolved By - sub-file #52.25, field #11.
; [5] Action Taken - file #52.25, field #12.
; [6] Amount Paid - sub-file #9002313.0301, field #509.
; [7] Insurance Name - file #9002313.59, field #902.33.
; [8] Drug - file #52, field #6.
; [9] Rejection - sub-file #52.25, field #.01.
; [10] Division - file #52, field #20.
; [11] Patient - file #52, field #2.
; [12] E-Payable? - 1 if ECME Status is E PAYABLE.
;
N PSOACTION,PSOCOB,PSODATA,PSODIVISION,PSODATE,PSODRUG
N PSODTREJECTED,PSODTRESLVDA,PSODTRESLVDB,PSOECMESTATUS
N PSOEPAYABLE,PSOFILL,PSOINSURANCE,PSOPAIDAMT,PSOPATIENT
N PSOREJ,PSOREJCODEA,PSOREJCODEB,PSORESLVDBYA,PSORESLVDBYB
N PSORX,PSOSORTB
;
I IOST["C-",'PSOEXCEL W !,"Compiling..."
;
; All closed/resolved rejects will appear in the "CLSDAT" cross-
; reference: ^PSRX("CLSDAT",Closed Date/Time,Rx,Reject). Loop
; through them and include those that meet the filter criteria.
;
S PSODATE=PSODTEND+.999999
F S PSODATE=$O(^PSRX("CLSDAT",PSODATE),-1) Q:PSODATE="" Q:(PSODATE\1)<PSODTBEGIN D
. S PSORX=""
. F S PSORX=$O(^PSRX("CLSDAT",PSODATE,PSORX)) Q:PSORX="" D
. . ;
. . ; Check to see if this Rx/Reject should be included.
. . ;
. . I PSOINCLUDE("RX")'="ALL",'$D(PSOINCLUDE("RX",PSORX)) Q
. . ;
. . ; Check to see if this Patient should be included.
. . ;
. . S PSOPATIENT=$$GET1^DIQ(52,PSORX,2,"I")
. . I PSOINCLUDE("PATIENT")'="ALL",'$D(PSOINCLUDE("PATIENT",PSOPATIENT)) Q
. . ;
. . ; Check to see if this Drug should be included.
. . ;
. . S PSODRUG=$$GET1^DIQ(52,PSORX,6,"I")
. . I PSOINCLUDE("DRUG")'="ALL",'$D(PSOINCLUDE("DRUG",PSODRUG)) Q
. . S PSODRUG=$$GET1^DIQ(50,PSODRUG_",",.01)
. . ;
. . ; Check to see if this Division should be included.
. . ;
. . S PSODIVISION=$$GET1^DIQ(52,PSORX,20,"I")
. . I PSODIV'="ALL",'$D(PSODIV(PSODIVISION)) Q
. . ;
. . S PSOREJ=""
. . F S PSOREJ=$O(^PSRX("CLSDAT",PSODATE,PSORX,PSOREJ)) Q:PSOREJ="" D
. . . ;
. . . ; For the RRR Revenue report, skip if RRR flag is not set.
. . . ;
. . . I PSOREPORT="R",'$$GET1^DIQ(52.25,PSOREJ_","_PSORX,30,"I") Q
. . . ;
. . . ; Check to see if this Reject Code should be included.
. . . ;
. . . S PSOREJCODEA=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",.01)
. . . I PSOINCLUDE("REJECT CODE")'="ALL",'$D(PSOINCLUDE("REJECT CODE",PSOREJCODEA)) Q
. . . S PSOREJCODEB=PSOREJCODEA
. . . ;
. . . ; Determine Fill# and COB.
. . . ;
. . . S PSOFILL=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",5)
. . . I PSOFILL="" S PSOFILL=0
. . . S PSOCOB=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",27,"I")
. . . I PSOCOB="" S PSOCOB=1
. . . ;
. . . ; If any unresolved rejects, Quit.
. . . ;
. . . I $$FIND^PSOREJUT(PSORX,PSOFILL,,,1) Q
. . . ;
. . . ; Pull Date Rejected, Date Resolved, Resolved By, Action Taken
. . . ; and Paid Amount.
. . . ;
. . . S PSODTREJECTED=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",1,"I")\1 ; Date Rejected.
. . . S PSODTRESLVDA=PSODATE\1 ; Date Resolved.
. . . S PSORESLVDBYA=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",11,"I") ; Resolved By.
. . . S PSOACTION=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",12) ; Action Taken.
. . . S PSODTRESLVDB=PSODTRESLVDA,PSORESLVDBYB=PSORESLVDBYA
. . . S PSOPAIDAMT=$P($$PAIDAMNT^BPSUTIL(PSORX,PSOFILL),U,2) ; Amount Paid; IA 4146.
. . . I PSOPAIDAMT'="" S PSOPAIDAMT=$J(PSOPAIDAMT,1,2)
. . . ;
. . . I $$ECMEINS(.PSOEPAYABLE) D ADDLINE
. . . ;
. . . ; If the report type is RRR Revenue report, then conditionally
. . . ; display all subsequent refills on the Prescription.
. . . ;
. . . I PSOREPORT="R" D
. . . . ;
. . . . ; Clear out those data elements that are based on the Reject
. . . . ; and not the Prescription.
. . . . ;
. . . . S PSODTREJECTED=""
. . . . S PSODTRESLVDB=""
. . . . S PSORESLVDBYB=""
. . . . S PSOACTION=""
. . . . S PSOREJCODEB=""
. . . . ;
. . . . F S PSOFILL=$O(^PSRX(PSORX,1,PSOFILL)) Q:'PSOFILL D
. . . . . S PSOPAIDAMT=$P($$PAIDAMNT^BPSUTIL(PSORX,PSOFILL),U,2) ; Amount Paid; IA 4146.
. . . . . I PSOPAIDAMT'="" S PSOPAIDAMT=$J(PSOPAIDAMT,1,2)
. . . . . I $$ECMEINS(.PSOEPAYABLE) D ADDLINE
. . . . . Q
. . . . Q
. . . Q
. . Q
. Q
;
Q
;
ECMEINS(PSOEPAYABLE) ; Check ECME Status and Insurance Company.
;
; Determine ECME Status and Insurance. Check to see if this ECME
; Status and this Insurance should be included. If not, Quit 0.
; If it passes the checks, Quit 1. The variable EPAYABLE, passed
; by reference, gets set to 1 if the ECME status is E PAYABLE.
;
S PSOEPAYABLE=0
S PSOECMESTATUS=$P($$STATUS^BPSOSRX(PSORX,PSOFILL,,,PSOCOB),U,1) ; IA 4412.
I PSOECMESTATUS'="E PAYABLE",PSOECMESTATUS'="E REJECTED" Q 0
I PSOECMESTATUS="E PAYABLE",PSOSTATUS="R" Q 0
I PSOECMESTATUS="E REJECTED",PSOSTATUS="P" Q 0
I PSOECMESTATUS="E PAYABLE" S PSOEPAYABLE=1
;
S PSOINSURANCE=$$BPSINSCO^BPSUTIL(PSORX,PSOFILL) ; IA 4410.
I PSOINCLUDE("INSURANCE")'="ALL",'$D(PSOINCLUDE("INSURANCE",PSOINSURANCE)) Q 0
;
Q 1
;
ADDLINE ; Add one Rx/Fill to the ^TMP global.
;
I PSOFILL=0 S PSODATA=$$GET1^DIQ(52,PSORX_",",31,"I")\1 ; Release Date.
I PSOFILL>0 S PSODATA=$$GET1^DIQ(52.1,PSOFILL_","_PSORX_",",17,"I")\1 ; Release Date.
I +PSODATA=0 S PSODATA=""
S PSODATA=PSODATA_"^"_PSODTREJECTED ; Date Rejected.
S PSODATA=PSODATA_"^"_PSODTRESLVDB ; Date Resolved.
S PSODATA=PSODATA_"^"_PSORESLVDBYB ; Resolved By.
S PSODATA=PSODATA_"^"_PSOACTION ; Action Taken.
S PSODATA=PSODATA_"^"_PSOPAIDAMT ; Amount Paid
S PSODATA=PSODATA_"^"_PSOINSURANCE ; Insurance Name.
S PSODATA=PSODATA_"^"_PSODRUG ; Drug.
S PSODATA=PSODATA_"^"_PSOREJCODEB ; Rejection.
S PSODATA=PSODATA_"^"_PSODIVISION ; Division.
S PSODATA=PSODATA_"^"_PSOPATIENT ; Patient.
S PSODATA=PSODATA_"^"_PSOEPAYABLE ; E-Payable?
;
; Determine the first sort level, indicated by the user. Possible
; sorts are Division, Date Resolved, User Resolved By, Drug Name
; and Reject Code.
;
S PSOSORTB=$S(PSOSORT="D":PSODIVISION,PSOSORT="R":PSODTRESLVDA,PSOSORT="B":PSORESLVDBYA,PSOSORT="N":PSODRUG,PSOSORT="C":PSOREJCODEA,1:" ")
;
; If there is already a resolved reject for this Rx/Fill, then reset
; the Amount Paid field to "*****" for the current reject. Since we
; are looping through the rejects in reverse chronological order, the
; result will be that only the most recently resolved reject will
; display the dollar amount instead of both of them.
;
I $D(^TMP("PSOPRODB",$J,PSORX,PSOFILL)) S $P(PSODATA,U,6)="*****"
S ^TMP("PSOPRODB",$J,PSORX,PSOFILL)=""
;
; Add to ^TMP global.
;
S ^TMP("PSOPRODA",$J,PSOSORTB,PSORX,PSOFILL,PSOREJ)=PSODATA
;
Q
;
PRINT ; Print report data.
;
; Variables assumed to exist from EN^PSOPROD1:
; PSODIV - Either equal to "ALL", or an array of each Division
; selected by the user to be included.
; PSODTBEGIN - Earliest Date Resolved to include.
; PSODTEND - Latest Date Resolved to include.
; PSOEXCEL - 1 if user requested Excel format, otherwise 0.
; PSOINCLUDE - Populated when user selects which to include.
; The user can selected by PATIENT, DRUG, RX, INSURANCE
; or REJECT CODE. (For more info, see comments in ^PSOPROD1.)
; PSOREPORT - "P" for Productivity report, "R" for Revenue report.
; PSOSHOWPAT - 1 if user wants patient names displayed, else 0.
; PSOSORT - D/R/B/N/C to indicate the primary sort (Division, date
; Resolved, resolved By, drug Name, reject Code).
; PSOSTATUS - "P" to include E Payable rejects, "R" to include E
; Rejected rejects, "B" in include both.
;
N DIR,PSOCRT,PSODASHES,PSODATA,PSOFILL,PSOPAGE,PSORX
N PSOSORTB,PSOSTOP,PSOX,Y
;
S PSOCRT=$S(IOST["C-":1,1:0)
I PSOEXCEL S IOSL=999999 ; Ensure long screen length for Excel output.
S PSOPAGE=0,PSOSTOP=0,$P(PSODASHES,"=",113)=""
I PSOINCLUDE="PATIENT",'PSOEXCEL,'PSOSHOWPAT S PSOINCLUDE("PATIENT")=""
;
D HDR
I '$D(^TMP("PSOPRODA",$J)) W:'PSOEXCEL !!?5,"No data meets the criteria." G PX
;
S PSOSORTB=""
F S PSOSORTB=$O(^TMP("PSOPRODA",$J,PSOSORTB)) Q:PSOSORTB=""!PSOSTOP D
. S PSORX=""
. F S PSORX=$O(^TMP("PSOPRODA",$J,PSOSORTB,PSORX)) Q:PSORX=""!PSOSTOP D
. . S PSOFILL=""
. . F S PSOFILL=$O(^TMP("PSOPRODA",$J,PSOSORTB,PSORX,PSOFILL)) Q:PSOFILL=""!PSOSTOP D
. . . S PSOREJ=""
. . . F S PSOREJ=$O(^TMP("PSOPRODA",$J,PSOSORTB,PSORX,PSOFILL,PSOREJ)) Q:PSOREJ=""!PSOSTOP D
. . . . S PSODATA=$G(^TMP("PSOPRODA",$J,PSOSORTB,PSORX,PSOFILL,PSOREJ))
. . . . ;
. . . . ; If Excel, write the formatted line then Quit.
. . . . ;
. . . . I PSOEXCEL D EXCELN Q
. . . . ;
. . . . I $Y+3>IOSL D HDR I PSOSTOP Q
. . . . ;
. . . . W !,$$GET1^DIQ(52,PSORX_",",.01),"/",PSOFILL
. . . . W ?12,$$FMTE^XLFDT($P(PSODATA,U,1),"2Z") ; Release Date.
. . . . W ?22,$$FMTE^XLFDT($P(PSODATA,U,2),"2Z") ; Date Rejected.
. . . . W ?35,$$FMTE^XLFDT($P(PSODATA,U,3),"2Z") ; Date Resolved.
. . . . I $P(PSODATA,U,4)'="" W ?48,$E($$GET1^DIQ(200,$P(PSODATA,U,4)_",",.01),1,16) ; Resolved By.
. . . . E I '$P(PSODATA,U,12) W ?48,"*Not ePayable*" ; E-Payable?
. . . . W ?65,$E($P(PSODATA,U,5),1,21) ; Action Taken.
. . . . W ?87,$J($P(PSODATA,U,6),10) ; Amount Paid.
. . . . W ?99,$E($$GET1^DIQ(36,$P(PSODATA,U,7)_",",.01),1,13) ; Insurance Name.
. . . . W !?4,$E($P(PSODATA,U,8),1,31) ; Drug.
. . . . I $P(PSODATA,U,9)'="" D ; Rejection.
. . . . . S PSOX=$O(^BPSF(9002313.93,"B",$P(PSODATA,U,9),"")) ; IA 4720.
. . . . . S PSOX=$$GET1^DIQ(9002313.93,PSOX_",",.02) ; IA 4720.
. . . . . W ?36,$E($P(PSODATA,U,9)_" - "_PSOX,1,29)
. . . . . Q
. . . . W ?66,$E($$GET1^DIQ(59,$P(PSODATA,U,10)_",",.01),1,17) ; Division.
. . . . I PSOSHOWPAT W ?84,$E($$GET1^DIQ(2,$P(PSODATA,U,11)_",",.01),1,18) ; Patient.
. . . . ;
. . . . Q
. . . Q
. . Q
. Q
;
I PSOSTOP G PRINTX
I $Y+4>IOSL D HDR I PSOSTOP G PRINTX
I 'PSOEXCEL W !!?5,"*** End of Report ***"
;
PX ;
I PSOCRT S DIR(0)="E" W ! D ^DIR K DIR
PRINTX ;
Q
;
EXCELN ; Write one line in Excel format.
;
N PSOX
;
W !,$$GET1^DIQ(52,PSORX_",",.01)_"/"_PSOFILL,"^" ; Rx / Fill.
W $$FMTE^XLFDT($P(PSODATA,U,1),"2Z"),"^" ; Release Date.
W $$FMTE^XLFDT($P(PSODATA,U,2),"2Z"),"^" ; Date Rejected.
W $$FMTE^XLFDT($P(PSODATA,U,3),"2Z"),"^" ; Date Resolved.
W $$GET1^DIQ(200,$P(PSODATA,U,4)_",",.01),"^" ; Resolved By.
W $P(PSODATA,U,5),"^" ; Action Taken.
W $P(PSODATA,U,6),"^" ; Amount Paid.
W $$GET1^DIQ(36,$P(PSODATA,U,7)_",",.01),"^" ; Insurance Name.
W $P(PSODATA,U,8),"^" ; Drug
S PSOX=""
I $P(PSODATA,U,9)'="" D ; Rejection.
. S PSOX=$O(^BPSF(9002313.93,"B",$P(PSODATA,U,9),"")) ; IA 4720.
. S PSOX=$P(PSODATA,U,9)_" - "_$$GET1^DIQ(9002313.93,PSOX_",",.02) ; IA 4720.
. Q
W PSOX,"^" ; Rejection.
W $$GET1^DIQ(59,$P(PSODATA,U,10)_",",.01),"^" ; Division.
W $$GET1^DIQ(2,$P(PSODATA,U,11)_",",.01),"^" ; Patient.
W $S($P(PSODATA,U,12):"Y",1:"N") ; E-Payable?
;
Q
;
HDR ; Write the report header.
;
; If PAGE (i.e. not the first page) and device is the screen, do an
; end-of-page reader call. If PAGE or screen output, do a form feed.
; If this is the first page ('PSOPAGE), and device is file or printer
; ('PSOCRT), reset the left margin ($C(13)).
;
I PSOPAGE,PSOCRT S DIR(0)="E" D ^DIR K DIR I 'Y S PSOSTOP=1 G HDRX
I PSOPAGE!PSOCRT W @IOF
I 'PSOPAGE,'PSOCRT W $C(13)
S PSOPAGE=PSOPAGE+1
;
; For Excel format, display only the column headers then exit.
;
I PSOEXCEL D EXCELHDR G HDRX
;
; Write the report header.
;
I PSOREPORT="P" W "Pharmacy Productivity Report"
E W "RRR Revenue Report"
W ?58,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"1M")
W ?97,"Page: ",PSOPAGE
W !,"Selected Divisions: ",PSODIV
W !,"Date Reject Resolved: ",$$FMTE^XLFDT(PSODTBEGIN,"2Z")," - ",$$FMTE^XLFDT(PSODTEND,"2Z")
I PSOSTATUS(0)'="" W ?50,"Status: ",PSOSTATUS(0)
I PSOINCLUDE(PSOINCLUDE)="" W !,"Select by ",PSOINCLUDE
E W !,$E("Select by "_PSOINCLUDE_": "_PSOINCLUDE(PSOINCLUDE),1,132)
W !,"Sort by ",PSOSORT(0)
;
; Write the column headers.
;
W !,PSODASHES
W !,"RX#/FILL",?12,"REL DATE",?22,"DT REJECTED",?35,"DT RESOLVED"
W ?48,"RESOLVED BY",?65,"ACTION TAKEN",?89,"AMT PAID",?98,"INSURANCE NAME"
W !?4,"DRUG",?36,"REJECTION",?66,"DIVISION"
I PSOSHOWPAT W ?84,"PATIENT NAME"
W !,PSODASHES
;
HDRX ;
Q
;
EXCELHDR ; Write the Excel header record.
;
W "Rx#/FILL^REL DATE^DT REJECTED^DT RESOLVED^RESOLVED BY^"
W "ACTION TAKEN^AMOUNT PAID^INSURANCE NAME^DRUG^REJECTON^"
W "DIVISION^PATIENT NAME^E-PAYABLE?"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPROD2 14780 printed Sep 23, 2025@20:09:31 Page 2
PSOPROD2 ;ALB/MRD - Pharmacy Productivity and Revenue Report ;9/8/15
+1 ;;7.0;OUTPATIENT PHARMACY;**448**;DEC 1997;Build 25
+2 ;Reference to $$BPSINSCO^BPSUTIL supported by IA 4410
+3 ;Reference to $$PAIDAMNT^BPSUTIL supported by IA 4146
+4 ;Reference to $$STATUS^BPSOSRX supported by IA 4412
+5 ;Reference to File 9002313.93 - BPS NCPDP REJECT CODES supported by IA 4720
+6 ;
+7 QUIT
+8 ;
EN ; Main entry point for compile and print.
+1 ;
+2 KILL ^TMP("PSOPRODA",$JOB),^TMP("PSOPRODB",$JOB)
+3 ;
+4 DO COMPILE
+5 DO PRINT
+6 ;
+7 KILL ^TMP("PSOPRODA",$JOB),^TMP("PSOPRODB",$JOB)
+8 ;
+9 ; If queued, purge the task after exiting.
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+10 ;
+11 QUIT
+12 ;
COMPILE ; Compile data for report.
+1 ;
+2 ; Variables assumed to exist from EN^PSOPROD1:
+3 ; PSODIV - Either equal to "ALL", or an array of each Division
+4 ; selected by the user to be included.
+5 ; PSODTBEGIN - Earliest Date Resolved to include.
+6 ; PSODTEND - Latest Date Resolved to include.
+7 ; PSOINCLUDE - Populated when user selects which to include.
+8 ; The user can selected by PATIENT, DRUG, RX, INSURANCE
+9 ; or REJECT CODE. (For more info, see comments in ^PSOPROD1.)
+10 ; PSOREPORT - "P" for Productivity report, "R" for Revenue report.
+11 ; PSOSORT - D/R/B/N/C to indicate the primary sort (Division, date
+12 ; Resolved, resolved By, drug Name, reject Code).
+13 ; PSOSTATUS - "P" to include E Payable rejects, "R" to include E
+14 ; Rejected rejects, "B" in include both.
+15 ;
+16 ; The data to be displayed on the report is compiled into the ^TMP
+17 ; array in the following format:
+18 ; ^TMP("PSOPRODA",$J,SortValue,Rx,Fill,Reject) = Data
+19 ; SortValue - Value of the field corresponding to the SortCode,
+20 ; such as Division, Drug Name or Reject Code.
+21 ; Rx - Prescription Number - file #52, IEN.
+22 ; Fill - Refill Number - file #52.25, field #5.
+23 ; Reject - Reject Number - file #52.25, IEN.
+24 ; Data =
+25 ; [1] Release Date - file #52, field #31, or sub-file #52.1, field #17.
+26 ; [2] Date Rejected - sub-file #52.25, field #1.
+27 ; [3] Date Resolved - sub-file #52.25, field #10.
+28 ; [4] Resolved By - sub-file #52.25, field #11.
+29 ; [5] Action Taken - file #52.25, field #12.
+30 ; [6] Amount Paid - sub-file #9002313.0301, field #509.
+31 ; [7] Insurance Name - file #9002313.59, field #902.33.
+32 ; [8] Drug - file #52, field #6.
+33 ; [9] Rejection - sub-file #52.25, field #.01.
+34 ; [10] Division - file #52, field #20.
+35 ; [11] Patient - file #52, field #2.
+36 ; [12] E-Payable? - 1 if ECME Status is E PAYABLE.
+37 ;
+38 NEW PSOACTION,PSOCOB,PSODATA,PSODIVISION,PSODATE,PSODRUG
+39 NEW PSODTREJECTED,PSODTRESLVDA,PSODTRESLVDB,PSOECMESTATUS
+40 NEW PSOEPAYABLE,PSOFILL,PSOINSURANCE,PSOPAIDAMT,PSOPATIENT
+41 NEW PSOREJ,PSOREJCODEA,PSOREJCODEB,PSORESLVDBYA,PSORESLVDBYB
+42 NEW PSORX,PSOSORTB
+43 ;
+44 IF IOST["C-"
IF 'PSOEXCEL
WRITE !,"Compiling..."
+45 ;
+46 ; All closed/resolved rejects will appear in the "CLSDAT" cross-
+47 ; reference: ^PSRX("CLSDAT",Closed Date/Time,Rx,Reject). Loop
+48 ; through them and include those that meet the filter criteria.
+49 ;
+50 SET PSODATE=PSODTEND+.999999
+51 FOR
SET PSODATE=$ORDER(^PSRX("CLSDAT",PSODATE),-1)
if PSODATE=""
QUIT
if (PSODATE\1)<PSODTBEGIN
QUIT
Begin DoDot:1
+52 SET PSORX=""
+53 FOR
SET PSORX=$ORDER(^PSRX("CLSDAT",PSODATE,PSORX))
if PSORX=""
QUIT
Begin DoDot:2
+54 ;
+55 ; Check to see if this Rx/Reject should be included.
+56 ;
+57 IF PSOINCLUDE("RX")'="ALL"
IF '$DATA(PSOINCLUDE("RX",PSORX))
QUIT
+58 ;
+59 ; Check to see if this Patient should be included.
+60 ;
+61 SET PSOPATIENT=$$GET1^DIQ(52,PSORX,2,"I")
+62 IF PSOINCLUDE("PATIENT")'="ALL"
IF '$DATA(PSOINCLUDE("PATIENT",PSOPATIENT))
QUIT
+63 ;
+64 ; Check to see if this Drug should be included.
+65 ;
+66 SET PSODRUG=$$GET1^DIQ(52,PSORX,6,"I")
+67 IF PSOINCLUDE("DRUG")'="ALL"
IF '$DATA(PSOINCLUDE("DRUG",PSODRUG))
QUIT
+68 SET PSODRUG=$$GET1^DIQ(50,PSODRUG_",",.01)
+69 ;
+70 ; Check to see if this Division should be included.
+71 ;
+72 SET PSODIVISION=$$GET1^DIQ(52,PSORX,20,"I")
+73 IF PSODIV'="ALL"
IF '$DATA(PSODIV(PSODIVISION))
QUIT
+74 ;
+75 SET PSOREJ=""
+76 FOR
SET PSOREJ=$ORDER(^PSRX("CLSDAT",PSODATE,PSORX,PSOREJ))
if PSOREJ=""
QUIT
Begin DoDot:3
+77 ;
+78 ; For the RRR Revenue report, skip if RRR flag is not set.
+79 ;
+80 IF PSOREPORT="R"
IF '$$GET1^DIQ(52.25,PSOREJ_","_PSORX,30,"I")
QUIT
+81 ;
+82 ; Check to see if this Reject Code should be included.
+83 ;
+84 SET PSOREJCODEA=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",.01)
+85 IF PSOINCLUDE("REJECT CODE")'="ALL"
IF '$DATA(PSOINCLUDE("REJECT CODE",PSOREJCODEA))
QUIT
+86 SET PSOREJCODEB=PSOREJCODEA
+87 ;
+88 ; Determine Fill# and COB.
+89 ;
+90 SET PSOFILL=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",5)
+91 IF PSOFILL=""
SET PSOFILL=0
+92 SET PSOCOB=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",27,"I")
+93 IF PSOCOB=""
SET PSOCOB=1
+94 ;
+95 ; If any unresolved rejects, Quit.
+96 ;
+97 IF $$FIND^PSOREJUT(PSORX,PSOFILL,,,1)
QUIT
+98 ;
+99 ; Pull Date Rejected, Date Resolved, Resolved By, Action Taken
+100 ; and Paid Amount.
+101 ;
+102 ; Date Rejected.
SET PSODTREJECTED=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",1,"I")\1
+103 ; Date Resolved.
SET PSODTRESLVDA=PSODATE\1
+104 ; Resolved By.
SET PSORESLVDBYA=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",11,"I")
+105 ; Action Taken.
SET PSOACTION=$$GET1^DIQ(52.25,PSOREJ_","_PSORX_",",12)
+106 SET PSODTRESLVDB=PSODTRESLVDA
SET PSORESLVDBYB=PSORESLVDBYA
+107 ; Amount Paid; IA 4146.
SET PSOPAIDAMT=$PIECE($$PAIDAMNT^BPSUTIL(PSORX,PSOFILL),U,2)
+108 IF PSOPAIDAMT'=""
SET PSOPAIDAMT=$JUSTIFY(PSOPAIDAMT,1,2)
+109 ;
+110 IF $$ECMEINS(.PSOEPAYABLE)
DO ADDLINE
+111 ;
+112 ; If the report type is RRR Revenue report, then conditionally
+113 ; display all subsequent refills on the Prescription.
+114 ;
+115 IF PSOREPORT="R"
Begin DoDot:4
+116 ;
+117 ; Clear out those data elements that are based on the Reject
+118 ; and not the Prescription.
+119 ;
+120 SET PSODTREJECTED=""
+121 SET PSODTRESLVDB=""
+122 SET PSORESLVDBYB=""
+123 SET PSOACTION=""
+124 SET PSOREJCODEB=""
+125 ;
+126 FOR
SET PSOFILL=$ORDER(^PSRX(PSORX,1,PSOFILL))
if 'PSOFILL
QUIT
Begin DoDot:5
+127 ; Amount Paid; IA 4146.
SET PSOPAIDAMT=$PIECE($$PAIDAMNT^BPSUTIL(PSORX,PSOFILL),U,2)
+128 IF PSOPAIDAMT'=""
SET PSOPAIDAMT=$JUSTIFY(PSOPAIDAMT,1,2)
+129 IF $$ECMEINS(.PSOEPAYABLE)
DO ADDLINE
+130 QUIT
End DoDot:5
+131 QUIT
End DoDot:4
+132 QUIT
End DoDot:3
+133 QUIT
End DoDot:2
+134 QUIT
End DoDot:1
+135 ;
+136 QUIT
+137 ;
ECMEINS(PSOEPAYABLE) ; Check ECME Status and Insurance Company.
+1 ;
+2 ; Determine ECME Status and Insurance. Check to see if this ECME
+3 ; Status and this Insurance should be included. If not, Quit 0.
+4 ; If it passes the checks, Quit 1. The variable EPAYABLE, passed
+5 ; by reference, gets set to 1 if the ECME status is E PAYABLE.
+6 ;
+7 SET PSOEPAYABLE=0
+8 ; IA 4412.
SET PSOECMESTATUS=$PIECE($$STATUS^BPSOSRX(PSORX,PSOFILL,,,PSOCOB),U,1)
+9 IF PSOECMESTATUS'="E PAYABLE"
IF PSOECMESTATUS'="E REJECTED"
QUIT 0
+10 IF PSOECMESTATUS="E PAYABLE"
IF PSOSTATUS="R"
QUIT 0
+11 IF PSOECMESTATUS="E REJECTED"
IF PSOSTATUS="P"
QUIT 0
+12 IF PSOECMESTATUS="E PAYABLE"
SET PSOEPAYABLE=1
+13 ;
+14 ; IA 4410.
SET PSOINSURANCE=$$BPSINSCO^BPSUTIL(PSORX,PSOFILL)
+15 IF PSOINCLUDE("INSURANCE")'="ALL"
IF '$DATA(PSOINCLUDE("INSURANCE",PSOINSURANCE))
QUIT 0
+16 ;
+17 QUIT 1
+18 ;
ADDLINE ; Add one Rx/Fill to the ^TMP global.
+1 ;
+2 ; Release Date.
IF PSOFILL=0
SET PSODATA=$$GET1^DIQ(52,PSORX_",",31,"I")\1
+3 ; Release Date.
IF PSOFILL>0
SET PSODATA=$$GET1^DIQ(52.1,PSOFILL_","_PSORX_",",17,"I")\1
+4 IF +PSODATA=0
SET PSODATA=""
+5 ; Date Rejected.
SET PSODATA=PSODATA_"^"_PSODTREJECTED
+6 ; Date Resolved.
SET PSODATA=PSODATA_"^"_PSODTRESLVDB
+7 ; Resolved By.
SET PSODATA=PSODATA_"^"_PSORESLVDBYB
+8 ; Action Taken.
SET PSODATA=PSODATA_"^"_PSOACTION
+9 ; Amount Paid
SET PSODATA=PSODATA_"^"_PSOPAIDAMT
+10 ; Insurance Name.
SET PSODATA=PSODATA_"^"_PSOINSURANCE
+11 ; Drug.
SET PSODATA=PSODATA_"^"_PSODRUG
+12 ; Rejection.
SET PSODATA=PSODATA_"^"_PSOREJCODEB
+13 ; Division.
SET PSODATA=PSODATA_"^"_PSODIVISION
+14 ; Patient.
SET PSODATA=PSODATA_"^"_PSOPATIENT
+15 ; E-Payable?
SET PSODATA=PSODATA_"^"_PSOEPAYABLE
+16 ;
+17 ; Determine the first sort level, indicated by the user. Possible
+18 ; sorts are Division, Date Resolved, User Resolved By, Drug Name
+19 ; and Reject Code.
+20 ;
+21 SET PSOSORTB=$SELECT(PSOSORT="D":PSODIVISION,PSOSORT="R":PSODTRESLVDA,PSOSORT="B":PSORESLVDBYA,PSOSORT="N":PSODRUG,PSOSORT="C":PSOREJCODEA,1:" ")
+22 ;
+23 ; If there is already a resolved reject for this Rx/Fill, then reset
+24 ; the Amount Paid field to "*****" for the current reject. Since we
+25 ; are looping through the rejects in reverse chronological order, the
+26 ; result will be that only the most recently resolved reject will
+27 ; display the dollar amount instead of both of them.
+28 ;
+29 IF $DATA(^TMP("PSOPRODB",$JOB,PSORX,PSOFILL))
SET $PIECE(PSODATA,U,6)="*****"
+30 SET ^TMP("PSOPRODB",$JOB,PSORX,PSOFILL)=""
+31 ;
+32 ; Add to ^TMP global.
+33 ;
+34 SET ^TMP("PSOPRODA",$JOB,PSOSORTB,PSORX,PSOFILL,PSOREJ)=PSODATA
+35 ;
+36 QUIT
+37 ;
PRINT ; Print report data.
+1 ;
+2 ; Variables assumed to exist from EN^PSOPROD1:
+3 ; PSODIV - Either equal to "ALL", or an array of each Division
+4 ; selected by the user to be included.
+5 ; PSODTBEGIN - Earliest Date Resolved to include.
+6 ; PSODTEND - Latest Date Resolved to include.
+7 ; PSOEXCEL - 1 if user requested Excel format, otherwise 0.
+8 ; PSOINCLUDE - Populated when user selects which to include.
+9 ; The user can selected by PATIENT, DRUG, RX, INSURANCE
+10 ; or REJECT CODE. (For more info, see comments in ^PSOPROD1.)
+11 ; PSOREPORT - "P" for Productivity report, "R" for Revenue report.
+12 ; PSOSHOWPAT - 1 if user wants patient names displayed, else 0.
+13 ; PSOSORT - D/R/B/N/C to indicate the primary sort (Division, date
+14 ; Resolved, resolved By, drug Name, reject Code).
+15 ; PSOSTATUS - "P" to include E Payable rejects, "R" to include E
+16 ; Rejected rejects, "B" in include both.
+17 ;
+18 NEW DIR,PSOCRT,PSODASHES,PSODATA,PSOFILL,PSOPAGE,PSORX
+19 NEW PSOSORTB,PSOSTOP,PSOX,Y
+20 ;
+21 SET PSOCRT=$SELECT(IOST["C-":1,1:0)
+22 ; Ensure long screen length for Excel output.
IF PSOEXCEL
SET IOSL=999999
+23 SET PSOPAGE=0
SET PSOSTOP=0
SET $PIECE(PSODASHES,"=",113)=""
+24 IF PSOINCLUDE="PATIENT"
IF 'PSOEXCEL
IF 'PSOSHOWPAT
SET PSOINCLUDE("PATIENT")=""
+25 ;
+26 DO HDR
+27 IF '$DATA(^TMP("PSOPRODA",$JOB))
if 'PSOEXCEL
WRITE !!?5,"No data meets the criteria."
GOTO PX
+28 ;
+29 SET PSOSORTB=""
+30 FOR
SET PSOSORTB=$ORDER(^TMP("PSOPRODA",$JOB,PSOSORTB))
if PSOSORTB=""!PSOSTOP
QUIT
Begin DoDot:1
+31 SET PSORX=""
+32 FOR
SET PSORX=$ORDER(^TMP("PSOPRODA",$JOB,PSOSORTB,PSORX))
if PSORX=""!PSOSTOP
QUIT
Begin DoDot:2
+33 SET PSOFILL=""
+34 FOR
SET PSOFILL=$ORDER(^TMP("PSOPRODA",$JOB,PSOSORTB,PSORX,PSOFILL))
if PSOFILL=""!PSOSTOP
QUIT
Begin DoDot:3
+35 SET PSOREJ=""
+36 FOR
SET PSOREJ=$ORDER(^TMP("PSOPRODA",$JOB,PSOSORTB,PSORX,PSOFILL,PSOREJ))
if PSOREJ=""!PSOSTOP
QUIT
Begin DoDot:4
+37 SET PSODATA=$GET(^TMP("PSOPRODA",$JOB,PSOSORTB,PSORX,PSOFILL,PSOREJ))
+38 ;
+39 ; If Excel, write the formatted line then Quit.
+40 ;
+41 IF PSOEXCEL
DO EXCELN
QUIT
+42 ;
+43 IF $Y+3>IOSL
DO HDR
IF PSOSTOP
QUIT
+44 ;
+45 WRITE !,$$GET1^DIQ(52,PSORX_",",.01),"/",PSOFILL
+46 ; Release Date.
WRITE ?12,$$FMTE^XLFDT($PIECE(PSODATA,U,1),"2Z")
+47 ; Date Rejected.
WRITE ?22,$$FMTE^XLFDT($PIECE(PSODATA,U,2),"2Z")
+48 ; Date Resolved.
WRITE ?35,$$FMTE^XLFDT($PIECE(PSODATA,U,3),"2Z")
+49 ; Resolved By.
IF $PIECE(PSODATA,U,4)'=""
WRITE ?48,$EXTRACT($$GET1^DIQ(200,$PIECE(PSODATA,U,4)_",",.01),1,16)
+50 ; E-Payable?
IF '$TEST
IF '$PIECE(PSODATA,U,12)
WRITE ?48,"*Not ePayable*"
+51 ; Action Taken.
WRITE ?65,$EXTRACT($PIECE(PSODATA,U,5),1,21)
+52 ; Amount Paid.
WRITE ?87,$JUSTIFY($PIECE(PSODATA,U,6),10)
+53 ; Insurance Name.
WRITE ?99,$EXTRACT($$GET1^DIQ(36,$PIECE(PSODATA,U,7)_",",.01),1,13)
+54 ; Drug.
WRITE !?4,$EXTRACT($PIECE(PSODATA,U,8),1,31)
+55 ; Rejection.
IF $PIECE(PSODATA,U,9)'=""
Begin DoDot:5
+56 ; IA 4720.
SET PSOX=$ORDER(^BPSF(9002313.93,"B",$PIECE(PSODATA,U,9),""))
+57 ; IA 4720.
SET PSOX=$$GET1^DIQ(9002313.93,PSOX_",",.02)
+58 WRITE ?36,$EXTRACT($PIECE(PSODATA,U,9)_" - "_PSOX,1,29)
+59 QUIT
End DoDot:5
+60 ; Division.
WRITE ?66,$EXTRACT($$GET1^DIQ(59,$PIECE(PSODATA,U,10)_",",.01),1,17)
+61 ; Patient.
IF PSOSHOWPAT
WRITE ?84,$EXTRACT($$GET1^DIQ(2,$PIECE(PSODATA,U,11)_",",.01),1,18)
+62 ;
+63 QUIT
End DoDot:4
+64 QUIT
End DoDot:3
+65 QUIT
End DoDot:2
+66 QUIT
End DoDot:1
+67 ;
+68 IF PSOSTOP
GOTO PRINTX
+69 IF $Y+4>IOSL
DO HDR
IF PSOSTOP
GOTO PRINTX
+70 IF 'PSOEXCEL
WRITE !!?5,"*** End of Report ***"
+71 ;
PX ;
+1 IF PSOCRT
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
PRINTX ;
+1 QUIT
+2 ;
EXCELN ; Write one line in Excel format.
+1 ;
+2 NEW PSOX
+3 ;
+4 ; Rx / Fill.
WRITE !,$$GET1^DIQ(52,PSORX_",",.01)_"/"_PSOFILL,"^"
+5 ; Release Date.
WRITE $$FMTE^XLFDT($PIECE(PSODATA,U,1),"2Z"),"^"
+6 ; Date Rejected.
WRITE $$FMTE^XLFDT($PIECE(PSODATA,U,2),"2Z"),"^"
+7 ; Date Resolved.
WRITE $$FMTE^XLFDT($PIECE(PSODATA,U,3),"2Z"),"^"
+8 ; Resolved By.
WRITE $$GET1^DIQ(200,$PIECE(PSODATA,U,4)_",",.01),"^"
+9 ; Action Taken.
WRITE $PIECE(PSODATA,U,5),"^"
+10 ; Amount Paid.
WRITE $PIECE(PSODATA,U,6),"^"
+11 ; Insurance Name.
WRITE $$GET1^DIQ(36,$PIECE(PSODATA,U,7)_",",.01),"^"
+12 ; Drug
WRITE $PIECE(PSODATA,U,8),"^"
+13 SET PSOX=""
+14 ; Rejection.
IF $PIECE(PSODATA,U,9)'=""
Begin DoDot:1
+15 ; IA 4720.
SET PSOX=$ORDER(^BPSF(9002313.93,"B",$PIECE(PSODATA,U,9),""))
+16 ; IA 4720.
SET PSOX=$PIECE(PSODATA,U,9)_" - "_$$GET1^DIQ(9002313.93,PSOX_",",.02)
+17 QUIT
End DoDot:1
+18 ; Rejection.
WRITE PSOX,"^"
+19 ; Division.
WRITE $$GET1^DIQ(59,$PIECE(PSODATA,U,10)_",",.01),"^"
+20 ; Patient.
WRITE $$GET1^DIQ(2,$PIECE(PSODATA,U,11)_",",.01),"^"
+21 ; E-Payable?
WRITE $SELECT($PIECE(PSODATA,U,12):"Y",1:"N")
+22 ;
+23 QUIT
+24 ;
HDR ; Write the report header.
+1 ;
+2 ; If PAGE (i.e. not the first page) and device is the screen, do an
+3 ; end-of-page reader call. If PAGE or screen output, do a form feed.
+4 ; If this is the first page ('PSOPAGE), and device is file or printer
+5 ; ('PSOCRT), reset the left margin ($C(13)).
+6 ;
+7 IF PSOPAGE
IF PSOCRT
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSOSTOP=1
GOTO HDRX
+8 IF PSOPAGE!PSOCRT
WRITE @IOF
+9 IF 'PSOPAGE
IF 'PSOCRT
WRITE $CHAR(13)
+10 SET PSOPAGE=PSOPAGE+1
+11 ;
+12 ; For Excel format, display only the column headers then exit.
+13 ;
+14 IF PSOEXCEL
DO EXCELHDR
GOTO HDRX
+15 ;
+16 ; Write the report header.
+17 ;
+18 IF PSOREPORT="P"
WRITE "Pharmacy Productivity Report"
+19 IF '$TEST
WRITE "RRR Revenue Report"
+20 WRITE ?58,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"1M")
+21 WRITE ?97,"Page: ",PSOPAGE
+22 WRITE !,"Selected Divisions: ",PSODIV
+23 WRITE !,"Date Reject Resolved: ",$$FMTE^XLFDT(PSODTBEGIN,"2Z")," - ",$$FMTE^XLFDT(PSODTEND,"2Z")
+24 IF PSOSTATUS(0)'=""
WRITE ?50,"Status: ",PSOSTATUS(0)
+25 IF PSOINCLUDE(PSOINCLUDE)=""
WRITE !,"Select by ",PSOINCLUDE
+26 IF '$TEST
WRITE !,$EXTRACT("Select by "_PSOINCLUDE_": "_PSOINCLUDE(PSOINCLUDE),1,132)
+27 WRITE !,"Sort by ",PSOSORT(0)
+28 ;
+29 ; Write the column headers.
+30 ;
+31 WRITE !,PSODASHES
+32 WRITE !,"RX#/FILL",?12,"REL DATE",?22,"DT REJECTED",?35,"DT RESOLVED"
+33 WRITE ?48,"RESOLVED BY",?65,"ACTION TAKEN",?89,"AMT PAID",?98,"INSURANCE NAME"
+34 WRITE !?4,"DRUG",?36,"REJECTION",?66,"DIVISION"
+35 IF PSOSHOWPAT
WRITE ?84,"PATIENT NAME"
+36 WRITE !,PSODASHES
+37 ;
HDRX ;
+1 QUIT
+2 ;
EXCELHDR ; Write the Excel header record.
+1 ;
+2 WRITE "Rx#/FILL^REL DATE^DT REJECTED^DT RESOLVED^RESOLVED BY^"
+3 WRITE "ACTION TAKEN^AMOUNT PAID^INSURANCE NAME^DRUG^REJECTON^"
+4 WRITE "DIVISION^PATIENT NAME^E-PAYABLE?"
+5 QUIT
+6 ;
