source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSODGAL.m@ 1154

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1PSODGAL ;BIR/LC-DRUG ALLERGY REACTION CHECKING ;08/09/95 02:22
2 ;;7.0;OUTPATIENT PHARMACY;**26,243**;DEC 1997;Build 22
3 ;External reference to ^GMRADPT supported by DBIA 10099
4 ;External reference to ORCHK^GMRAOR supported by DBIA 2378
5 ;External reference to $P(^GMR(120.8,LP,3),"^",3) supp. by DBIA 2214
6 ;External reference to ^PS(50.605 supported by DBIA 696
7 ;External reference to EN1^GMRAOR2 supported by DBIA 2422
8 ;External reference to GETDATA^GMRAOR supported by DBIA 4847
9 ;External reference to ^TMP("GMRAOC" supported by DBIA 4848
10 ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076
11CHK(DFN,TYP,PTR) ;matched to ndf
12 K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR) D:$G(PSOACK)=1
13 .Q:$D(^XUSEC("PSORPH",DUZ))
14 .S ^TMP("PSODAI",$J,0)=1
15 .S I=0 F S I=$O(GMRAING(I)) Q:'I S ^TMP("PSODAI",$J,I,0)=GMRAING(I)
16 D:$G(PSOACK)=1 DSPLY
17 K PSOACK,GMRAING,I
18 Q
19CHK1(DFN) ;not matched to ndf
20 K ^TMP("PSODAI",$J)
21 S GMRA="0^0^001" D ^GMRADPT F LP=0:0 S LP=$O(GMRAL(LP)) Q:'LP!($G(PSOACK)) D:$D(^GMR(120.8,LP,0))
22 .S:'$D(PSOACK) APTR=$P(^GMR(120.8,LP,0),"^",3)
23 .I $P(APTR,";",2)="PSDRUG(",$P(APTR,";")=PSODRUG("IEN") S PSOACK=1
24 .Q:$D(^XUSEC("PSORPH",DUZ)) S:$G(PSOACK)=1 ^TMP("PSODAI",$J,0)=1
25 D:$G(PSOACK)=1 DSPLY
26 K APTR,GMRA,GMRAL,LP,PSOACK
27 Q
28 ;
29CLASS(DFN) ;
30 N CPT,CLCHK,CT,AGNL,CC,GMRA,LEN
31 S LEN=4
32 I $E(PSODRUG("VA CLASS"),1,4)="CN10" S LEN=5 ;look at 5 chars if ANALGESICS
33 K ^TMP($J,"PSODRCLS")
34 I $T(GETDATA^GMRAOR)]"" G CLASS2 ; CHECK FOR EXISTENCE OF NEW ENTRY POINT BEFORE USING
35 S CLCHK=""
36 S GMRA="0^0^111" D ^GMRADPT F CC=0:0 S CC=$O(GMRAL(CC)) Q:'CC D
37 .K AGNL D EN1^GMRAOR2(CC,"AGNL")
38 .I $D(AGNL("V")) F CT=0:1 S CPT=$O(AGNL("V",CT)) Q:'CPT I $E($P($G(AGNL("V",CPT)),"^"),1,LEN)=$E(PSODRUG("VA CLASS"),1,LEN) D
39 ..S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=$P($G(AGNL("V",CPT)),"^")_" "_$P($G(AGNL("V",CPT)),"^",2)
40 G CLASSDSP
41CLASS2 ;
42 N RET
43 S RET=$$DRCL(DFN)
44 I '$G(RET) Q
45 S CLCHK="",CT="" F S CT=$O(GMRADRCL(CT)) Q:CT="" D
46 .I $E(PSODRUG("VA CLASS"),1,LEN)=$E(CT,1,LEN) S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=CT_" "_$P(GMRADRCL(CT),"^",2)
47CLASSDSP ;
48 I '$D(^TMP($J,"PSODRCLS")) Q
49 W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
50 W !,"Drug: "_PSODRUG("NAME")
51 S CT="" F S CT=$O(^TMP($J,"PSODRCLS",CT)) Q:CT="" W !,"Drug Class: "_^TMP($J,"PSODRCLS",CT)
52 K ^TMP($J,"PSODRCLS")
53 S DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"
54 S DIR("?")=" 'NO' if you DON'T want to enter a reaction for this medication,"
55 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR
56 I Y D ^PSORXI
57 I '$G(Y) K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q
58 Q
59DSPLY ;
60 W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
61 I $D(^XUSEC("PSORPH",DUZ)) D
62 .W !,"Drug: "_PSODRUG("NAME") I $O(GMRAING(0)) W !,?6,"Ingredients: "
63 .S DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"
64 .S DIR("?")=" 'NO' if you DON'T want to enter a reaction for this medication,"
65 .W ?19 S I=0 F S I=$O(GMRAING(I)) Q:'I W:$X+$L($G(GMRAING(I)))+2>IOM !?19 W $G(GMRAING(I))_", "
66 .S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR
67 .I 'Y K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q
68 .I Y D ^PSORXI
69 K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y
70 Q
71 ;
72DRCL(DFN) ;
73 N RET
74 S RET=0
75 K GMRADRCL
76 D GETDATA^GMRAOR(DFN)
77 Q:'$D(^TMP("GMRAOC",$J,"APC")) 0
78 N GMRACL
79 S GMRACL="" F S GMRACL=$O(^TMP("GMRAOC",$J,"APC",GMRACL)) Q:'$L(GMRACL) D
80 .N GMRANM,GMRALOC
81 .S GMRALOC=^TMP("GMRAOC",$J,"APC",GMRACL)
82 .S GMRANM=$P(^PS(50.605,+$O(^PS(50.605,"B",GMRACL,0)),0),U,2)
83 .S GMRADRCL(GMRACL)=GMRACL_U_GMRANM_" ("_GMRALOC_")"
84 .S RET=RET+1
85 K ^TMP("GMRAOC",$J)
86 Q RET
Note: See TracBrowser for help on using the repository browser.