source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMC24.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: 1.8 KB
Line 
1QAMC24 ;ISC7/LJA,DAD-CONDITION: PATIENTS WITH 2+ RXS FOR SAME DRUG CLASS ;9/3/93 13:22
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3EN1 ; *** CONDITION CODE
4 S QAMDCL=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:+^("P1"),1:0)
5 ;
6 F QAMID=QAMTODAY-.0000001:0 S QAMID=$O(^PSRX("AD",QAMID)) Q:(QAMID'>0)!(QAMID>(QAMTODAY+.9999999))!(QAMID\1'?7N) D
7 . F QAMRXN=0:0 S QAMRXN=$O(^PSRX("AD",+QAMID,QAMRXN)) Q:QAMRXN'>0 D
8 .. S QAMRX0=$G(^PSRX(QAMRXN,0)),QAMDFN=+$P(QAMRX0,U,2)
9 .. Q:('$P(QAMRX0,U,6))!('QAMDFN) ; No drug / patient
10 .. Q:"^11^12^13^"[("^"_$P(QAMRX0,"^",15)_"^") ; Status
11 .. S QA=+$P($G(^PSDRUG(+$P(QAMRX0,U,6),"ND")),U,6) ; Class
12 .. Q:$O(^QA(743.5,QAMDCL,"GRP","AB",QA,0))'>0
13 .. S QAMEXP=QAMTODAY
14 .. F S QAMEXP=$O(^PS(55,QAMDFN,"P","A",QAMEXP)) Q:QAMEXP'>0 F QAMRXD0=0:0 S QAMRXD0=$O(^PS(55,QAMDFN,"P","A",QAMEXP,QAMRXD0)) Q:QAMRXD0'>0 D
15 ... Q:QAMRXN=QAMRXD0
16 ... S QAMRX0=$G(^PSRX(QAMRXD0,0))
17 ... Q:'$P(QAMRX0,U,6) ; No drug found
18 ... Q:"^11^12^13^"[("^"_$P(QAMRX0,"^",15)_"^") ; Status
19 ... S QA=+$P($G(^PSDRUG(+$P(QAMRX0,U,6),"ND")),U,6) ; Class
20 ... Q:$O(^QA(743.5,QAMDCL,"GRP","AB",QA,0))'>0
21 ... S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN)=""
22 ... S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN,QAMID)=QAMRXN
23 ... Q
24 .. Q
25 . Q
26 K QAMDCL,QAMEXP,QAMRX0,QAMRXD0,QAMRXN
27 Q
28 ;
29EN2 ; *** PARAMETER CODE
30 K DIC,DIR,DIRUT
31 S DIC=743.5,DIC(0)="EMNQZ",DIC("A")="DRUG CLASS GROUP: "
32 S DIC("B")=$P($G(^QA(743,QAMD0,"COND",QAMD1,"P1")),"^",2)
33 K:DIC("B")="" DIC("B")
34 S DIC("S")="I $P(^QA(743.5,+Y,0),""^"",2)=50.605"
35 S DIC("W")="W "" "",$P(^(0),""^"",2)"
36 S DIR("?",1)="Enter the DRUG CLASS group you wish to monitor. All 'TODAY-1'"
37 S DIR("?")="fills will be scanned for duplicate fills for this group."
38 S QAMPARAM="P1" D EN2^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
39 S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y_"^"_Y(0,0)
40 ;
41EXIT K Y
42 K QAMPARAM
43Y Q
Note: See TracBrowser for help on using the repository browser.