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

BPXRMAL1.m

Go to the documentation of this file. 
  1. BPXRMAL1 ;IHS/MSC/MGH - Handle Allergy findings for drugs ;30-Mar-2018 14:29;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1001,1002,1009**;Feb 04, 2005;Build 17
  1.  ;--------------------------------------------------------------
  1.  ;Patch 1009 added Statin drugs
  1.  ;ROUTINE TO TEST ALLERGY STATUS
  1.  ;ENTRY POINT REM JUST NEEDS THE PSODFN.NOT NECESSARILY THE TERM WILL FIND ALL
  1.  ;TERMS THAT HAVE DRUGS IN THEM EITHER DRUG OR VA GENERIC
  1.  Q
  1.  ;
  1. ASAREM(PSODFN,TEST,DATE,VALUE,TEXT) ; EP ASPIRIN COMPUTED ALLERGY CHECK RETURN TEST=1 IF ALLERGY
  1.  S TERM="IHS-ASPIRIN"
  1.  D REM(PSODFN,.TEST,.DATE,.VALUE,.TEXT)
  1.  Q
  1.  ;
  1. STATREM(PSODFN,TEST,DATE,VALUE,TEXT) ;EP Statin computed allergy check added patch 1009
  1.  S TERM="IHS-STATIN DRUGS"
  1.  D REM(PSODFN,.TEST,.DATE,.VALUE,.TEXT)
  1.  Q
  1.  ;
  1. AAREM(PSODFN,TEST,DATE,VALUE,TEXT) ; EP ACE/ARB COMPUTED ALLERGY CHECK RETURN TEST=1 IF ALLERGY
  1.  N VALUE,TEST1,TEXT1,TEST2,TEXT2
  1.  S VALUE="",DATE=DT,CHECK=""
  1.  S I="CV800"
  1.  S CHECK=$$FIND1^DIC(50.605,"","MX",I)_"C"
  1.  I CHECK="" S TEST=0,TEXT="VA DRUG CLASSES FOR 'CV800' NOT DEFINED!!" Q
  1.  D ALLER(PSODFN,CHECK,.TEST1,.TEXT1)
  1.  S I="CV805"
  1.  S CHECK=$$FIND1^DIC(50.605,"","MX",I)_"C"
  1.  I CHECK="" S TEST=0,TEXT="VA DRUG CLASSES FOR 'CV805' NOT DEFINED!!" Q
  1.  D ALLER(PSODFN,CHECK,.TEST2,.TEXT2)
  1.  I TEST1=1&(TEST2=1) S TEST=1,TEXT="ALLERGIES TO BOTH"
  1.  E  S TEST=0,TEXT="ALLERGIES TO BOTH CLASSES NOT FOUND"
  1.  Q
  1.  ;
  1. REM(PSODFN,TEST,DATE,VALUE,TEXT) ; EP YOU GIVE THE PSODFN AND THE TERM DEFINDED BELOW
  1.  ;MAIN ENTRY POINT ABOVE GIVEN PSODFN AND TERM
  1.  ;TERM IS THE NAME OF THE REMINDER TERM TO QUERY
  1.  ;IF I DON'T HAVE A TERM I'LL QUERY THE REMINDER TERM LOOKING FOR A DRUG OR VA DRUG TERM
  1.  ;--------------------------------------------------------------------
  1.  S DATE=DT,VALUE=""
  1.  N RESULT,TERMLONG,TERMS,I
  1.  I $G(TERM)']"" D  ;ADD THIS BELOW FOR CASE WHEN NO TERM DEFINED IHS/OKCAO/POC 11/7/2006
  1.  .D LIST^DIC(811.902,","_PXRMITEM_",",.01,"I",,,,,,,"TERMLONG")
  1.  .M TERMS=TERMLONG("DILIST",1)
  1.  .S I="" F  S I=$O(TERMS(I)) Q:I=""  I $P(TERMS(I),";",2)'="PXRMD(811.5," K TERMS(I)  ;JUST THE TERMS
  1.  .I '$D(TERMS) S TEST=0,TEXT="THERE ARE NO VALID TERM FINDINGS (DRUG OR VA DRUG) IN THE REMINDER TAXONMY "_$$GET1^DIQ(811.9,PXRMITEM_",",.01) Q  ;NO VALID TERM DRUG OR VA DRUG FINDINGS IN THE REMINDER TERM
  1.  .S I="" F  S I=$O(TERMS(I)) Q:I=""  Q:$G(TEST)  S TERM="`"_$P(TERMS(I),";") D  ;QUIT IS TEST=1 FOUND ALLERGY TO SOMETHING DON'T OVERWRITE IT
  1.  ..D TERM(TERM,.RETURN)
  1.  ..I '$G(RETURN) S TEST=0,TEXT="THERE ARE NO VALID FINDINGS IN THE REMINDER TAXONMY "_$$GET1^DIQ(811.9,PXRMITEM_",",.01) Q  ;NO VALID FINDINGS IN THE REMINDER TERM
  1.  ..D ALLER(PSODFN,RETURN,.TEST,.TEXT)
  1.  ;I $G(TERM)']"" S TEST=0,TEXT="NEED TO DEFINE THE TERM.  CALL PROGRAMMER!" Q
  1.  ;GIVE THE TERM ALSO  <---
  1.  E  D
  1.  .D TERM(TERM,.RETURN)
  1.  .I '$G(RETURN) S TEST=0,TEXT="THERE ARE NO VALID FINDINGS IN THE REMINDER TAXONMY "_TERM Q  ;NO VALID FINDINGS IN THE REMINDER TERM
  1.  .D ALLER(PSODFN,RETURN,.TEST,.TEXT)
  1.  Q
  1.  ;END OF CHANGES IHS/OKCAO/POC 11/7/2006
  1.  ;
  1. TERM(TERM,RETURN) ;GIVEN REMINDER TERM  RETURN THE STRING TO PASS TO ALLER
  1.  ;FINDINGS MUST BE FROM THE DRUG FILE!!
  1.  N TARLONG,IEN,FINDINGS,TERMIEN
  1.  K RETURN
  1.  S TERMIEN=$$FIND1^DIC(811.5,"","MX",TERM)  ;REMINDER TERM
  1.  I 'TERMIEN S TEST=0,TEXT="NO REMINDER TERM "_TERM_" FOUND!!" Q
  1.  D LIST^DIC(811.52,","_TERMIEN_",",".01","I","","","","",,"","TARLONG")
  1.  M FINDINGS=TARLONG("DILIST",1) ;FINDINGS FOR THIS REMINDER
  1.  S IEN="" F  S IEN=$O(FINDINGS(IEN)) Q:'IEN  D
  1.  .;WE'LL ONLY LOOK AT ENTRIES POINTING TO DRUGS OR VA GENERICS NOT VA CLASSES IHS/OKCAO/POC 5/11/2006
  1.  .S RETURN=$G(RETURN)_"^"_$S(FINDINGS(IEN)["PSDRUG":+FINDINGS(IEN)_"D",FINDINGS(IEN)["PSNDF(50.6,":+FINDINGS(IEN)_"G",1:"")
  1.  S RETURN=$E($G(RETURN),2,$L($G(RETURN)))   ;GET RID OF FIRST '^')
  1.  Q
  1.  ;
  1. ALLER(PSODFN,CHECK,TEST,TEXT) ; EP
  1.  ;TEST =1 IF ALLERGY 0 IF NO ALLERGY   TEXT IS WRITTEN TEXT
  1.  ;PSODFN=DFN CHECK=IS THE ENTITY TO CHECK SEE STING TAG
  1.  ;CHECK CAN BE MUTIPLES SEPARATED BY '^'
  1.  ;INPUT GMRAAR LIKE THIS FOR FILE 120.82=IEN_"A", FILE 50=IEN_"D", FILE 50.6=IEN_"G", FILE 50.605=IEN_"C", FILE 50.416=IEN_"I"
  1.  ;EXAMPLE CHECK="305D^276C WOULD BE IEN 305 IN FILE 50 AND IEN 276 IN 50.605
  1.  ;-------------------------------------------------------------------
  1.  N REACTION
  1.  S TEST=0,TEXT=""
  1.  S REACTION=$$NKA^GMRANKA(PSODFN)
  1.  I REACTION="" S TEXT="NO ALLERGY INFORMATION FOR THIS PATIENT HAS BEEN RECORDED" Q
  1.  I REACTION=0 S TEXT="THIS PATIENT HAS BEEN RECORDED AS 'NKA'" Q
  1.  K ING,CLASS,DRUG
  1.  F I=1:1 S GMRAAR=$P(CHECK,"^",I) Q:GMRAAR=""  D STING(GMRAAR,.ING,.CLASS,.DRUG)
  1.  ;NOW YOU HAVE ARRAY OF ING-VA INGREDIENT IEN, CLASS- VA DRUG CLASS IENS, AND DRUG-DRUG IEN
  1.  ;START LOOPING THROUGH THE GMR(120.8 GLOBAL
  1.  N IEN
  1.  S IEN=0 F  S IEN=$O(^GMR(120.8,"B",PSODFN,IEN)) Q:IEN'=+IEN!TEST  D
  1.  .Q:$$TEST(IEN)  ;NOT VERIFIED OR IS AN ERROR OR IS INACTIVE
  1.  .N INGIEN
  1.  .S INGIEN=0 F  S INGIEN=$O(^GMR(120.8,IEN,2,"B",INGIEN)) Q:INGIEN'=+INGIEN!TEST  D
  1.  ..I $D(ING(INGIEN)) S TEST=1,DATE=DT,TEXT="PT ALLERGIC TO DRUG INGREDIENT "_$P($G(^PS(50.416,INGIEN,0)),"^")_" IN PATIENT ALLERGY "_$P($G(^GMR(120.8,IEN,0)),"^",2)_"-"_IEN
  1.  .Q:TEST
  1.  .N CLASSIEN
  1.  .S CLASSIEN=0 F  S CLASSIEN=$O(^GMR(120.8,IEN,3,"B",CLASSIEN)) Q:CLASSIEN'=+CLASSIEN!TEST  D
  1.  ..I $D(CLASS(CLASSIEN)) S TEST=1,DATE=DT,TEXT="PT ALLERGIC TO DRUG CLASS "_$P($G(^PS(50.605,CLASSIEN,0)),"^")_" IN PATIENT ALLERGY "_$P($G(^GMR(120.8,IEN,0)),"^",2)_"-"_IEN
  1.  .Q:TEST
  1.  .N DRUGIEN
  1.  .S DRUGIEN=$P(^GMR(120.8,IEN,0),"^",3)
  1.  .I DRUGIEN["PSDRUG(" S:$D(DRUG(+DRUGIEN)) TEST=1,DATE=DT,TEXT="PT ALLERGIC TO DRUG "_$P($G(^PSDRUG(+DRUGIEN,0)),"^")_" IN PATIENT ALLERGY "_$P($G(^GMR(120.8,IEN,0)),"^",2)_"-"_IEN
  1.  Q
  1.  ;
  1. STING(GMRAAR,GMRAING,GMRADRCL,PSODRUG) ;
  1.  ;INPUT GMRAAR LIKE THIS FOR FILE 120.82=IEN_"A", FILE 50=IEN_"D", FILE 50.6=IEN_"G", FILE 50.605=IEN_"C", FILE 50.416=IEN_"I"
  1.  ;GMRAING=DRUG INGREDIENTS, AND GMRADRCL=VA DRUG CLASS, AND PSODRUG=DRUG ARE RETURNED IN ARRAY
  1.  ;K GMRAING,GMRADRCL  ;GMRAING=DRUG INGREDIENTS GMRADRCL=CLASSES
  1.  ;------------------------------------------------------------------------
  1.  N Y
  1.  I GMRAAR["I" S GMRAING(+GMRAAR)=""
  1.  ;If the Reacant is a Drug Class
  1.  I GMRAAR["C" D VACLASS(+GMRAAR,.GMRADRCL)
  1.  ;If the Reactant is a entry in the GMR ALLERGY file
  1.  I GMRAAR["A" D
  1.  .S Y=0 F  S Y=$O(^GMRD(120.82,+GMRAAR,"ING",Y)) Q:Y'>0  I $D(^GMRD(120.82,+GMRAAR,"ING",Y,0)),+^(0)>0 S GMRAING(+^(0))=""
  1.  .S Y=0 F  S Y=$O(^GMRD(120.82,+GMRAAR,"CLASS",Y)) Q:Y'>0  I $D(^GMRD(120.82,+GMRAAR,"CLASS",Y,0)),+^(0)>0 S GMRADRCL(+^(0))=""
  1.  .Q
  1.  I GMRAAR["D" D
  1.  .S PSODRUG(+GMRAAR)=$P($G(^PSDRUG(+GMRAAR,0)),"^")  ;ADD PSODRUG
  1.  .N PSODA
  1.  .S PSODA=+GMRAAR K ^TMP("PSO",$J) D ^PSONGR F Y=0:0 S Y=$O(^TMP("PSO",$J,Y)) Q:Y'>0  S GMRAING(Y)=""
  1.  .N GMRAX,GMRAY
  1.  .S GMRAX=$P($G(^PSDRUG(+GMRAAR,"ND")),U,6) S:GMRAX>0 GMRADRCL(GMRAX)="" Q
  1.  .S GMRAX=$P($G(^PSDRUG(+GMRAAR,0)),U,2) Q:GMRAX=""
  1.  .S GMRAY=$O(^PS(50.605,"B",GMRAX,"")) S:GMRAY>0 GMRADRCL(GMRAY)=""
  1.  .Q
  1.  I GMRAAR["G" D
  1.  .N PSNDA
  1.  .S PSNDA=+GMRAAR K ^TMP("PSN",$J) D ^PSNNGR F Y=0:0 S Y=$O(^TMP("PSN",$J,Y)) Q:Y'>0  S GMRAING(Y)=""
  1.  .; all classes for NDF entry returned in GMRADRCL
  1.  .N CLASS
  1.  .S CLASS=$$CLIST^PSNAPIS(+GMRAAR,.GMRADRCL)
  1.  .Q
  1.  K ^TMP("PSO",$J),^TMP("PSN",$J),PSOID,PSNID
  1.  Q
  1.  ;
  1. VACLASS(ENTRY,PICK) ;EXPAND THE CLASSES
  1.  N TEMP
  1.  D TEMP
  1.  N CHILD
  1.  S CHILD=0 F  S CHILD=$O(TEMP(ENTRY,CHILD)) Q:CHILD=""  D
  1.  .S PICK(CHILD)=""  ;$P(^PS(50.605,CHILD,0),"^",1)
  1.  .D:CHILD'=ENTRY PICK1(CHILD)
  1.  Q
  1.  ;
  1. TEMP ; MAKE YOUR TEMP GLOBAL OF TEMP(PARENT,CHILD)=""
  1.  N CHILD,PARENT
  1.  S CHILD=0 F  S CHILD=$O(^PS(50.605,CHILD)) Q:CHILD'=+CHILD  D
  1.  .S TEMP(CHILD,CHILD)=""  ;ALWAYS SET THE ENTRY TO ITSELF
  1.  .S PARENT=$P(^PS(50.605,CHILD,0),"^",3)
  1.  .Q:'PARENT
  1.  .S TEMP(PARENT,CHILD)=""
  1.  Q
  1.  ;
  1. PICK1(ENTRY) ;Part of expansion
  1.  N CHILD
  1.  S CHILD=0 F  S CHILD=$O(TEMP(ENTRY,CHILD)) Q:CHILD=""  D
  1.  .S PICK(CHILD)=$P(^PS(50.605,CHILD,0),"^",1)
  1.  .D:CHILD'=ENTRY PICK2(CHILD)
  1.  Q
  1.  ;
  1. PICK2(ENTRY) ;Part of expansion
  1.  N CHILD
  1.  S CHILD=0 F  S CHILD=$O(TEMP(ENTRY,CHILD)) Q:CHILD=""  D
  1.  .S PICK(CHILD)=$P(^PS(50.605,CHILD,0),"^",1)
  1.  .D:CHILD'=ENTRY PICK3(CHILD)
  1.  Q
  1.  ;
  1. PICK3(ENTRY) ;THIS SHOULD BE EN
  1.  N CHILD S CHILD=0 F  S CHILD=$O(TEMP(ENTRY,CHILD)) Q:CHILD=""  D
  1.  .S PICK(CHILD)=$P(^PS(50.605,CHILD,0),"^",1)
  1.  Q
  1.  ;
  1.  ;
  1. TEST(AZOIT) ;CHECK FOR ERRORS AND VERIFED STATUS
  1.  N AZOCHECK,INAC
  1.  S AZOCHECK=0
  1.  S:+$G(^GMR(120.8,AZOIT,"ER")) AZOCHECK=1
  1.  ;S:$P(^GMR(120.8,AZOIT,0),U,16)'="1" AZOCHECK=1
  1.  S INAC=$$INACTIVE^GMRADSP6(AZOIT)        ;PATCH 1008
  1.  I +INAC S AZOCHECK=1    ;Quit if inactive
  1.  Q AZOCHECK