PSOVRPT ;BHAM ISC/SAB - log of non-verified rx's sorted by patient or user code ;06/29/92 16:56
;;7.0;OUTPATIENT PHARMACY;**251**;DEC 1997;Build 202
;External reference to $$DS^PSSDSAPI supported by DBIA 5424
SORT S DIR("A")="Sort By Patient or Clerk: ",DIR("B")="P",DIR(0)="SA^P:PATIENT;C:CLERK" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S PSOQUIT=1 G END
S PSRT=Y
K IOP,%ZIS S PSOION=ION,%ZIS="MQ" D ^%ZIS I POP S IOP=PSOION D ^%ZIS K PSOION S PSOQUIT=1 G END
I $D(IO("Q")) S ZTRTN="START^PSOVRPT",ZTDESC="REPORT OF NON-VERIFIED RXs SORTED BY PATIENT OR CLERK",ZTSAVE("PSRT")="" D ^%ZTLOAD W:$D(ZTSK) !,"Task Queued " K PSOION,ZTSK S PSOQUIT=1 G END
START U IO
N PAGE,PSOQUIT,LINE,ZPAT,CLERK,RDATE,ZCLK,ZZZZ,PNAME,COUNT,ZZZ,ZSORT,PATNAME,EOFLAG,IDATE,CLNAME,CLINT,PNODE,PSOCT,SSS,PSORX
K ^TMP($J,"PSOVR"),^TMP($J,"PSOCR") S PAGE=1,PSOQUIT=0,$P(LINE,"-",79)=""
D NOW^%DTC S Y=% X ^DD("DD") S RDATE=Y
I $G(PSRT)="C" G CLERK
PAT ;sort by patient
F ZPAT=0:0 S ZPAT=$O(^PS(52.4,"C",ZPAT)) Q:'ZPAT S COUNT=0 F ZZZ=0:0 S ZZZ=$O(^PS(52.4,"C",ZPAT,ZZZ)) Q:'ZZZ S PATNAME=$P($G(^DPT(ZPAT,0)),"^") D:PATNAME'=""&($D(^PS(52.4,ZZZ,0)))
.I $G(ZSORT),$P($G(^PS(52.4,ZZZ,0)),"^",3)'=$G(CLINT) Q
.I $D(^PSRX(ZZZ,0)) S COUNT=COUNT+1,^TMP($J,"PSOVR",PATNAME,COUNT)=ZZZ_"^"_$P($G(^PSDRUG(+$P(^PSRX(ZZZ,0),"^",6),0)),"^")_"^"_$P(^PSRX(ZZZ,0),"^",13)_"^"_$P(^PS(52.4,ZZZ,0),"^",3)
I $G(ZSORT) Q
D HD I '$D(^TMP($J,"PSOVR")) W !!,"NO NON-VERIFIED PRESCRIPTIONS TO PRINT.",! D:$E(IOST)="C" G END
.K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
CLPT ;
S PNAME="" F S PNAME=$O(^TMP($J,"PSOVR",PNAME)) Q:PNAME=""!(PSOQUIT) S PSOCT=0 F SSS=0:0 S SSS=$O(^TMP($J,"PSOVR",PNAME,SSS)) Q:'SSS!(PSOQUIT) D
.S PSOCT=PSOCT+1,PNODE=^TMP($J,"PSOVR",PNAME,SSS)
.S EOFLAG=0 I ($Y+5)>IOSL D Q:PSOQUIT
..I $E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR S:'Y PSOQUIT=1 I 'PSOQUIT S EOFLAG=1 D HD
..I $E(IOST)'="C" S EOFLAG=1 D HD
.S ZZZZ=0 I PSOCT=1 W !!?3,PNAME S ZZZZ=1
.I 'ZZZZ,$G(EOFLAG) W !!?3,PNAME_" (continued)"
.W !,$P($G(^PSRX(+$P(PNODE,"^"),0)),"^")
.S IDATE=$P(PNODE,"^",3),PSORX="",PSORX=$O(^PS(52.4,"B",+$P(PNODE,"^")))
.W ?13,$E(IDATE,4,5)_"/"_$E(IDATE,6,7)_"/"_$E(IDATE,2,3)
.W ?22,$S($O(^PS(52.4,"ADI",+$P(PNODE,"^"),0))!($$DS^PSSDSAPI&($$GET1^DIQ(52.4,+PNODE,8,"I"))):"#",1:" "),$P(PNODE,"^",2)
.I $G(PSRT)="P" W ?63,$J(+$P(PNODE,"^",4),15)
Q:$G(PSRT)="C"
G END
;
CLERK ;sort by clerk
F ZCLK=0:0 S ZCLK=$O(^PS(52.4,"D",ZCLK)) Q:'ZCLK S COUNT=0 F ZZZ=0:0 S ZZZ=$O(^PS(52.4,"D",ZCLK,ZZZ)) Q:'ZZZ D:$P($G(^VA(200,ZCLK,0)),"^")'=""&($D(^PS(52.4,ZZZ,0)))
.S CLERK=$P($G(^VA(200,+$P($G(^PS(52.4,ZZZ,0)),"^",3),0)),"^")
.I $D(^PSRX(ZZZ,0)),CLERK'="" S ^TMP($J,"PSOCR",CLERK,ZCLK)=""
I '$D(^TMP($J,"PSOCR")) D HD W !!,"NO NON-VERIFIED PRESCRIPTIONS TO PRINT.",! D:$E(IOST)="C" G END
.K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
S CLNAME="" F S CLNAME=$O(^TMP($J,"PSOCR",CLNAME)) Q:CLNAME=""!(PSOQUIT) S CLINT=$O(^TMP($J,"PSOCR",CLNAME,0)) D
.S ZSORT=1 D PAT D:$D(^TMP($J,"PSOVR")) HD D:$D(^TMP($J,"PSOVR")) CLPT D:$E(IOST)="C"&('$G(PSOQUIT)) K ZSORT,^TMP($J,"PSOVR")
..K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR S:Y'=1 PSOQUIT=1 Q
END D:$E(IOST)="C"&($G(PSRT)="P")&('$G(PSOQUIT)) K ^TMP($J,"PSOVR"),^TMP($J,"PSOCR") K PSRT W:$E(IOST)="P" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
.W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
;
HD W:$G(PAGE)'=1!($E(IOST)="C") @IOF W !?29,"NON-VERIFIED PRESCRIPTIONS",!?29,"AS OF "_$G(RDATE),!,?34,"SORTED BY "_$S($G(PSRT)="P":"PATIENT",1:"CLERK")
I $$DS^PSSDSAPI W !?30,"(# indicates Order Check)"
E W !?23,"(# indicates Critical Drug Interaction)"
W !?3,"Patient name",?70,"Page: ",$G(PAGE),!,"Rx #",?13,"Issued",?23,"Drug" D:$G(PSRT)="C" W:$G(PSRT)="P" ?70,"Entry By" W !,LINE S PAGE=PAGE+1
.W ?35,"CLERK-> "_$G(CLNAME)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOVRPT 3998 printed Dec 13, 2024@02:36:25 Page 2
PSOVRPT ;BHAM ISC/SAB - log of non-verified rx's sorted by patient or user code ;06/29/92 16:56
+1 ;;7.0;OUTPATIENT PHARMACY;**251**;DEC 1997;Build 202
+2 ;External reference to $$DS^PSSDSAPI supported by DBIA 5424
SORT SET DIR("A")="Sort By Patient or Clerk: "
SET DIR("B")="P"
SET DIR(0)="SA^P:PATIENT;C:CLERK"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET PSOQUIT=1
GOTO END
+1 SET PSRT=Y
+2 KILL IOP,%ZIS
SET PSOION=ION
SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
KILL PSOION
SET PSOQUIT=1
GOTO END
+3 IF $DATA(IO("Q"))
SET ZTRTN="START^PSOVRPT"
SET ZTDESC="REPORT OF NON-VERIFIED RXs SORTED BY PATIENT OR CLERK"
SET ZTSAVE("PSRT")=""
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Task Queued "
KILL PSOION,ZTSK
SET PSOQUIT=1
GOTO END
START USE IO
+1 NEW PAGE,PSOQUIT,LINE,ZPAT,CLERK,RDATE,ZCLK,ZZZZ,PNAME,COUNT,ZZZ,ZSORT,PATNAME,EOFLAG,IDATE,CLNAME,CLINT,PNODE,PSOCT,SSS,PSORX
+2 KILL ^TMP($JOB,"PSOVR"),^TMP($JOB,"PSOCR")
SET PAGE=1
SET PSOQUIT=0
SET $PIECE(LINE,"-",79)=""
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET RDATE=Y
+4 IF $GET(PSRT)="C"
GOTO CLERK
PAT ;sort by patient
+1 FOR ZPAT=0:0
SET ZPAT=$ORDER(^PS(52.4,"C",ZPAT))
if 'ZPAT
QUIT
SET COUNT=0
FOR ZZZ=0:0
SET ZZZ=$ORDER(^PS(52.4,"C",ZPAT,ZZZ))
if 'ZZZ
QUIT
SET PATNAME=$PIECE($GET(^DPT(ZPAT,0)),"^")
if PATNAME'=""&($DATA(^PS(52.4,ZZZ,0)))
Begin DoDot:1
+2 IF $GET(ZSORT)
IF $PIECE($GET(^PS(52.4,ZZZ,0)),"^",3)'=$GET(CLINT)
QUIT
+3 IF $DATA(^PSRX(ZZZ,0))
SET COUNT=COUNT+1
SET ^TMP($JOB,"PSOVR",PATNAME,COUNT)=ZZZ_"^"_$PIECE($GET(^PSDRUG(+$PIECE(^PSRX(ZZZ,0),"^",6),0)),"^")_"^"_$PIECE(^PSRX(ZZZ,0),"^",13)_"^"_$PIECE(^PS(52.4,ZZZ,0),"^",3)
End DoDot:1
+4 IF $GET(ZSORT)
QUIT
+5 DO HD
IF '$DATA(^TMP($JOB,"PSOVR"))
WRITE !!,"NO NON-VERIFIED PRESCRIPTIONS TO PRINT.",!
if $EXTRACT(IOST)="C"
Begin DoDot:1
+6 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
GOTO END
CLPT ;
+1 SET PNAME=""
FOR
SET PNAME=$ORDER(^TMP($JOB,"PSOVR",PNAME))
if PNAME=""!(PSOQUIT)
QUIT
SET PSOCT=0
FOR SSS=0:0
SET SSS=$ORDER(^TMP($JOB,"PSOVR",PNAME,SSS))
if 'SSS!(PSOQUIT)
QUIT
Begin DoDot:1
+2 SET PSOCT=PSOCT+1
SET PNODE=^TMP($JOB,"PSOVR",PNAME,SSS)
+3 SET EOFLAG=0
IF ($Y+5)>IOSL
Begin DoDot:2
+4 IF $EXTRACT(IOST)="C"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue,'^' to exit"
DO ^DIR
KILL DIR
if 'Y
SET PSOQUIT=1
IF 'PSOQUIT
SET EOFLAG=1
DO HD
+5 IF $EXTRACT(IOST)'="C"
SET EOFLAG=1
DO HD
End DoDot:2
if PSOQUIT
QUIT
+6 SET ZZZZ=0
IF PSOCT=1
WRITE !!?3,PNAME
SET ZZZZ=1
+7 IF 'ZZZZ
IF $GET(EOFLAG)
WRITE !!?3,PNAME_" (continued)"
+8 WRITE !,$PIECE($GET(^PSRX(+$PIECE(PNODE,"^"),0)),"^")
+9 SET IDATE=$PIECE(PNODE,"^",3)
SET PSORX=""
SET PSORX=$ORDER(^PS(52.4,"B",+$PIECE(PNODE,"^")))
+10 WRITE ?13,$EXTRACT(IDATE,4,5)_"/"_$EXTRACT(IDATE,6,7)_"/"_$EXTRACT(IDATE,2,3)
+11 WRITE ?22,$SELECT($ORDER(^PS(52.4,"ADI",+$PIECE(PNODE,"^"),0))!($$DS^PSSDSAPI&($$GET1^DIQ(52.4,+PNODE,8,"I"))):"#",1:" "),$PIECE(PNODE,"^",2)
+12 IF $GET(PSRT)="P"
WRITE ?63,$JUSTIFY(+$PIECE(PNODE,"^",4),15)
End DoDot:1
+13 if $GET(PSRT)="C"
QUIT
+14 GOTO END
+15 ;
CLERK ;sort by clerk
+1 FOR ZCLK=0:0
SET ZCLK=$ORDER(^PS(52.4,"D",ZCLK))
if 'ZCLK
QUIT
SET COUNT=0
FOR ZZZ=0:0
SET ZZZ=$ORDER(^PS(52.4,"D",ZCLK,ZZZ))
if 'ZZZ
QUIT
if $PIECE($GET(^VA(200,ZCLK,0)),"^")'=""&($DATA(^PS(52.4,ZZZ,0)))
Begin DoDot:1
+2 SET CLERK=$PIECE($GET(^VA(200,+$PIECE($GET(^PS(52.4,ZZZ,0)),"^",3),0)),"^")
+3 IF $DATA(^PSRX(ZZZ,0))
IF CLERK'=""
SET ^TMP($JOB,"PSOCR",CLERK,ZCLK)=""
End DoDot:1
+4 IF '$DATA(^TMP($JOB,"PSOCR"))
DO HD
WRITE !!,"NO NON-VERIFIED PRESCRIPTIONS TO PRINT.",!
if $EXTRACT(IOST)="C"
Begin DoDot:1
+5 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
GOTO END
+6 SET CLNAME=""
FOR
SET CLNAME=$ORDER(^TMP($JOB,"PSOCR",CLNAME))
if CLNAME=""!(PSOQUIT)
QUIT
SET CLINT=$ORDER(^TMP($JOB,"PSOCR",CLNAME,0))
Begin DoDot:1
+7 SET ZSORT=1
DO PAT
if $DATA(^TMP($JOB,"PSOVR"))
DO HD
if $DATA(^TMP($JOB,"PSOVR"))
DO CLPT
if $EXTRACT(IOST)="C"&('$GET(PSOQUIT))
Begin DoDot:2
+8 KILL DIR
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to continue,'^' to exit"
DO ^DIR
KILL DIR
if Y'=1
SET PSOQUIT=1
QUIT
End DoDot:2
KILL ZSORT,^TMP($JOB,"PSOVR")
End DoDot:1
END if $EXTRACT(IOST)="C"&($GET(PSRT)="P")&('$GET(PSOQUIT))
Begin DoDot:1
+1 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
KILL ^TMP($JOB,"PSOVR"),^TMP($JOB,"PSOCR")
KILL PSRT
if $EXTRACT(IOST)="P"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 ;
HD if $GET(PAGE)'=1!($EXTRACT(IOST)="C")
WRITE @IOF
WRITE !?29,"NON-VERIFIED PRESCRIPTIONS",!?29,"AS OF "_$GET(RDATE),!,?34,"SORTED BY "_$SELECT($GET(PSRT)="P":"PATIENT",1:"CLERK")
+1 IF $$DS^PSSDSAPI
WRITE !?30,"(# indicates Order Check)"
+2 IF '$TEST
WRITE !?23,"(# indicates Critical Drug Interaction)"
+3 WRITE !?3,"Patient name",?70,"Page: ",$GET(PAGE),!,"Rx #",?13,"Issued",?23,"Drug"
if $GET(PSRT)="C"
Begin DoDot:1
+4 WRITE ?35,"CLERK-> "_$GET(CLNAME)
End DoDot:1
if $GET(PSRT)="P"
WRITE ?70,"Entry By"
WRITE !,LINE
SET PAGE=PAGE+1
+5 QUIT
