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

GMRAFX2.m

Go to the documentation of this file. 
  1. GMRAFX2 ;SLC/DAN Select reactant for update ;01-May-2012 14:17;DU
  1.  ;;4.0;Adverse Reaction Tracking;**17,19,21,23,1002,1006**;Mar 29, 1996;Build 29
  1.  ;DBIA SECTION
  1.  ;10026 - DIR
  1.  ;2056  - DIQ
  1.  ;221   - PSDRUG("B", and PSDRUG("C", cross references
  1.  ;10104 - XLFSTR
  1.  ;10006 - DIC
  1.  ;2531  - $$T^PSNAPIS
  1.  ;2574  - $$TGTOG^PSNAPIS
  1.  ;
  1. EN1 ; Select new reactant
  1.  N DIR,Y,DIRUT,X,DTOUT,DUOUT,DIC,GMRALAR,D,ENTRY,OK,CNT,LST,ROOT,NAM,DIROUT
  1.  S DIR(0)="FO^3:30",DIR("A")="Enter Causative Agent",DIR("?")="^D HELP^GMRAFX2" D ^DIR S:$D(DIROUT) STOP=1 Q:$D(DIRUT)  S GMRALAR=$$UP^XLFSTR(Y)
  1.  ;IHS/MSC/MGH mod returned patch 1006
  1. NPA S DIC("S")="I $P(^(0),U)'=""OTHER ALLERGY/ADVERSE REACTION""&('$$CHECK^GMRAPES0(Y))&($S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.82,.01,Y_"",""),1:1))" ;21,23
  1.  ;S DIC("S")="I $P(^(0),U)'=""OTHER ALLERGY/ADVERSE REACTION""&($S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.82,.01,Y_"",""),1:1))" ;21,23
  1.  W !!,"Checking GMR ALLERGIES (#120.82) file for matches...",! K Y,DTOUT,DUOUT,ENTRY S X=GMRALAR,DIC="^GMRD(120.82,",DIC(0)="EZM",DIC("W")="" D ^DIC K DIC S:+Y>0 ENTRY=X D DIC ;21
  1.  I +Y>0&($G(OK)) S GMRAAR=+Y_";GMRD(120.82,",GMRAAR(0)=$P(Y,"^",2),GMRAAR("O")=$P(Y(0),"^",2) Q
  1. NDF ;find partial matches and select from NDF
  1.  K Y,DTOUT,DUOUT,ENTRY
  1.  W !!,"Now checking the National Drug File - Generic Names (#50.6)",!
  1.  S DIC=50.6,X=GMRALAR,DIC(0)="EZM",DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.6,.01,Y_"",""),1:1)" D ^DIC K DIC S:+Y>0 ENTRY=X D DIC ;23
  1.  I +Y>0&($G(OK)) S GMRAAR=+Y_";PSNDF(50.6,",GMRAAR(0)=$P(Y,U,2),GMRAAR("O")="D" Q
  1.  W !!,"Now checking the National Drug File - Trade Names (#50.67)",!
  1.  K DUOUT,DTOUT,Y,ENTRY
  1.  S ROOT=$$T^PSNAPIS,CNT=0,X=GMRALAR
  1.  I $D(@ROOT@(X)),$S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.6,.01,$$TGTOG^PSNAPIS(X)_","),1:1) S CNT=CNT+1,LST(CNT)=$$TGTOG^PSNAPIS(X)_U_X ;23 Exact match stores IEN in 50.6 along with trade name
  1.  S NAM=X F  S NAM=$O(@ROOT@(NAM)) Q:NAM=""!($E(NAM,1,$L(X))'=X)  D
  1.  .Q:$S($L($T(SCREEN^XTID)):$$SCREEN^XTID(50.6,.01,$$TGTOG^PSNAPIS(NAM)_","),1:0)  ;23
  1.  .S CNT=CNT+1,LST(CNT)=$$TGTOG^PSNAPIS(NAM)_U_NAM
  1.  I 'CNT S Y=-1 ;No matches found
  1.  I CNT=1 S Y(0)=LST(1),ENTRY=$P(Y(0),U,2),Y=+LST(1) ;Only one choice
  1.  I CNT>1 D
  1.  .D MATCHES
  1.  .S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
  1.  .S DIR("?")="Select the number of desired causative agent"
  1.  .D ^DIR S Y=$S(+Y:+Y,1:-1) S:Y>0 Y(0)=LST(Y),(ENTRY,X)=$P(Y(0),U,2)
  1.  D DIC
  1.  I +Y>0&($G(OK)) S GMRAAR=+Y(0)_";PSNDF(50.6,",GMRAAR(0)=$P(Y(0),U,2),GMRAAR("O")="D" Q
  1.  ;Selection from file 50 removed in patch 23
  1. DRUG ;W !!,"Now checking the DRUG (#50) file for matches...",! K Y,DTOUT,DUOUT,ENTRY
  1.  ;S CNT=0,X=GMRALAR K LST
  1.  ;F ROOT="^PSDRUG(""B"")","^PSDRUG(""C"")" D
  1.  ;.I $D(@ROOT@(X)) S CNT=CNT+1,LST(CNT)=$O(@ROOT@(X,0))_U_$S(ROOT["C":$$GET1^DIQ(50,$O(@ROOT@(X,0)),.01)_" <"_X_">",1:X) ;Exact match stores IEN in 50
  1.  ;.S NAM=X F  S NAM=$O(@ROOT@(NAM)) Q:NAM=""!($E(NAM,1,$L(X))'=X)  D
  1.  ;..S CNT=CNT+1,LST(CNT)=$O(@ROOT@(NAM,0))_U_$S(ROOT["C":$$GET1^DIQ(50,$O(@ROOT@(NAM,0)),.01)_" <"_NAM_">",1:NAM)
  1.  ;I 'CNT S Y=-1 ;No matches found
  1.  ;I CNT=1 S Y(0)=LST(1),ENTRY=$P(Y(0),U,2),Y=+LST(1) ;Only one choice
  1.  ;I CNT>1 D
  1.  ;.D MATCHES
  1.  ;.S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
  1.  ;.S DIR("?")="Select the number of desired causative agent"
  1.  ;.D ^DIR S Y=$S(+Y:+Y,1:-1) S:Y>0 Y(0)=LST(Y),(ENTRY,X)=$P(Y(0),U,2)
  1.  ;D DIC
  1.  ;I +Y>0&($G(OK)) S GMRAAR=+Y(0)_";PSDRUG(",GMRAAR(0)=$$GET1^DIQ(50,+Y(0),.01),GMRAAR("O")="D" Q
  1.  ;19 - Moved ING and CLASS code here from above
  1. ING W !!,"Now checking INGREDIENT (#50.416) file for matches...",! ;23
  1.  K Y,DTOUT,DUOUT,ENTRY S D="P",DIC="^PS(50.416,",DIC(0)="SEMZ",DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.416,.01,Y_"",""),1:1)",X=GMRALAR D IX^DIC K DIC S:+Y>0 ENTRY=X D DIC ;23
  1.  I +Y>0&($G(OK)) S GMRAAR=+Y_";PS(50.416,",GMRAAR(0)=$S(X?1A.E:X,1:$P(Y,"^",2)),GMRAAR("O")="D" Q
  1. CLASS W !!,"Now checking VA DRUG CLASS (#50.605) file for matches...",! ;23
  1.  K Y,DTOUT,DUOUT,ENTRY S X=GMRALAR,DIC="^PS(50.605,",DIC(0)="SEZ",DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.605,.01,Y_"",""),1:1)",D="C" D IX^DIC K DIC S:+Y>0 ENTRY=X D DIC ;23
  1.  I +Y>0&($G(OK)) S GMRAAR=+Y_";PS(50.605,",GMRAAR(0)=$S(X?1A.E:X,1:$P(Y,"^",2)),GMRAAR("O")="D" Q
  1. YNOTH W !!,"Could not find ",GMRALAR," in any files.",!,"Please try again (check spelling, etc).",!,"If you need to add a new reactant, use the AE option." G EN1
  1.  Q
  1. DIC ; VALIDATE LOOKUP FOR A/AR
  1.  N DIR,X,Y
  1.  Q:'$D(ENTRY)
  1.  K OK
  1.  W !!,"You selected ",ENTRY
  1.  S DIR(0)="Y",DIR("B")="Y",DIR("A")="Is this correct",DIR("?")="Answer yes if this is the correct reactant" D ^DIR S:Y=1 OK=1
  1.  Q
  1. MATCHES ; -- List matches for NDF
  1.  N I,J,QUIT
  1.  W !!,"Choose from the following "_+$G(CNT)_" matches:"
  1.  S (I,J,QUIT)=0 F  S I=$O(LST(I)) Q:I'>0  D  Q:QUIT
  1.  . S J=J+1 I '(J#(IOSL-5)) S:'$$MORE QUIT=1 Q:QUIT
  1.  . W !,J,"  ",$P(LST(I),"^",2)
  1.  Q
  1.  ;
  1. MORE() ; -- show more matches
  1.  N DIR,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="EA",DIR("A")="Press <return> to see more, or ^ to stop ..."
  1.  D ^DIR
  1.  Q +Y
  1.  ;
  1. HELP ;Display help for selection of causative agent
  1.  W !,"Enter new causative agent to be assigned to the selected entries."
  1.  W !,"Enter between 3 and 30 characters.  The entered text will then be"
  1.  W !,"searched for in a number of different files.  Select the appropriate"
  1.  W !,"entry from the appropriate file to update the selected patient."
  1.  W !!,"Enter ^ to skip the current patient or ^^ to exit the entire process."
  1.  Q