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

APSQALLE.m

Go to the documentation of this file. 
  1. APSQALLE ;IHS/ASDS/ENM/POC - ROUTINE TO CHECK FOR ALLERGIES   [ 01/13/2003  12:38 PM ]
  1.  ;;6.0;IHS PHARMACY MODIFICATIONS;**3,4**;11/27/2002
  1.  ;;A LITTLE SOMETHING EXTRA
  1.  Q
  1. EN ;EP HERE WE START
  1.  W !!,"CHECKING FOR DRUG ALLERGIES..."  ;FIX TYPO IHS/OKCAO/POC 11/27/2002
  1.  Q:'$D(PSODFN)
  1.  Q:'$D(^GMR(120.8,"B",PSODFN))
  1.  Q:$O(^GMR(120.8,"ANKA",PSODFN,""))="n"  ;PT HAS NKA XREF
  1.  S AZOQUIT=0  ;AZOQUIT=1=NONDF AZOQUIT=2=NO CLASS
  1.  ;AZOXREF IS SPECIAL XREF OF DRUG INGREDIENT FILE
  1.  S AZOXREF=$G(PSODRUG("NDF"),0) S:AZOXREF="" AZOXREF=0,AZOQUIT=1
  1.  IF '(AZOXREF?1.N1"A"1.N) S AZOXREF=0,AZOQUIT=1  ;GOT TO KNOW WHEN NO NDF
  1.  ;S:AZOXREF="" AZOXREF=0 ;JUST TO BE SAFE
  1.  S AZOCLASS=$G(PSODRUG("VA CLASS"),0) S:AZOCLASS="" AZOCLASS=0
  1.  S:AZOCLASS=0 AZOQUIT=2
  1.  D:AZOQUIT=0 XREF  ;GOT A SPECIAL XREF
  1.  D:AZOQUIT=1 CLASS  ;GOT A CLASS ONLY
  1.  D:AZOQUIT=2 DRUG  ;GOT A DRUG NAME ONLY
  1.  ;WORK THRU THE PATIENT ALLERGY FILE USING EITHER SPECIAL XREF OR CLASS
  1.  D FULL:AZOQUIT=0,HALF:AZOQUIT=1,QUAR:AZOQUIT=2,NONE:AZOQUIT=3
  1.  D END
  1.  Q
  1.  ;SUBROUTINES
  1.  ;
  1. NONE ;SHOULD NOT GET HERE BUT!!!
  1. END ;CLEAN UP TIME
  1.  D EN^XBVK("AZO")
  1.  Q
  1. XREF ;GET THE DRUG COMPONENTS TO BE CHECKED
  1.  S AZODRCOM=0 F I=1:1 S AZODRCOM=$O(^PS(50.416,"APD",AZOXREF,AZODRCOM)) Q:AZODRCOM=""  D
  1.  .IF $P(^PS(50.416,AZODRCOM,0),U,2)]"" S AZODREF(I)=$P(^(0),U,2)  ;THIS IS A LITTLE TRICKY
  1.  .E  S AZODREF(I)=AZODRCOM
  1.  .Q
  1.  IF '$D(AZODREF) S AZO("MESS")="THERE IS NO DRUG COMPONENT (NO NDF ENTRY) FOR THE DRUG "_PSODRUG("NAME")_".  IT CANNOT BE CHECKED WITH CERTAINTY FOR ALLERGIES.",AZOQUIT=1 D CLASS  ;SEE IF CAN BE CHECKED WITH CLASS
  1.  Q
  1.  ;
  1. CLASS ;CHECKS FOR CLASS IF NO ENTRY IN NDF
  1.  ;S AZOCLASS=$G(PSODRUG("VA CLASS"),0) S:AZOCLASS="" AZOCLASS=0
  1.  ;IF AZOCLASS=0 S AZO("MESS")="THERE IS NO DRUG COMPONENT (NO NDF ENTRY) OR CLASS FOR THE DRUG "_PSODRUG("NAME")_".  IT CANNOT BE CHECKED PROPERLY FOR ALLERGIES.",AZOQUIT=2 D DRUG
  1.  ;WRITES MESSAGE TO BE DISPLAY IF GOT CLASS ONLY
  1.  S AZO("MESS")="THERE IS NO DRUG COMPONENT (NO NDF ENTRY) FOR THE DRUG "_PSODRUG("NAME")_".  IT CANNOT BE CHECKED PROPERLY FOR ALLERGIES."
  1.  Q
  1.  ;
  1. DRUG ;GO HERE IF NO NDF OR CLASS
  1.  IF AZOCLASS=0 S AZOQUIT=2,AZO("MESS")="THERE IS NO DRUG COMPONENT (NO NDF ENTRY) OR CLASS FOR THE DRUG "_PSODRUG("NAME")_".  IT CANNOT BE CHECKED PROPERLY FOR ALLERGIES."
  1.  Q
  1.  ;
  1.  ;
  1. FULL ;
  1.  S AZOALLD=0 F  S AZOALLD=$O(^GMR(120.8,"API",PSODFN,AZOALLD)) Q:AZOALLD=""  D  ;AZOALLD=SPECIAL XREF FOR ALLERGY IN FILE 50.416
  1.  .S AZOALLI=$O(^GMR(120.8,"API",PSODFN,AZOALLD,""))
  1.  .;Q:$D(^GMR(120.8,AZOALLI,"ER"))  ;ENTERED IN ERROR NODE
  1.  .Q:$$TEST(AZOALLI)
  1.  .S AZOALLDR=$S($P(^PS(50.416,AZOALLD,0),U,2)["":$P(^(0),U,2),1:AZOALLD)  ;THIS IS TRICKY NOTE SOME DRUG INGREDIENTS MAY "POINT" TO OTHER DRUG INGREDEINTS
  1.  .;NOW TO LOOP THRU OUR DRUG BEING CHECKED=AZODREF(I)'S WITH THIS AZOALLDR=ALLERGY DRUG
  1.  .S I=0 F  S I=$O(AZODREF(I)) Q:I=""  D
  1.  ..IF AZODREF(I)=AZOALLD S AZOHIT=1,AZO("HITE"_$P(^GMR(120.8,AZOALLI,0),U,2))="THE DRUG "_PSODRUG("NAME")_" IS 'MATCHED' WITH PATIENT'S ALLERGY FILE NAME "_$P(^GMR(120.8,AZOALLI,0),U,2)  ;GET ONLY 1 MSG FOR A DRUG W/ MULTI DRUG COMPONENTS
  1.  ..Q
  1.  .Q
  1.  D:$G(AZOHIT) ASK
  1.  KILL AZOHIT
  1.  Q
  1.  ;
  1. HALF ;THIS IS USED TO CHECK IF ONLY HAVE A CLASS
  1.  ;DONE LIKE FULL EXCEPT USE APC XREF FOR CLASS
  1.  S AZOALLC=0 F  S AZOALLC=$O(^GMR(120.8,"APC",PSODFN,AZOALLC)) Q:AZOALLC=""  D
  1.  .S AZOALLI=$O(^GMR(120.8,"APC",PSODFN,AZOALLC,""))
  1.  .;Q:$D(^GMR(120.8,AZOALLC,"ER"))
  1.  .Q:$$TEST(AZOALLI)
  1.  .IF AZOCLASS=AZOALLC S AZOHIT=1,AZO("HITC"_AZOALLI)="THE DRUG "_PSODRUG("NAME")_" IS 'CLASSED' WITH PATIENT ALLERGY FILE AS "_$P(^GMR(120.8,AZOALLI,0),U,2)
  1.  .Q
  1.  D:$G(AZOHIT) ASK
  1.  K AZOHIT
  1.  Q
  1.  ;
  1. QUAR ;WELL NOTHING IS LEFT BUT TO CHECK THE DRUG ITSELF
  1.  S AZODRUG=PSODRUG("IEN")  ;OUR DRUG TO COMPARE WITH ALLERGIES
  1.  S AZODRUGC=0 F  S AZODRUGC=$O(^GMR(120.8,"B",PSODFN,AZODRUGC)) Q:AZODRUGC=""  D
  1.  .Q:$$TEST(AZODRUGC)
  1.  .IF $P($P(^GMR(120.8,AZODRUGC,0),U,3),";",2)="PSDRUG(" S AZODRUGI=+$P(^(0),U,3) IF $G(AZODRUGI)=AZODRUG D
  1.  ..S AZOHIT=1,AZO("HITD"_$P(^GMR(120.8,AZODRUGC,0),U,2))="THE DRUG "_PSODRUG("NAME")_" IS 'IDENTICAL' WITH PATIENT ALLERGY FILE NAME "_$P(^GMR(120.8,AZODRUGC,0),U,2)
  1.  ..Q
  1.  .Q
  1.  D:$G(AZOHIT) ASK
  1.  K AZOHIT
  1.  Q
  1.  ;
  1. ASK ;ASK WHAT IS TO BE DONE
  1.  ;LETS DO REVERSE VIDEO
  1.  S X="IORVON;IORVOFF" D ENDR^%ZISS
  1.  ;FIRST WRITE MESSAGES
  1.  S I="" F  S I=$O(AZO(I)) Q:I=""  W:I="MESS" IORVON W !,*7,AZO(I) W:I="MESS" IORVOFF
  1.  ;S DIR("A")="WHAT IS YOUR POISON?  "
  1.  S DIR("A")="WHAT IS YOUR CHOICE?  "
  1.  S DIR("A",1)="1  DO YOU WANT TO DELETE THIS DRUG?"
  1.  S DIR("A",2)="2  DO AN INTERVENTION?"
  1.  S DIR("A",3)="3  DO BOTH 1 AND 2?"
  1.  S DIR("A",4)="4  JUST CONTINUE?"
  1.  S DIR("B")=1
  1.  S DIR(0)="N^1:4:0"
  1.  D ^DIR
  1.  ;IF (Y="")!(Y["^") S Y=1
  1.  IF $D(DIRUT)!($D(DIROUT)) S Y=1
  1.  K DIR,DTOUT,DIRUT,DUOUT,DIROUT
  1.  D @Y
  1.  Q
  1.  ;
  1. TEST(AZOIT)        ;CHECK FOR ERRORS AND VERIFED STATUS
  1.  S AZOCHECK=0
  1.  S:$D(^GMR(120.8,AZOIT,"ER")) AZOCHECK=1
  1.  S:$P(^GMR(120.8,AZOIT,0),U,16)'="1" AZOCHECK=1
  1.  Q AZOCHECK
  1.  ;
  1. 1 ;DELETE THE DRUG
  1.  S PSORX("DFLG")=1,DGI=""
  1.  Q
  1. 2 ;DO AN INTERVENTION
  1.  S PSORX("INTERVENE")=3,DGI=""
  1.  Q
  1. 3 ;DO BOTH 1 AND 2
  1.  D 2,1
  1.  Q
  1. 4 ;DO NOTHING
  1.  Q