PSOVCNT ;BHAM ISC/SAB - NON-VERIFIED PRESCRIPTION COUNTS ; 06/29/92 16:02
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
K IOP,%ZIS,POP S PSOION=ION,%ZIS="MQ" D ^%ZIS I POP S IOP=PSOION D ^%ZIS K PSOION G END
I $D(IO("Q")) S ZTRTN="EN^PSOVCNT",ZTDESC="NON-VERIFIED PRESCRIPTION COUNT" D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued to Print " K ZTSK,IO("Q") G END
EN S (PSOVR,PSOVP,PSOV,PSOOUT)=0 F I=0:0 S I=$O(^PS(52.4,I)) Q:'I S PSOVR=PSOVR+1
F I=0:0 S I=$O(^PS(52.4,"C",I)) Q:'I S PSOVP=PSOVP+1
U IO D NOW^%DTC S Y=% X ^DD("DD") W @IOF,!?24,"NON-VERIFIED PRESCRIPTION COUNTS",!?30,Y,!
W !,"TOTAL NUMBER OF NON-VERIFIED PRESCRIPTIONS : ",PSOVR
W !!,"NUMBER OF PATIENTS WITH ONE OR MORE NON-VERIFIED PRESCRIPTIONS : ",PSOVP
W !!,"(NOTE: Total number of patients listed here may not always equal the number at",!,"the bottom, since some patients at the bottom may be counted more than once,",!,"possibly having non-verified Rx's entered on different days.)",!
K ^TMP($J,"PSOV"),^TMP($J,"PSOP") F ZZ=0:0 S ZZ=$O(^PS(52.4,"LD",ZZ)) Q:'ZZ D
.S RXCNT=0 F RR=0:0 S RR=$O(^PS(52.4,"LD",ZZ,RR)) Q:'RR S RXCNT=RXCNT+1
.S ^TMP($J,"PSOV",ZZ)=RXCNT
.F AA=0:0 S AA=$O(^PS(52.4,"LD",ZZ,AA)) Q:'AA I $P($G(^PS(52.4,AA,0)),"^",2) S ^TMP($J,"PSOP",ZZ,$P(^PS(52.4,AA,0),"^",2))=""
.S PCNT=0 F PP=0:0 S PP=$O(^TMP($J,"PSOP",ZZ,PP)) Q:'PP S PCNT=PCNT+1
.S ^TMP($J,"PSOV",ZZ)=^TMP($J,"PSOV",ZZ)_"^"_+$G(PCNT)
D HD1
S (TOT,PATTOT)=0
F AA=0:0 S AA=$O(^TMP($J,"PSOV",AA)) Q:'AA D:$Y+6>IOSL&('$G(PSOOUT)) HD W:'$G(PSOOUT) !?3,$E(AA,4,5)_"-"_$E(AA,6,7)_"-"_$E(AA,2,3),?20,$J($P(^TMP($J,"PSOV",AA),"^"),3),?42,$J($P(^(AA),"^",2),3) D
.S TOT=TOT+$P(^TMP($J,"PSOV",AA),"^"),PATTOT=PATTOT+$P(^(AA),"^",2)
W !?20,"----",?42,"----",!,"TOTAL",?20,TOT,?42,PATTOT I $E(IOST)'["P" W ! K DIR S DIR(0)="E" D ^DIR K DIR
END K ^TMP($J,"PSOV"),^TMP($J,"PSOP") W:$E(IOST)="P" @IOF D ^%ZISC K PSOION,I,PSOVR,PSOVP,PSOV,ZZ,RR,AA,PP,TOT,PATTOT,PCNT,PSOOUT,RXCNT S:$D(ZTQUEUED) ZTREQ="@"
Q
HD I $E(IOST)'["P" W ! K DIR S DIR(0)="E" D ^DIR K DIR I Y'=1 S PSOOUT=1 Q
W @IOF
HD1 W !?20,"# of",?42,"# of",!?5,"Date",?14,"Non-verified Rx's",?35,"Different Patients",!?5,"----",?14,"-----------------",?35,"------------------",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOVCNT 2217 printed Apr 09, 2024@21:36:38 Page 2
PSOVCNT ;BHAM ISC/SAB - NON-VERIFIED PRESCRIPTION COUNTS ; 06/29/92 16:02
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
+2 KILL IOP,%ZIS,POP
SET PSOION=ION
SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
KILL PSOION
GOTO END
+3 IF $DATA(IO("Q"))
SET ZTRTN="EN^PSOVCNT"
SET ZTDESC="NON-VERIFIED PRESCRIPTION COUNT"
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Task Queued to Print "
KILL ZTSK,IO("Q")
GOTO END
EN SET (PSOVR,PSOVP,PSOV,PSOOUT)=0
FOR I=0:0
SET I=$ORDER(^PS(52.4,I))
if 'I
QUIT
SET PSOVR=PSOVR+1
+1 FOR I=0:0
SET I=$ORDER(^PS(52.4,"C",I))
if 'I
QUIT
SET PSOVP=PSOVP+1
+2 USE IO
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE @IOF,!?24,"NON-VERIFIED PRESCRIPTION COUNTS",!?30,Y,!
+3 WRITE !,"TOTAL NUMBER OF NON-VERIFIED PRESCRIPTIONS : ",PSOVR
+4 WRITE !!,"NUMBER OF PATIENTS WITH ONE OR MORE NON-VERIFIED PRESCRIPTIONS : ",PSOVP
+5 WRITE !!,"(NOTE: Total number of patients listed here may not always equal the number at",!,"the bottom, since some patients at the bottom may be counted more than once,",!,"possibly having non-verified Rx's entered on different days.)",!
+6 KILL ^TMP($JOB,"PSOV"),^TMP($JOB,"PSOP")
FOR ZZ=0:0
SET ZZ=$ORDER(^PS(52.4,"LD",ZZ))
if 'ZZ
QUIT
Begin DoDot:1
+7 SET RXCNT=0
FOR RR=0:0
SET RR=$ORDER(^PS(52.4,"LD",ZZ,RR))
if 'RR
QUIT
SET RXCNT=RXCNT+1
+8 SET ^TMP($JOB,"PSOV",ZZ)=RXCNT
+9 FOR AA=0:0
SET AA=$ORDER(^PS(52.4,"LD",ZZ,AA))
if 'AA
QUIT
IF $PIECE($GET(^PS(52.4,AA,0)),"^",2)
SET ^TMP($JOB,"PSOP",ZZ,$PIECE(^PS(52.4,AA,0),"^",2))=""
+10 SET PCNT=0
FOR PP=0:0
SET PP=$ORDER(^TMP($JOB,"PSOP",ZZ,PP))
if 'PP
QUIT
SET PCNT=PCNT+1
+11 SET ^TMP($JOB,"PSOV",ZZ)=^TMP($JOB,"PSOV",ZZ)_"^"_+$GET(PCNT)
End DoDot:1
+12 DO HD1
+13 SET (TOT,PATTOT)=0
+14 FOR AA=0:0
SET AA=$ORDER(^TMP($JOB,"PSOV",AA))
if 'AA
QUIT
if $Y+6>IOSL&('$GET(PSOOUT))
DO HD
if '$GET(PSOOUT)
WRITE !?3,$EXTRACT(AA,4,5)_"-"_$EXTRACT(AA,6,7)_"-"_$EXTRACT(AA,2,3),?20,$JUSTIFY($PIECE(^TMP($JOB,"PSOV",AA),"^"),3),?42,$JUSTIFY($PIECE(^(AA),"^",2),3)
Begin DoDot:1
+15 SET TOT=TOT+$PIECE(^TMP($JOB,"PSOV",AA),"^")
SET PATTOT=PATTOT+$PIECE(^(AA),"^",2)
End DoDot:1
+16 WRITE !?20,"----",?42,"----",!,"TOTAL",?20,TOT,?42,PATTOT
IF $EXTRACT(IOST)'["P"
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
END KILL ^TMP($JOB,"PSOV"),^TMP($JOB,"PSOP")
if $EXTRACT(IOST)="P"
WRITE @IOF
DO ^%ZISC
KILL PSOION,I,PSOVR,PSOVP,PSOV,ZZ,RR,AA,PP,TOT,PATTOT,PCNT,PSOOUT,RXCNT
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
HD IF $EXTRACT(IOST)'["P"
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y'=1
SET PSOOUT=1
QUIT
+1 WRITE @IOF
HD1 WRITE !?20,"# of",?42,"# of",!?5,"Date",?14,"Non-verified Rx's",?35,"Different Patients",!?5,"----",?14,"-----------------",?35,"------------------",!
+1 QUIT
