source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRARAD.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1GMRARAD ;HIRMFO/RM-Radiology\ART Interface Routine ;12/8/04 08:03
2 ;;4.0;Adverse Reaction Tracking;**21,27**;Mar 29, 1996
3 ;
4RADD(DFN,OH,YN,VER) ; THIS EXTRINSIC FUNCTION WILL ADD A CONTRAST MEDIA
5 ; ALLERGY TO FILE 120.8 FOR PATIENT WITH IEN DFN. INPUT VARIABLES:
6 ; DFN = IEN IN FILE 2 OF PATIENT
7 ; OH = 'o' FOR OBSERVED, 'h' FOR HISTORICAL, OR
8 ; 'p' IF THE UTILITY SHOULD PROMPT FOR OBSERVED/HISTORICAL.
9 ; YN = 'Y' MEANS CONTRAST RXN, 'N' MEANS NO CONTRAST RXN,
10 ; 'U' MEANS UNKNOWN CONTRAST RXN, "" MEANS CONTRAST RXN DELETED
11 ; VER (optional) = '1' MEANS DATA WILL BE AUTOVERIFIED,
12 ; '0' MEANS DATA WILL NOT BE VERIFIED,
13 ; '$D MEANS USE ART AUTOVERIFICATION CHECKS.
14 ; FUNCTION RETURNS THE IEN OF NEW 120.8 ENTRY, OR -1 IF NOT ADDED.
15 N DA,DIK,GMRA,GMRACAUS,GMRADRCL,GMRAL,GMRACLS,GMRANEW,GMRANOW,GMRAX,GMRAY,GMRAER,X,Y
16 I YN'="YES",YN'="Y" S DA=-1 G RETRA ; if no rxn, then no need to add
17 I DFN'>0 S DA=-1 G RETRA ; if bad DFN, then quit
18 S GMRACAUS="RADIOLOGICAL/CONTRAST MEDIA",GMRADRCL=$O(^PS(50.605,"B","DX100",0))_";PS(50.605," I +GMRADRCL'>0 S DA=-1 G RETRA ; is DX100 in file 50.605
19 S DA=0 F S DA=$O(^GMR(120.8,"B",DFN,DA)) Q:DA'>0 I $$RALLG(DA) Q ; check to see if RAD allergy present
20 I DA>0 G RETRA ; if RAD allergy present, then quit
21 I OH="p" D ; read for OH if desired
22 . K DIR S DIR("A")="(O)bserved or (H)istorical reaction? ",DIR(0)="SAO^O:Observed;H:Historical",DIR("?",1)=" IF THIS REACTION HAS BEEN OBSERVED, PLEASE ENTER AN O,",DIR("?")=" IF THIS REACTION IS HISTORICAL, ENTER AN H." D ^DIR
23 . K DIR I Y="O"!(Y="H") S OH=$$LOW^XLFSTR(Y)
24 . Q
25 I OH'="o",OH'="h" S DA=-1 G RETRA ; is OH set up right
26 S GMRANOW=$$HTFM^XLFDT($H),GMRAL=DFN_"^"_GMRACAUS_"^"_GMRADRCL_"^"_GMRANOW_"^"_$S('$G(RAAF18):DUZ,1:"")_"^"_OH_"^^^^^^1^^U^^^^^^D",GMRACLS=+GMRADRCL ; 120.8 record 0th node
27 I '$D(VER) D ; need to check site's autoverify parameters
28 . S GMRAY="",GMRAY(0)=GMRAL,VER=$$VFY^GMRASIGN(.GMRAY)
29 . K GMRASITE,GMRATYPE,GMRAY
30 . Q
31 I VER'=0,VER'=1 S DA=-1 G RETRA ; is VER set up correctly
32 S $P(GMRAL,U,16)=VER I VER S $P(GMRAL,U,17)=GMRANOW ; set up verify data in 0th node
33 S GMRANEW=$P($G(^GMR(120.8,0)),"^",3,4) ; get 120.8 0th node
34 F DA=1+GMRANEW:1 L +^GMR(120.8,DA,0):0 Q:$T&'$D(^GMR(120.8,DA,0)) L:$T&$D(^GMR(120.8,DA,0)) -^GMR(120.8,DA,0) ; find IEN for new record
35 S ^GMR(120.8,DA,0)=GMRAL ; set 0th node for new record
36 S ^GMR(120.8,DA,3,0)="^120.803PA^1^1",^GMR(120.8,DA,3,1,0)=GMRACLS ; set drug class multiple for new record
37 S ^GMR(120.8,DA,13,0)="^120.813DA^1^1",^GMR(120.8,DA,13,1,0)=$$DT^XLFDT_"^"_$G(DUZ,"") ;21 Add marked on chart when entered
38 S DIK="^GMR(120.8," D IX1^DIK L -^GMR(120.8,DA,0) ; xref new record
39 S $P(^GMR(120.8,0),"^",3,4)=DA_"^"_($P(GMRANEW,"^",2)+1) ; update 120.8 0th node
40 I '$G(RAAF18) S GMRAPA=DA,ZTSAVE("GMRAPA")="",ZTDESC="Send GMRA Bulletins For Radiology Allergy",ZTIO="",ZTRTN="QBULL^GMRARAD0",ZTDTH=$H D ^%ZTLOAD K ZTSK,GMRAPA ; send ART bulletins
41 D NKADD^GMRARAD0 ; add NKA entry if necessary
42RETRA Q DA ; exit returning entry number of new record
43 ;
44RACHK(DFN,YN) ; This function will be called from input transform on the
45 ; .05 field of file 70. If the patient (DFN) has allergies in ART
46 ; to contrast media, and the user is changing the .05 field to
47 ; indicate NO contrast media allergy (YN), this function will prompt
48 ; the user if this change is correct.
49 ; Input variables: DFN=Patient IEN in file 2.
50 ; YN=new value of the .05 field.
51 ; Return value: 1 if X should be killed, 0 if not
52 ;
53 N DA,DIK,DIR,FXN,GMRADA,GMRAER,GMRAX,GMRAY,X,Y
54 S FXN=0
55 I YN="N" D CHKEXAL^GMRARAD0
56 Q FXN
57RALLG(DA,ERR) ; This function will determine if entry DA in 120.8 represents
58 ; a contrast media allergy that is not entered in error.
59 ; Input variable: DA=entry in file 120.8
60 ; ERR(optional)=if set to 0 do not check for E/E
61 ; Return value: 1 if entry is contrast media allergy, 0 if not
62 ;
63 N FXN,ZERO,DRCL,DRCL1
64 S FXN=0,ZERO=$G(^GMR(120.8,DA,0)) I '$D(ERR) S ERR=1
65 I 'ERR!(ERR&'+$G(^GMR(120.8,DA,"ER"))) D
66 .F DRCL="DX100","DX101","DX102","DX103","DX104","DX105","DX106","DX107","DX108","DX109" S DRCL1=$O(^PS(50.605,"B",DRCL,0))_";PS(50.605," I $P(ZERO,U,3)=DRCL1!$D(^GMR(120.8,DA,3,"B",+DRCL1)) S FXN=1 Q
67 .I 'FXN,$P(ZERO,U,3)["GMRD(120.82"&$D(^GMRD(120.82,"D","RADIOLOGICAL/CONTRAST MEDIA",+$P(ZERO,U,3))) S FXN=1
68 .I 'FXN,$$PSCHK^GMRARAD1($P(ZERO,U,3)) S FXN=1
69 .Q
70 Q FXN
71OTHRAD(DFN,DA) ; This function will determine if another entry for patient
72 ; (DFN) exists other than entry DA that is also a Radiological
73 ; allergy.
74 ; Input Variables: DFN=IEN of patient, DA=entry in 120.8
75 ; Function Returns: 1 if another entry exists, else returns 0
76 ;
77 N FXN,GMRADA
78 S (GMRADA,FXN)=0 F S GMRADA=$O(^GMR(120.8,"B",DFN,GMRADA)) Q:GMRADA'>0 I $$RALLG(GMRADA),GMRADA'=DA S FXN=1 Q
79 Q FXN
Note: See TracBrowser for help on using the repository browser.