source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAFX2.m@ 1697

Last change on this file since 1697 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1GMRAFX2 ;SLC/DAN Select reactant for update ;5/13/05 15:44
2 ;;4.0;Adverse Reaction Tracking;**17,19,21,23**;Mar 29, 1996
3 ;DBIA SECTION
4 ;10026 - DIR
5 ;2056 - DIQ
6 ;221 - PSDRUG("B", and PSDRUG("C", cross references
7 ;10104 - XLFSTR
8 ;10006 - DIC
9 ;2531 - $$T^PSNAPIS
10 ;2574 - $$TGTOG^PSNAPIS
11 ;
12EN1 ; Select new reactant
13 N DIR,Y,DIRUT,X,DTOUT,DUOUT,DIC,GMRALAR,D,ENTRY,OK,CNT,LST,ROOT,NAM,DIROUT
14 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)
15NPA 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
16 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
17 I +Y>0&($G(OK)) S GMRAAR=+Y_";GMRD(120.82,",GMRAAR(0)=$P(Y,"^",2),GMRAAR("O")=$P(Y(0),"^",2) Q
18NDF ;find partial matches and select from NDF
19 K Y,DTOUT,DUOUT,ENTRY
20 W !!,"Now checking the National Drug File - Generic Names (#50.6)",!
21 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
22 I +Y>0&($G(OK)) S GMRAAR=+Y_";PSNDF(50.6,",GMRAAR(0)=$P(Y,U,2),GMRAAR("O")="D" Q
23 W !!,"Now checking the National Drug File - Trade Names (#50.67)",!
24 K DUOUT,DTOUT,Y,ENTRY
25 S ROOT=$$T^PSNAPIS,CNT=0,X=GMRALAR
26 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
27 S NAM=X F S NAM=$O(@ROOT@(NAM)) Q:NAM=""!($E(NAM,1,$L(X))'=X) D
28 .Q:$S($L($T(SCREEN^XTID)):$$SCREEN^XTID(50.6,.01,$$TGTOG^PSNAPIS(NAM)_","),1:0) ;23
29 .S CNT=CNT+1,LST(CNT)=$$TGTOG^PSNAPIS(NAM)_U_NAM
30 I 'CNT S Y=-1 ;No matches found
31 I CNT=1 S Y(0)=LST(1),ENTRY=$P(Y(0),U,2),Y=+LST(1) ;Only one choice
32 I CNT>1 D
33 .D MATCHES
34 .S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
35 .S DIR("?")="Select the number of desired causative agent"
36 .D ^DIR S Y=$S(+Y:+Y,1:-1) S:Y>0 Y(0)=LST(Y),(ENTRY,X)=$P(Y(0),U,2)
37 D DIC
38 I +Y>0&($G(OK)) S GMRAAR=+Y(0)_";PSNDF(50.6,",GMRAAR(0)=$P(Y(0),U,2),GMRAAR("O")="D" Q
39 ;Selection from file 50 removed in patch 23
40DRUG ;W !!,"Now checking the DRUG (#50) file for matches...",! K Y,DTOUT,DUOUT,ENTRY
41 ;S CNT=0,X=GMRALAR K LST
42 ;F ROOT="^PSDRUG(""B"")","^PSDRUG(""C"")" D
43 ;.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
44 ;.S NAM=X F S NAM=$O(@ROOT@(NAM)) Q:NAM=""!($E(NAM,1,$L(X))'=X) D
45 ;..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)
46 ;I 'CNT S Y=-1 ;No matches found
47 ;I CNT=1 S Y(0)=LST(1),ENTRY=$P(Y(0),U,2),Y=+LST(1) ;Only one choice
48 ;I CNT>1 D
49 ;.D MATCHES
50 ;.S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
51 ;.S DIR("?")="Select the number of desired causative agent"
52 ;.D ^DIR S Y=$S(+Y:+Y,1:-1) S:Y>0 Y(0)=LST(Y),(ENTRY,X)=$P(Y(0),U,2)
53 ;D DIC
54 ;I +Y>0&($G(OK)) S GMRAAR=+Y(0)_";PSDRUG(",GMRAAR(0)=$$GET1^DIQ(50,+Y(0),.01),GMRAAR("O")="D" Q
55 ;19 - Moved ING and CLASS code here from above
56ING W !!,"Now checking INGREDIENT (#50.416) file for matches...",! ;23
57 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
58 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
59CLASS W !!,"Now checking VA DRUG CLASS (#50.605) file for matches...",! ;23
60 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
61 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
62YNOTH 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
63 Q
64DIC ; VALIDATE LOOKUP FOR A/AR
65 N DIR,X,Y
66 Q:'$D(ENTRY)
67 K OK
68 W !!,"You selected ",ENTRY
69 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
70 Q
71MATCHES ; -- List matches for NDF
72 N I,J,QUIT
73 W !!,"Choose from the following "_+$G(CNT)_" matches:"
74 S (I,J,QUIT)=0 F S I=$O(LST(I)) Q:I'>0 D Q:QUIT
75 . S J=J+1 I '(J#(IOSL-5)) S:'$$MORE QUIT=1 Q:QUIT
76 . W !,J," ",$P(LST(I),"^",2)
77 Q
78 ;
79MORE() ; -- show more matches
80 N DIR,DTOUT,DUOUT,X,Y
81 S DIR(0)="EA",DIR("A")="Press <return> to see more, or ^ to stop ..."
82 D ^DIR
83 Q +Y
84 ;
85HELP ;Display help for selection of causative agent
86 W !,"Enter new causative agent to be assigned to the selected entries."
87 W !,"Enter between 3 and 30 characters. The entered text will then be"
88 W !,"searched for in a number of different files. Select the appropriate"
89 W !,"entry from the appropriate file to update the selected patient."
90 W !!,"Enter ^ to skip the current patient or ^^ to exit the entire process."
91 Q
Note: See TracBrowser for help on using the repository browser.