1 | GMRARAD0 ;HIRMFO/RM-Radiology\ART Interface Routine (cont.);12/30/93
|
---|
2 | ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
|
---|
3 | NKADD ; This entry point will add the NKA entry in file 120.8 if needed.
|
---|
4 | N GMRATMP,GMRAPA,GMRA,GMRAY,GMRAX,DA,DFN,DIK
|
---|
5 | S GMRA(0)=GMRAL
|
---|
6 | Q:$P($G(^GMR(120.86,+GMRA(0),0)),U,2)=1
|
---|
7 | I '$D(^GMR(120.86,+GMRA(0),0)) D
|
---|
8 | .N GMRACNT,GMRADFN,GMRAX
|
---|
9 | .S GMRADFN=+GMRA(0),GMRAX=$G(^GMR(120.86,0))
|
---|
10 | .S:GMRAX="" GMRAX="ADVERSE REACTION ASSESSMENT^120.86P^^"
|
---|
11 | .S GMRACNT=($P(GMRAX,U,4)+1),^GMR(120.86,GMRADFN,0)=GMRADFN_U_"1"
|
---|
12 | .S ^GMR(120.86,"B",GMRADFN,GMRADFN)=""
|
---|
13 | .S $P(GMRAX,U,3,4)=GMRADFN_U_GMRACNT S ^GMR(120.86,0)=GMRAX
|
---|
14 | .Q
|
---|
15 | I $P($G(^GMR(120.86,+GMRA(0),0)),U,2)'=1 S $P(^(0),U,2)="1"
|
---|
16 | Q
|
---|
17 | CHKEXAL ; This entry point will check the database for existing Rad. Allergies,
|
---|
18 | ; and ask user if they should be entered in error.
|
---|
19 | S GMRADA=0 F S GMRADA=$O(^GMR(120.8,"B",DFN,GMRADA)) Q:GMRADA'>0 I $$RALLG^GMRARAD(GMRADA) Q
|
---|
20 | Q:GMRADA'>0 W $C(7),!!!,$C(7)
|
---|
21 | S DIR("A",1)="*** WARNING *** WARNING *** WARNING ***",DIR("A",2)="Contrast media allergies have already been documented for this patient.",DIR("A",3)="By answering this question NO, you will be deleting this data."
|
---|
22 | S DIR("A")="ARE YOU SURE THIS IS WHAT YOU WANT TO DO? ",DIR("?")="Answer Yes if you want to delete existing data, else answer No.",DIR(0)="YA" D ^DIR
|
---|
23 | I Y'=1 S FXN=1 Q
|
---|
24 | S GMRADA=0 F S GMRADA=$O(^GMR(120.8,"B",DFN,GMRADA)) Q:GMRADA'>0 I $$RALLG^GMRARAD(GMRADA) D
|
---|
25 | . S GMRAER=$G(^GMR(120.8,GMRADA,"ER")),DA=GMRADA
|
---|
26 | . F GMRAX=22,23,24 S X=$S(GMRAX=22:$P(GMRAER,U),GMRAX=23:$P(GMRAER,U,2),1:$P(GMRAER,U,3)),GMRAY=0 F S GMRAY=$O(^DD(120.8,GMRAX,1,GMRAY)) Q:GMRAY'>0 X:$D(^DD(120.8,GMRAX,1,GMRAY,2)) ^(2)
|
---|
27 | . S GMRAER="1^"_$$HTFM^XLFDT($H)_"^"_DUZ,^GMR(120.8,GMRADA,"ER")=GMRAER
|
---|
28 | . F GMRAX=22,23,24 S X=$S(GMRAX=22:$P(GMRAER,U),GMRAX=23:$P(GMRAER,U,2),1:$P(GMRAER,U,3)),GMRAY=0 F S GMRAY=$O(^DD(120.8,GMRAX,1,GMRAY)) Q:GMRAY'>0 X:$D(^DD(120.8,GMRAX,1,GMRAY,1)) ^(1)
|
---|
29 | Q
|
---|
30 | QBULL ; THIS ENTRY POINT WILL ALLOW BE CALLED AS A TASKED JOB TO SEND
|
---|
31 | ; BULLETINS FOR A RAD ALLERGY IF NECESSARY.
|
---|
32 | ; INPUT VARIABLE: GMRAPA = IEN 120.8 ENTRY
|
---|
33 | Q:GMRAPA'>0
|
---|
34 | S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:$P(GMRAPA(0),U,2)=""
|
---|
35 | S DFN=+GMRAPA(0) Q:DFN'>0
|
---|
36 | D 1^VADPT S GMRANAM=VADM(1),GMRALOC=$P(VAIN(4),U,2),GMRAVIP=VA("PID") D KVAR^VADPT K VA
|
---|
37 | D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
|
---|
38 | I '$P(GMRAPA(0),U,16) D EN1^GMRAVAB ; Send Verify bull. if not ver.
|
---|
39 | I '$O(^GMR(120.8,GMRAPA,13,0))!'($P(GMRASITE(0),U,5)=0!(GMRALOC="")!$O(^GMR(120.8,GMRAPA,14,0))) D BULLT^GMRASEND ; Send Mark Chart/ID Band bull. if necessary.
|
---|
40 | I $P(GMRAPA(0),U,6)="o",$P(GMRAPA(0),U,20)["D" D PTBUL^GMRAROBS ; Send P&T bull. if observed drug rxn.
|
---|
41 | K %,DFN,GMRAHLOC,GMRALOC,GMRANAM,GMRAOUT,GMRAPA,GMRASITE,GMRATYPE,GMRAVIP,XMB,XMY,XQA,XQAMSG S ZTREQ="@"
|
---|
42 | Q
|
---|
43 | DRCLRACK(DA) ; This function will determine if entry DA in 120.8 represents
|
---|
44 | ; a contrast media allergy that is not entered in error if the Drug
|
---|
45 | ; Class DX100 is deleted.
|
---|
46 | ; Input variable: DA=entry in file 120.8
|
---|
47 | ; Return value: 1 if entry is contrast media allergy, 0 if not
|
---|
48 | ;
|
---|
49 | N FXN,ZERO,DRCL,DRCL1,DRCL2
|
---|
50 | S FXN=0,ZERO=$G(^GMR(120.8,DA(1),0))
|
---|
51 | I '+$G(^GMR(120.8,DA(1),"ER")) D
|
---|
52 | . F DRCL="DX100","DX101","DX102" D Q:FXN
|
---|
53 | . . S DRCL1=$O(^PS(50.605,"B",DRCL,0))_";PS(50.605,"
|
---|
54 | . . I $P(ZERO,U,3)=DRCL1 S FXN=1 Q
|
---|
55 | . . S DRCL2=0 F S DRCL2=$O(^GMR(120.8,DA(1),3,DRCL2)) Q:DRCL2<1 I DRCL2'=DA,+$G(^GMR(120.8,DA(1),3,DRCL2,0))=+DRCL1 S FXN=1 Q
|
---|
56 | . . Q
|
---|
57 | . I 'FXN,$P(ZERO,U,3)["GMRD(120.82"&$D(^GMRD(120.82,"D","RADIOLOGICAL/CONTRAST MEDIA",+$P(ZERO,U,3))) S FXN=1
|
---|
58 | . Q
|
---|
59 | Q FXN
|
---|