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

BPXRMALL.m

Go to the documentation of this file. 
  1. BPXRMALL ;IHS/CIA/MGH - Handle Allergy findings. ;18-Apr-2014 15:23;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1001,1002**;Feb 04, 2005;Build 15
  1.  ;=======================================================================
  1. ALLERGY ;******************************ALLERGIES*******************************
  1.  ;
  1. ALL1(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding to return a 1 if Adverse Reaction entry is not found.
  1.  S DATE=DT
  1.  S TEST=1
  1.  I $D(^GMR(120.86,"B",DFN)) S TEST=0
  1.  Q
  1.  ;
  1. ALLEGG(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding to return a 1 if EGG allergy is found.
  1.  N AA,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Not Found"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q
  1.  .;Quit if entered in error
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  . Q:+INAC    ;Quit if inactive
  1.  . I Y["EGG" S TEST=1,DATE=DT,TEXT="Egg allergy found"
  1.  K AA,TESTI,X,Y
  1.  Q
  1.  ;
  1. ALLTHRM(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding to return a 1 if Thimerosal allergy is found.
  1.  N AA,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Not Found"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q         ;Quit if entered in error
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  . Q:+INAC    ;Quit if inactive
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . I Y["THIMEROSAL" S TEST=1,DATE=DT,TEXT="Thimerosal allergy found"
  1.  K AA,TESTI,X,Y
  1.  Q
  1.  ;
  1. ALLINFL(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding to return a 1 if Influenza vaccine allergy is found.
  1.  N AA,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Not Found"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q         ;Quit if entered in error
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  . Q:+INAC    ;Quit if inactive
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . I Y["FLU" S TEST=1,DATE=DT,TEXT="Influenza vaccine allergy found"
  1.  K AA,TESTI,X,Y
  1.  Q
  1.  ;
  1. ALLPNEU(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding to return a 1 if Pneumonia vaccine allergy is found.
  1.  N AA,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Not Found"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q         ;Quit if entered in error
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  . Q:+INAC    ;Quit if inactive
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . I Y["PNEUMO" S TEST=1,DATE=DT,TEXT="Pneumonia vaccine allergy found"
  1.  K AA,TESTI,X,Y
  1.  Q
  1.  ;
  1. ALLTETA(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding to return a 1 if Tetanus vaccine allergy is found.
  1.  N AA,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Not Found"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q         ;Quit if entered in error
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  . Q:+INAC    ;Quit if inactive
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . I Y["TETANUS" S TEST=1,DATE=DT,TEXT="Tetanus vaccine allergy found"
  1.  K AA,TESTI,X,Y
  1.  Q
  1.  ;
  1. ALLCLOP(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding to return a 1 if plavix allergy is found.
  1.  N AA,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Not Found"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q         ;Quit if entered in error
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  . Q:+INAC    ;Quit if inactive
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . I Y["CLOPIDOGREL" S TEST=1,DATE=DT,TEXT="Clopidogrel allergy found"
  1.  K AA,TESTI,X,Y
  1.  Q
  1. ALLWARF(DFN,TEST,DATE,VALUE,TEXT) ;Return TEST=1 if allergy to ANTICOAGULANTS found
  1.  N AA,BB,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Not Found"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q  ;Quit if entered in error
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  . Q:+INAC    ;Quit if inactive
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . I (Y["COUMADIN")!(Y["WARFARIN") S TEST=1,DATE=DT,TEXT="Warfarin Allergy found" Q
  1.  . S BB=0
  1.  . F  S BB=$O(^GMR(120.8,AA,3,"B",BB)) Q:BB'>0  D
  1.  . . I $P(^PS(50.605,BB,0),"^",1)="BL100" S TEST=1,TEXT="Warfarin allergy found" Q
  1.  K AA,BB,TESTI,X,Y
  1.  Q
  1.  ;
  1. ALLASP(DFN,TEST,DATE,VALUE,TEXT) ;Return TEST=1 if allergy to ASPIRIN found
  1.  N AA,BB,TESTI,X,Y,INAC
  1.  S (AA,TEST)=0,TEXT="Aspirin not found, didn't evaluate for NSAIDS"
  1.  I '$D(^GMR(120.8,"B",DFN)) Q
  1.  F  S AA=$O(^GMR(120.8,"B",DFN,AA)) Q:AA'>0  D
  1.  . ;I $P(^GMR(120.8,AA,0),"^",16)'=1 Q    ;Quit if not verified
  1.  . I $D(^GMR(120.8,AA,"ER")),$P(^GMR(120.8,AA,"ER"),"^",1)=1 Q         ;Quit if entered in error
  1.  . S INAC=$$INACTIVE^GMRADSP6(AA)
  1.  .Q:+INAC    ;Quit if inactive
  1.  . S X=$P(^GMR(120.8,AA,0),"^",2) X ^%ZOSF("UPPERCASE")
  1.  . I (Y["ASPIRIN")!(Y["SALSA")!(Y["SALICY") S TEST=1,DATE=DT,TEXT="Aspirin allergy found" Q
  1.  . ; Can't check for drug class, too many non-aspirin drugs in class
  1.  . ; Check in drug ingredient field however
  1.  . S BB=0
  1.  . F  S BB=$O(^GMR(120.8,AA,2,"B",BB)) Q:BB'>0  D
  1.  . . I '$D(^PS(50.416,BB,0)) Q
  1.  . . S X=$P(^PS(50.416,BB,0),"^",1) X ^%ZOSF("UPPERCASE")
  1.  . . I (Y["ASPIRIN")!(Y["SALSA")!(Y["SALICY") S TEST=1,DATE=DT,TEXT="Aspirin allergy found" Q
  1.  K AA,BB,TESTI,X,Y
  1.  Q
  1.  ;
  1. ALLBETA(PSODFN,TEST,DATE,VALUE,TEXT) ;Return TEST=1 if allergy to  BETA BLOCKERS/RELATED found
  1.  S VALUE="",DATE=DT
  1.  N CHECK,I S CHECK=""
  1.  S I="CV100" S CHECK=CHECK_"^"_$$FIND1^DIC(50.605,"","MX",I)_"C"
  1.  S CHECK=$E(CHECK,2,$L(CHECK))  ;GET RID OF FIRST '^'
  1.  I $L(CHECK,"^")'=1 S TEST=0,TEXT="VA DRUG CLASS FOR 'CV100' NOT DEFINED!!" Q
  1.  D ALLER^BPXRMAL1(PSODFN,CHECK,.TEST,.TEXT)
  1.  Q
  1.  ;
  1. ALLACE(PSODFN,TEST,DATE,VALUE,TEXT) ;Return TEST=1 if allergy to  ACE INHIBITORS found
  1.  S VALUE="",DATE=DT
  1.  N CHECK,I S CHECK=""
  1.  S I="CV800" S CHECK=CHECK_"^"_$$FIND1^DIC(50.605,"","MX",I)_"C"
  1.  S CHECK=$E(CHECK,2,$L(CHECK))  ;GET RID OF FIRST '^'
  1.  I $L(CHECK,"^")'=1 S TEST=0,TEXT="VA DRUG CLASS FOR 'CV100' NOT DEFINED!!" Q
  1.  D ALLER^BPXRMAL1(PSODFN,CHECK,.TEST,.TEXT)
  1.  Q
  1. ALLARB(PSODFN,TEST,DATE,VALUE,TEXT) ;Return TEST=1 if allergy to  ARBS
  1.  S VALUE="",DATE=DT
  1.  N CHECK,I S CHECK=""
  1.  S I="CV805" S CHECK=CHECK_"^"_$$FIND1^DIC(50.605,"","MX",I)_"C"
  1.  S CHECK=$E(CHECK,2,$L(CHECK))  ;GET RID OF FIRST '^'
  1.  I $L(CHECK,"^")'=1 S TEST=0,TEXT="VA DRUG CLASS FOR CV100 NOT DEFINED!!" Q
  1.  D ALLER^BPXRMAL1(PSODFN,CHECK,.TEST,.TEXT)
  1.  Q
  1. ALL(DFN,TEST,DATE,VALUE,TEXT) ;Return whether or not a patient has an allergy assessment
  1.  ;
  1.  ;1 Patient has known reaction
  1.  ;0 Patient has NO known reaction
  1.  ;null Paient has never been asked about reaction
  1.  N AJEY
  1.  S AJEY=$$NKA^GMRANKA(DFN)
  1.  S TEST=1,DATE=DT
  1.  I AJEY="" S TEST=0,DATE=""
  1.  Q