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

APSPALG.m

Go to the documentation of this file. 
  1. APSPALG ;IHS/DSD/ENM - POC ALLERGY DRUG CHECK [ 06/07/2001  10:53 AM ]
  1.  ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;01/15/98
  1.  ;This routine was developed by Patrick Cox @Oklahoma Area
  1.  ;in December, 1997.
  1.  Q
  1. EN ;EP ENTRY POINT FROM PSODRG
  1.  W !,"CHECK FOR DRUG ALLERGIES..."
  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 APSZQUIT=0 ;APSZQUIT=0=XREF APSZQUIT=1=NONDF APSZQUIT=2=NOCLASS
  1.  ;APSZXREF IS SPECIAL XREF OF DRUG INGREDIENT FILE
  1.  S APSZXREF=$G(PSODRUG("NDF"),0) S:APSZXREF="" APSZXREF=0,APSZQUIT=1
  1.  S:'(APSZXREF?1.N1"A"1.N) APSZXREF=0,APSZQUIT=1 ;GOT TO KNOW WHEN NO NDF
  1.  S APSZCLASS=$G(PSODRUG("VA CLASS"),0) S:APSZCLASS="" APSZCLASS=0
  1.  S:APSZCLASS=0 APSZQUIT=2
  1.  D XREF:APSZQUIT=0,CLASS:APSZQUIT=1,DRUG:APSZQUIT=2
  1.  ;0 SPECIAL XREF 1 CLASS 2 JUST A DRUG NAME
  1.  ;WORK THRU THE PATIENT ALLERGY FILE USING ABOVE
  1.  D FULL:APSZQUIT=0,HALF:APSZQUIT=1,QUAR:APSZQUIT=2,NONE:APSZQUIT=3
  1.  D END
  1.  Q
  1.  ;SUBROUTINES
  1. XREF ;GET THE DRUG COMPONENTS TO BE CHECKED
  1.  S APSZDRCOM=0 F I=1:1 S APSZDRCOM=$O(^PS(50.416,"APD",APSZXREF,APSZDRCOM)) Q:APSZDRCOM=""  D
  1.  .I $P(^PS(50.416,APSZDRCOM,0),U,2)]"" S APSZDREF(I)=$P(^(0),U,2)
  1.  .;THE ABOVE IS FOR SOME INGREDIENTS POINTING TO OTHER INGREDIENTS
  1.  .E  S APSZDREF(I)=APSZDRCOM
  1.  .Q
  1.  I '$D(APSZDREF) S APSZ("MESS")="THERE IS NO DRUG COMPONENT (NO NDF ENTRY) FOR THE DRUG "_PSODRUG("NAME")_".  IT CANNOT BE CHECKED WITH CERTAINTY FOR ALLERGIES.",APSZQUIT=1 ;D CLASS ;POC CHECK THIS
  1.  Q
  1.  ;
  1. CLASS ;CHECKS FOR CLASS IF NO ENTRY IN NDF
  1.  S APSZ("MESS")="THERE IS NO DRUG COMPONENT (NO NDF ENTRY) FOR THE DRUG "_PSODRUG("NAME")_". IT CANNOT BE CHECKED WITH CERTAINTY FOR ALLERGIES."
  1.  Q
  1.  ;
  1. DRUG ;GO HERE IF NO NDF OR CLASS
  1.  S APSZ("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. FULL S APSZALLD=0 F  S APSZALLD=$O(^GMR(120.8,"API",PSODFN,APSZALLD)) Q:APSZALLD=""  D
  1.  .S APSZALLI=$O(^GMR(120.8,"API",PSODFN,APSZALLD,""))
  1.  .Q:$$TEST(APSZALLI)
  1.  .S APSZALLDR=$S($P(^PS(50.416,APSZALLD,0),U,2)["":$P(^(0),U,2),1:APSZALLD) ;SOME DRUG INGREDIENTS POINT TO OTHER DRUG INGREDIENTS
  1.  .S I=0 F  S I=$O(APSZDREF(I)) Q:I=""  D  ;NOW LOOP THRU OUR DRUG BEING CHECKED APSZDREF(I)'S
  1.  ..I APSZDREF(I)=APSZALLD S APSZHIT=1,APSZ("HITE"_$P(^GMR(120.8,APSZALLI,0),U,2))="THE DRUG "_PSODRUG("NAME")_" IS 'MATCHED' WITH PATIENT'S ALLERGY FILE NAME"_$P(^GMR(120.8,APSZALLI,0),U,2)
  1.  ..;THIS WAY GOING GET ONE MESSAGE FOR COMBINATION DRUGS
  1.  ..Q
  1.  .Q
  1.  D:$G(APSZHIT) ASK
  1.  K APSZHIT
  1.  Q
  1.  ;
  1. HALF S APSZALLC=0 F  S APSZALLC=$O(^GMR(120.8,"APC",PSODFN,APSZALLC)) Q:APSZALLC=""  D
  1.  .S APSZALLI=$O(^GMR(120.8,"APC",PSODFN,APSZALLC,""))
  1.  .Q:$$TEST(APSZALLI)
  1.  .I APSZCLASS=APSZALLC S APSZHIT=1,APSZ("HITC"_APSZALLI)="THE DRUG "_PSODRUG("NAME")_" IS 'CLASSED' WITH PATIENT ALLERGY FILE AS "_$P(^GMR(120.8,APSZALLI,0),U,2)
  1.  .Q
  1.  D:$G(APSZHIT) ASK
  1.  K APSZHIT
  1.  QUIT
  1.  ;
  1. QUAR S APSZDRUG=PSODRUG("IEN") ;OUR DRUG TO COMPARE WITH ALLERGIES
  1.  S APSZDRUGC=0 F  S APSZDRUGC=$O(^GMR(120.8,"B",PSODFN,APSZDRUGC)) Q:APSZDRUGC=""  D
  1.  .Q:$$TEST(APSZDRUGC)
  1.  .I $P($P(^GMR(120.8,APSZDRUGC,0),U,3),";",2)="PSDRUG(" S APSZDRUGI=+$P(^(0),U,3) I $G(APSZDRUGI)=APSZDRUG D
  1.  ..S APSZHIT=1,APSZ("HITD"_$P(^GMR(120.8,APSZDRUGC,0),U,2))="THE DRUG "_PSODRUG("NAME")_" IS 'IDENTICAL' WITH PATIENT ALLERGY FILE NAME "_$P(^GMR(120.8,APSZDRUGC,0),U,2)
  1.  ..Q
  1.  .Q:$G(APSZHIT)
  1.  .I $P(^GMR(120.8,APSZDRUGC,0),U,3)="1;GMRD(120.82," S APSZDRUGN=$P(^(0),U,2) I PSODRUG("NAME")[$G(APSZDRUGN) D
  1.  ..S APSZHIT=1,APSZ("HITS"_$P(^GMR(120.8,APSZDRUGC,0),U,2))="THE DRUG "_PSODRUG("NAME")_" IS 'PART OF AN ENTRY' PATIENT ALLERGY FILE NAME "_$P(^GMR(120.8,APSZDRUGC,0),U,2)
  1.  ..Q
  1.  .Q
  1.  D:$G(APSZHIT) ASK
  1.  K APSZHIT
  1.  Q
  1.  ;
  1. ASK S X="IORVON;IORVOFF" D ENDR^%ZISS
  1.  ;WRITE THE MESSAGES
  1.  S I="" F  S I=$O(APSZ(I)) Q:I=""  W:I="MESS" IORVON W !,*7,APSZ(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?",DIR("A",3)="3  DO BOTH 1 AND 2?"
  1.  S DIR("A",4)="4  JUST CONTINUE?",DIR("B")=1,DIR(0)="N^1:4:0"
  1.  D ^DIR
  1.  I $D(DIRUT)!($D(DIROUT)) S Y=1
  1.  K DIR,DTOUT,DIRUT,DUOUT,DIROUT
  1.  D @Y
  1.  Q
  1.  ;
  1. TEST(APSZIT)        ;CHECK FOR ERRORS AND VERIFED STATUS
  1.  S APSZCHECK=0
  1.  S:$D(^GMR(120.8,APSZIT,"ER")) APSZCHECK=1
  1.  S:$P(^GMR(120.8,APSZIT,0),U,16)'="1" APSZCHECK=1
  1.  ;NOTE APSZCHECK=1 MEANS STOP
  1.  Q APSZCHECK
  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
  1. NONE ;SHOULD NOT GET HERE
  1. END ;CLEAN UP TIME
  1.  D EN^XBVK("APSZ")
  1.  Q