| 1 | PSORXCLE ;BHAM ISC/SAB-routine to look for bad Rxs ;08/27/00
|
---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**49,50**;DEC 1997
|
---|
| 3 | ;External reference to ^PS(59.7 supported by DBIA 694
|
---|
| 4 | ;External reference to ^PSDRUG supported by DBIA 221
|
---|
| 5 | ;External reference to ^PS(50.7 supported by DBIA 2223
|
---|
| 6 | ;External reference ^PS(50.606 supported by DBIA 2174
|
---|
| 7 | K ^TMP($J),^TMP("PSOTMP",$J)
|
---|
| 8 | S SER=1 D ASK G:$G(QUE) END I $G(PSTOP) K PSTOP G END
|
---|
| 9 | EN D QUE,PRI,END
|
---|
| 10 | Q
|
---|
| 11 | ;
|
---|
| 12 | QUE S SDT=SDT-1 F S SDT=$O(^PSRX("AD",SDT)) Q:'SDT F RXN1=0:0 S RXN1=$O(^PSRX("AD",SDT,RXN1)) Q:'RXN1 D
|
---|
| 13 | .Q:$D(^TMP($J,RXN1,0)) S ^TMP($J,RXN1,0)=1
|
---|
| 14 | .I $E($P($G(^PSRX(RXN1,3)),"^",7),1,33)="New Order Created by editing Rx #" D:$G(SER) PAT D:$G(DRG) DRGS
|
---|
| 15 | Q
|
---|
| 16 | PRI ;output
|
---|
| 17 | D NOW^%DTC S Y=% X ^DD("DD") S TD=Y K %
|
---|
| 18 | S $P(LINE,"=",130)="=",$P(SEP,"-",130)="-" D HDR I '$O(^TMP("PSOTMP",$J,0)) W !!,"No Data Found",! G END
|
---|
| 19 | F I=0:0 S I=$O(^TMP("PSOTMP",$J,I)) Q:'I S DAT=^TMP("PSOTMP",$J,I,0) D
|
---|
| 20 | .I ($Y+7)>IOSL D HDR
|
---|
| 21 | .I $G(DRG) D PRI1 Q
|
---|
| 22 | .W !,$P(^PSRX(I,0),"^"),?35,$P(^DPT($P(DAT,"^"),0),"^")_" ("_$P(DAT,"^",7)_")",?76,$P(^PSDRUG($P(DAT,"^",2),0),"^")
|
---|
| 23 | .W !," Rx Created: "_$P(DAT,"^",9)_" Remarks: "_$P(DAT,"^",4)
|
---|
| 24 | .W !,$P(^PSRX($P(DAT,"^",3),0),"^"),?35,$P(^DPT($P(DAT,"^",5),0),"^")_" ("_$P(DAT,"^",8)_")",?76,$P(^PSDRUG($P(DAT,"^",6),0),"^"),!,LINE
|
---|
| 25 | END ;
|
---|
| 26 | D ^%ZISC K LINE,SEP,PAT1,PAT2,RXN1,RXN2,I,NODE,DAT,^TMP("PSOTMP",$J),SDT,^TMP($J),INSTD,PG,TD,VA,RX,END,INST,X,Y,QUE,SER,DRG,DRG1,DRG2,OR1,OR2,%DT,%T
|
---|
| 27 | Q
|
---|
| 28 | PRI1 ;outputs drug report
|
---|
| 29 | W !,$P(^DPT($P(DAT,"^"),0),"^")_" ("_$P(DAT,"^",8)_")"
|
---|
| 30 | W !,$P(^PSRX(I,0),"^"),?15,$P(^PSDRUG($P(DAT,"^",2),0),"^"),?60,$P(^PS(50.7,$P(DAT,"^",3),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
|
---|
| 31 | I $P(^PSDRUG($P(DAT,"^",2),2),"^") W !?34,"Drug File Orderable Item: "_$P(^PS(50.7,$P(^PSDRUG($P(DAT,"^",2),2),"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
|
---|
| 32 | W !?5,"Rx Created: "_$P(DAT,"^",9)_" Remarks: "_$P(DAT,"^",5)
|
---|
| 33 | W !,$P(^PSRX($P(DAT,"^",4),0),"^"),?15,$P(^PSDRUG($P(DAT,"^",6),0),"^"),?60,$P(^PS(50.7,$P(DAT,"^",7),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
|
---|
| 34 | I $P(^PSDRUG($P(DAT,"^",6),2),"^") W !?34,"Drug File Orderable Item: "_$P(^PS(50.7,$P(^PSDRUG($P(DAT,"^",6),2),"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
|
---|
| 35 | W !,LINE
|
---|
| 36 | Q
|
---|
| 37 | HDR ;header
|
---|
| 38 | S PG=$G(PG)+1
|
---|
| 39 | U IO W @IOF,"Report of New Prescriptions Created by an Edited Prescription - "_$S($G(SER)=1:"Patient",1:"Drug")_" Search",?122,"Page: "_PG,!,"Search Date from "_INSTD,?35,"Run Date/Time: "_TD
|
---|
| 40 | I $G(SER)=1 W !!,"New Rx",?35,"Patient",?76,"Drug",!,"Edited Rx",!,SEP Q
|
---|
| 41 | W !!,"Patient's Name",!,"New Rx",!,"Edited Rx",?15,"Drug",?60,"Rx Orderable Item",!,SEP
|
---|
| 42 | Q
|
---|
| 43 | ASK S (Y,INST)=$P(^PS(59.7,1,49.99),"^",4) X ^DD("DD") S INSTD=Y
|
---|
| 44 | W !!,"Version 7.0 of Outpatient Pharmacy was installed on "_INSTD_"."
|
---|
| 45 | K %DT S %DT("A")="What Date would you like to start your search: ",%DT("B")=INSTD
|
---|
| 46 | S %DT(0)=INST,%DT="EPXA" D ^%DT I "^"[X D END S QUE=1 W !!,"Report Request Cancelled!",! Q
|
---|
| 47 | G ASK:Y<0 S SDT=Y X ^DD("DD") S INSTD=Y K %DT
|
---|
| 48 | W !!,"This is a 132 column Report.",! K %ZIS,IOP,ZTSK,ZTQUEUED
|
---|
| 49 | S %ZIS("A")="Select a Printer: ",PSOION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=PSOION,PSTOP=1 D ^%ZIS K IOP,PSOION G END
|
---|
| 50 | K PSOION,QUE I $D(IO("Q")) S QUE=1 D
|
---|
| 51 | .S ZTDESC="Outpatient Pharmacy Rx Search",ZTRTN=$S($G(SER)=1:"EN",1:"EN1")_"^PSORXCLE",ZTSAVE("ZTREQ")="@",(ZTSAVE("SDT"),ZTSAVE("INSTD"),ZTSAVE("DRG"),ZTSAVE("SER"))="" D ^%ZTLOAD
|
---|
| 52 | .I $D(ZTSK) W !,"Printout Queued to Print.",! K ZTSK
|
---|
| 53 | Q
|
---|
| 54 | DRG ;entry point to look for wrong drug
|
---|
| 55 | K ^TMP($J),^TMP("PSOTMP",$J)
|
---|
| 56 | W !,"This option will print a report of possible Prescriptions where the",!,"dispense drug name was changed incorrectly."
|
---|
| 57 | S DRG=1 D ASK G:$G(QUE) END I $G(PSTOP) K PSTOP G END
|
---|
| 58 | EN1 D QUE,PRI,END
|
---|
| 59 | Q
|
---|
| 60 | PAT Q:RXN1']""!('$D(^PSRX(+RXN1,0))) S PAT1=$P(^PSRX(RXN1,0),"^",2),RMK=$P(^PSRX(RXN1,3),"^",7)
|
---|
| 61 | S RXN2=$P(RMK,"Rx # ",2),RXN2=$P(RXN2,"."),RXN2=$O(^PSRX("B",RXN2,0))
|
---|
| 62 | Q:RXN2']""!('$D(^PSRX(+RXN2,0))) S PAT2=$P(^PSRX(RXN2,0),"^",2)
|
---|
| 63 | I PAT1=PAT2 K PAT1,PAT2,RXN2,RMK Q
|
---|
| 64 | S ^TMP("PSOTMP",$J,RXN1,0)=PAT1_"^"_$P(^PSRX(RXN1,0),"^",6)_"^"_RXN2_"^"_RMK_"^"_PAT2_"^"_$P(^PSRX(RXN2,0),"^",6)
|
---|
| 65 | F DFN=PAT1,PAT2 D PID^VADPT S ^TMP("PSOTMP",$J,RXN1,0)=^TMP("PSOTMP",$J,RXN1,0)_"^"_VA("BID")
|
---|
| 66 | S Y=$P(^PSRX(RXN1,2),"^") X ^DD("DD") S ^TMP("PSOTMP",$J,RXN1,0)=^TMP("PSOTMP",$J,RXN1,0)_"^"_Y
|
---|
| 67 | K PAT1,PAT2,RXN2,RMK,VA,DFN
|
---|
| 68 | Q
|
---|
| 69 | DRGS Q:RXN1']""!('$D(^PSRX(+RXN1,0)))
|
---|
| 70 | S PAT1=$P(^PSRX(RXN1,0),"^",2),RMK=$P(^PSRX(RXN1,3),"^",7),RXN2=$P(RMK,"Rx # ",2),RXN2=$P(RXN2,"."),RXN2=$O(^PSRX("B",RXN2,0))
|
---|
| 71 | Q:RXN2']""!('$D(^PSRX(+RXN2,0)))
|
---|
| 72 | S PAT2=$P(^PSRX(RXN2,0),"^",2),DRG2=$P(^PSRX(RXN2,0),"^",6),DRG1=$P(^PSRX(RXN1,0),"^",6)
|
---|
| 73 | S OR1=$P(^PSRX(RXN1,"OR1"),"^"),OR2=$P(^PSRX(RXN2,"OR1"),"^")
|
---|
| 74 | I DRG1=DRG2 K PAT1,PAT2,RXN2,RMK,DRG1,DRG2,OR1,OR2 Q
|
---|
| 75 | I PAT1'=PAT2 K PAT1,PAT2,RXN2,RMK,DRG1,DRG2,OR1,OR2 Q
|
---|
| 76 | I DRG1'=DRG2,$P(^PSDRUG(DRG1,2),"^")=$P(^PSDRUG(DRG2,2),"^") K PAT1,PAT2,RXN2,RMK,DRG1,DRG2,OR1,OR2 Q
|
---|
| 77 | S ^TMP("PSOTMP",$J,RXN1,0)=PAT1_"^"_DRG1_"^"_OR1_"^"_RXN2_"^"_RMK_"^"_DRG2_"^"_OR2
|
---|
| 78 | S DFN=PAT1 D PID^VADPT S ^TMP("PSOTMP",$J,RXN1,0)=^TMP("PSOTMP",$J,RXN1,0)_"^"_VA("BID")
|
---|
| 79 | S Y=$P(^PSRX(RXN1,2),"^") X ^DD("DD") S ^TMP("PSOTMP",$J,RXN1,0)=^TMP("PSOTMP",$J,RXN1,0)_"^"_Y
|
---|
| 80 | K PAT1,PAT2,RXN2,RMK,VA,DFN,DRG1,DRG2,OR1,OR2
|
---|
| 81 | Q
|
---|