source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORXLAB.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1PSORXLAB ;BHAM ISC/SAB - drug+lab result print ; 11/19/92 14:04
2 ;;7.0;OUTPATIENT PHARMACY;**29**;DEC 1997
3 ;a routine which loop thru the last fill x-ref of ^psrx and gets
4 ;patients with a specific drug. then gets the lrdfn from the
5 ;patient file and loops thru the patients lab data to find
6 ;results within the date range you specify for the lab test
7 ;used to minitor the drug. it then prints the patient's name
8 ;ssn, last fill date, and the lab test results if any.
9 ;this is intended as a qa minitor and should not be run for
10 ;more than a 30 day fill date interval, or 1 year lab test interval.
11 ;External ref. to ^LAB(60, is supp. by DBIA# 333
12 ;External ref. to ^LR(LRDFN,"CH", is supp. by DBIA# 844
13 ;External ref. to ^PSDRUG( is supp. by DBIA# 221
14 ;External ref. to ^VA(200, is supp. by DBIA# 10060
15ANQSITE K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^")
16 I $G(DA) D
17 .S DIC=4,DIQ(0)="I",DR=".01;99" D EN^DIQ1
18 .S SITE=$G(^UTILITY("DIQ1",$J,4,DA,.01,"I"))_" "_$G(^UTILITY("DIQ1",$J,4,DA,99,"I"))
19 .K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC
20 S Y=DT X ^DD("DD") S SITE=$G(SITE)_" "_Y
21BDATE S %DT="EXTA",%DT("A")="Beginning fill date: " D ^%DT G CLEAN:Y<0 S ANQBD=Y X ^DD("DD") S ANQBDR=Y
22EDATE S %DT("A")="Ending last fill date: " D ^%DT G CLEAN:Y<0 S ANQED=Y X ^DD("DD") S ANQEDR=Y
23LDATE S %DT("A")="Earliest date for lab results: " D ^%DT G CLEAN:Y<0 S LDATE=Y X ^DD("DD") S LDATER=Y
24DRUG R !,"Enter the key word in the Drug Generic name: ",ANQDRUG:DTIME G CLEAN:'$T I "^"[ANQDRUG G CLEAN
25 I $O(^PSDRUG("B",$E(ANQDRUG,1,$L(ANQDRUG)-1)))'[ANQDRUG W !,"No corresponding entry, try again or type return to exit" G DRUG
26LABT 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
27 S ANQLABT=^LAB(60,ANQLBT,.2)
28 W !,"Enter the specimen used in the lab for this test, serum,plasma,blood etc."
29ANQSP 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
30ANQUNIT S ANQUNIT=$S($G(ANQSP)]"":$P($G(^LAB(60,ANQLBT,1,ANQSP,0)),"^",7),1:"")
31ANQANS 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
32DEVICE K IOP S %ZIS="MQ" D ^%ZIS G:POP CLEAN2
33 I $D(IO("Q")) K IO("Q") S ZTSAVE("*")="",ZTRTN="DQ^PSORXLAB",ZTDESC="LAB LIST" D ^%ZTLOAD K ZTSK G CLEAN
34DQ S PSOLABQ=0 K ^TMP($J) S ANQBD=ANQBD-1,PAGE=0 U IO W @IOF D HDR
35LOOP1 F J=0:0 S ANQBD=$O(^PSRX("AD",ANQBD)) Q:ANQBD=""!($G(PSOLABQ)) Q:ANQBD>ANQED S ANQRX=0 D LOOP2
36 G CLEAN
37LOOP2 F J2=0:0 S ANQRX=$O(^PSRX("AD",ANQBD,ANQRX)) Q:ANQRX=""!($G(PSOLABQ)) D:$G(^PSRX(ANQRX,0))]"" CHECK1
38 Q
39CHECK1 S ANQDGN=+$P($G(^PSRX(ANQRX,0)),"^",6),ANQDRUGN=$P($G(^PSDRUG(ANQDGN,0)),"^")
40 I ANQDRUGN'[ANQDRUG Q
41 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)
42 S ANQTYPE="NONE" I ANQPROT S ANQTYPE=$P("FULL TIME^PART TIME^C & A^FEE^STAFF","^",ANQPROT)
43CHECK2 Q:'$P($G(^PSRX(ANQRX,0)),"^",2)
44 S (DFN,ANQPT)=$P(^PSRX(ANQRX,0),"^",2) W ! D PID^VADPT,PRINT2
45 I '$D(^DPT(ANQPT,"LR")) W ?55,"No lab data exists",?81,$E(ANQPROVN,1,20),?106,ANQTYPE,! D:ANQANS["Y" ANQRXI Q
46 S LRDFN=$P(^DPT(ANQPT,"LR"),"^"),ANQLBENT=0,ANQINDIC=0
47LOOP3 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
48 I ANQINDIC=0 W ?55,"NO LAB DATA IN RANGE",?81,$E(ANQPROVN,1,20),?106,ANQTYPE,!
49 D:ANQANS["Y" ANQRXI
50 Q
51CHECK3 I $D(^LR(LRDFN,"CH",ANQLBENT,ANQLABT)) D RESULT
52 Q
53RESULT Q:$P(^LR(LRDFN,"CH",ANQLBENT,0),"^",5)'=ANQSP Q:'$P(^(0),"^",3)
54 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 !
55 S ANQINDIC=1 Q
56 Q
57PRINT2 I $Y>(IOSL-6) D Q:$G(PSOLABQ) W @IOF,SITE,! D HDR2
58 .I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSOLABQ=1
59 W ?1,$E($P(^DPT(ANQPT,0),"^"),1,20),?25,VA("PID") S Y=ANQBD X ^DD("DD") W ?43,Y Q
60HDR W SITE,!!,"Patients receiving "_ANQDRUG_" with fills between "_ANQBDR_" and "_ANQEDR,!," with date of collection and results for lab test "_ANQLABTN_" after ",LDATER,!
61HDR2 S PAGE=PAGE+1 W !,"Name",?25,"ID#",?43,"Fill Date",?55,"Lab Date",?71,"Results",?81,"Rx Provider",?106,"Type",?116,"Page "_PAGE,!
62 F J=1:1:IOM-1 W "_"
63 W ! Q
64ANQRXI Q:$G(PSOLABQ) W "Rx #: "_$P(^PSRX(ANQRX,0),"^")_" Drug: "_$P(^PSDRUG(ANQDGN,0),"^")
65 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)
66 K FSIG,PSREV I '$P($G(^PSRX(ANQRX,"SIG")),"^",2) D EN2^PSOUTLA1(ANQRX,72)
67 W !?1,"Sig: ",$G(BSIG(1))
68 I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?6,$G(BSIG(PSREV))
69 I $Y>(IOSL-6) D Q:$G(PSOLABQ) W @IOF,SITE,! D HDR2
70 .I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSOLABQ=1
71 W ! Q
72CLEAN W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
73CLEAN2 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
74 K ZTDESC,ZTRTN,ZTSAVE,%ZIS Q
Note: See TracBrowser for help on using the repository browser.