PSOSUDCN ;BHAM ISC/JMB-Counts of suspended Rx's by day ; 12/10/92
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) D WARN Q
INIT W !!!,?5,"DAILY COUNTS OF RX'S ON SUSPENSE"
S EXIT="" D DATE G:EXIT="" EXIT S %ZIS="QM" K IO("Q") D ^%ZIS K %ZIS Q:POP G:$D(IO("Q")) QUEUP
START U IO S (PSD,PSDP,PST,PSTP)=0 D HD
F J=(BEGDATE-1):0 S J=$O(^PS(52.5,"C",J)) Q:'J!(J>ENDDATE) D CNT D:($Y+5)>IOSL HANG,HD I PSD S Y=J X ^DD("DD") W !,?10,Y,?25,$J(PSD,9),?40,$J(PSDP,9) S (PSD,PSDP)=0
D:($Y+5)>IOSL HANG,HD W !,?10,"-----------",?25,"---------",?40,"---------",!,?10,"TOTAL",?25,$J(PST,9),?40,$J(PSTP,9),! D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
EXIT K %,%DT,%H,BEGDATE,DAY,DIRUT,ENDDATE,PSPOP,EXIT,POP,PSD,PSDP,PST,PSTP,J,JJ,TIM,HR,MIN,%DT,D,X,Y,Z,G,ZTRTN,ZTSAVE,ZTSK Q
CNT F JJ=0:0 S JJ=$O(^PS(52.5,"C",J,JJ)) Q:'JJ I $P($G(^PS(52.5,JJ,0)),"^",6)=$G(PSOSITE) S PSD=PSD+1,PST=PST+1 S:$G(^("P"))=1 PSDP=PSDP+1,PSTP=PSTP+1
Q
DATE K BEGDATE,ENDDATE,%DT(0) W !!!,"**** DATE SELECTION ****"
W ! S %DT="AEX",%DT("A")=" BEGIN DATE : " D ^%DT K %DT Q:Y<0 S (%DT(0),BEGDATE)=Y
W ! S %DT="AEX",%DT("A")=" ENDING DATE: " D ^%DT Q:Y<0 S ENDDATE=Y
S EXIT="NORMAL" Q
HANG I $E(IOST)="C" W $C(7),!!,"Press RETURN to CONTINUE!!" R X:DTIME Q
HD I $D(IOF),IOF]"" W @IOF
D NOW^%DTC S Y=% X ^DD("DD") S DAY=$P(Y,"@"),TIM=$P(Y,"@",2)
W !!,?9,"*** COUNTS OF RX'S IN SUSPENSE BY DAY ***"
W !?((55-$L($P(^PS(59,$G(PSOSITE),0),"^")))\2),"FOR ",$P(^(0),"^")
W !,?15,"AS OF ",DAY," AT ",TIM,!!,?10,"DATE",?25,"# OF RX'S",?40,"# PRINTED",!,?10,"-----------",?25,"---------",?40,"---------"
Q
QUEUP S ZTRTN="START^PSOSUDCN",ZTDESC="Outpatient Pharmacy Count of Suspensed Prescriptions" F G="PSOSITE","BEGDATE","ENDDATE" S:$D(@G) ZTSAVE(G)=""
D ^%ZTLOAD G EXIT
DQ K IO(0),IOP Q
WARN W $C(7),!!,?5,"Site Parameters must be defined to use this option!",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSUDCN 1884 printed Sep 23, 2025@20:11:49 Page 2
PSOSUDCN ;BHAM ISC/JMB-Counts of suspended Rx's by day ; 12/10/92
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
+2 IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
DO WARN
QUIT
INIT WRITE !!!,?5,"DAILY COUNTS OF RX'S ON SUSPENSE"
+1 SET EXIT=""
DO DATE
if EXIT=""
GOTO EXIT
SET %ZIS="QM"
KILL IO("Q")
DO ^%ZIS
KILL %ZIS
if POP
QUIT
if $DATA(IO("Q"))
GOTO QUEUP
START USE IO
SET (PSD,PSDP,PST,PSTP)=0
DO HD
+1 FOR J=(BEGDATE-1):0
SET J=$ORDER(^PS(52.5,"C",J))
if 'J!(J>ENDDATE)
QUIT
DO CNT
if ($Y+5)>IOSL
DO HANG
DO HD
IF PSD
SET Y=J
XECUTE ^DD("DD")
WRITE !,?10,Y,?25,$JUSTIFY(PSD,9),?40,$JUSTIFY(PSDP,9)
SET (PSD,PSDP)=0
+2 if ($Y+5)>IOSL
DO HANG
DO HD
WRITE !,?10,"-----------",?25,"---------",?40,"---------",!,?10,"TOTAL",?25,$JUSTIFY(PST,9),?40,$JUSTIFY(PSTP,9),!
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
EXIT KILL %,%DT,%H,BEGDATE,DAY,DIRUT,ENDDATE,PSPOP,EXIT,POP,PSD,PSDP,PST,PSTP,J,JJ,TIM,HR,MIN,%DT,D,X,Y,Z,G,ZTRTN,ZTSAVE,ZTSK
QUIT
CNT FOR JJ=0:0
SET JJ=$ORDER(^PS(52.5,"C",J,JJ))
if 'JJ
QUIT
IF $PIECE($GET(^PS(52.5,JJ,0)),"^",6)=$GET(PSOSITE)
SET PSD=PSD+1
SET PST=PST+1
if $GET(^("P"))=1
SET PSDP=PSDP+1
SET PSTP=PSTP+1
+1 QUIT
DATE KILL BEGDATE,ENDDATE,%DT(0)
WRITE !!!,"**** DATE SELECTION ****"
+1 WRITE !
SET %DT="AEX"
SET %DT("A")=" BEGIN DATE : "
DO ^%DT
KILL %DT
if Y<0
QUIT
SET (%DT(0),BEGDATE)=Y
+2 WRITE !
SET %DT="AEX"
SET %DT("A")=" ENDING DATE: "
DO ^%DT
if Y<0
QUIT
SET ENDDATE=Y
+3 SET EXIT="NORMAL"
QUIT
HANG IF $EXTRACT(IOST)="C"
WRITE $CHAR(7),!!,"Press RETURN to CONTINUE!!"
READ X:DTIME
QUIT
HD IF $DATA(IOF)
IF IOF]""
WRITE @IOF
+1 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DAY=$PIECE(Y,"@")
SET TIM=$PIECE(Y,"@",2)
+2 WRITE !!,?9,"*** COUNTS OF RX'S IN SUSPENSE BY DAY ***"
+3 WRITE !?((55-$LENGTH($PIECE(^PS(59,$GET(PSOSITE),0),"^")))\2),"FOR ",$PIECE(^(0),"^")
+4 WRITE !,?15,"AS OF ",DAY," AT ",TIM,!!,?10,"DATE",?25,"# OF RX'S",?40,"# PRINTED",!,?10,"-----------",?25,"---------",?40,"---------"
+5 QUIT
QUEUP SET ZTRTN="START^PSOSUDCN"
SET ZTDESC="Outpatient Pharmacy Count of Suspensed Prescriptions"
FOR G="PSOSITE","BEGDATE","ENDDATE"
if $DATA(@G)
SET ZTSAVE(G)=""
+1 DO ^%ZTLOAD
GOTO EXIT
DQ KILL IO(0),IOP
QUIT
WARN WRITE $CHAR(7),!!,?5,"Site Parameters must be defined to use this option!",!
QUIT
