Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAIAD1

GMRAIAD1.m

Go to the documentation of this file. 
  1. GMRAIAD1 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ADVERSE REACTION - PART 1 ; 18 Feb 2005  2:54 PM
  1.  ;;4.0;Adverse Reaction Tracking;**22,23**;Mar 29, 1996
  1. VALID ;;VDEF HL7 MESSAGE BUILDER
  1.  ; Creates HL7 V2.4 ORU^R01 message for allergy adverse reaction
  1.  ;
  1.  ; This routines uses the following IAs:
  1.  ;   #4248 - VDEFEL calls        (controlled)
  1.  ;   #3630 - VAFCQRY calls       (controlled)
  1.  ;   #2196 - ^PS(50.416,IEN,0)   (controlled)
  1.  ;   #4571 - ERR^VDEFREQ         (controlled)
  1.  ;
  1.  ; This routine is called at tag EN as a Function by VDEFREQ1
  1.  ;
  1.  ; This routine calls GMRAIAD2 for a portion of message
  1.  ;
  1.  Q
  1.  ;
  1. EN(EVIEN,KEY,VFLAG,OUT,MSHP) ;
  1.  ;
  1.  ; Inputs: EVIEN = IEN of message in file 577
  1.  ;      KEY - IEN of file to create message from
  1.  ;      VFLAG - "V" for VistA HL7 destination (default)
  1.  ;      OUT - target array, passed by reference
  1.  ;      MSHP - Piece 4 contains message subtype
  1.  ;
  1.  ; Output: Two part string with parts separated by "^"
  1.  ;      Part 1: "LM" - output in local array passed in "OUT" parameter
  1.  ;              "GM" - output in ^TMP("HLS",$J)
  1.  ;      Part 2: No longer used
  1.  ;
  1.  N DFN,HLFS,HLCM,HLSC,HLRP,HLES,HLQ,ALRDATA,DTE,DTP,ADD
  1.  N DATA,VAL,I,S,X,Y,Z,X1,X2,HL7RC,IEN,OUTX,LIKE,LIKERSP,GMRAPID,SEQ
  1.  N SEPF,SEPC,SEPR,SEPE,SEPS,ARRAY,PTC,CMP,GMRAHL
  1.  ;
  1.  ; Initialize stuff
  1.  K ^TMP("HLS",$J) S S=0,ARRAY="OUT("_"""HLS"""_",S)",TARGET="LM^"
  1.  M GMRAHL=VDEFHL
  1.  ;
  1.  ; Set up HL7 delimiters
  1.  S HLCM=$E(GMRAHL("ECH")),HLRP=$E(GMRAHL("ECH"),2),HLSC=$E(GMRAHL("ECH"),4),HLES=$E(GMRAHL("ECH"),3)
  1.  S HLFS=GMRAHL("FS"),HLQ=GMRAHL("Q"),HL7RC=HLES_HLFS_HLCM_HLRP_HLSC
  1.  D SETDLMS^VDEFEL
  1.  ;
  1.  ; Get allergy data & patient ID
  1.  S ALRDATA=$G(^GMR(120.85,KEY,0))
  1.  I ALRDATA="" D ERR^VDEFREQ("No data in file GMR(120.85) for IEN "_KEY) S ZTSTOP=1 G EXIT
  1.  S DFN=$P(ALRDATA,U,2)
  1.  I $G(^DPT(DFN,0))="" D ERR^VDEFREQ("No data in file DPT for DFN "_DFN) S ZTSTOP=1 G EXIT
  1.  ;
  1.  ; Build segments for message in OUT, $P # = HL7 field #
  1.  ;
  1.  ; PID - Use MPI PID builder
  1. PID K GMRAPID S OUTX="",S=1,SEQ=""
  1.  D BLDPID^VAFCQRY(DFN,1,SEQ,.GMRAPID,.GMRAHL)
  1.  F I=2:1 Q:$G(GMRAPID(I))=""  S GMRAPID(1,I-1)=GMRAPID(I) K GMRAPID(I)
  1.  M OUTX=GMRAPID(1) K GMRAPID D SAVE
  1.  ;
  1.  ; OBR
  1. OBR S S=S+1,OUTX="",$P(OUTX,HLFS)=1,$P(OUTX,HLFS,25)="F"
  1.  S VAL=KEY_HLCM_$P(SITEPARM,U,6)_"_120.85",$P(OUTX,HLFS,3)=VAL
  1.  S $P(OUTX,HLFS,4)="ADVERSE REACTION REPORT"_HLCM_HLCM_"L"
  1.  ;
  1.  ;Date/time reaction occured
  1.  S $P(OUTX,HLFS,7)=$$TS^VDEFEL($P(ALRDATA,U,1))
  1.  ;
  1.  ; Entering User
  1.  S VAL=$$XCN200^VDEFEL($P(ALRDATA,U,19)),$P(VAL,HLCM,8)="ENT",$P(OUTX,HLFS,32)=VAL
  1.  ;
  1.  ; Observer (Witness)
  1.  S VAL=$$XCN200^VDEFEL($P(ALRDATA,U,13)),$P(VAL,HLCM,8)="OBS"
  1.  ;
  1.  ; Reporter
  1.  S X=$P($G(^GMR(120.85,KEY,"RPT")),U,1)
  1.  S X=HLCM_$P(X,",",1)_HLCM_$P($P(X,",",2)," ",1)_HLCM_$P($P(X,",",2)," ",2)
  1.  S $P(X,HLCM,8)="RPT",$P(OUTX,HLFS,34)=VAL_HLRP_X
  1.  ;
  1.  ; Related Reaction
  1.  S X=$P(ALRDATA,U,15)_HLCM_$P($G(^GMR(120.8,$P(ALRDATA,U,15),0)),U,2)_HLCM_"L"
  1.  S $P(OUTX,HLFS,47)=X
  1.  S OUTX="OBR"_HLFS_OUTX D SAVE
  1.  ;
  1.  ; OBX 1 - Symptoms
  1. OBX1 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"SYMPTOM"_HLFS
  1.  ;
  1.  ; Get the reactions
  1.  S X=0,(Y,Z)="" F  S X=$O(^GMR(120.85,KEY,2,X))  Q:X'?1N.N  D
  1.  . S Y=^GMR(120.85,KEY,2,X,0),VAL=$P(Y,U,3)
  1.  . I $P(Y,U,2)'="" S Z=Z_$P(Y,U,2)_HLRP
  1.  . E  S Z=Z_$P(^GMRD(120.83,+Y,0),U,1)_HLRP
  1.  S $P(OUTX,HLFS,5)=$E(Z,1,$L(Z)-1)
  1.  ;
  1.  ; Severity
  1.  S $P(OUTX,HLFS,8)=$$GET1^DIQ(120.85,KEY_",",14.5)
  1.  ;
  1.  ; Reaction entered by
  1.  S $P(OUTX,HLFS,16)=$$XCN200^VDEFEL(VAL)
  1.  S $P(OUTX,HLFS,11)="F"
  1.  S OUTX="OBX"_HLFS_OUTX D SAVE
  1.  ;
  1.  ; RXA/RXE/RXR/OBX Suspected Agent Group
  1.  G OBX2:$G(^GMR(120.85,KEY,3,1,0))="" S IEN=0
  1. RXAGRP1 F  S IEN=$O(^GMR(120.85,KEY,3,IEN)) Q:IEN'?1N.N  D
  1.  . S S=S+1,OUTX="0"_HLFS_"1" K ALRDATA M ALRDATA=^GMR(120.85,KEY,3,IEN)
  1.  . ;
  1.  . ; RXA
  1.  . ; Start & Stop dates
  1.  . S VAL=$P($G(ALRDATA(1)),U) I VAL S $P(OUTX,HLFS,3)=$$TS^VDEFEL(VAL)
  1.  . S VAL=$P($G(ALRDATA(1)),U,2) I VAL S $P(OUTX,HLFS,4)=$$TS^VDEFEL(VAL)
  1.  . ;
  1.  . ; Suspected agent & daily dose
  1.  . S VAL=$P(ALRDATA(0),U),$P(OUTX,HLFS,5)=$$HL7RC(VAL)
  1.  . S VAL=$P(ALRDATA(0),U,2),$P(OUTX,HLFS,6)=$$HL7RC(VAL)
  1.  . ;
  1.  . ; Lot number, Exp. Date, Manufacturer
  1.  . S VAL=$P(ALRDATA(0),U,8) S:VAL $P(OUTX,HLFS,15)=$$HL7RC(VAL)
  1.  . S VAL=$P($G(ALRDATA(1)),U,3) I VAL S $P(OUTX,HLFS,16)=$$TS^VDEFEL(VAL)
  1.  . S VAL=$P(ALRDATA(0),U,7) S:VAL $P(OUTX,HLFS,17)=$$HL7RC(VAL)
  1.  . ;
  1.  . ; Indication for use
  1.  . S VAL=$P(ALRDATA(0),U,4) S:VAL $P(OUTX,HLFS,19)=$$HL7RC(VAL)
  1.  . ;
  1.  . ; Set into array
  1.  . S OUTX="RXA"_HLFS_OUTX D SAVE
  1.  . ;
  1.  . ; RXE
  1.  . S S=S+1,OUTX="",CMP=""
  1.  . ;
  1.  . ; Previous doses
  1.  . S $P(CMP,HLCM,1)=$$HL7RC($P(ALRDATA(0),U,9))
  1.  . ;
  1.  . ; Duration
  1.  . S X1=$P($G(ALRDATA(1)),U,2),X2=$P($G(ALRDATA(1)),U) D ^%DTC S:X="" X=0 S $P(CMP,HLCM,3)=X
  1.  . ;
  1.  . ; Last date given
  1.  . S VAL=$P(ALRDATA(0),U,10) I VAL S $P(CMP,HLCM,5)=$$TS^VDEFEL(VAL)
  1.  . S $P(OUTX,HLFS)=CMP,CMP=""
  1.  . ;
  1.  . ; Give codes
  1.  . S VAL=$P(ALRDATA(0),U),$P(CMP,HLCM,1)=$$HL7RC(VAL)
  1.  . S $P(CMP,HLCM,4)=$P($G(ALRDATA(1)),U,4),$P(CMP,HLCM,6)="NDC"
  1.  . S $P(OUTX,HLFS,2)=CMP,$P(OUTX,HLFS,3)=0
  1.  . ;
  1.  . ; SIG
  1.  . S $P(OUTX,HLFS,7)=$$HL7RC($P($G(ALRDATA(1)),U,5))
  1.  . ;
  1.  . ; Daily dose
  1.  . S $P(OUTX,HLFS,19)=$$HL7RC($P(ALRDATA(0),U,2))
  1.  . S OUTX="RXE"_HLFS_OUTX D SAVE
  1.  . ;
  1.  . ; RXR
  1.  . ; Route of administration
  1.  . S OUTX="",VAL=$P(ALRDATA(0),U,3) S:VAL="" VAL="UNKNOWN" S $P(OUTX,HLFS,1)=$$HL7RC(VAL)
  1.  . S S=S+1,OUTX="RXR"_HLFS_OUTX D SAVE
  1.  . ;
  1.  . ; OBX - LIKES
  1.  . S LIKERSP=$G(ALRDATA("LIKE")) I LIKERSP'="" F LIKE=1:1:6 D
  1.  . . S S=S+1,OUTX=1_HLFS_"CE"_HLFS
  1.  . . S VAL="LIKE "_LIKE_HLCM_$P($T(LIKEQ+(LIKE)),";",3),$P(OUTX,HLFS,3)=VAL
  1.  . . S X=$P(LIKERSP,U,LIKE),X=$S(X="y":"Y",X="n":"N",1:""),VAL=X_HLCM
  1.  . . S X=$S(X="Y":"YES",X="N":"NO",1:"")
  1.  . . S VAL=VAL_X_HLCM_"HL70136",$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)="F"
  1.  . . S OUTX="OBX"_HLFS_OUTX D SAVE
  1.  . . ;
  1.  . ; Likelihood
  1.  . S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"LIKELIHOOD"
  1.  . S VAL=$P(LIKERSP,U,7) S:VAL="" VAL=5
  1.  . S X=VAL_HLCM_$P("REMOTE,POSSIBLE,PROBABLE,HIGHLY PROBABLE, ",",",VAL)
  1.  . S $P(OUTX,HLFS,5)=X,$P(OUTX,HLFS,11)="F"
  1.  . S OUTX="OBX"_HLFS_OUTX D SAVE
  1.  ;
  1.  ; OBX2 - Lab Results
  1. OBX2 S X=$G(^GMR(120.85,KEY,4,0)) G CALL:X=""
  1.  S IEN=0 F  S IEN=$O(^GMR(120.85,KEY,4,IEN)) Q:IEN'?1N.N  D
  1.  . S S=S+1,OUTX=1_HLFS_"CE"_HLFS
  1.  . S X=^GMR(120.85,KEY,4,IEN,0),$P(OUTX,HLFS,3)=$$HL7RC($P(X,U,1))
  1.  . S $P(OUTX,HLFS,5)=$$HL7RC($P(X,U,2)),$P(OUTX,HLFS,11)="F"
  1.  . S $P(OUTX,HLFS,14)=$$TS^VDEFEL($P(X,U,3))
  1.  . S OUTX="OBX"_HLFS_OUTX D SAVE
  1.  ;
  1.  ; Call GMRAIAD2
  1. CALL D ENTRY^GMRAIAD2
  1.  ;
  1.  ; OBX10 - IND/NDA Info
  1. OBX10 S X=$G(^GMR(120.85,KEY,"MFR2")) G RXAGRP2:X=""
  1.  S S=S+1,OUTX=1_HLFS_"ST",$P(OUTX,HLFS,5)=$P(X,U,1)
  1.  S OUTX="OBX"_HLFS_OUTX D SAVE
  1.  ;
  1.  ; RXA/RXE Concommitant Drugs Group
  1. RXAGRP2 S X=$G(^GMR(120.85,KEY,13,0)) G EXIT:X=""
  1.  S IEN=0 F  S IEN=$O(^GMR(120.85,KEY,13,IEN)) Q:IEN'?1N.N  D
  1.  . ;
  1.  . ; RXA
  1.  . S X=^GMR(120.85,KEY,13,IEN,0),S=S+1,OUTX=0_HLFS_1
  1.  . ;
  1.  . ; Start Date, Stop Date
  1.  . I $P(X,U,2)'="" S $P(OUTX,HLFS,3)=$$TS^VDEFEL($P(X,U,2))
  1.  . I $P(X,U,3)'="" S $P(OUTX,HLFS,4)=$$TS^VDEFEL($P(X,U,3))
  1.  . ;
  1.  . ; Drug Name
  1.  . S $P(OUTX,HLFS,5)=$$HL7RC($P(X,U,1)),$P(OUTX,HLFS,6)=0
  1.  . S OUTX="RXA"_HLFS_OUTX D SAVE
  1.  . ;
  1.  . ; RXE
  1.  . ; Stop Date
  1.  . S S=S+1,OUTX="",VAL=$$TS^VDEFEL($P(X,U,3))
  1.  . S Y="",$P(Y,HLCM,5)=VAL,$P(OUTX,HLFS,1)=Y
  1.  . ;
  1.  . ; Drug Name
  1.  . S $P(OUTX,HLFS,2)=$$HL7RC($P(X,U,1)),$P(OUTX,HLFS,3)=0
  1.  . ;
  1.  . ; SIG if known
  1.  . S $P(OUTX,HLFS,5)="UNK",$P(OUTX,HLFS,7)=$$HL7RC($P(X,U,5))
  1.  . S OUTX="RXE"_HLFS_OUTX D SAVE
  1.  ;
  1.  ; Done building segments
  1. EXIT Q TARGET
  1.  ;
  1.  ;
  1.  ; Place current string into message array
  1.  ; Turn string into array if length >245.
  1.  ; Move local array to global if needed
  1. SAVE N I
  1.  I $P(OUTX,HLFS)'="PID",$L(OUTX)>245 D
  1.  . K ADD S ADD=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX))
  1.  . F I=1:1 S ADD(I)=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX)) Q:OUTX=""
  1.  . K OUTX M OUTX=ADD
  1.  M @ARRAY=OUTX
  1.  ;
  1.  ; Move local array to global if it's getting big.
  1.  I $P(TARGET,U)="LM",$S<16000 D
  1.  . K ^TMP("HLS",$J) M ^TMP("HLS",$J)=OUT("HLS") K OUT("HLS")
  1.  . S $P(TARGET,U)="GM",ARRAY="^TMP("_"""HLS"""_",$J,S)"
  1.  K OUTX,ADD
  1.  Q
  1.  ;
  1.  ; Replace any HL7 coding chars. in strings with HL7 escape sequence
  1.  ; Input: X = data string
  1. HL7RC(X) N OCHR,RCHR,RCHRI,TYPE,I F TYPE="E","F","C","R","S" D
  1.  . S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
  1.  . S OCHR=$E(HL7RC,RCHRI),RCHR=$E("EFSRT",RCHRI)
  1.  . Q:'$F(X,OCHR)
  1.  . F I=1:1 Q:$E(X,I)=""  I $E(X,I)=OCHR S X=$E(X,1,I-1)_HLES_RCHR_HLES_$E(X,I+1,999),I=I+2
  1.  Q X
  1.  ;
  1. LIKEQ ; LIKE set
  1.  ;;1. Reaction normally occurs with this reactant?
  1.  ;;2. Administration of the reactant was stopped?
  1.  ;;3. Reaction stopped when the administration of the reactant was terminated?
  1.  ;;4. Reactant was re-administered?
  1.  ;;5. Reaction could be due to the patient current clinical condition?
  1.  ;;6. Reaction reappeared after the reactant was re-administered?