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

ORQQAL.m

Go to the documentation of this file. 
  1. ORQQAL ; slc/CLA,JFR - Functions which return patient allergy data ;28-Jan-2016 08:49;DU
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,1007,216,232,243,1010,1011,1015**;Dec 17, 1997;Build 29
  1.  ;Modified - IHS/MSC/MGH Modified to remove inactive allergies
  1.  ;              IHS/MSC/MGH - 04/06/2012 -  Patch 10 added data for reactions
  1.  ;              IHS/MSC/MGH - 12/21/2012 -  Patch 12 for compound medications
  1. LIST(ORAY,ORPT) ; RETURN PATIENT'S ALLERGY/ADVERSE REACTION INFO:
  1.  ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
  1.  ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
  1.  N I,J,K
  1.  S I=1,J=0,K=0
  1.  D EN1^GMRAOR1(ORPT,"GMRARXN")
  1.  I $G(GMRARXN)="" S ORAY(I)="^No Allergy Assessment"
  1.  I $G(GMRARXN)=0 S ORAY(I)="^No Known Allergies"
  1.  I $G(GMRARXN)=1 F  S J=$O(GMRARXN(J)) Q:J=""  S ORAY(I)=$P(GMRARXN(J),"^",3)_"^"_$P(GMRARXN(J),"^")_"^"_$P(GMRARXN(J),"^",2) D SIGNS S I=I+1
  1.  S:'$D(ORAY(1)) ORAY(1)="^No allergies found."
  1.  K GMRARXN
  1.  Q
  1. SIGNS S K=0,N=0 F  S K=$O(GMRARXN(J,"S",K)) Q:K'>0  D
  1.  .I N=0 S ORAY(I)=ORAY(I)_"^"_$P(GMRARXN(J,"S",K),";")
  1.  .E  S ORAY(I)=ORAY(I)_";"_$P(GMRARXN(J,"S",K),";")
  1.  .S N=N+1
  1.  Q
  1. LRPT(ORAY,ORPT) ; RETURN PT'S ALLERGY/ADVERSE REACTION INFO IN REPORT FORMAT:
  1.  ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies
  1.  ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien
  1.  N I,J,K,SEVER,CR,GMRAIDT ;216
  1.  S CR=$CHAR(13)
  1.  S I=1,J=0,K=0,SEVER="",GMRAIDT=1 ;216
  1.  D EN1^GMRAOR1(ORPT,"GMRARXN")
  1.  I $G(GMRARXN)="" S ORAY(I)="No Allergy Assessment"
  1.  I $G(GMRARXN)=0 S ORAY(I)="No Known Allergies"
  1.  I $G(GMRARXN)=1 F  S J=$O(GMRARXN(J)) Q:J=""  D
  1.  .S SEVER=$P(GMRARXN(J),U,2)
  1.  .S ORAY(I)=$P(GMRARXN(J),U)_"     "_$S($L($G(SEVER)):"[Severity: "_SEVER_"]",1:""),I=I+1
  1.  .S K=0,N=0 F  S K=$O(GMRARXN(J,"S",K)) Q:K'>0  D
  1.  ..I N=0 S ORAY(I)="    Signs/symptoms: "_$P(GMRARXN(J,"S",K),";")
  1.  ..E     S ORAY(I)="                    "_$P(GMRARXN(J,"S",K),";")
  1.  ..I $P(GMRARXN(J,"S",K),";",2) S ORAY(I)=ORAY(I)_" ("_$$FMTE^XLFDT($P(GMRARXN(J,"S",K),";",2),2)_")" ;216
  1.  ..S N=N+1,I=I+1
  1.  .S ORAY(I)=" ",I=I+1
  1.  S:'$D(ORAY(1)) ORAY(1)="No allergies found."
  1.  K GMRARXN
  1.  Q
  1. RXN(ORAY,ORPT,SRC,NDF,PSDRUG) ; RETURN TRUE OR FALSE IF PATIENT IS ALLERGIC TO AGENT
  1.  ; SRC: ALLERGEN SOURCE (CM=CONTRAST MEDIA, DR=DRUG)
  1.  ; NDF: IF SRC=DR, NDF=Nat'l Drug File ien ELSE NDF=""
  1.  ; PSDRUG:IF SRC=DR, PSDRUG=(local) Drug file ien ELSE PSDRUG=""
  1.  N CMP,CMPDR,SAVE,TEMP,TEMP2,CDRG,CNT,NDF2
  1.  I +PSDRUG D
  1.  .S SAVE=0,TEMP2=""
  1.  .;IHS/MSC/MGH Mod for compound meds patch 1011
  1.  .S CMP=$P($G(^PSDRUG(PSDRUG,999999935)),U,1)
  1.  .I CMP=1 D
  1.  ..S CMPDR=0
  1.  ..F  S CMPDR=$O(^PSDRUG(PSDRUG,999999936,CMPDR)) Q:'+CMPDR  D
  1.  ...S CDRG=$P($G(^PSDRUG(PSDRUG,999999936,CMPDR,0)),U,1)
  1.  ...S NDF2=$$GET1^DIQ(50,CDRG,20,"I")_"."_$$GET1^DIQ(50,CDRG,22,"I")
  1.  ...S ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF2,"",1)
  1.  ...I ORAY=1 S SAVE=1
  1.  ...D SETARRY
  1.  ...I $P(ORAY,U,2)'="" S TEMP($P(ORAY,U,2))=""
  1.  ...K ORAY
  1.  ..;end MOD for compound meds
  1.  .S (X,TEMP2)="",CNT=0
  1.  .F  S X=$O(TEMP(X)) Q:X=""  D
  1.  ..S CNT=CNT+1
  1.  ..S TEMP2=TEMP2_" "_CNT_") "_X
  1.  .S ORAY=SAVE_U_TEMP2
  1.  ;IHS/MSC/MGH Removed requirement for a NDF match
  1.  ;I +NDF D
  1.  S ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF,"",1)
  1.  D SETARRY
  1.  Q
  1. SETARRY ; Get the data
  1.  I SRC="DR",ORAY=1 D  ;drug ingredient allergy found
  1.  .S I=1,J=0 F  S J=$O(GMRAING(J)) Q:J=""  D
  1.  ..I I=1 S ORAY=ORAY_U_GMRAING(J)
  1.  ..E  S ORAY=ORAY_";"_GMRAING(J)
  1.  ..S I=I+1
  1.  .N K
  1.  .;IHS/MSC/MGH added reaction data patch 1010
  1.  .I $D(GMRAREAC) D
  1.  ..S K=0 F  S K=$O(GMRAREAC(K)) Q:K=""  D
  1.  ...I K=1 S ORAY=ORAY_" Reac: "_GMRAREAC(K)
  1.  ...E  S ORAY=ORAY_";"_GMRAREAC(K)
  1.  .;END MOD
  1.  I SRC="DR",ORAY=2 D  ;drug class allergy found
  1.  .S CL="",I=1,J=0 F  S J=$O(GMRADRCL(J)) Q:J=""  D
  1.  ..; per test sites 3/17/04 - no oc for pt allergy to entire HERBS class:
  1.  ..Q:$P(GMRADRCL(J),U)="HA000"
  1.  ..I I=1 S ORAY=ORAY_U_$P(GMRADRCL(J),U,2)
  1.  ..E  S CL=$P(GMRADRCL(J),U,2) I ORAY'[CL S ORAY=ORAY_";"_CL
  1.  ..;IHS/MSC/MGH added reaction data patch 1010
  1.  ..I $D(GMRAREAC) D
  1.  ...S K=0 F  S K=$O(GMRAREAC(K)) Q:K=""  D
  1.  ....I K=1 S ORAY=ORAY_" Reac: "_GMRAREAC(K)
  1.  ....E  S ORAY=ORAY_";"_GMRAREAC(K)
  1.  ..;END MOD
  1.  ..S I=I+1
  1.  I SRC="DR",(+$G(ORAY)<1) D MEDCLASS(.ORAY,ORPT,PSDRUG)
  1.  K I,J,GMRADRCL,GMRAING,CL,GMRAREAC
  1.  Q
  1. MEDCLASS(ORAY,DFN,PSDRUG) ;check for allergens with medications in same VA drug class
  1.  N ORVACLS,CL,X,I,RET,TYP
  1.  S TYP="DR"
  1.  Q:+$G(PSDRUG)<1
  1.  ;S ORVACLS=$P(^PSDRUG(PSDRUG,0),U,2)
  1.  S ORVACLS=$$CLASS50^ORPEAPI(PSDRUG)
  1.  Q:$L(ORVACLS)<4
  1.  Q:$G(ORVACLS)="HA000"  ;don't process herbal drug class for order checks
  1.  S CL=$S($E(ORVACLS,1,4)="CN10":5,1:4) ;look at 5 chars if ANALGESICS
  1.  D GETDATA^GMRAOR(DFN)
  1.  Q:'$D(^TMP("GMRAOC",$J,"APC"))
  1.  S I="" F  S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I)  D
  1.  .I $E(I,1,CL)=$E(ORVACLS,1,CL) S X=I
  1.  I $L($G(X)) D
  1.  .N IEN,NAME
  1.  .D IEN^PSN50P65(,X,"ORQQAL")
  1.  .S IEN=$O(^TMP($J,"ORQQAL","B",X,0))
  1.  .I 'IEN S ORAY="2"_U_X Q
  1.  .S NAME=$G(^TMP($J,"ORQQAL",IEN,1))
  1.  .I '$L(NAME) S ORAY="2"_U_X Q
  1.  .S ORAY="2"_U_NAME_": ("_$G(^TMP("GMRAOC",$J,"APC",X))_")"
  1.  .N K S K=0 S K=$O(^TMP("GMRAOC",$J,"APC",X,"REAC",K)) Q:'+K  D
  1.  ..I K=1 S ORAY=ORAY_"Reac: "_$G(^TMP("GMRAOC",$J,"APC",X,"REAC",K))
  1.  ..E  S ORAY=ORAY_";"_$G(^TMP("GMRAOC",$J,"APC",X,"REAC",K))
  1.  K ^TMP("GMRAOC",$J)
  1.  Q
  1. DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION:
  1.  D EN1^GMRAOR2(ALLR,"GMRACT")
  1.  N CR,OX,OH S CR=$CHAR(13),I=1
  1.  S ORAY(I)="    Causative agent: "_$P(GMRACT,U),I=I+1
  1.  S ORAY(I)=" Nature of Reaction: "_$S($P(GMRACT,U,6)="ALLERGY":"Allergy",$P(GMRACT,U,6)="PHARMACOLOGIC":"Adverse Reaction",$P(GMRACT,U,6)="UNKNOWN":"Unknown",1:""),I=I+1 ;216
  1.  S ORAY(I)=" ",I=I+1
  1.  I $D(GMRACT("S",1)) D SYMP
  1.  I $D(GMRACT("V",1)) D CLAS
  1.  S ORAY(I)="         Originator: "_$P(GMRACT,U,2)_$S($L($P(GMRACT,U,3)):" ("_$P(GMRACT,U,3)_")",1:""),I=I+1 ;216
  1.  S ORAY(I)="         Originated: "_$P(GMRACT,U,10),I=I+1 ;216
  1.  I $D(GMRACT("O",1)) D OBS
  1.  S ORAY(I)="           Verified: "_$S($P(GMRACT,U,4)="VERIFIED":$P(GMRACT,U,8),1:"No"),I=I+1 ;216
  1.  S ORAY(I)="Observed/Historical: "_$S($P(GMRACT,U,5)="OBSERVED":"Observed",$P(GMRACT,U,5)="HISTORICAL":"Historical",1:""),I=I+1
  1.  I $D(GMRACT("C",1)) D COM
  1.  K GMRACT
  1.  Q
  1. SYMP S K=0,N=0 F  S K=$O(GMRACT("S",K)) Q:K'>0  D
  1.  .I N=0 S ORAY(I)="     Signs/symptoms: "_GMRACT("S",K),I=I+1
  1.  .E  S ORAY(I)="                     "_GMRACT("S",K),I=I+1
  1.  .S N=N+1
  1.  S ORAY(I)=" ",I=I+1
  1.  K N,K
  1.  Q
  1. CLAS S K=0,N=0 F  S K=$O(GMRACT("V",K)) Q:K'>0  D
  1.  .I N=0 S ORAY(I)="       Drug Classes: "_$P(GMRACT("V",K),U,2),I=I+1
  1.  .E  S ORAY(I)="                     "_$P(GMRACT("V",K),U,2),I=I+1
  1.  .S N=N+1
  1.  S ORAY(I)=" ",I=I+1
  1.  K N,K
  1.  Q
  1. OBS S K=0,N=0 F  S K=$O(GMRACT("O",K)) Q:K'>0  D
  1.  .I N=0 D
  1.  ..S Y=$P(GMRACT("O",K),U) D DD^%DT
  1.  ..S ORAY(I)=" Obs dates/severity: "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
  1.  .E  D
  1.  ..S Y=$P(GMRACT("O",K),U) D DD^%DT
  1.  ..S ORAY(I)="                     "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1
  1.  .S N=N+1
  1.  S ORAY(I)=" ",I=I+1
  1.  K N,K,Y
  1.  Q
  1. COM S K=0,N=0,ORAY(I)=" ",I=I+1
  1.  F  S K=$O(GMRACT("C",K)) Q:K'>0  D
  1.  .I N=0 S ORAY(I)="Comments:",I=I+1
  1.  .S Y=$P(GMRACT("C",K),U) D DD^%DT
  1.  .S ORAY(I)="   "_Y_" by "_$P(GMRACT("C",K),U,2),I=I+1
  1.  .I $D(GMRACT("C",K,1,0)) S L=0 F  S L=$O(GMRACT("C",K,L)) Q:L'>0  D
  1.  ..S ORAY(I)=GMRACT("C",K,L,0),I=I+1
  1.  .S N=N+1
  1.  S ORAY(I)=" ",I=I+1
  1.  K N,K,L,Y
  1.  Q