75 lines
5.3 KiB
Mathematica
75 lines
5.3 KiB
Mathematica
|
PSORXLAB ;BHAM ISC/SAB - drug+lab result print ; 11/19/92 14:04
|
||
|
|
;;7.0;OUTPATIENT PHARMACY;**29**;DEC 1997
|
||
|
|
;a routine which loop thru the last fill x-ref of ^psrx and gets
|
||
|
|
;patients with a specific drug. then gets the lrdfn from the
|
||
|
|
;patient file and loops thru the patients lab data to find
|
||
|
|
;results within the date range you specify for the lab test
|
||
|
|
;used to minitor the drug. it then prints the patient's name
|
||
|
|
;ssn, last fill date, and the lab test results if any.
|
||
|
|
;this is intended as a qa minitor and should not be run for
|
||
|
|
;more than a 30 day fill date interval, or 1 year lab test interval.
|
||
|
|
;External ref. to ^LAB(60, is supp. by DBIA# 333
|
||
|
|
;External ref. to ^LR(LRDFN,"CH", is supp. by DBIA# 844
|
||
|
|
;External ref. to ^PSDRUG( is supp. by DBIA# 221
|
||
|
|
;External ref. to ^VA(200, is supp. by DBIA# 10060
|
||
|
|
ANQSITE K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^")
|
||
|
|
I $G(DA) D
|
||
|
|
.S DIC=4,DIQ(0)="I",DR=".01;99" D EN^DIQ1
|
||
|
|
.S SITE=$G(^UTILITY("DIQ1",$J,4,DA,.01,"I"))_" "_$G(^UTILITY("DIQ1",$J,4,DA,99,"I"))
|
||
|
|
.K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC
|
||
|
|
S Y=DT X ^DD("DD") S SITE=$G(SITE)_" "_Y
|
||
|
|
BDATE S %DT="EXTA",%DT("A")="Beginning fill date: " D ^%DT G CLEAN:Y<0 S ANQBD=Y X ^DD("DD") S ANQBDR=Y
|
||
|
|
EDATE S %DT("A")="Ending last fill date: " D ^%DT G CLEAN:Y<0 S ANQED=Y X ^DD("DD") S ANQEDR=Y
|
||
|
|
LDATE S %DT("A")="Earliest date for lab results: " D ^%DT G CLEAN:Y<0 S LDATE=Y X ^DD("DD") S LDATER=Y
|
||
|
|
DRUG R !,"Enter the key word in the Drug Generic name: ",ANQDRUG:DTIME G CLEAN:'$T I "^"[ANQDRUG G CLEAN
|
||
|
|
I $O(^PSDRUG("B",$E(ANQDRUG,1,$L(ANQDRUG)-1)))'[ANQDRUG W !,"No corresponding entry, try again or type return to exit" G DRUG
|
||
|
|
LABT S DIC="^LAB(60,",DIC(0)="QEAM" D ^DIC K DIC G:Y<0 CLEAN S ANQLBT=$P(Y,"^"),ANQLABTN=$P(Y,"^",2) G:ANQLBT="" CLEAN I $G(^LAB(60,ANQLBT,.2))']"" W !!,$C(7),"Data Name missing !!",! K Y,ANQLBT G LABT
|
||
|
|
S ANQLABT=^LAB(60,ANQLBT,.2)
|
||
|
|
W !,"Enter the specimen used in the lab for this test, serum,plasma,blood etc."
|
||
|
|
ANQSP S DIC="^LAB(61,",DIC(0)="QEAM" D ^DIC G:Y<0 CLEAN S ANQSP=$P(Y,"^") G:ANQSP="" CLEAN ;;I $P($G(^LAB(60,ANQLBT,1,ANQSP,0)),"^",7)']"" W !!,$C(7),"Specimen data missing !!",! ;K Y,ANQSP G ANQSP
|
||
|
|
ANQUNIT S ANQUNIT=$S($G(ANQSP)]"":$P($G(^LAB(60,ANQLBT,1,ANQSP,0)),"^",7),1:"")
|
||
|
|
ANQANS R !,"Do you want Rx info? N// ",ANQANS:DTIME G CLEAN:'$T S:ANQANS="" ANQANS="N" G:ANQANS="^" CLEAN2 I "YN"'[ANQANS W !,"ANSWER YES OR NO" G ANQANS
|
||
|
|
DEVICE K IOP S %ZIS="MQ" D ^%ZIS G:POP CLEAN2
|
||
|
|
I $D(IO("Q")) K IO("Q") S ZTSAVE("*")="",ZTRTN="DQ^PSORXLAB",ZTDESC="LAB LIST" D ^%ZTLOAD K ZTSK G CLEAN
|
||
|
|
DQ S PSOLABQ=0 K ^TMP($J) S ANQBD=ANQBD-1,PAGE=0 U IO W @IOF D HDR
|
||
|
|
LOOP1 F J=0:0 S ANQBD=$O(^PSRX("AD",ANQBD)) Q:ANQBD=""!($G(PSOLABQ)) Q:ANQBD>ANQED S ANQRX=0 D LOOP2
|
||
|
|
G CLEAN
|
||
|
|
LOOP2 F J2=0:0 S ANQRX=$O(^PSRX("AD",ANQBD,ANQRX)) Q:ANQRX=""!($G(PSOLABQ)) D:$G(^PSRX(ANQRX,0))]"" CHECK1
|
||
|
|
Q
|
||
|
|
CHECK1 S ANQDGN=+$P($G(^PSRX(ANQRX,0)),"^",6),ANQDRUGN=$P($G(^PSDRUG(ANQDGN,0)),"^")
|
||
|
|
I ANQDRUGN'[ANQDRUG Q
|
||
|
|
Q:'$P($G(^PSRX(ANQRX,0)),"^",4) S ANQPROV=$P(^PSRX(ANQRX,0),"^",4),ANQPROVN=$P(^VA(200,ANQPROV,0),"^"),ANQPROT=$P(^VA(200,ANQPROV,0),"^",5)
|
||
|
|
S ANQTYPE="NONE" I ANQPROT S ANQTYPE=$P("FULL TIME^PART TIME^C & A^FEE^STAFF","^",ANQPROT)
|
||
|
|
CHECK2 Q:'$P($G(^PSRX(ANQRX,0)),"^",2)
|
||
|
|
S (DFN,ANQPT)=$P(^PSRX(ANQRX,0),"^",2) W ! D PID^VADPT,PRINT2
|
||
|
|
I '$D(^DPT(ANQPT,"LR")) W ?55,"No lab data exists",?81,$E(ANQPROVN,1,20),?106,ANQTYPE,! D:ANQANS["Y" ANQRXI Q
|
||
|
|
S LRDFN=$P(^DPT(ANQPT,"LR"),"^"),ANQLBENT=0,ANQINDIC=0
|
||
|
|
LOOP3 F J2=0:0 S ANQLBENT=$O(^LR(LRDFN,"CH",ANQLBENT)) Q:ANQLBENT=""!($G(PSOLABQ)) S ANQLDATE=$P(^LR(LRDFN,"CH",ANQLBENT,0),"^") Q:ANQLDATE<LDATE D CHECK3
|
||
|
|
I ANQINDIC=0 W ?55,"NO LAB DATA IN RANGE",?81,$E(ANQPROVN,1,20),?106,ANQTYPE,!
|
||
|
|
D:ANQANS["Y" ANQRXI
|
||
|
|
Q
|
||
|
|
CHECK3 I $D(^LR(LRDFN,"CH",ANQLBENT,ANQLABT)) D RESULT
|
||
|
|
Q
|
||
|
|
RESULT Q:$P(^LR(LRDFN,"CH",ANQLBENT,0),"^",5)'=ANQSP Q:'$P(^(0),"^",3)
|
||
|
|
S Y=ANQLDATE X ^DD("DD") W ?55,$E(Y,1,11),?70,$P(^LR(LRDFN,"CH",ANQLBENT,ANQLABT),"^")_" "_ANQUNIT,?81,$E(ANQPROVN,1,20),?106,ANQTYPE W !
|
||
|
|
S ANQINDIC=1 Q
|
||
|
|
Q
|
||
|
|
PRINT2 I $Y>(IOSL-6) D Q:$G(PSOLABQ) W @IOF,SITE,! D HDR2
|
||
|
|
.I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSOLABQ=1
|
||
|
|
W ?1,$E($P(^DPT(ANQPT,0),"^"),1,20),?25,VA("PID") S Y=ANQBD X ^DD("DD") W ?43,Y Q
|
||
|
|
HDR W SITE,!!,"Patients receiving "_ANQDRUG_" with fills between "_ANQBDR_" and "_ANQEDR,!," with date of collection and results for lab test "_ANQLABTN_" after ",LDATER,!
|
||
|
|
HDR2 S PAGE=PAGE+1 W !,"Name",?25,"ID#",?43,"Fill Date",?55,"Lab Date",?71,"Results",?81,"Rx Provider",?106,"Type",?116,"Page "_PAGE,!
|
||
|
|
F J=1:1:IOM-1 W "_"
|
||
|
|
W ! Q
|
||
|
|
ANQRXI Q:$G(PSOLABQ) W "Rx #: "_$P(^PSRX(ANQRX,0),"^")_" Drug: "_$P(^PSDRUG(ANQDGN,0),"^")
|
||
|
|
K FSIG,BSIG I $P($G(^PSRX(ANQRX,"SIG")),"^",2) D FSIG^PSOUTLA("R",ANQRX,72) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
|
||
|
|
K FSIG,PSREV I '$P($G(^PSRX(ANQRX,"SIG")),"^",2) D EN2^PSOUTLA1(ANQRX,72)
|
||
|
|
W !?1,"Sig: ",$G(BSIG(1))
|
||
|
|
I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?6,$G(BSIG(PSREV))
|
||
|
|
I $Y>(IOSL-6) D Q:$G(PSOLABQ) W @IOF,SITE,! D HDR2
|
||
|
|
.I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSOLABQ=1
|
||
|
|
W ! Q
|
||
|
|
CLEAN W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
||
|
|
CLEAN2 K ANQINDIC,ANQPT,ANQLDATE,PAGE,ANQBD,ANQBDR,ANQLBENT,ANQLABT,ANQDGN,ANQDRUGN,ANQDRUG,J,J1,J2,ANQRX,ANQPROV,ANQPROVN,LDATE,LDATER,ANQED,ANQEDR,ANQPROT,ANQTYPE,ANQLABTN,ANQLBT,ANQSP,ANQUNIT,ANQANS,DIC,LRDFN,POP,SITE,Y,%DT,PSOLABQ
|
||
|
|
K ZTDESC,ZTRTN,ZTSAVE,%ZIS Q
|