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