- GMRADPT ; HIRMFO/RM,WAA - UTILITY TO GATHER PATIENT DATA ; Oct 16, 2023@3:03:00
- ;;4.0;Adverse Reaction Tracking;**2,10,46,52,53,63,51,68**;Mar 29, 1996;Build 5
- ;
- EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
- ;*BD
- N GMRAOTH,GMRAV1
- Q:'$D(DFN)
- I '$D(GMRA)#2 S GMRA="0^0^111"
- K GMRAL
- S GMRAV1=1,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
- D DPT
- Q
- ;*ED
- EN2 ; ENTRY TO GATHER PATIENT A/AR DATA
- ;INPUT VARIABLES:
- ;
- ; DFN Pointer to Patient file.
- ; GMRA (OPTIONAL) A^B^C^D^E DEFAULT="0^0^111^0^0"
- ; where A = 0 return all reactions (allergic/non-allergic).
- ; 1 return allergies only.
- ; 2 return non-allergies only.
- ; B = 0 return all data (verified or non-verified).
- ; 1 return only verified data.
- ; 2 return only non-verified data.
- ; C = X_Y_Z
- ; where X, Y, and Z are either 0 or 1. 1 would mean to
- ; return an Adverse Reaction of that particular type,
- ; and zero means do not return an Adverse Reaction of
- ; that type.
- ; X is for TYPE=OTHER
- ; Y is for TYPE=FOOD
- ; Z is for TYPE=DRUG.
- ; E.g., 001 (return drug only), 111 (returns all types),
- ; and 010 (returns food only).
- ; D = 0 return local allergies only
- ; 1 return local and remote allergies
- ; E = 0 exclude entered in error entries
- ; 1 include entered in error entries
- ;OUTPUT VARIABLES:
- ; GMRAL = 1 if patient has Adverse Reaction
- ; 0 if patient has no known Adverse Reaction
- ; null if patient has not been asked about Adverse Reaction
- ; GMRAL(PTR) = A^B^C^D^E^F^G^H^I^J^K
- ; where PTR = Either pointer to 120.8 for local reactions or
- ; 'R' appended with pointer to ^XTMP("ORRDI","ART",DFN, for remote reactions
- ; A = Pointer to Patient file.
- ; B = Free text of causative agent.
- ; *C = Type of reaction, where D is drug, F is food, and O is
- ; other.
- ; D = 1 if Adverse Reaction has been verified
- ; 0 if Adverse Reaction has not been verified
- ; E = 0 if this is an allergic reaction
- ; 1 if this is not an allergic reaction
- ; **F = the mechanism of reaction in the format:
- ; External format;Internal format
- ; (ALLERGY;0, PHARMACOLOGIC;2, UNKNOWN;U).
- ; G = Type of reaction.
- ; where D = drug
- ; DF = drug/food
- ; DFO = drug/food/other
- ; DO = drug/other
- ; F = food
- ; FO = food/other
- ; O = other
- ; H = the mechanism of reaction in the format:
- ; External format;Internal format
- ; (ALLERGY;A, PHARMACOLOGIC;P, UNKNOWN;U)
- ; I = variable pointer to the causative agent returned in piece B
- ; J = observed/historical of the reaction in the format:
- ; External format;Internal format
- ; GMRAL(PTR,"S",COUNT) = S^D
- ; where COUNT = number 1 to number of signs/symptoms for this
- ; reaction.
- ; S = a sign/symptom for this reaction in the format:
- ; External format;Internal format
- ; D = date/time sign/symptom entered in the format:
- ; External format;Internal format
- ; GMRAL(PTR,"O",COUNT) = S^D
- ; where COUNT = number 1 to number of observations for this
- ; reaction.
- ; S = a severity for this reaction in the format:
- ; External format;Internal format
- ; D = date/time of observation in the format:
- ; External format;Internal format
- ; GMRAL(PTR,"H") = S^D
- ; S = a severity for this reaction in the format:
- ; External format;Internal format
- ; D = date/time of observation in the format:
- ; External format;Internal format
- ; GMRAL(PTR,"ERROR") = D
- ; where D = date/time entry marked entered in error in the format:
- ; External format;Internal format
- ; Note: This will only exist for local reactions
- ;
- ; GMRAL(PTR,"SITE") = SITE
- ; where SITE = reporting institution in the format:
- ; Institution File (#4) Pointer^Station Name^Station Number
- ; Note: This will only exist for remote reactions
- ;
- ;* NOTE: This piece will no longer be supported after 9/1/97,
- ; Please use piece G.
- ;** NOTE: This piece will no longer be supported after 9/1/97,
- ; Please use piece H.
- ;
- ;*BD
- D DPT2
- Q
- ;*ED
- DPT ;
- ;*BD
- ;Read NKA Node in file 120.86
- S GMRAL=$P($G(^GMR(120.86,DFN,0)),U,2)
- ;Do not set GMRAL array if patient is unassessed or NKA.
- I GMRAL=0 Q ;PATIENT HAS NO KNOWN ALLERGIES
- 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)
- 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
- K GMRA,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
- Q
- DPT2 ;DO NOT CALL THIS ENTRY POINT AS IT WILL BE DELETED IN THE FUTURE. USE EN2 INSTEAD.
- ;*ED
- N GMRAOTH,REMOTE,MECH,IDX,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
- Q:'$D(DFN)
- I '$D(GMRA)#2 S GMRA="0^0^111^0^0"
- K GMRAL
- S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
- S REMOTE=$S(+$P(GMRA,U,4):$$HDRDATA^GMRAHDR,1:0)
- S GMRAL=$$NKA^GMRANKA(DFN)
- I +GMRAL=0,$P(GMRA,U,4),($D(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9) D
- .S IDX=0 F S IDX=$O(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX)) Q:'IDX D
- ..N RETURN
- ..S RETURN=$$INTERNAL(120.86,1,^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
- ..I RETURN=1 S GMRAL=1
- ..I GMRAL'=1,(RETURN=0) S GMRAL=0
- I +GMRAL=0,'$P(GMRA,U,5) Q
- D MECH
- 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)
- I +$G(REMOTE)>0 D
- .N INDEX
- .S INDEX=0 F S INDEX=$O(^XTMP("ORRDI","ART",DFN,INDEX)) Q:+$G(INDEX)=0 D
- ..N GMRANODE,GMRAREC,RETURN
- ..S GMRAREC=$NA(^XTMP("ORRDI","ART",DFN,INDEX))
- ..S RETURN=$$INTERNAL(120.8,17,$G(@GMRAREC@("MECHANISM",0)))
- ..S:RETURN'=-1 $P(GMRANODE,U,14)=RETURN
- ..S RETURN=$$UP^XLFSTR($E($G(@GMRAREC@("VERIFIED",0)),1))
- ..S $P(GMRANODE,U,16)=$S(RETURN="Y":1,RETURN="N":0,1:"")
- ..S $P(GMRANODE,U,20)=$P($G(@GMRAREC@("TYPE",0)),U,1)
- ..D SETAL(1)
- I GMRAL=1,$O(GMRAL(0))="" S GMRAL=0
- K GMRA
- Q
- INTERNAL(FILE,FIELD,VALUE) ;RETURN INTERNAL VALUE OF VUID
- ;PARAMETERS: FILE => FILE NUMBER WHERE THE DATA RESIDES
- ; FIELD => FIELD NUMBER WHERE THE DATA RESIDES
- ; VALUE => CARET-DELIMITED STRING WHERE THE FIRST
- ; PIECE CONTAINS THE VUID
- ;RETURNS: -1 => BAD INPUT PARAMETERS
- ; INTERNAL VALUE OF VUID
- N RETURN
- S RETURN=-1
- Q:$G(VALUE)="" RETURN
- N GMRARRAY
- D GETIREF^XTID(FILE,,$P(VALUE,U,1),"GMRARRAY")
- S:$D(GMRARRAY(FILE,FIELD))>9 RETURN=$O(GMRARRAY(FILE,FIELD,""))
- Q RETURN
- SETAL(REMOTE) ;DETERMINE WHETHER TO RETURN CURRENT ALLERGY
- ;PARAMETER: REMOTE => 0 IF ALLERGY IS LOCAL, 1 IF IT IS REMOTE
- N %,GMRAI,GMRASIGN
- ;IF LOCAL, EXCLUDE ENTERED IN ERROR AND ENTRY IS ENTERED IN ERROR, THEN QUIT
- ;(REMOTE ENTERED IN ERROR ALREADY FILTERED)
- I 'REMOTE,'$P(GMRA,U,5),(+$G(^GMR(120.8,GMRAREC,"ER"))) Q
- I GMRAL'=1 S GMRAL=1 ; PATIENT HAS ALLERGIES
- S GMRAI=0 ; BEGIN CHECK FOR ADR/ALL CRITERIA
- I '$P(GMRA,U) S GMRAI=1
- E I $P(GMRA,U)=1 S:$F("AU",$P(GMRANODE,U,14))>1 GMRAI=1
- E S:$F("P",$P(GMRANODE,U,14))>1 GMRAI=1
- Q:'GMRAI ; QUIT IF ADR/ALL CRITERIA NOT MET
- Q:2-$P(GMRA,U,2)=(1-$P(GMRANODE,U,16)) ;QUIT IF VER/NON VER CRITERIA NOT MET
- S GMRAI=0 ; BEGIN CHECK FOR ALLERGY TYPE CRITERIA
- F %=1:1:3 I $E($P(GMRA,U,3),%),$P(GMRANODE,U,20)[$E("OFD",%) S GMRAI=1 Q
- Q:'GMRAI ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
- D DATA(.GMRAREC,.GMRAL)
- Q
- DATA(GMRAREC,GMRAL) ;RETRIEVE THE APPROPRIATE DATA
- ;PARAMETERS: GMRAREC => REFERENCE TO THE VARIABLE CONTAINING THE CURRENT ALLERGY'S IEN
- ; GMRAL => REFERENCE TO THE ARRAY IN WHICH TO RETURN DATA
- D:+$G(GMRAREC)>0 PASS(.GMRAREC,.GMRAL)
- D:+$G(GMRAREC)=0 REMOTE(.GMRAL,.GMRAREC)
- Q
- PASS(GMRAREC,GMRAL) ;RETRIEVE LOCAL DATA
- ;PARAMETERS: GMRAREC => IEN OF THE CURRENT ALLERGY
- ; GMRAL => ARRAY IN WHICH TO RETURN DATA
- N GMRANODE,%,GMRAX,GMRAY,GMRAZ,GMRAKC
- I '$D(MECH) D
- .D MECH
- .S GMRAKC=1
- S GMRANODE=$G(^GMR(120.8,GMRAREC,0)) Q:GMRANODE=""
- S %=$P(GMRANODE,U,14)
- 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)
- 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:"")
- S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$P(GMRANODE,U,3)
- ;*BD
- I '$G(GMRAV1) D
- .;*ED
- .S %=$P(GMRANODE,U,6)
- .S GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$$EXTERNAL^DILFD(120.8,6,,%)_";"_%
- .I $D(^GMR(120.85,"C",GMRAREC))>9 D
- ..N IEN,IDX
- ..S IEN=0 F S IEN=$O(^GMR(120.85,"C",GMRAREC,IEN)) Q:'+IEN D
- ...S IDX=1+$G(IDX),%=$P($G(^GMR(120.85,IEN,0)),U,14)
- ...S GMRAL(GMRAREC,"O",IDX)=$$EXTERNAL^DILFD(120.85,14.5,,%)_";"_%_U
- ...S %=$P($G(^GMR(120.85,IEN,0)),U)
- ...S GMRAL(GMRAREC,"O",IDX)=GMRAL(GMRAREC,"O",IDX)_$$EXTERNAL^DILFD(120.85,.01,,%)_";"_%
- .I $P($G(^GMR(120.8,GMRAREC,"ER")),U)=1 D
- ..S %=$P($G(^GMR(120.8,GMRAREC,"ER")),U,2)
- ..S GMRAL(GMRAREC,"ERROR")=$$EXTERNAL^DILFD(120.8,23,,%)_";"_%
- I $P(GMRANODE,U,6)="h" D
- .N SEVR,SEVRDT
- .S SEVR=$P(GMRANODE,U,8)
- .S SEVRDT=$P(GMRANODE,U,9)
- .S GMRAL(GMRAREC,"H")=$$EXTERNAL^DILFD(120.8,8,,SEVR)_";"_SEVR_U_$$EXTERNAL^DILFD(120.8,9,,SEVRDT)_";"_SEVRDT
- I $O(^GMR(120.8,GMRAREC,10,0)) D
- .S GMRAX=0,GMRAY=1 F S GMRAX=$O(^GMR(120.8,GMRAREC,10,GMRAX)) Q:GMRAX<1 D
- ..S GMRAZ=$G(^GMR(120.8,GMRAREC,10,GMRAX,0))
- ..Q:GMRAZ=""
- ..S GMRAZ(1)=$S(+GMRAZ'=GMRAOTH:$P($G(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$P(GMRAZ,U,2)_";"_+GMRAZ)
- ..;*BD
- ..I '$G(GMRAV1) D
- ...;*ED (CLEAN UP PERIODS)
- ...S GMRAZ(1)=GMRAZ(1)_U_$$FMTE^XLFDT($P(GMRAZ,U,4))_";"_$P(GMRAZ,U,4)
- ..S GMRAL(GMRAREC,"S",GMRAY)=GMRAZ(1),GMRAY=GMRAY+1
- K:+$G(GMRAKC) MECH
- Q
- REMOTE(GMRAL,NODE) ;RETRIEVE REMOTE DATA
- ;PARAMETERS: GMRAL => ARRAY IN WHICH TO RETURN DATA
- ; NODE => IEN OF THE CURRENT ALLERGY
- S MECH=$P(GMRANODE,U,14)
- ;A, B, & C
- S GMRAL("R"_INDEX)=DFN_U_$G(@NODE@("REACTANT",0))_U_U
- ;D
- S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_+$P(GMRANODE,U,16)_U
- ;E & F
- S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$S(MECH="A"!(MECH="U"):0,1:1)_U_U
- ;G
- S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$P(GMRANODE,U,20)_U
- ;H
- S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$S(MECH'="":$G(MECH(MECH)),1:"")_U
- ;I
- N VUID,FILE,IEN,GLOBAL,RETURN,ERROR,GMRARRAY
- S VUID=$P($G(@NODE@("GMRALLERGY",0)),U,1)
- S FILE=$P($P($G(@NODE@("GMRALLERGY",0)),U,3),"99VA",2)
- I FILE>0 D
- .D FILE^DID(FILE,,"GLOBAL NAME","RETURN","ERROR")
- .Q:$D(ERROR)
- .D GETIREF^XTID(FILE,,VUID,"GMRARRAY")
- .S IEN=0 F S IEN=$O(GMRARRAY(FILE,.01,IEN)) Q:+$G(IEN)=0 D
- ..S $P(GMRAL("R"_INDEX),U,9)=+IEN_";"_$P(RETURN("GLOBAL NAME"),U,2)
- S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_U
- ;J
- N OBSHIS
- I $D(@NODE@("OBS/HISTORICAL"))>9 D
- .N GMRARRAY
- .D GETIREF^XTID(120.8,,$P($G(@NODE@("OBS/HISTORICAL",0)),U,1),"GMRARRAY")
- .S OBSHIS=$O(GMRARRAY(120.8,6,"")),OBSHIS=$$EXTERNAL^DILFD(120.8,6,,OBSHIS)_";"_OBSHIS
- S GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$G(OBSHIS)
- ;K
- I $D(@NODE@("SEVERITY"))>9 D
- .S GMRAL("R"_INDEX,"O",1)=$P($G(@NODE@("SEVERITY",0)),U,2)_";"_$P($G(@NODE@("SEVERITY",0)),U)_U
- N SINDEX,DATE
- S SINDEX=0 F S SINDEX=$O(@NODE@("SIGNS/SYMPTOMS",SINDEX)) Q:+$G(SINDEX)=0 D
- .I $P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)="L" D
- ..S GMRAL("R"_INDEX,"S",SINDEX)=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_GMRAOTH
- .I $P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)'="L" D
- ..N GMRARRAY
- ..S VUID=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,1)
- ..S FILE=$P($P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3),"99VA",2)
- ..D GETIREF^XTID(FILE,,VUID,"GMRARRAY")
- ..S IEN=0 F S IEN=$O(GMRARRAY(FILE,.01,IEN)) Q:+$G(IEN)=0 D
- ...S GMRAL("R"_INDEX,"S",SINDEX)=$P($G(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_+IEN
- .S DATE=$$HL7TFM^XLFDT($G(@NODE@("SIGNS/SYMPTOMS",SINDEX,"DATE_ENTERED",0)))
- .S $P(GMRAL("R"_INDEX,"S",SINDEX),U,2)=$$FMTE^XLFDT(DATE)_";"_DATE
- S GMRAL("R"_INDEX,"SITE")=$G(@NODE@("FACILITY",0))
- MECH ;CREATE MECHANISM ARRAY
- S MECH("A")="ALLERGY;A",MECH("P")="PHARMACOLOGIC;P",MECH("U")="UNKNOWN;U"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADPT 12788 printed Jan 18, 2025@02:40:04 Page 2
- 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
- +2 ;
- EN1 ; ENTRY TO GATHER PATIENT A/AR DATA
- +1 ;*BD
- +2 NEW GMRAOTH,GMRAV1
- +3 if '$DATA(DFN)
- QUIT
- +4 IF '$DATA(GMRA)#2
- SET GMRA="0^0^111"
- +5 KILL GMRAL
- +6 SET GMRAV1=1
- SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
- +7 DO DPT
- +8 QUIT
- +9 ;*ED
- EN2 ; ENTRY TO GATHER PATIENT A/AR DATA
- +1 ;INPUT VARIABLES:
- +2 ;
- +3 ; DFN Pointer to Patient file.
- +4 ; GMRA (OPTIONAL) A^B^C^D^E DEFAULT="0^0^111^0^0"
- +5 ; where A = 0 return all reactions (allergic/non-allergic).
- +6 ; 1 return allergies only.
- +7 ; 2 return non-allergies only.
- +8 ; B = 0 return all data (verified or non-verified).
- +9 ; 1 return only verified data.
- +10 ; 2 return only non-verified data.
- +11 ; C = X_Y_Z
- +12 ; where X, Y, and Z are either 0 or 1. 1 would mean to
- +13 ; return an Adverse Reaction of that particular type,
- +14 ; and zero means do not return an Adverse Reaction of
- +15 ; that type.
- +16 ; X is for TYPE=OTHER
- +17 ; Y is for TYPE=FOOD
- +18 ; Z is for TYPE=DRUG.
- +19 ; E.g., 001 (return drug only), 111 (returns all types),
- +20 ; and 010 (returns food only).
- +21 ; D = 0 return local allergies only
- +22 ; 1 return local and remote allergies
- +23 ; E = 0 exclude entered in error entries
- +24 ; 1 include entered in error entries
- +25 ;OUTPUT VARIABLES:
- +26 ; GMRAL = 1 if patient has Adverse Reaction
- +27 ; 0 if patient has no known Adverse Reaction
- +28 ; null if patient has not been asked about Adverse Reaction
- +29 ; GMRAL(PTR) = A^B^C^D^E^F^G^H^I^J^K
- +30 ; where PTR = Either pointer to 120.8 for local reactions or
- +31 ; 'R' appended with pointer to ^XTMP("ORRDI","ART",DFN, for remote reactions
- +32 ; A = Pointer to Patient file.
- +33 ; B = Free text of causative agent.
- +34 ; *C = Type of reaction, where D is drug, F is food, and O is
- +35 ; other.
- +36 ; D = 1 if Adverse Reaction has been verified
- +37 ; 0 if Adverse Reaction has not been verified
- +38 ; E = 0 if this is an allergic reaction
- +39 ; 1 if this is not an allergic reaction
- +40 ; **F = the mechanism of reaction in the format:
- +41 ; External format;Internal format
- +42 ; (ALLERGY;0, PHARMACOLOGIC;2, UNKNOWN;U).
- +43 ; G = Type of reaction.
- +44 ; where D = drug
- +45 ; DF = drug/food
- +46 ; DFO = drug/food/other
- +47 ; DO = drug/other
- +48 ; F = food
- +49 ; FO = food/other
- +50 ; O = other
- +51 ; H = the mechanism of reaction in the format:
- +52 ; External format;Internal format
- +53 ; (ALLERGY;A, PHARMACOLOGIC;P, UNKNOWN;U)
- +54 ; I = variable pointer to the causative agent returned in piece B
- +55 ; J = observed/historical of the reaction in the format:
- +56 ; External format;Internal format
- +57 ; GMRAL(PTR,"S",COUNT) = S^D
- +58 ; where COUNT = number 1 to number of signs/symptoms for this
- +59 ; reaction.
- +60 ; S = a sign/symptom for this reaction in the format:
- +61 ; External format;Internal format
- +62 ; D = date/time sign/symptom entered in the format:
- +63 ; External format;Internal format
- +64 ; GMRAL(PTR,"O",COUNT) = S^D
- +65 ; where COUNT = number 1 to number of observations for this
- +66 ; reaction.
- +67 ; S = a severity for this reaction in the format:
- +68 ; External format;Internal format
- +69 ; D = date/time of observation in the format:
- +70 ; External format;Internal format
- +71 ; GMRAL(PTR,"H") = S^D
- +72 ; S = a severity for this reaction in the format:
- +73 ; External format;Internal format
- +74 ; D = date/time of observation in the format:
- +75 ; External format;Internal format
- +76 ; GMRAL(PTR,"ERROR") = D
- +77 ; where D = date/time entry marked entered in error in the format:
- +78 ; External format;Internal format
- +79 ; Note: This will only exist for local reactions
- +80 ;
- +81 ; GMRAL(PTR,"SITE") = SITE
- +82 ; where SITE = reporting institution in the format:
- +83 ; Institution File (#4) Pointer^Station Name^Station Number
- +84 ; Note: This will only exist for remote reactions
- +85 ;
- +86 ;* NOTE: This piece will no longer be supported after 9/1/97,
- +87 ; Please use piece G.
- +88 ;** NOTE: This piece will no longer be supported after 9/1/97,
- +89 ; Please use piece H.
- +90 ;
- +91 ;*BD
- +92 DO DPT2
- +93 QUIT
- +94 ;*ED
- DPT ;
- +1 ;*BD
- +2 ;Read NKA Node in file 120.86
- +3 SET GMRAL=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
- +4 ;Do not set GMRAL array if patient is unassessed or NKA.
- +5 ;PATIENT HAS NO KNOWN ALLERGIES
- IF GMRAL=0
- QUIT
- +6 FOR GMRAREC=0:0
- SET GMRAREC=$ORDER(^GMR(120.8,"B",DFN,GMRAREC))
- if GMRAREC'>0
- QUIT
- SET GMRANODE=$SELECT($DATA(^GMR(120.8,GMRAREC,0)):^(0),1:"")
- if GMRANODE
- DO SETAL(0)
- +7 ;if flag is set to 1 (reactions exist), then make certain the reactions are passed in the GMRAL array
- IF GMRAL=1
- IF +$ORDER(GMRAL(0))'>0
- SET GMRAL=0
- +8 KILL GMRA,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
- +9 QUIT
- DPT2 ;DO NOT CALL THIS ENTRY POINT AS IT WILL BE DELETED IN THE FUTURE. USE EN2 INSTEAD.
- +1 ;*ED
- +2 NEW GMRAOTH,REMOTE,MECH,IDX,GMRANODE,GMRAOSOF,GMRAREC,GMRATCNT
- +3 if '$DATA(DFN)
- QUIT
- +4 IF '$DATA(GMRA)#2
- SET GMRA="0^0^111^0^0"
- +5 KILL GMRAL
- +6 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
- +7 SET REMOTE=$SELECT(+$PIECE(GMRA,U,4):$$HDRDATA^GMRAHDR,1:0)
- +8 SET GMRAL=$$NKA^GMRANKA(DFN)
- +9 IF +GMRAL=0
- IF $PIECE(GMRA,U,4)
- IF ($DATA(^XTMP("ORRDI","ART",DFN,"ASSESSMENT"))>9)
- Begin DoDot:1
- +10 SET IDX=0
- FOR
- SET IDX=$ORDER(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
- if 'IDX
- QUIT
- Begin DoDot:2
- +11 NEW RETURN
- +12 SET RETURN=$$INTERNAL(120.86,1,^XTMP("ORRDI","ART",DFN,"ASSESSMENT",IDX))
- +13 IF RETURN=1
- SET GMRAL=1
- +14 IF GMRAL'=1
- IF (RETURN=0)
- SET GMRAL=0
- End DoDot:2
- End DoDot:1
- +15 IF +GMRAL=0
- IF '$PIECE(GMRA,U,5)
- QUIT
- +16 DO MECH
- +17 FOR GMRAREC=0:0
- SET GMRAREC=$ORDER(^GMR(120.8,"B",DFN,GMRAREC))
- if GMRAREC'>0
- QUIT
- SET GMRANODE=$SELECT($DATA(^GMR(120.8,GMRAREC,0)):^(0),1:"")
- if GMRANODE
- DO SETAL(0)
- +18 IF +$GET(REMOTE)>0
- Begin DoDot:1
- +19 NEW INDEX
- +20 SET INDEX=0
- FOR
- SET INDEX=$ORDER(^XTMP("ORRDI","ART",DFN,INDEX))
- if +$GET(INDEX)=0
- QUIT
- Begin DoDot:2
- +21 NEW GMRANODE,GMRAREC,RETURN
- +22 SET GMRAREC=$NAME(^XTMP("ORRDI","ART",DFN,INDEX))
- +23 SET RETURN=$$INTERNAL(120.8,17,$GET(@GMRAREC@("MECHANISM",0)))
- +24 if RETURN'=-1
- SET $PIECE(GMRANODE,U,14)=RETURN
- +25 SET RETURN=$$UP^XLFSTR($EXTRACT($GET(@GMRAREC@("VERIFIED",0)),1))
- +26 SET $PIECE(GMRANODE,U,16)=$SELECT(RETURN="Y":1,RETURN="N":0,1:"")
- +27 SET $PIECE(GMRANODE,U,20)=$PIECE($GET(@GMRAREC@("TYPE",0)),U,1)
- +28 DO SETAL(1)
- End DoDot:2
- End DoDot:1
- +29 IF GMRAL=1
- IF $ORDER(GMRAL(0))=""
- SET GMRAL=0
- +30 KILL GMRA
- +31 QUIT
- INTERNAL(FILE,FIELD,VALUE) ;RETURN INTERNAL VALUE OF VUID
- +1 ;PARAMETERS: FILE => FILE NUMBER WHERE THE DATA RESIDES
- +2 ; FIELD => FIELD NUMBER WHERE THE DATA RESIDES
- +3 ; VALUE => CARET-DELIMITED STRING WHERE THE FIRST
- +4 ; PIECE CONTAINS THE VUID
- +5 ;RETURNS: -1 => BAD INPUT PARAMETERS
- +6 ; INTERNAL VALUE OF VUID
- +7 NEW RETURN
- +8 SET RETURN=-1
- +9 if $GET(VALUE)=""
- QUIT RETURN
- +10 NEW GMRARRAY
- +11 DO GETIREF^XTID(FILE,,$PIECE(VALUE,U,1),"GMRARRAY")
- +12 if $DATA(GMRARRAY(FILE,FIELD))>9
- SET RETURN=$ORDER(GMRARRAY(FILE,FIELD,""))
- +13 QUIT RETURN
- SETAL(REMOTE) ;DETERMINE WHETHER TO RETURN CURRENT ALLERGY
- +1 ;PARAMETER: REMOTE => 0 IF ALLERGY IS LOCAL, 1 IF IT IS REMOTE
- +2 NEW %,GMRAI,GMRASIGN
- +3 ;IF LOCAL, EXCLUDE ENTERED IN ERROR AND ENTRY IS ENTERED IN ERROR, THEN QUIT
- +4 ;(REMOTE ENTERED IN ERROR ALREADY FILTERED)
- +5 IF 'REMOTE
- IF '$PIECE(GMRA,U,5)
- IF (+$GET(^GMR(120.8,GMRAREC,"ER")))
- QUIT
- +6 ; PATIENT HAS ALLERGIES
- IF GMRAL'=1
- SET GMRAL=1
- +7 ; BEGIN CHECK FOR ADR/ALL CRITERIA
- SET GMRAI=0
- +8 IF '$PIECE(GMRA,U)
- SET GMRAI=1
- +9 IF '$TEST
- IF $PIECE(GMRA,U)=1
- if $FIND("AU",$PIECE(GMRANODE,U,14))>1
- SET GMRAI=1
- +10 IF '$TEST
- if $FIND("P",$PIECE(GMRANODE,U,14))>1
- SET GMRAI=1
- +11 ; QUIT IF ADR/ALL CRITERIA NOT MET
- if 'GMRAI
- QUIT
- +12 ;QUIT IF VER/NON VER CRITERIA NOT MET
- if 2-$PIECE(GMRA,U,2)=(1-$PIECE(GMRANODE,U,16))
- QUIT
- +13 ; BEGIN CHECK FOR ALLERGY TYPE CRITERIA
- SET GMRAI=0
- +14 FOR %=1:1:3
- IF $EXTRACT($PIECE(GMRA,U,3),%)
- IF $PIECE(GMRANODE,U,20)[$EXTRACT("OFD",%)
- SET GMRAI=1
- QUIT
- +15 ; QUIT IF ALLERGY TYPE CRITERIA NOT MET
- if 'GMRAI
- QUIT
- +16 DO DATA(.GMRAREC,.GMRAL)
- +17 QUIT
- DATA(GMRAREC,GMRAL) ;RETRIEVE THE APPROPRIATE DATA
- +1 ;PARAMETERS: GMRAREC => REFERENCE TO THE VARIABLE CONTAINING THE CURRENT ALLERGY'S IEN
- +2 ; GMRAL => REFERENCE TO THE ARRAY IN WHICH TO RETURN DATA
- +3 if +$GET(GMRAREC)>0
- DO PASS(.GMRAREC,.GMRAL)
- +4 if +$GET(GMRAREC)=0
- DO REMOTE(.GMRAL,.GMRAREC)
- +5 QUIT
- PASS(GMRAREC,GMRAL) ;RETRIEVE LOCAL DATA
- +1 ;PARAMETERS: GMRAREC => IEN OF THE CURRENT ALLERGY
- +2 ; GMRAL => ARRAY IN WHICH TO RETURN DATA
- +3 NEW GMRANODE,%,GMRAX,GMRAY,GMRAZ,GMRAKC
- +4 IF '$DATA(MECH)
- Begin DoDot:1
- +5 DO MECH
- +6 SET GMRAKC=1
- End DoDot:1
- +7 SET GMRANODE=$GET(^GMR(120.8,GMRAREC,0))
- if GMRANODE=""
- QUIT
- +8 SET %=$PIECE(GMRANODE,U,14)
- +9 SET GMRAL(GMRAREC)=$PIECE(GMRANODE,U,1,2)_U_$EXTRACT($PIECE(GMRANODE,U,20))_U_+$PIECE(GMRANODE,U,16)_U_$SELECT(%="A"!(%="U"):0,1:1)
- +10 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$SELECT(%="A":"ALLERGY;0",%="P":"PHARMACOLOGIC;2",%="U":"UNKNOWN;U",1:"")_U_$PIECE(GMRANODE,U,20)_U_$SELECT(%'="":$GET(MECH(%)),1:"")
- +11 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$PIECE(GMRANODE,U,3)
- +12 ;*BD
- +13 IF '$GET(GMRAV1)
- Begin DoDot:1
- +14 ;*ED
- +15 SET %=$PIECE(GMRANODE,U,6)
- +16 SET GMRAL(GMRAREC)=GMRAL(GMRAREC)_U_$$EXTERNAL^DILFD(120.8,6,,%)_";"_%
- +17 IF $DATA(^GMR(120.85,"C",GMRAREC))>9
- Begin DoDot:2
- +18 NEW IEN,IDX
- +19 SET IEN=0
- FOR
- SET IEN=$ORDER(^GMR(120.85,"C",GMRAREC,IEN))
- if '+IEN
- QUIT
- Begin DoDot:3
- +20 SET IDX=1+$GET(IDX)
- SET %=$PIECE($GET(^GMR(120.85,IEN,0)),U,14)
- +21 SET GMRAL(GMRAREC,"O",IDX)=$$EXTERNAL^DILFD(120.85,14.5,,%)_";"_%_U
- +22 SET %=$PIECE($GET(^GMR(120.85,IEN,0)),U)
- +23 SET GMRAL(GMRAREC,"O",IDX)=GMRAL(GMRAREC,"O",IDX)_$$EXTERNAL^DILFD(120.85,.01,,%)_";"_%
- End DoDot:3
- End DoDot:2
- +24 IF $PIECE($GET(^GMR(120.8,GMRAREC,"ER")),U)=1
- Begin DoDot:2
- +25 SET %=$PIECE($GET(^GMR(120.8,GMRAREC,"ER")),U,2)
- +26 SET GMRAL(GMRAREC,"ERROR")=$$EXTERNAL^DILFD(120.8,23,,%)_";"_%
- End DoDot:2
- End DoDot:1
- +27 IF $PIECE(GMRANODE,U,6)="h"
- Begin DoDot:1
- +28 NEW SEVR,SEVRDT
- +29 SET SEVR=$PIECE(GMRANODE,U,8)
- +30 SET SEVRDT=$PIECE(GMRANODE,U,9)
- +31 SET GMRAL(GMRAREC,"H")=$$EXTERNAL^DILFD(120.8,8,,SEVR)_";"_SEVR_U_$$EXTERNAL^DILFD(120.8,9,,SEVRDT)_";"_SEVRDT
- End DoDot:1
- +32 IF $ORDER(^GMR(120.8,GMRAREC,10,0))
- Begin DoDot:1
- +33 SET GMRAX=0
- SET GMRAY=1
- FOR
- SET GMRAX=$ORDER(^GMR(120.8,GMRAREC,10,GMRAX))
- if GMRAX<1
- QUIT
- Begin DoDot:2
- +34 SET GMRAZ=$GET(^GMR(120.8,GMRAREC,10,GMRAX,0))
- +35 if GMRAZ=""
- QUIT
- +36 SET GMRAZ(1)=$SELECT(+GMRAZ'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+GMRAZ,0)),U)_";"_+GMRAZ,1:$PIECE(GMRAZ,U,2)_";"_+GMRAZ)
- +37 ;*BD
- +38 IF '$GET(GMRAV1)
- Begin DoDot:3
- +39 ;*ED (CLEAN UP PERIODS)
- +40 SET GMRAZ(1)=GMRAZ(1)_U_$$FMTE^XLFDT($PIECE(GMRAZ,U,4))_";"_$PIECE(GMRAZ,U,4)
- End DoDot:3
- +41 SET GMRAL(GMRAREC,"S",GMRAY)=GMRAZ(1)
- SET GMRAY=GMRAY+1
- End DoDot:2
- End DoDot:1
- +42 if +$GET(GMRAKC)
- KILL MECH
- +43 QUIT
- REMOTE(GMRAL,NODE) ;RETRIEVE REMOTE DATA
- +1 ;PARAMETERS: GMRAL => ARRAY IN WHICH TO RETURN DATA
- +2 ; NODE => IEN OF THE CURRENT ALLERGY
- +3 SET MECH=$PIECE(GMRANODE,U,14)
- +4 ;A, B, & C
- +5 SET GMRAL("R"_INDEX)=DFN_U_$GET(@NODE@("REACTANT",0))_U_U
- +6 ;D
- +7 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_+$PIECE(GMRANODE,U,16)_U
- +8 ;E & F
- +9 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$SELECT(MECH="A"!(MECH="U"):0,1:1)_U_U
- +10 ;G
- +11 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$PIECE(GMRANODE,U,20)_U
- +12 ;H
- +13 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$SELECT(MECH'="":$GET(MECH(MECH)),1:"")_U
- +14 ;I
- +15 NEW VUID,FILE,IEN,GLOBAL,RETURN,ERROR,GMRARRAY
- +16 SET VUID=$PIECE($GET(@NODE@("GMRALLERGY",0)),U,1)
- +17 SET FILE=$PIECE($PIECE($GET(@NODE@("GMRALLERGY",0)),U,3),"99VA",2)
- +18 IF FILE>0
- Begin DoDot:1
- +19 DO FILE^DID(FILE,,"GLOBAL NAME","RETURN","ERROR")
- +20 if $DATA(ERROR)
- QUIT
- +21 DO GETIREF^XTID(FILE,,VUID,"GMRARRAY")
- +22 SET IEN=0
- FOR
- SET IEN=$ORDER(GMRARRAY(FILE,.01,IEN))
- if +$GET(IEN)=0
- QUIT
- Begin DoDot:2
- +23 SET $PIECE(GMRAL("R"_INDEX),U,9)=+IEN_";"_$PIECE(RETURN("GLOBAL NAME"),U,2)
- End DoDot:2
- End DoDot:1
- +24 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_U
- +25 ;J
- +26 NEW OBSHIS
- +27 IF $DATA(@NODE@("OBS/HISTORICAL"))>9
- Begin DoDot:1
- +28 NEW GMRARRAY
- +29 DO GETIREF^XTID(120.8,,$PIECE($GET(@NODE@("OBS/HISTORICAL",0)),U,1),"GMRARRAY")
- +30 SET OBSHIS=$ORDER(GMRARRAY(120.8,6,""))
- SET OBSHIS=$$EXTERNAL^DILFD(120.8,6,,OBSHIS)_";"_OBSHIS
- End DoDot:1
- +31 SET GMRAL("R"_INDEX)=GMRAL("R"_INDEX)_$GET(OBSHIS)
- +32 ;K
- +33 IF $DATA(@NODE@("SEVERITY"))>9
- Begin DoDot:1
- +34 SET GMRAL("R"_INDEX,"O",1)=$PIECE($GET(@NODE@("SEVERITY",0)),U,2)_";"_$PIECE($GET(@NODE@("SEVERITY",0)),U)_U
- End DoDot:1
- +35 NEW SINDEX,DATE
- +36 SET SINDEX=0
- FOR
- SET SINDEX=$ORDER(@NODE@("SIGNS/SYMPTOMS",SINDEX))
- if +$GET(SINDEX)=0
- QUIT
- Begin DoDot:1
- +37 IF $PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)="L"
- Begin DoDot:2
- +38 SET GMRAL("R"_INDEX,"S",SINDEX)=$PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_GMRAOTH
- End DoDot:2
- +39 IF $PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3)'="L"
- Begin DoDot:2
- +40 NEW GMRARRAY
- +41 SET VUID=$PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,1)
- +42 SET FILE=$PIECE($PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,3),"99VA",2)
- +43 DO GETIREF^XTID(FILE,,VUID,"GMRARRAY")
- +44 SET IEN=0
- FOR
- SET IEN=$ORDER(GMRARRAY(FILE,.01,IEN))
- if +$GET(IEN)=0
- QUIT
- Begin DoDot:3
- +45 SET GMRAL("R"_INDEX,"S",SINDEX)=$PIECE($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX)),U,2)_";"_+IEN
- End DoDot:3
- End DoDot:2
- +46 SET DATE=$$HL7TFM^XLFDT($GET(@NODE@("SIGNS/SYMPTOMS",SINDEX,"DATE_ENTERED",0)))
- +47 SET $PIECE(GMRAL("R"_INDEX,"S",SINDEX),U,2)=$$FMTE^XLFDT(DATE)_";"_DATE
- End DoDot:1
- +48 SET GMRAL("R"_INDEX,"SITE")=$GET(@NODE@("FACILITY",0))
- MECH ;CREATE MECHANISM ARRAY
- +1 SET MECH("A")="ALLERGY;A"
- SET MECH("P")="PHARMACOLOGIC;P"
- SET MECH("U")="UNKNOWN;U"
- +2 QUIT