GMRAFX2 ;SLC/DAN - Select reactant for update ;1/7/08 09:36
;;4.0;Adverse Reaction Tracking;**17,19,21,23,41**;Mar 29, 1996;Build 8
;DBIA SECTION
;10026 - DIR
;4631 - XTID
;4829 - PSN5067
;10104 - XLFSTR
;10103 - XLFDT
;10006 - DIC
;4554 - PSNDI
;2574 - $$TGTOG^PSNAPIS
;
EN1 ; Select new reactant
N DIR,Y,DIRUT,X,DTOUT,DUOUT,DIC,GMRALAR,D,ENTRY,OK,CNT,LST,ROOT,NAM,DIROUT
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)
NPA 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
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
I +Y>0&($G(OK)) S GMRAAR=+Y_";GMRD(120.82,",GMRAAR(0)=$P(Y,"^",2),GMRAAR("O")=$P(Y(0),"^",2) Q
NDF ;find partial matches and select from NDF
K Y,DTOUT,DUOUT,ENTRY
W !!,"Now checking the National Drug File - Generic Names (#50.6)",!
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^PSNDI(50.6,"GMRA",.DIC,.X,,$$DT^XLFDT) K DIC S:+Y>0 ENTRY=X D DIC ;23,41
I +Y>0&($G(OK)) S GMRAAR=+Y_";PSNDF(50.6,",GMRAAR(0)=$P(Y,U,2),GMRAAR("O")="D" Q
W !!,"Now checking the National Drug File - Trade Names (#50.67)",!
K DUOUT,DTOUT,Y,ENTRY
S ROOT="^TMP($J,""GMRASEL"",""B"")",CNT=0,X=GMRALAR ;41
D ALL^PSN5067(,X,$$DT^XLFDT,"GMRASEL") ;41
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
S NAM=X F S NAM=$O(@ROOT@(NAM)) Q:NAM=""!($E(NAM,1,$L(X))'=X) D
.Q:$S($L($T(SCREEN^XTID)):$$SCREEN^XTID(50.6,.01,$$TGTOG^PSNAPIS(NAM)_","),1:0) ;23
.S CNT=CNT+1,LST(CNT)=$$TGTOG^PSNAPIS(NAM)_U_NAM
I 'CNT S Y=-1 ;No matches found
I CNT=1 S Y(0)=LST(1),ENTRY=$P(Y(0),U,2),Y=+LST(1) ;Only one choice
I CNT>1 D
.D MATCHES
.S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
.S DIR("?")="Select the number of desired causative agent"
.D ^DIR S Y=$S(+Y:+Y,1:-1) S:Y>0 Y(0)=LST(Y),(ENTRY,X)=$P(Y(0),U,2)
D DIC
I +Y>0&($G(OK)) S GMRAAR=+Y(0)_";PSNDF(50.6,",GMRAAR(0)=$P(Y(0),U,2),GMRAAR("O")="D" Q
;Selection from file 50 removed in patch 23 and code actually removed in 41
;19 - Moved ING and CLASS code here from above
ING W !!,"Now checking INGREDIENT (#50.416) file for matches...",! ;23
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^PSNDI(50.416,"GMRA",.DIC,D,.X,,$$DT^XLFDT) K DIC S:+Y>0 ENTRY=X D DIC ;23,41
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
CLASS W !!,"Now checking VA DRUG CLASS (#50.605) file for matches...",! ;23
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^PSNDI(50.605,"GMRA",.DIC,D,.X,,$$DT^XLFDT) K DIC S:+Y>0 ENTRY=X D DIC ;23,41
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
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
Q
DIC ; VALIDATE LOOKUP FOR A/AR
N DIR,X,Y
Q:'$D(ENTRY)
K OK
W !!,"You selected ",ENTRY
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
Q
MATCHES ; -- List matches for NDF
N I,J,QUIT
W !!,"Choose from the following "_+$G(CNT)_" matches:"
S (I,J,QUIT)=0 F S I=$O(LST(I)) Q:I'>0 D Q:QUIT
. S J=J+1 I '(J#(IOSL-5)) S:'$$MORE QUIT=1 Q:QUIT
. W !,J," ",$P(LST(I),"^",2)
Q
;
MORE() ; -- show more matches
N DIR,DTOUT,DUOUT,X,Y
S DIR(0)="EA",DIR("A")="Press <return> to see more, or ^ to stop ..."
D ^DIR
Q +Y
;
HELP ;Display help for selection of causative agent
W !,"Enter new causative agent to be assigned to the selected entries."
W !,"Enter between 3 and 30 characters. The entered text will then be"
W !,"searched for in a number of different files. Select the appropriate"
W !,"entry from the appropriate file to update the selected patient."
W !!,"Enter ^ to skip the current patient or ^^ to exit the entire process."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAFX2 4559 printed Apr 09, 2024@20:44:55 Page 2
GMRAFX2 ;SLC/DAN - Select reactant for update ;1/7/08 09:36
+1 ;;4.0;Adverse Reaction Tracking;**17,19,21,23,41**;Mar 29, 1996;Build 8
+2 ;DBIA SECTION
+3 ;10026 - DIR
+4 ;4631 - XTID
+5 ;4829 - PSN5067
+6 ;10104 - XLFSTR
+7 ;10103 - XLFDT
+8 ;10006 - DIC
+9 ;4554 - PSNDI
+10 ;2574 - $$TGTOG^PSNAPIS
+11 ;
EN1 ; Select new reactant
+1 NEW DIR,Y,DIRUT,X,DTOUT,DUOUT,DIC,GMRALAR,D,ENTRY,OK,CNT,LST,ROOT,NAM,DIROUT
+2 SET DIR(0)="FO^3:30"
SET DIR("A")="Enter Causative Agent"
SET DIR("?")="^D HELP^GMRAFX2"
DO ^DIR
if $DATA(DIROUT)
SET STOP=1
if $DATA(DIRUT)
QUIT
SET GMRALAR=$$UP^XLFSTR(Y)
NPA ;21,23
SET DIC("S")="I $P(^(0),U)'=""OTHER ALLERGY/ADVERSE REACTION""&($S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.82,.01,Y_"",""),1:1))"
+1 ;21
WRITE !!,"Checking GMR ALLERGIES (#120.82) file for matches...",!
KILL Y,DTOUT,DUOUT,ENTRY
SET X=GMRALAR
SET DIC="^GMRD(120.82,"
SET DIC(0)="EZM"
SET DIC("W")=""
DO ^DIC
KILL DIC
if +Y>0
SET ENTRY=X
DO DIC
+2 IF +Y>0&($GET(OK))
SET GMRAAR=+Y_";GMRD(120.82,"
SET GMRAAR(0)=$PIECE(Y,"^",2)
SET GMRAAR("O")=$PIECE(Y(0),"^",2)
QUIT
NDF ;find partial matches and select from NDF
+1 KILL Y,DTOUT,DUOUT,ENTRY
+2 WRITE !!,"Now checking the National Drug File - Generic Names (#50.6)",!
+3 ;23,41
SET DIC=50.6
SET X=GMRALAR
SET DIC(0)="EZM"
SET DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.6,.01,Y_"",""),1:1)"
DO DIC^PSNDI(50.6,"GMRA",.DIC,.X,,$$DT^XLFDT)
KILL DIC
if +Y>0
SET ENTRY=X
DO DIC
+4 IF +Y>0&($GET(OK))
SET GMRAAR=+Y_";PSNDF(50.6,"
SET GMRAAR(0)=$PIECE(Y,U,2)
SET GMRAAR("O")="D"
QUIT
+5 WRITE !!,"Now checking the National Drug File - Trade Names (#50.67)",!
+6 KILL DUOUT,DTOUT,Y,ENTRY
+7 ;41
SET ROOT="^TMP($J,""GMRASEL"",""B"")"
SET CNT=0
SET X=GMRALAR
+8 ;41
DO ALL^PSN5067(,X,$$DT^XLFDT,"GMRASEL")
+9 ;23 Exact match stores IEN in 50.6 along with trade name
IF $DATA(@ROOT@(X))
IF $SELECT($LENGTH($TEXT(SCREEN^XTID)):'$$SCREEN^XTID(50.6,.01,$$TGTOG^PSNAPIS(X)_","),1:1)
SET CNT=CNT+1
SET LST(CNT)=$$TGTOG^PSNAPIS(X)_U_X
+10 SET NAM=X
FOR
SET NAM=$ORDER(@ROOT@(NAM))
if NAM=""!($EXTRACT(NAM,1,$LENGTH(X))'=X)
QUIT
Begin DoDot:1
+11 ;23
if $SELECT($LENGTH($TEXT(SCREEN^XTID))
QUIT
+12 SET CNT=CNT+1
SET LST(CNT)=$$TGTOG^PSNAPIS(NAM)_U_NAM
End DoDot:1
+13 ;No matches found
IF 'CNT
SET Y=-1
+14 ;Only one choice
IF CNT=1
SET Y(0)=LST(1)
SET ENTRY=$PIECE(Y(0),U,2)
SET Y=+LST(1)
+15 IF CNT>1
Begin DoDot:1
+16 DO MATCHES
+17 SET DIR(0)="NAO^1:"_CNT
SET DIR("A")="Select 1-"_CNT_": "
+18 SET DIR("?")="Select the number of desired causative agent"
+19 DO ^DIR
SET Y=$SELECT(+Y:+Y,1:-1)
if Y>0
SET Y(0)=LST(Y)
SET (ENTRY,X)=$PIECE(Y(0),U,2)
End DoDot:1
+20 DO DIC
+21 IF +Y>0&($GET(OK))
SET GMRAAR=+Y(0)_";PSNDF(50.6,"
SET GMRAAR(0)=$PIECE(Y(0),U,2)
SET GMRAAR("O")="D"
QUIT
+22 ;Selection from file 50 removed in patch 23 and code actually removed in 41
+23 ;19 - Moved ING and CLASS code here from above
ING ;23
WRITE !!,"Now checking INGREDIENT (#50.416) file for matches...",!
+1 ;23,41
KILL Y,DTOUT,DUOUT,ENTRY
SET D="P"
SET DIC="^PS(50.416,"
SET DIC(0)="SEMZ"
SET DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.416,.01,Y_"",""),1:1)"
SET X=GMRALAR
DO IX^PSNDI(50.416,"GMRA",.DIC,D,.X,,$$DT^XLFDT)
KILL DIC
if +Y>0
SET ENTRY=X
DO DIC
+2 IF +Y>0&($GET(OK))
SET GMRAAR=+Y_";PS(50.416,"
SET GMRAAR(0)=$SELECT(X?1A.E:X,1:$PIECE(Y,"^",2))
SET GMRAAR("O")="D"
QUIT
CLASS ;23
WRITE !!,"Now checking VA DRUG CLASS (#50.605) file for matches...",!
+1 ;23,41
KILL Y,DTOUT,DUOUT,ENTRY
SET X=GMRALAR
SET DIC="^PS(50.605,"
SET DIC(0)="SEZ"
SET DIC("S")="I $S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(50.605,.01,Y_"",""),1:1)"
SET D="C"
DO IX^PSNDI(50.605,"GMRA",.DIC,D,.X,,$$DT^XLFDT)
KILL DIC
if +Y>0
SET ENTRY=X
DO DIC
+2 IF +Y>0&($GET(OK))
SET GMRAAR=+Y_";PS(50.605,"
SET GMRAAR(0)=$SELECT(X?1A.E:X,1:$PIECE(Y,"^",2))
SET GMRAAR("O")="D"
QUIT
YNOTH WRITE !!,"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."
GOTO EN1
+1 QUIT
DIC ; VALIDATE LOOKUP FOR A/AR
+1 NEW DIR,X,Y
+2 if '$DATA(ENTRY)
QUIT
+3 KILL OK
+4 WRITE !!,"You selected ",ENTRY
+5 SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Is this correct"
SET DIR("?")="Answer yes if this is the correct reactant"
DO ^DIR
if Y=1
SET OK=1
+6 QUIT
MATCHES ; -- List matches for NDF
+1 NEW I,J,QUIT
+2 WRITE !!,"Choose from the following "_+$GET(CNT)_" matches:"
+3 SET (I,J,QUIT)=0
FOR
SET I=$ORDER(LST(I))
if I'>0
QUIT
Begin DoDot:1
+4 SET J=J+1
IF '(J#(IOSL-5))
if '$$MORE
SET QUIT=1
if QUIT
QUIT
+5 WRITE !,J," ",$PIECE(LST(I),"^",2)
End DoDot:1
if QUIT
QUIT
+6 QUIT
+7 ;
MORE() ; -- show more matches
+1 NEW DIR,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="EA"
SET DIR("A")="Press <return> to see more, or ^ to stop ..."
+3 DO ^DIR
+4 QUIT +Y
+5 ;
HELP ;Display help for selection of causative agent
+1 WRITE !,"Enter new causative agent to be assigned to the selected entries."
+2 WRITE !,"Enter between 3 and 30 characters. The entered text will then be"
+3 WRITE !,"searched for in a number of different files. Select the appropriate"
+4 WRITE !,"entry from the appropriate file to update the selected patient."
+5 WRITE !!,"Enter ^ to skip the current patient or ^^ to exit the entire process."
+6 QUIT
