QAMC24 ;ISC7/LJA,DAD-CONDITION: PATIENTS WITH 2+ RXS FOR SAME DRUG CLASS ;9/3/93 13:22
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** CONDITION CODE
S QAMDCL=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:+^("P1"),1:0)
;
F QAMID=QAMTODAY-.0000001:0 S QAMID=$O(^PSRX("AD",QAMID)) Q:(QAMID'>0)!(QAMID>(QAMTODAY+.9999999))!(QAMID\1'?7N) D
. F QAMRXN=0:0 S QAMRXN=$O(^PSRX("AD",+QAMID,QAMRXN)) Q:QAMRXN'>0 D
.. S QAMRX0=$G(^PSRX(QAMRXN,0)),QAMDFN=+$P(QAMRX0,U,2)
.. Q:('$P(QAMRX0,U,6))!('QAMDFN) ; No drug / patient
.. Q:"^11^12^13^"[("^"_$P(QAMRX0,"^",15)_"^") ; Status
.. S QA=+$P($G(^PSDRUG(+$P(QAMRX0,U,6),"ND")),U,6) ; Class
.. Q:$O(^QA(743.5,QAMDCL,"GRP","AB",QA,0))'>0
.. S QAMEXP=QAMTODAY
.. 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
... Q:QAMRXN=QAMRXD0
... S QAMRX0=$G(^PSRX(QAMRXD0,0))
... Q:'$P(QAMRX0,U,6) ; No drug found
... Q:"^11^12^13^"[("^"_$P(QAMRX0,"^",15)_"^") ; Status
... S QA=+$P($G(^PSDRUG(+$P(QAMRX0,U,6),"ND")),U,6) ; Class
... Q:$O(^QA(743.5,QAMDCL,"GRP","AB",QA,0))'>0
... S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN)=""
... S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN,QAMID)=QAMRXN
... Q
.. Q
. Q
K QAMDCL,QAMEXP,QAMRX0,QAMRXD0,QAMRXN
Q
;
EN2 ; *** PARAMETER CODE
K DIC,DIR,DIRUT
S DIC=743.5,DIC(0)="EMNQZ",DIC("A")="DRUG CLASS GROUP: "
S DIC("B")=$P($G(^QA(743,QAMD0,"COND",QAMD1,"P1")),"^",2)
K:DIC("B")="" DIC("B")
S DIC("S")="I $P(^QA(743.5,+Y,0),""^"",2)=50.605"
S DIC("W")="W "" "",$P(^(0),""^"",2)"
S DIR("?",1)="Enter the DRUG CLASS group you wish to monitor. All 'TODAY-1'"
S DIR("?")="fills will be scanned for duplicate fills for this group."
S QAMPARAM="P1" D EN2^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y_"^"_Y(0,0)
;
EXIT K Y
K QAMPARAM
Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMC24 1904 printed Dec 13, 2024@01:42:08 Page 2
QAMC24 ;ISC7/LJA,DAD-CONDITION: PATIENTS WITH 2+ RXS FOR SAME DRUG CLASS ;9/3/93 13:22
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** CONDITION CODE
+1 SET QAMDCL=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:+^("P1"),1:0)
+2 ;
+3 FOR QAMID=QAMTODAY-.0000001:0
SET QAMID=$ORDER(^PSRX("AD",QAMID))
if (QAMID'>0)!(QAMID>(QAMTODAY+.9999999))!(QAMID\1'?7N)
QUIT
Begin DoDot:1
+4 FOR QAMRXN=0:0
SET QAMRXN=$ORDER(^PSRX("AD",+QAMID,QAMRXN))
if QAMRXN'>0
QUIT
Begin DoDot:2
+5 SET QAMRX0=$GET(^PSRX(QAMRXN,0))
SET QAMDFN=+$PIECE(QAMRX0,U,2)
+6 ; No drug / patient
if ('$PIECE(QAMRX0,U,6))!('QAMDFN)
QUIT
+7 ; Status
if "^11^12^13^"[("^"_$PIECE(QAMRX0,"^",15)_"^")
QUIT
+8 ; Class
SET QA=+$PIECE($GET(^PSDRUG(+$PIECE(QAMRX0,U,6),"ND")),U,6)
+9 if $ORDER(^QA(743.5,QAMDCL,"GRP","AB",QA,0))'>0
QUIT
+10 SET QAMEXP=QAMTODAY
+11 FOR
SET QAMEXP=$ORDER(^PS(55,QAMDFN,"P","A",QAMEXP))
if QAMEXP'>0
QUIT
FOR QAMRXD0=0:0
SET QAMRXD0=$ORDER(^PS(55,QAMDFN,"P","A",QAMEXP,QAMRXD0))
if QAMRXD0'>0
QUIT
Begin DoDot:3
+12 if QAMRXN=QAMRXD0
QUIT
+13 SET QAMRX0=$GET(^PSRX(QAMRXD0,0))
+14 ; No drug found
if '$PIECE(QAMRX0,U,6)
QUIT
+15 ; Status
if "^11^12^13^"[("^"_$PIECE(QAMRX0,"^",15)_"^")
QUIT
+16 ; Class
SET QA=+$PIECE($GET(^PSDRUG(+$PIECE(QAMRX0,U,6),"ND")),U,6)
+17 if $ORDER(^QA(743.5,QAMDCL,"GRP","AB",QA,0))'>0
QUIT
+18 SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAMDFN)=""
+19 SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAMDFN,QAMID)=QAMRXN
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 KILL QAMDCL,QAMEXP,QAMRX0,QAMRXD0,QAMRXN
+24 QUIT
+25 ;
EN2 ; *** PARAMETER CODE
+1 KILL DIC,DIR,DIRUT
+2 SET DIC=743.5
SET DIC(0)="EMNQZ"
SET DIC("A")="DRUG CLASS GROUP: "
+3 SET DIC("B")=$PIECE($GET(^QA(743,QAMD0,"COND",QAMD1,"P1")),"^",2)
+4 if DIC("B")=""
KILL DIC("B")
+5 SET DIC("S")="I $P(^QA(743.5,+Y,0),""^"",2)=50.605"
+6 SET DIC("W")="W "" "",$P(^(0),""^"",2)"
+7 SET DIR("?",1)="Enter the DRUG CLASS group you wish to monitor. All 'TODAY-1'"
+8 SET DIR("?")="fills will be scanned for duplicate fills for this group."
+9 SET QAMPARAM="P1"
DO EN2^QAMUTL1
IF $DATA(DIRUT)
SET Y=-1
GOTO Y
+10 if Y]""
SET ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y_"^"_Y(0,0)
+11 ;
EXIT KILL Y
+1 KILL QAMPARAM
Y QUIT
