86 lines
4.3 KiB
Mathematica
86 lines
4.3 KiB
Mathematica
GMRAU85 ;HIRMFO/RFM,WAA-UTILITIES FOR FILE 120.85 ; 1/6/93
|
|
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
|
|
EN1 ; LOOKUP FOR FILE 120.85 ENTRY IF PATIENT IS NOT KNOWN
|
|
; THEN 120.85 ENTRY (GMRAPA1) IS RETURNED AND GMRAOUT IF ABNORMAL EXIT.
|
|
S GMRAOUT=+($G(GMRAOUT))
|
|
W ! S GMRAPA1=-1,DIC="^DPT(",DIC(0)="AEQM" D ^DIC K DIC G:+Y'>0 Q1 S DFN=+Y,GMRANAM=$P(Y,"^",2)
|
|
D ADR
|
|
I GMRAPA1'>0&'GMRAOUT G EN1
|
|
Q1 ;
|
|
K GMRANAM
|
|
Q
|
|
ADR ; LOOKUP FOR FILE 120.85 ENTRY IF PATIENT (DFN) IS KNOWN,
|
|
; THEN 120.85 ENTRY (GMRAPA1) IS RETURNED AND GMRAOUT IF ABNORMAL EXIT.
|
|
;v=New Line
|
|
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
|
|
;V========= Old Line
|
|
;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
|
|
I 'X W !?4,$C(7),"THIS PATIENT HAS NO ALLERGY/ADVERSE REACTIONS TO REPORT ON." Q
|
|
F D Q:GMRAOUT I +Y>0 S GMRAPA=+Y,GMRAPA(0)=Y(0) Q
|
|
. 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."
|
|
. S DIR("??")="^D HLP^GMRAU851" D ^DIR K DIR I $D(DIRUT) S GMRAOUT=1 Q
|
|
. S:GMRAOUT GMRAOUT=GMRAOUT-1
|
|
. 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
|
|
. I $D(DTOUT)!$D(DUOUT) S GMRAOUT=1 Q
|
|
. ;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
|
|
. Q
|
|
I GMRAOUT S GMRAOUT=2-GMRAOUT Q
|
|
D EN2
|
|
Q
|
|
EN2 ; LOOKUP 120.85 ENTRY IF PATIENT (DFN) KNOWN, AND 120.8 ENTRY (GMRAPA)
|
|
; IS KNOWN.
|
|
; THEN 120.85 ENTRY (GMRAPA1) IS RETURNED AND GMRAOUT IF ABNORMAL EXIT.
|
|
S GMRAPA1=-1
|
|
F D Q:GMRAOUT I +Y>0 S GMRAPA1=+Y Q
|
|
. K DIR S DIR(0)="DO^:NOW:ETX",DIR("A")="Select date reaction was OBSERVED (Time Optional)"
|
|
. 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
|
|
. I $D(DIRUT) S GMRAOUT=2 S:$D(DTOUT)!$D(DUOUT) GMRAOUT=1 Q
|
|
. S (X,GMRAX)=Y,DIC=120.85,DIC(0)="EQ"_$S(GMRALAGO:"L",1:"")
|
|
. S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,15)=GMRAPA" S:GMRALAGO DLAYGO=120.85
|
|
. 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
|
|
. S GMRAPA1=+Y
|
|
. I '$$LOCK^GMRAUTL(120.85,GMRAPA1,1) S (GMRAPA1,Y)=-1 Q
|
|
. I $P(Y,U,3)=1 S GMRAN85=1 D
|
|
. . ; This code may be of no use anymore after this is change *****
|
|
. . 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
|
|
. . . Q:'$D(^GMR(120.8,GMRAPA,10,GMRAX,0))
|
|
. . . S ^GMR(120.85,GMRAPA1,2,GMRAX,0)=$P(^GMR(120.8,GMRAPA,10,GMRAX,0),U,1,2)_"^"_DUZ
|
|
. . . Q
|
|
. . D:'$G(GMRASITE) SITE^GMRAUTL
|
|
. . 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)
|
|
. . S ^GMR(120.85,GMRAPA1,3,0)="^120.8503^1^1"
|
|
. . S ^GMR(120.85,GMRAPA1,3,1,0)=$P(GMRAPA(0),U,2)
|
|
. . S DA=GMRAPA1,DIK="^GMR(120.85," D IX1^DIK
|
|
. . Q
|
|
. Q
|
|
I GMRAOUT S GMRAOUT=2-GMRAOUT
|
|
K GMRAX
|
|
Q
|
|
SCR02 ; SCREEN FOR .02 FIELD OF FILE 120.85
|
|
I $G(DA)<1 Q
|
|
S GMRA=$G(^GMR(120.85,DA,0))
|
|
I $P(GMRA,U,15)<1 K GMRA Q
|
|
I +Y=$P($G(^GMR(120.8,$P(GMRA,U,15),0)),U) K GMRA Q
|
|
I 0
|
|
K GMRA
|
|
Q
|
|
SCR03 ; SCREEN FOR .03 FIELD OF FILE 120.85
|
|
I $G(DA)<1 Q
|
|
S GMRA=$G(^GMR(120.85,DA,0)),GMRA(0)=$G(^GMR(120.8,+Y,0))
|
|
I $P(GMRA(0),U,2)']"" X "I 0" K GMRA Q
|
|
I $P(GMRA,U,2)<1 K GMRA Q
|
|
I $P($G(^GMR(120.8,+Y,0)),U)=$P(GMRA,U,2) K GMRA Q
|
|
I 0
|
|
K GMRA
|
|
Q
|
|
OBSDRG(GMRA) ; GIVEN GMRA AS ENTRY IN 120.8, FUNCTION RETURNS 1 IF OBS. DRUG
|
|
; ELSE IT RETURNS 0
|
|
I $G(GMRA)="" S GMRA=$P($G(^GMR(120.85,+Y,0)),U,15)
|
|
S GMRA(0)=GMRA,GMRA=$G(^GMR(120.8,+GMRA,0))
|
|
;v===New Line
|
|
I $P(GMRA,U,20)'["D"!+$G(^GMR(120.8,+GMRA(0),"ER")) S GMRA=0
|
|
;V===Old Line
|
|
;I $P(GMRA,U,6)'="o"!($P(GMRA,U,20)'["D")!+$G(^GMR(120.8,+GMRA(0),"ER")) S GMRA=0
|
|
E S GMRA=1
|
|
Q GMRA
|