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

GMRADPT.m

Go to the documentation of this file.
  1. GMRADPT ; HIRMFO/RM,WAA - UTILITY TO GATHER PATIENT DATA ; Oct 16, 2023@3:03:00
  1. ;;4.0;Adverse Reaction Tracking;**2,10,46,52,53,63,51,68**;Mar 29, 1996;Build 5
  1. ;
  1. EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
  1. ;*BD
  1. N GMRAOTH,GMRAV1
  1. Q:'$D(DFN)
  1. I '$D(GMRA)#2 S GMRA="0^0^111"
  1. K GMRAL
  1. S GMRAV1=1,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
  1. D DPT
  1. Q
  1. ;*ED
  1. EN2 ; ENTRY TO GATHER PATIENT A/AR DATA
  1. ;INPUT VARIABLES:
  1. ;
  1. ; DFN Pointer to Patient file.
  1. ; GMRA (OPTIONAL) A^B^C^D^E DEFAULT="0^0^111^0^0"
  1. ; where A = 0 return all reactions (allergic/non-allergic).
  1. ; 1 return allergies only.
  1. ; 2 return non-allergies only.
  1. ; B = 0 return all data (verified or non-verified).
  1. ; 1 return only verified data.
  1. ; 2 return only non-verified data.
  1. ; C = X_Y_Z
  1. ; where X, Y, and Z are either 0 or 1. 1 would mean to
  1. ; return an Adverse Reaction of that particular type,
  1. ; and zero means do not return an Adverse Reaction of
  1. ; that type.
  1. ; X is for TYPE=OTHER
  1. ; Y is for TYPE=FOOD
  1. ; Z is for TYPE=DRUG.
  1. ; E.g., 001 (return drug only), 111 (returns all types),
  1. ; and 010 (returns food only).
  1. ; D = 0 return local allergies only
  1. ; 1 return local and remote allergies
  1. ; E = 0 exclude entered in error entries
  1. ; 1 include entered in error entries
  1. ;OUTPUT VARIABLES:
  1. ; GMRAL = 1 if patient has Adverse Reaction
  1. ; 0 if patient has no known Adverse Reaction
  1. ; null if patient has not been asked about Adverse Reaction
  1. ; GMRAL(PTR) = A^B^C^D^E^F^G^H^I^J^K
  1. ; where PTR = Either pointer to 120.8 for local reactions or
  1. ; 'R' appended with pointer to ^XTMP("ORRDI","ART",DFN, for remote reactions
  1. ; A = Pointer to Patient file.
  1. ; B = Free text of causative agent.
  1. ; *C = Type of reaction, where D is drug, F is food, and O is
  1. ; other.
  1. ; D = 1 if Adverse Reaction has been verified
  1. ; 0 if Adverse Reaction has not been verified
  1. ; E = 0 if this is an allergic reaction
  1. ; 1 if this is not an allergic reaction
  1. ; **F = the mechanism of reaction in the format:
  1. ; External format;Internal format
  1. ; (ALLERGY;0, PHARMACOLOGIC;2, UNKNOWN;U).
  1. ; G = Type of reaction.
  1. ; where D = drug
  1. ; DF = drug/food
  1. ; DFO = drug/food/other
  1. ; DO = drug/other
  1. ; F = food
  1. ; FO = food/other
  1. ; O = other
  1. ; H = the mechanism of reaction in the format:
  1. ; External format;Internal format
  1. ; (ALLERGY;A, PHARMACOLOGIC;P, UNKNOWN;U)
  1. ; I = variable pointer to the causative agent returned in piece B
  1. ; J = observed/historical of the reaction in the format:
  1. ; External format;Internal format
  1. ; GMRAL(PTR,"S",COUNT) = S^D
  1. ; where COUNT = number 1 to number of signs/symptoms for this
  1. ; reaction.
  1. ; S = a sign/symptom for this reaction in the format:
  1. ; External format;Internal format
  1. ; D = date/time sign/symptom entered in the format:
  1. ; External format;Internal format
  1. ; GMRAL(PTR,"O",COUNT) = S^D
  1. ; where COUNT = number 1 to number of observations for this
  1. ; reaction.
  1. ; S = a severity for this reaction in the format:
  1. ; External format;Internal format
  1. ; D = date/time of observation in the format:
  1. ; External format;Internal format
  1. ; GMRAL(PTR,"H") = S^D
  1. ; S = a severity for this reaction in the format:
  1. ; External format;Internal format
  1. ; D = date/time of observation in the format:
  1. ; External format;Internal format
  1. ; GMRAL(PTR,"ERROR") = D
  1. ; where D = date/time entry marked entered in error in the format:
  1. ; External format;Internal format
  1. ; Note: This will only exist for local reactions
  1. ;
  1. ; GMRAL(PTR,"SITE") = SITE
  1. ; where SITE = reporting institution in the format:
  1. ; Institution File (#4) Pointer^Station Name^Station Number
  1. ; Note: This will only exist for remote reactions
  1. ;
  1. ;* NOTE: This piece will no longer be supported after 9/1/97,
  1. ; Please use piece G.
  1. ;** NOTE: This piece will no longer be supported after 9/1/97,
  1. ; Please use piece H.
  1. ;
  1. ;*BD
  1. D DPT2
  1. Q
  1. ;*ED
  1. DPT ;
  1. ;*BD
  1. ;Read NKA Node in file 120.86
  1. S GMRAL=$P($G(^GMR(120.86,DFN,0)),U,2)
  1. ;Do not set GMRAL array if patient is unassessed or NKA.
  1. I GMRAL=0 Q ;PATIENT HAS NO KNOWN ALLERGIES
  1. F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"B",DFN,GMRAREC)) Q:GMRAREC'>0 S GMRANODE=$S($D(^GMR(120.8,GMRAREC,0)):^(0),1:"") D:GMRANODE SETAL(0)
  1. I GMRAL=1,+$O(GMRAL(0))'>0 S GMRAL=0 ;if flag is set to 1 (reactions exist), then make certain the reactions are passed in the GMRAL array
  1. K GMRA,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
  1. Q
  1. DPT2 ;DO NOT CALL THIS ENTRY POINT AS IT WILL BE DELETED IN THE FUTURE. USE EN2 INSTEAD.
  1. ;*ED
  1. N GMRAOTH,REMOTE,MECH,IDX,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
  1. Q:'$D(DFN)
  1. I '$D(GMRA)#2 S GMRA="0^0^111^0^0"
  1. K GMRAL
  1. S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
  1. S REMOTE=$S(+$P(GMRA,U,4):$$HDRDATA^GMRAHDR,1:0)
  1. S GMRAL=$$NKA^GMRANKA(DFN)
  1. I +GMRAL=0,$P(GMRA,U,4),($D(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9) D
  1. .S IDX=0 F S IDX=$O(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX)) Q:'IDX D
  1. ..N RETURN
  1. ..S RETURN=$$INTERNAL(120.86,1,^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
  1. ..I RETURN=1 S GMRAL=1
  1. ..I GMRAL'=1,(RETURN=0) S GMRAL=0
  1. I +GMRAL=0,'$P(GMRA,U,5) Q
  1. D MECH
  1. F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"B",DFN,GMRAREC)) Q:GMRAREC'>0 S GMRANODE=$S($D(^GMR(120.8,GMRAREC,0)):^(0),1:"") D:GMRANODE SETAL(0)
  1. I +$G(REMOTE)>0 D
  1. .N INDEX
  1. .S INDEX=0 F S INDEX=$O(^XTMP("ORRDI","ART",DFN,INDEX)) Q:+$G(INDEX)=0 D
  1. ..N GMRANODE,GMRAREC,RETURN
  1. ..S GMRAREC=$NA(^XTMP("ORRDI","ART",DFN,INDEX))
  1. ..S RETURN=$$INTERNAL(120.8,17,$G(@GMRAREC@("MECHANISM",0)))
  1. ..S:RETURN'=-1 $P(GMRANODE,U,14)=RETURN
  1. ..S RETURN=$$UP^XLFSTR($E($G(@GMRAREC@("VERIFIED",0)),1))
  1. ..S $P(GMRANODE,U,16)=$S(RETURN="Y":1,RETURN="N":0,1:"")
  1. ..S $P(GMRANODE,U,20)=$P($G(@GMRAREC@("TYPE",0)),U,1)
  1. ..D SETAL(1)
  1. I GMRAL=1,$O(GMRAL(0))="" S GMRAL=0
  1. K GMRA
  1. Q
  1. INTERNAL(FILE,FIELD,VALUE) ;RETURN INTERNAL VALUE OF VUID
  1. ;PARAMETERS: FILE => FILE NUMBER WHERE THE DATA RESIDES
  1. ; FIELD => FIELD NUMBER WHERE THE DATA RESIDES
  1. ; VALUE => CARET-DELIMITED STRING WHERE THE FIRST
  1. ; PIECE CONTAINS THE VUID
  1. ;RETURNS: -1 => BAD INPUT PARAMETERS
  1. ; INTERNAL VALUE OF VUID
  1. N RETURN
  1. S RETURN=-1
  1. Q:$G(VALUE)="" RETURN
  1. N GMRARRAY
  1. D GETIREF^XTID(FILE,,$P(VALUE,U,1),"GMRARRAY")
  1. S:$D(GMRARRAY(FILE,FIELD))>9 RETURN=$O(GMRARRAY(FILE,FIELD,""))
  1. Q RETURN
  1. SETAL(REMOTE) ;DETERMINE WHETHER TO RETURN CURRENT ALLERGY
  1. ;PARAMETER: REMOTE => 0 IF ALLERGY IS LOCAL, 1 IF IT IS REMOTE
  1. N %,GMRAI,GMRASIGN
  1. ;IF LOCAL, EXCLUDE ENTERED IN ERROR AND ENTRY IS ENTERED IN ERROR, THEN QUIT
  1. ;(REMOTE ENTERED IN ERROR ALREADY FILTERED)
  1. I 'REMOTE,'$P(GMRA,U,5),(+$G(^GMR(120.8,GMRAREC,"ER"))) Q
  1. I GMRAL'=1 S GMRAL=1 ; PATIENT HAS ALLERGIES
  1. S GMRAI=0 ; BEGIN CHECK FOR ADR/ALL CRITERIA
  1. I '$P(GMRA,U) S GMRAI=1
  1. E I $P(GMRA,U)=1 S:$F("AU",$P(GMRANODE,U,14))>1 GMRAI=1
  1. E S:$F("P",$P(GMRANODE,U,14))>1 GMRAI=1
  1. Q:'GMRAI ; QUIT IF ADR/ALL CRITERIA NOT MET
  1. Q:2-$P(GMRA,U,2)=(1-$P(GMRANODE,U,16)) ;QUIT IF VER/NON VER CRITERIA NOT MET
  1. S GMRAI=0 ; BEGIN CHECK FOR ALLERGY TYPE CRITERIA
  1. F %=1:1:3 I $E($P(GMRA,U,3),%),$P(GMRANODE,U,20)[$E("OFD",%) S GMRAI=1 Q
  1. Q:'GMRAI ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
  1. D DATA(.GMRAREC,.GMRAL)
  1. Q
  1. DATA(GMRAREC,GMRAL) ;RETRIEVE THE APPROPRIATE DATA
  1. ;PARAMETERS: GMRAREC => REFERENCE TO THE VARIABLE CONTAINING THE CURRENT ALLERGY'S IEN
  1. ; GMRAL => REFERENCE TO THE ARRAY IN WHICH TO RETURN DATA
  1. D:+$G(GMRAREC)>0 PASS(.GMRAREC,.GMRAL)
  1. D:+$G(GMRAREC)=0 REMOTE(.GMRAL,.GMRAREC)
  1. Q
  1. PASS(GMRAREC,GMRAL) ;RETRIEVE LOCAL DATA
  1. ;PARAMETERS: GMRAREC => IEN OF THE CURRENT ALLERGY
  1. ; GMRAL => ARRAY IN WHICH TO RETURN DATA
  1. N GMRANODE,%,GMRAX,GMRAY,GMRAZ,GMRAKC
  1. I '$D(MECH) D
  1. .D MECH
  1. .S GMRAKC=1
  1. S GMRANODE=$G(^GMR(120.8,GMRAREC,0)) Q:GMRANODE=""
  1. S %=$P(GMRANODE,U,14)
  1. S GMRAL(GMRAREC)=$P(GMRANODE,U,1,2)_U_$E($P(GMRANODE,U,20))_U_+$P(GMRANODE,U,16)_U_$S(%="A"!(%="U"):0,1:1)
  1. S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$S(%="A":"ALLERGY;0",%="P":"PHARMACOLOGIC;2",%="U":"UNKNOWN;U",1:"")_U_$P(GMRANODE,U,20)_U_$S(%'="":$G(MECH(%)),1:"")
  1. S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$P(GMRANODE,U,3)
  1. ;*BD
  1. I '$G(GMRAV1) D
  1. .;*ED
  1. .S %=$P(GMRANODE,U,6)
  1. .S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$$EXTERNAL^DILFD(120.8,6,,%)_";"_%
  1. .I $D(^GMR(120.85,"C",GMRAREC))>9 D
  1. ..N IEN,IDX
  1. ..S IEN=0 F S IEN=$O(^GMR(120.85,"C",GMRAREC,IEN)) Q:'+IEN D
  1. ...S IDX=1+$G(IDX),%=$P($G(^GMR(120.85,IEN,0)),U,14)
  1. ...S GMRAL(GMRAREC,"O",IDX)=$$EXTERNAL^DILFD(120.85,14.5,,%)_";"_%_U
  1. ...S %=$P($G(^GMR(120.85,IEN,0)),U)
  1. ...S GMRAL(GMRAREC,"O",IDX)=GMRAL(GMRAREC,"O",IDX)_$$EXTERNAL^DILFD(120.85,.01,,%)_";"_%
  1. .I $P($G(^GMR(120.8,GMRAREC,"ER")),U)=1 D
  1. ..S %=$P($G(^GMR(120.8,GMRAREC,"ER")),U,2)
  1. ..S GMRAL(GMRAREC,"ERROR")=$$EXTERNAL^DILFD(120.8,23,,%)_";"_%
  1. I $P(GMRANODE,U,6)="h" D
  1. .N SEVR,SEVRDT
  1. .S SEVR=$P(GMRANODE,U,8)
  1. .S SEVRDT=$P(GMRANODE,U,9)
  1. .S GMRAL(GMRAREC,"H")=$$EXTERNAL^DILFD(120.8,8,,SEVR)_";"_SEVR_U_$$EXTERNAL^DILFD(120.8,9,,SEVRDT)_";"_SEVRDT
  1. I $O(^GMR(120.8,GMRAREC,10,0)) D
  1. .S GMRAX=0,GMRAY=1 F S GMRAX=$O(^GMR(120.8,GMRAREC,10,GMRAX)) Q:GMRAX<1 D
  1. ..S GMRAZ=$G(^GMR(120.8,GMRAREC,10,GMRAX,0))
  1. ..Q:GMRAZ=""
  1. ..S GMRAZ(1)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$P(GMRAZ,U,2)_";"_+GMRAZ)
  1. ..;*BD
  1. ..I '$G(GMRAV1) D
  1. ...;*ED (CLEAN UP PERIODS)
  1. ...S GMRAZ(1)=GMRAZ(1)_U_$$FMTE^XLFDT($P(GMRAZ,U,4))_";"_$P(GMRAZ,U,4)
  1. ..S GMRAL(GMRAREC,"S",GMRAY)=GMRAZ(1),GMRAY=GMRAY+1
  1. K:+$G(GMRAKC) MECH
  1. Q
  1. REMOTE(GMRAL,NODE) ;RETRIEVE REMOTE DATA
  1. ;PARAMETERS: GMRAL => ARRAY IN WHICH TO RETURN DATA
  1. ; NODE => IEN OF THE CURRENT ALLERGY
  1. S MECH=$P(GMRANODE,U,14)
  1. ;A, B, & C
  1. S GMRAL("R"_INDEX)=DFN_U_$G(@NODE@("REACTANT",0))_U_U
  1. ;D
  1. S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_+$P(GMRANODE,U,16)_U
  1. ;E & F
  1. S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$S(MECH="A"!(MECH="U"):0,1:1)_U_U
  1. ;G
  1. S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$P(GMRANODE,U,20)_U
  1. ;H
  1. S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$S(MECH'="":$G(MECH(MECH)),1:"")_U
  1. ;I
  1. N VUID,FILE,IEN,GLOBAL,RETURN,ERROR,GMRARRAY
  1. S VUID=$P($G(@NODE@("GMRALLERGY",0)),U,1)
  1. S FILE=$P($P($G(@NODE@("GMRALLERGY",0)),U,3),"99VA",2)
  1. I FILE>0 D
  1. .D FILE^DID(FILE,,"GLOBAL NAME","RETURN","ERROR")
  1. .Q:$D(ERROR)
  1. .D GETIREF^XTID(FILE,,VUID,"GMRARRAY")
  1. .S IEN=0 F S IEN=$O(GMRARRAY(FILE,.01,IEN)) Q:+$G(IEN)=0 D
  1. ..S $P(GMRAL("R"_INDEX),U,9)=+IEN_";"_$P(RETURN("GLOBAL NAME"),U,2)
  1. S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_U
  1. ;J
  1. N OBSHIS
  1. I $D(@NODE@("OBS/HISTORICAL"))>9 D
  1. .N GMRARRAY
  1. .D GETIREF^XTID(120.8,,$P($G(@NODE@("OBS/HISTORICAL",0)),U,1),"GMRARRAY")
  1. .S OBSHIS=$O(GMRARRAY(120.8,6,"")),OBSHIS=$$EXTERNAL^DILFD(120.8,6,,OBSHIS)_";"_OBSHIS
  1. S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$G(OBSHIS)
  1. ;K
  1. I $D(@NODE@("SEVERITY"))>9 D
  1. .S GMRAL("R"_INDEX,"O",1)=$P($G(@NODE@("SEVERITY",0)),U,2)_";"_$P($G(@NODE@("SEVERITY",0)),U)_U
  1. N SINDEX,DATE
  1. S SINDEX=0 F S SINDEX=$O(@NODE@("SIGNS/SYMPTOMS",SINDEX)) Q:+$G(SINDEX)=0 D
  1. .I $P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)="L" D
  1. ..S GMRAL("R"_INDEX,"S",SINDEX)=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_GMRAOTH
  1. .I $P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)'="L" D
  1. ..N GMRARRAY
  1. ..S VUID=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,1)
  1. ..S FILE=$P($P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3),"99VA",2)
  1. ..D GETIREF^XTID(FILE,,VUID,"GMRARRAY")
  1. ..S IEN=0 F S IEN=$O(GMRARRAY(FILE,.01,IEN)) Q:+$G(IEN)=0 D
  1. ...S GMRAL("R"_INDEX,"S",SINDEX)=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_+IEN
  1. .S DATE=$$HL7TFM^XLFDT($G(@NODE@("SIGNS/SYMPTOMS",SINDEX,"DATE_ENTERED",0)))
  1. .S $P(GMRAL("R"_INDEX,"S",SINDEX),U,2)=$$FMTE^XLFDT(DATE)_";"_DATE
  1. S GMRAL("R"_INDEX,"SITE")=$G(@NODE@("FACILITY",0))
  1. MECH ;CREATE MECHANISM ARRAY
  1. S MECH("A")="ALLERGY;A",MECH("P")="PHARMACOLOGIC;P",MECH("U")="UNKNOWN;U"
  1. Q