- 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;;DEC 1997
- 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
- 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) W ?13,$E(IDATE,4,5)_"/"_$E(IDATE,6,7)_"/"_$E(IDATE,2,3),?22,$S($O(^PS(52.4,"ADI",+$P(PNODE,"^"),0)):"#",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"),!?22,"(# 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
- 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;;DEC 1997
- 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
- +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)
- WRITE ?13,$EXTRACT(IDATE,4,5)_"/"_$EXTRACT(IDATE,6,7)_"/"_$EXTRACT(IDATE,2,3),?22,$SELECT($ORDER(^PS(52.4,"ADI",+$PIECE(PNODE,"^"),0)):"#",1:" "),$PIECE(PNODE,"^",2)
- +10 IF $GET(PSRT)="P"
- WRITE ?63,$JUSTIFY(+$PIECE(PNODE,"^",4),15)
- End DoDot:1
- +11 IF $GET(PSRT)="C"
- QUIT
- +12 GOTO END
- +13 ;
- 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"),!?22,"(# indicates Critical Drug Interaction)"
- +1 WRITE !?3,"Patient name",?70,"Page: ",$GET(PAGE),!,"Rx #",?13,"Issued",?23,"Drug"
- IF $GET(PSRT)="C"
- Begin DoDot:1
- +2 WRITE ?35,"CLERK-> "_$GET(CLNAME)
- End DoDot:1
- IF $GET(PSRT)="P"
- WRITE ?70,"Entry By"
- WRITE !,LINE
- SET PAGE=PAGE+1
- +3 QUIT
