PSORXFIN ;BHAM ISC/TJL - VPS Productivity Report ;5/17/21 12:39
;;7.0;OUTPATIENT PHARMACY;**630**;JAN 2021;Build 26
;
EN ; entry point
N I,X,Y,DATE,PSORUN,PSODESC,PSOSAVE
N RXSTDT,RXENDDT,RANGE,PSOERR,QFLG
S QFLG=0
; get today's date
D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S PSORUN=Y K %DT
W !!,"This report prints a listing of people who finished the order in pharmacy"
W !,"in the user-selected date range.",!
D DATES Q:QFLG
;device selection
S PSODESC="MbM-VPS Productivity Report"
F I="PSODESC","RXSTDT","RXENDDT","RANGE" D
. S PSOSAVE(I)=""
D EN^XUTMDEVQ("PROCESS^PSORXFIN",PSODESC,.PSOSAVE)
I POP W !!,"No device selected...exiting.",! Q
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
Q
DATES ; User inputs for date range
N %DT,SRANGE,ERANGE,X,Y
;
RETRY S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)="-NOW" D ^%DT
I Y<0 S QFLG=1 Q
S RXSTDT=Y D DD^%DT S SRANGE=$$FMTE^XLFDT(Y,12)
S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)="-NOW" D ^%DT
I Y<0 S QFLG=1 Q
I Y<RXSTDT D G RETRY
. W !!,"The ending date cannot be earlier than the starting date.",!
S RXENDDT=Y D DD^%DT S ERANGE=$$FMTE^XLFDT(Y,12)
S RANGE="Rx Orders finished from "_SRANGE_" through "_ERANGE
Q
;
PROCESS ; entry point for queued report
N ZTREQ
S ZTREQ="@"
S PSOERR=0 D EN1^PSORXFIN Q:PSOERR
Q
EN1 ;
N PAGENUM,FINISHDT,STOP
K ^TMP("PSORXFIN",$J)
S FINISHDT=RXSTDT-.1,RXENDDT=RXENDDT+.9999,(QFLG,PAGENUM,STOP)=0
D HEADER I STOP D EXIT Q
D GETDATA
I ^TMP("PSORXFIN",$J,"GRAND TOTAL")=0 D Q
. W !
. W !,?7,"***************************************************"
. W !,?7,"* Nothing to report for the selected time frame *"
. W !,?7,"***************************************************"
. D WAIT
D DETAIL I STOP D EXIT Q
D TOTAL
K ^TMP("PSORXFIN",$J)
Q
;
GETDATA ; Get data
N RXDA,RXOR1,FINIEN,FINNAME
S ^TMP("PSORXFIN",$J,"GRAND TOTAL")=0
F S FINISHDT=$O(^PSRX("AFDT",FINISHDT)) Q:(FINISHDT>RXENDDT)!('FINISHDT)!(QFLG=1) D
. S RXDA=0
. F S RXDA=$O(^PSRX("AFDT",FINISHDT,RXDA)) Q:('RXDA) D
. . Q:'$D(^PSRX(RXDA,"OR1"))
. . S RXOR1=$G(^PSRX(RXDA,"OR1"))
. . S FINIEN=$P(RXOR1,"^",5)
. . ; Get name of finisher
. . S FINNAME=$$GET1^DIQ(200,+FINIEN,.01,"E")
. . S:FINNAME="" FINNAME="ZZ^Missing from ^VA(200 :: DFN = "_FINIEN
. . I '$D(^TMP("PSORXFIN",$J,FINNAME)) S ^TMP("PSORXFIN",$J,FINNAME)=0
. . S ^TMP("PSORXFIN",$J,FINNAME)=^TMP("PSORXFIN",$J,FINNAME)+1
. . S ^TMP("PSORXFIN",$J,"GRAND TOTAL")=^TMP("PSORXFIN",$J,"GRAND TOTAL")+1
Q
;
N LN
W:$Y!($E(IOST)="C") @IOF S PAGENUM=PAGENUM+1
S $P(LN,"-",80)=""
W !,?1,"MbM-VPS Productivity Report",?51,"Run Date: ",PSORUN
W !,?1,RANGE,?68,$$RJ^XLFSTR("Page: "_PAGENUM,11),!
W !,?46,"Prescriptions"
W !,?7,"Finishing Person",?48,"Finished"
W !,LN
Q
;
DETAIL ; Print detail line
N RECORD,FCOUNT,NAME
S RECORD="" F S RECORD=$O(^TMP("PSORXFIN",$J,RECORD)) Q:(RECORD="")!(STOP) D
. S NAME=RECORD Q:NAME="GRAND TOTAL"
. S:NAME["ZZ^" NAME=$P(NAME,"^",2,3)
. S FCOUNT=^TMP("PSORXFIN",$J,RECORD)
. W !,?7,NAME,?48,$$RJ^XLFSTR(FCOUNT,6)
. I $Y>(IOSL-3) D WAIT Q:STOP D HEADER
Q
;
TOTAL ; Report totals
N DASH
S $P(DASH,"=",7)=""
W !,?49,DASH
W !?31,$$RJ^XLFSTR("Grand Total: "_^TMP("PSORXFIN",$J,"GRAND TOTAL"),23)
Q
;
WAIT ; End of page logic
S STOP=0
;CRT - Prompt for continue
I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
. F Q:$Y>(IOSL-3) W !
. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
. S DIR(0)="E"
. D ^DIR
. S STOP=$S(Y'=1:1,1:0)
; Background task - check TaskMan
S STOP=$$S^%ZTLOAD()
I STOP D
. W !,?7,"*********************************************"
. W !,?7,"* Printing of report stopped as requested *"
. W !,?7,"*********************************************"
Q
EXIT ; Kill ^TMP Global
K ^TMP("PSORXFIN",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORXFIN 3882 printed Sep 23, 2025@20:10:57 Page 2
PSORXFIN ;BHAM ISC/TJL - VPS Productivity Report ;5/17/21 12:39
+1 ;;7.0;OUTPATIENT PHARMACY;**630**;JAN 2021;Build 26
+2 ;
EN ; entry point
+1 NEW I,X,Y,DATE,PSORUN,PSODESC,PSOSAVE
+2 NEW RXSTDT,RXENDDT,RANGE,PSOERR,QFLG
+3 SET QFLG=0
+4 ; get today's date
+5 DO NOW^%DTC
SET DATE=X
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET PSORUN=Y
KILL %DT
+6 WRITE !!,"This report prints a listing of people who finished the order in pharmacy"
+7 WRITE !,"in the user-selected date range.",!
+8 DO DATES
if QFLG
QUIT
+9 ;device selection
+10 SET PSODESC="MbM-VPS Productivity Report"
+11 FOR I="PSODESC","RXSTDT","RXENDDT","RANGE"
Begin DoDot:1
+12 SET PSOSAVE(I)=""
End DoDot:1
+13 DO EN^XUTMDEVQ("PROCESS^PSORXFIN",PSODESC,.PSOSAVE)
+14 IF POP
WRITE !!,"No device selected...exiting.",!
QUIT
+15 IF IO'=IO(0)
DO ^%ZISC
+16 DO HOME^%ZIS
+17 QUIT
DATES ; User inputs for date range
+1 NEW %DT,SRANGE,ERANGE,X,Y
+2 ;
RETRY SET %DT="AEX"
SET %DT("A")="Starting with Date: "
SET %DT(0)="-NOW"
DO ^%DT
+1 IF Y<0
SET QFLG=1
QUIT
+2 SET RXSTDT=Y
DO DD^%DT
SET SRANGE=$$FMTE^XLFDT(Y,12)
+3 SET %DT="AEX"
SET %DT("A")="Ending with Date: "
SET %DT(0)="-NOW"
DO ^%DT
+4 IF Y<0
SET QFLG=1
QUIT
+5 IF Y<RXSTDT
Begin DoDot:1
+6 WRITE !!,"The ending date cannot be earlier than the starting date.",!
End DoDot:1
GOTO RETRY
+7 SET RXENDDT=Y
DO DD^%DT
SET ERANGE=$$FMTE^XLFDT(Y,12)
+8 SET RANGE="Rx Orders finished from "_SRANGE_" through "_ERANGE
+9 QUIT
+10 ;
PROCESS ; entry point for queued report
+1 NEW ZTREQ
+2 SET ZTREQ="@"
+3 SET PSOERR=0
DO EN1^PSORXFIN
if PSOERR
QUIT
+4 QUIT
EN1 ;
+1 NEW PAGENUM,FINISHDT,STOP
+2 KILL ^TMP("PSORXFIN",$JOB)
+3 SET FINISHDT=RXSTDT-.1
SET RXENDDT=RXENDDT+.9999
SET (QFLG,PAGENUM,STOP)=0
+4 DO HEADER
IF STOP
DO EXIT
QUIT
+5 DO GETDATA
+6 IF ^TMP("PSORXFIN",$JOB,"GRAND TOTAL")=0
Begin DoDot:1
+7 WRITE !
+8 WRITE !,?7,"***************************************************"
+9 WRITE !,?7,"* Nothing to report for the selected time frame *"
+10 WRITE !,?7,"***************************************************"
+11 DO WAIT
End DoDot:1
QUIT
+12 DO DETAIL
IF STOP
DO EXIT
QUIT
+13 DO TOTAL
+14 KILL ^TMP("PSORXFIN",$JOB)
+15 QUIT
+16 ;
GETDATA ; Get data
+1 NEW RXDA,RXOR1,FINIEN,FINNAME
+2 SET ^TMP("PSORXFIN",$JOB,"GRAND TOTAL")=0
+3 FOR
SET FINISHDT=$ORDER(^PSRX("AFDT",FINISHDT))
if (FINISHDT>RXENDDT)!('FINISHDT)!(QFLG=1)
QUIT
Begin DoDot:1
+4 SET RXDA=0
+5 FOR
SET RXDA=$ORDER(^PSRX("AFDT",FINISHDT,RXDA))
if ('RXDA)
QUIT
Begin DoDot:2
+6 if '$DATA(^PSRX(RXDA,"OR1"))
QUIT
+7 SET RXOR1=$GET(^PSRX(RXDA,"OR1"))
+8 SET FINIEN=$PIECE(RXOR1,"^",5)
+9 ; Get name of finisher
+10 SET FINNAME=$$GET1^DIQ(200,+FINIEN,.01,"E")
+11 if FINNAME=""
SET FINNAME="ZZ^Missing from ^VA(200 :: DFN = "_FINIEN
+12 IF '$DATA(^TMP("PSORXFIN",$JOB,FINNAME))
SET ^TMP("PSORXFIN",$JOB,FINNAME)=0
+13 SET ^TMP("PSORXFIN",$JOB,FINNAME)=^TMP("PSORXFIN",$JOB,FINNAME)+1
+14 SET ^TMP("PSORXFIN",$JOB,"GRAND TOTAL")=^TMP("PSORXFIN",$JOB,"GRAND TOTAL")+1
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
+1 NEW LN
+2 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
SET PAGENUM=PAGENUM+1
+3 SET $PIECE(LN,"-",80)=""
+4 WRITE !,?1,"MbM-VPS Productivity Report",?51,"Run Date: ",PSORUN
+5 WRITE !,?1,RANGE,?68,$$RJ^XLFSTR("Page: "_PAGENUM,11),!
+6 WRITE !,?46,"Prescriptions"
+7 WRITE !,?7,"Finishing Person",?48,"Finished"
+8 WRITE !,LN
+9 QUIT
+10 ;
DETAIL ; Print detail line
+1 NEW RECORD,FCOUNT,NAME
+2 SET RECORD=""
FOR
SET RECORD=$ORDER(^TMP("PSORXFIN",$JOB,RECORD))
if (RECORD="")!(STOP)
QUIT
Begin DoDot:1
+3 SET NAME=RECORD
if NAME="GRAND TOTAL"
QUIT
+4 if NAME["ZZ^"
SET NAME=$PIECE(NAME,"^",2,3)
+5 SET FCOUNT=^TMP("PSORXFIN",$JOB,RECORD)
+6 WRITE !,?7,NAME,?48,$$RJ^XLFSTR(FCOUNT,6)
+7 IF $Y>(IOSL-3)
DO WAIT
if STOP
QUIT
DO HEADER
End DoDot:1
+8 QUIT
+9 ;
TOTAL ; Report totals
+1 NEW DASH
+2 SET $PIECE(DASH,"=",7)=""
+3 WRITE !,?49,DASH
+4 WRITE !?31,$$RJ^XLFSTR("Grand Total: "_^TMP("PSORXFIN",$JOB,"GRAND TOTAL"),23)
+5 QUIT
+6 ;
WAIT ; End of page logic
+1 SET STOP=0
+2 ;CRT - Prompt for continue
+3 IF $EXTRACT(IOST,1,2)="C-"&(IOSL'>24)
Begin DoDot:1
+4 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+5 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+6 SET DIR(0)="E"
+7 DO ^DIR
+8 SET STOP=$SELECT(Y'=1:1,1:0)
End DoDot:1
QUIT
+9 ; Background task - check TaskMan
+10 SET STOP=$$S^%ZTLOAD()
+11 IF STOP
Begin DoDot:1
+12 WRITE !,?7,"*********************************************"
+13 WRITE !,?7,"* Printing of report stopped as requested *"
+14 WRITE !,?7,"*********************************************"
End DoDot:1
+15 QUIT
EXIT ; Kill ^TMP Global
+1 KILL ^TMP("PSORXFIN",$JOB)
+2 QUIT
