Routine: PSORXFIN

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

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

PROCESS ; entry point for queued report

 N ZTREQ

 S ZTREQ="@"

 S PSOERR=0 D EN1^PSORXFIN Q:PSOERR

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)

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

HEADER ; Header and page control

 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

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

TOTAL ; Report totals

 N DASH

 S $P(DASH,"=",7)=""

 W !,?49,DASH

 W !?31,$$RJ^XLFSTR("Grand Total:  "_^TMP("PSORXFIN",$J,"GRAND TOTAL"),23)

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,"*********************************************"

EXIT ; Kill ^TMP Global

 K ^TMP("PSORXFIN",$J)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORXFIN   3882     printed  Mar 13, 2025@21:39:25                                                                                                                                                                                                    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      ;

HEADER    ; Header and page control

 +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

PSORXFIN.m