source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAU85.m@ 1354

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1GMRAU85 ;HIRMFO/RFM,WAA-UTILITIES FOR FILE 120.85 ; 1/6/93
2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
3EN1 ; LOOKUP FOR FILE 120.85 ENTRY IF PATIENT IS NOT KNOWN
4 ; THEN 120.85 ENTRY (GMRAPA1) IS RETURNED AND GMRAOUT IF ABNORMAL EXIT.
5 S GMRAOUT=+($G(GMRAOUT))
6 W ! S GMRAPA1=-1,DIC="^DPT(",DIC(0)="AEQM" D ^DIC K DIC G:+Y'>0 Q1 S DFN=+Y,GMRANAM=$P(Y,"^",2)
7 D ADR
8 I GMRAPA1'>0&'GMRAOUT G EN1
9Q1 ;
10 K GMRANAM
11 Q
12ADR ; LOOKUP FOR FILE 120.85 ENTRY IF PATIENT (DFN) IS KNOWN,
13 ; THEN 120.85 ENTRY (GMRAPA1) IS RETURNED AND GMRAOUT IF ABNORMAL EXIT.
14 ;v=New Line
15 S X=0,GMRAPA1=-1 F Y=0:0 S Y=$O(^GMR(120.8,"B",DFN,Y)) Q:Y'>0 I $P($G(^GMR(120.8,Y,0)),U,2)]"",$P(^(0),U,20)["D" S X=1 Q
16 ;V========= Old Line
17 ;S X=0,GMRAPA1=-1 F Y=0:0 S Y=$O(^GMR(120.8,"B",DFN,Y)) Q:Y'>0 I $P($G(^GMR(120.8,Y,0)),U,2)]"",$P(^(0),U,6)="o",$P(^(0),U,20)["D" S X=1 Q
18 I 'X W !?4,$C(7),"THIS PATIENT HAS NO ALLERGY/ADVERSE REACTIONS TO REPORT ON." Q
19 F D Q:GMRAOUT I +Y>0 S GMRAPA=+Y,GMRAPA(0)=Y(0) Q
20 . K DIR S DIR("A")="Select CAUSATIVE AGENT: ",DIR(0)="FAO^1:60",DIR("?",1)=" Answer with a Causative Agent of an observed drug reaction.",DIR("?")=" Type ?? to get a listing of this patient's data."
21 . S DIR("??")="^D HLP^GMRAU851" D ^DIR K DIR I $D(DIRUT) S GMRAOUT=1 Q
22 . S:GMRAOUT GMRAOUT=GMRAOUT-1
23 . S GMRAX=Y,X=$P($G(^DPT(DFN,0)),"^"),DIC="^GMR(120.8,",DIC(0)="EZQ",DIC("S")="I $P(^(0),U)=DFN,$P($$UP^XLFSTR($P(^(0),U,2)),$$UP^XLFSTR(GMRAX))="""",$$OBSDRG^GMRAU85(Y)",DIC("W")="W "" "",$P($G(^(0)),U,2)" D ^DIC K DIC
24 . I $D(DTOUT)!$D(DUOUT) S GMRAOUT=1 Q
25 . ;S GMRAX=Y,X=GMRAX,DIC="^GMR(120.8,",DIC(0)="SEZQM",DIC("S")="I $P(^(0),U)=DFN,$$OBSDRG^GMRAU85(Y)",DIC("W")="W "" "",$P($G(^(0)),U,2)" D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) S GMRAOUT=1 Q
26 . Q
27 I GMRAOUT S GMRAOUT=2-GMRAOUT Q
28 D EN2
29 Q
30EN2 ; LOOKUP 120.85 ENTRY IF PATIENT (DFN) KNOWN, AND 120.8 ENTRY (GMRAPA)
31 ; IS KNOWN.
32 ; THEN 120.85 ENTRY (GMRAPA1) IS RETURNED AND GMRAOUT IF ABNORMAL EXIT.
33 S GMRAPA1=-1
34 F D Q:GMRAOUT I +Y>0 S GMRAPA1=+Y Q
35 . K DIR S DIR(0)="DO^:NOW:ETX",DIR("A")="Select date reaction was OBSERVED (Time Optional)"
36 . S DIR("?",1)=" Please enter the date (time optional) that a reaction to this particular",DIR("?",2)=" causative agent was witnessed.",DIR("?")=" ",DIR("??")="^D HLP1^GMRAU851" D ^DIR K DIR
37 . I $D(DIRUT) S GMRAOUT=2 S:$D(DTOUT)!$D(DUOUT) GMRAOUT=1 Q
38 . S (X,GMRAX)=Y,DIC=120.85,DIC(0)="EQ"_$S(GMRALAGO:"L",1:"")
39 . S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,15)=GMRAPA" S:GMRALAGO DLAYGO=120.85
40 . S DIC("W")="",DIC("DR")=".02////"_DFN_";.03////"_GMRAPA_";1.1///NOW;1.2////"_DUZ D ^DIC K DIC,DLAYGO I $D(DTOUT)!$D(DUOUT) S GMRAOUT=1 Q
41 . S GMRAPA1=+Y
42 . I '$$LOCK^GMRAUTL(120.85,GMRAPA1,1) S (GMRAPA1,Y)=-1 Q
43 . I $P(Y,U,3)=1 S GMRAN85=1 D
44 . . ; This code may be of no use anymore after this is change *****
45 . . I $O(^GMR(120.8,GMRAPA,10,0)) S ^GMR(120.85,GMRAPA1,2,0)="^120.8502P^"_$P(^GMR(120.8,GMRAPA,10,0),U,3,4),GMRAX=0 F S GMRAX=$O(^GMR(120.8,GMRAPA,10,GMRAX)) Q:GMRAX<1 D
46 . . . Q:'$D(^GMR(120.8,GMRAPA,10,GMRAX,0))
47 . . . S ^GMR(120.85,GMRAPA1,2,GMRAX,0)=$P(^GMR(120.8,GMRAPA,10,GMRAX,0),U,1,2)_"^"_DUZ
48 . . . Q
49 . . D:'$G(GMRASITE) SITE^GMRAUTL
50 . . I $D(^GMRD(120.84,+GMRASITE,"RPT")) S $P(^GMR(120.85,GMRAPA1,"RPT"),U,1,8)=$P(^GMRD(120.84,+GMRASITE,"RPT"),U,1,8)
51 . . S ^GMR(120.85,GMRAPA1,3,0)="^120.8503^1^1"
52 . . S ^GMR(120.85,GMRAPA1,3,1,0)=$P(GMRAPA(0),U,2)
53 . . S DA=GMRAPA1,DIK="^GMR(120.85," D IX1^DIK
54 . . Q
55 . Q
56 I GMRAOUT S GMRAOUT=2-GMRAOUT
57 K GMRAX
58 Q
59SCR02 ; SCREEN FOR .02 FIELD OF FILE 120.85
60 I $G(DA)<1 Q
61 S GMRA=$G(^GMR(120.85,DA,0))
62 I $P(GMRA,U,15)<1 K GMRA Q
63 I +Y=$P($G(^GMR(120.8,$P(GMRA,U,15),0)),U) K GMRA Q
64 I 0
65 K GMRA
66 Q
67SCR03 ; SCREEN FOR .03 FIELD OF FILE 120.85
68 I $G(DA)<1 Q
69 S GMRA=$G(^GMR(120.85,DA,0)),GMRA(0)=$G(^GMR(120.8,+Y,0))
70 I $P(GMRA(0),U,2)']"" X "I 0" K GMRA Q
71 I $P(GMRA,U,2)<1 K GMRA Q
72 I $P($G(^GMR(120.8,+Y,0)),U)=$P(GMRA,U,2) K GMRA Q
73 I 0
74 K GMRA
75 Q
76OBSDRG(GMRA) ; GIVEN GMRA AS ENTRY IN 120.8, FUNCTION RETURNS 1 IF OBS. DRUG
77 ; ELSE IT RETURNS 0
78 I $G(GMRA)="" S GMRA=$P($G(^GMR(120.85,+Y,0)),U,15)
79 S GMRA(0)=GMRA,GMRA=$G(^GMR(120.8,+GMRA,0))
80 ;v===New Line
81 I $P(GMRA,U,20)'["D"!+$G(^GMR(120.8,+GMRA(0),"ER")) S GMRA=0
82 ;V===Old Line
83 ;I $P(GMRA,U,6)'="o"!($P(GMRA,U,20)'["D")!+$G(^GMR(120.8,+GMRA(0),"ER")) S GMRA=0
84 E S GMRA=1
85 Q GMRA
Note: See TracBrowser for help on using the repository browser.