source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPER0.m@ 623

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

initial load of WorldVistAEHR

File size: 7.2 KB
Line 
1GMRAPER0 ;HIRMFO/WAA-REACTIONS SELECT ROUTINE ;6/9/05 11:12
2 ;;4.0;Adverse Reaction Tracking;**7,21,23**;Mar 29, 1996
3EN1 ; ENTRY POINT TO SELECT SIGNS/SYMPTOMS
4 K GMRARAD,GMRAROT,GMRARDL,GMRAROTD S GMRAR10(11)=GMRAOTH_"^OTHER SIGN/SYMPTOM"
5LIST ; Display Signs/Symptoms
6 W #
7 I $O(GMRARPR(""))="" W !!,"No signs/symptoms have been specified. Please add some now."
8RELIST D DSPREAC
9 ;This is to handle historical events
10 I 'GMRAOUT,($O(GMRARPR(""))=""&($P(GMRAPA(0),U,6)="h")) G Q1
11 ;This is to handle observed events
12 I 'GMRAOUT,($O(GMRARPR(""))=""&($P(GMRAPA(0),U,6)="o")) W !!,$C(7),"SIGNS/SYMPTOMS MUST BE SPECIFIED. THIS IS A REQUIRED RESPONSE." G RELIST
13 G:'GMRAOUT LIST S:GMRAOUT GMRAOUT=2-GMRAOUT
14Q1 ; Exit from program
15 K %,DIC,GMADATE,GMRACTR,GMRADO,GMRAOK,GMRAPC,GMRAR10,GMRADATE,GMRAREAC,GMRARECN,GMRARPR,GMRAX,GMRAY,GMRARADD,GMRAROTT,X,Y
16 Q
17DSPREAC ; Display all the patient reactions
18 I $O(GMRARPR(""))="" G NOREAC
19 W !!,"The following is the list of reported signs/symptoms for this reaction:"
20 ; GMRACHC(Y) is the reaction that the user can change
21 S GMRAREAC="",GMRACTR=0 K GMRACHC
22 F S GMRAREAC=$O(GMRARPR(GMRAREAC)) Q:GMRAREAC="" D
23 .S GMRARECN=0 F S GMRARECN=$O(GMRARPR(GMRAREAC,GMRARECN)) Q:GMRARECN'>0 D
24 ..S Y=$$CHC,GMRACHC(Y,GMRAREAC,GMRARECN)=""
25 ..S:Y GMRACHC(Y)=GMRARECN_U_GMRAREAC
26 ..Q
27 .Q
28 ;v=reaction that this user did not enter
29 I $D(GMRACHC(0)) D
30 .W !!," These reactions were entered by another user:"
31 .W !," Signs/Symptoms " W:'$G(GMRANDT) "Date Observed"
32 .W !,$$REPEAT^XLFSTR("-",75)
33 .S X="" F S X=$O(GMRACHC(0,X)) Q:X="" S Y=0 F S Y=$O(GMRACHC(0,X,Y)) Q:Y<1 D
34 ..S GMRARECN=Y
35 ..S GMRAREAC=X
36 ..D:$G(GMRAPRP(GMRAREAC,GMRARECN))="" PRTREAC
37 ..Q
38 .W !
39 .Q
40 ;v===Reaction that this user entered
41 S X=0 F S X=$O(GMRACHC(X)) Q:X<1 D
42 .S GMRARECN=$P(GMRACHC(X),U)
43 .S GMRAREAC=$P(GMRACHC(X),U,2)
44 .D:$G(GMRAPRP(GMRAREAC,GMRARECN))="" PRTREAC
45 .Q
46MANIL ;
47 W !!,"Select Action (A)DD",$S(GMRACTR>0:", (D)ELETE ",1:" "),"OR <RET>: " R X:DTIME S:'$T X="^^" I "^^"[X S GMRAOUT=2-(X'="") Q
48 S:X?1L X=$C($A(X)-32)
49 I '(X="A"!(X="D")) W !?4,$C(7),"ENTER AN A TO ADD SIGNS/SYMPTOMS TO THIS LIST," W:GMRACTR !?10,"OR D TO DELETE SIGNS/SYMPTOMS FROM THIS LIST," W !?10,"OR <RET> TO ACCEPT THIS LIST OF SIGNS/SYMPTOMS." G MANIL
50 I X="D" D DELREAC^GMRAPER1 Q
51NOREAC D ADREAC
52 Q:'$D(GMRARPR)
53 ;v---Ask the date then loop through the RPR array and put the date in 3
54 Q:GMRAOUT
55 S GMRAASK=0
56 S GMADATE=$G(GMADATE)
57 I GMADATE="",$G(GMRAODT)>0 S GMADATE=GMRAODT
58 I '$G(GMRANDT) D DATE(.GMADATE,.GMRAASK) Q:GMRAOUT D
59 .N GMRAX
60 .;Add the data to the new reaction unless it has a date
61 .;Reaction from the reaction file 120.8
62 .S GMRAX=0 F S GMRAX=$O(GMRARAD(GMRAX)) Q:GMRAX<1 D
63 ..I $P(GMRARAD(GMRAX),U,2)'=""!($D(GMRARADD("DONE",GMRAX))) Q ;Date had been added to this reaction or reaction has already been processed. Allows null entry
64 ..S $P(GMRARAD(GMRAX),U,2)=GMADATE,GMRARADD("DONE",GMRAX)="" ;keeps track of entries edited so null dates aren't over written during same session
65 ..S $P(GMRARPR($P(GMRARAD(GMRAX),U),GMRAX),U,3)=GMADATE
66 ..Q
67 .;Other Reaction
68 .S GMRAX="" F S GMRAX=$O(GMRAROT(GMRAX)) Q:GMRAX="" D
69 ..I $P(GMRAROT(GMRAX),U,2)'=""!($D(GMRAROTT("DONE",GMRAX))) Q ;Date had been added to this reaction or sign has already been processed.
70 ..S $P(GMRAROT(GMRAX),U,2)=GMADATE,GMRAROTT("DONE",GMRAX)="" ;entries processed will not be overwritten by other sign/symptoms during same editing session
71 ..S $P(GMRARPR($P(GMRAROT(GMRAX),U),GMRAOTH),U,3)=GMADATE
72 .Q
73 K GMADATE ;Delete date associated with this sign/symptom
74 Q
75ADREAC ;This is the site parameter's top ten most common signs/symptoms
76 I $G(ERR) W !!,"One or more entries you selected were inactive. Please use option 11",!,"to find a similar term to replace the inactive sign/symptom you selected." K ERR ;23
77 W !!,"The following are the top ten most common signs/symptoms:"
78 F GMRAREAC=1:1:5 W !,$J(GMRAREAC,2),".",?4,$P(GMRAR10(GMRAREAC),U,2),?35,$J(GMRAREAC+6,2),".",?39,$P(GMRAR10(GMRAREAC+6),U,2)
79 W !?1,"6.",?4,$P(GMRAR10(6),U,2)
80RRD ;
81 K DIR S DIR(0)="LOA^1:11"
82 S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
83 S DIR("A")="Enter from the list above : "
84 S DIR("?",1)="PLEASE ENTER THE NUMBERS OF THE SIGNS/SYMPTOMS YOU WOULD LIKE TO ADD."
85 S DIR("?",2)="RANGES CAN BE SEPARATED BY A HYPHEN (-) AND GROUPS OF NUMBERS,"
86 S DIR("?")="SEPARATED BY A COMMA (,)."
87 D ^DIR K DIR
88 S:$D(DTOUT) GMRAOUT=1
89 S:$D(DUOUT) GMRAOUT=1
90 Q:GMRAOUT!(Y="")
91 S GMRADO=Y K Y,GMRAY
92 S GMRAASK=0
93 F Y=1:1:$L(GMRADO,",") S GMRAY=$P(GMRADO,",",Y) I +GMRAY D
94 .I +GMRAY=11 D ADD Q ;23 Handle request for "other" separately
95 .I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.83,.01,$P(GMRAR10(+GMRAY),U)_",") W !!,$P(GMRAR10(+GMRAY),U,2)," is inactive and may not be used." S ERR=1 Q ;23
96 .D ADD ;23
97 I $G(ERR) G ADREAC ;23
98 Q
99CHC() ; Check reaction to see if user can see and edit this reaction
100 I $P(GMRARPR(GMRAREAC,GMRARECN),U,2)=DUZ!'$L($P(GMRARPR(GMRAREAC,GMRARECN),U,2)),'$P(GMRAPA(0),U,12)!$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRACTR=GMRACTR+1 Q GMRACTR
101 Q 0
102PRTREAC ;
103 N GMRAPDAT
104 I X=1 D
105 .W !!," Signs/Symptoms " W:'$G(GMRANDT) "Date Observed"
106 .W !,$$REPEAT^XLFSTR("-",75)
107 .Q
108 W !?1,$S(X:$J(X,2),1:""),?5,$E($P(GMRARPR(GMRAREAC,GMRARECN),U),1,45)
109 S GMRAPDAT=$S($P(GMRARPR(GMRAREAC,GMRARECN),U,3)'="":$P(GMRARPR(GMRAREAC,GMRARECN),U,3),$G(GMRADATE)>0:GMADATE,1:"")
110 I '$G(GMRANDT) W ?53 W:GMRAPDAT'="" $$FMTE^XLFDT(GMRAPDAT,1)
111 Q
112ADD ;
113 N Y
114 I GMRAY=11 D Q
115 .F D Q:+Y<0
116 ..S DIC=120.83,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U)'=""OTHER REACTION"",$S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.83,.01,Y_"",""),1:1)" D ^DIC
117 ..I +Y>0 D SETT
118 S Y=GMRAR10(GMRAY) D SETT
119 Q
120SETT ;
121 Q:'$L(Y)
122 S GMRAREAC=$P(Y,U,2),GMRARECN=$P(Y,U) K GMRARDL(GMRARECN)
123 S:'$D(GMRARPR(GMRAREAC,GMRARECN)) GMRARAD(GMRARECN)=GMRAREAC,GMRARPR(GMRAREAC,GMRARECN)=GMRAREAC
124 Q
125STRIN ;This will handle a string input
126 W !!,"Enter OTHER SIGN/SYMPTOM: " R X:DTIME S:'$T X="^^" I "^^"[X S:X="^^"!(X=U) GMRAOUT=1 Q
127 S DIC="^GMRD(120.83,",DIC("S")="I $P(^(0),U)'=""OTHER REACTION"",$S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.83,.01,Y_"",""),1:1)",DIC(0)="EM",D="B^D",GMRAREAC=X K DTOUT,DUOUT D MIX^DIC1 K DIC G:X?1"?".E STRIN ;21,23
128 I +Y'>0 S:$D(DTOUT)!$D(DUOUT) GMRAOUT=1 Q:GMRAOUT D ADDG Q:GMRAOUT G STRIN:%=2,ASKAN
129YNOK W !,$P(Y,U,2)_" OK " S %=1 D YN^DICN I '% W !?4,$C(7),"ANSWER YES IF THE DATA ABOVE IS CORRECT, ELSE ANSWER NO." G YNOK
130 I %=-1 S GMRAOUT=1 Q
131 I %=2 S X=GMRAREAC G STRIN:X=$P(Y,U,2) D ADDG Q:GMRAOUT G STRIN:%=2,ASKAN
132 D SETT
133ASKAN ;
134 W !,"Would you like to add another sign/symptom" S %=2 D YN^DICN I '% W !?4,$C(7),"ANSWER YES TO ADD ANOTHER SIGN/SYMPTOM, ELSE ANSWER NO." G ASKAN
135 S:%=-1 GMRAOUT=1 Q:%=2!GMRAOUT
136 G STRIN
137 Q
138ADDG ;
139 I $L(X)<3!($L(X)>30) W " ??",$C(7) S %=2 Q
140 W !,X," is not in the Sign/Symptoms file." S %=2 D:$L($T(NTRTMSG^HDISVAP)) NTRTMSG^HDISVAP() Q ;
141 S:%=-1 GMRAOUT=1
142 I %=1 N % I 'GMRAOUT S:'$D(GMRARPR(X,GMRAOTH)) GMRAROT(X)=X,GMRARPR(X,GMRAOTH)=X K GMRAROTD(X)
143 Q
144DATE(DATE,ASK) ; Enter the date for a reaction
145 Q:ASK
146 N %DT,X,Y
147 S DATE=$G(DATE,""),%DT="AEPT",%DT("A")="Date(Time Optional) of appearance of Sign/Symptom(s): "
148 S:$P(GMRAPA(0),U,6)="o" %DT("B")=$S(DATE="":"NOW",1:$$FMTE^XLFDT(DATE,1))
149 S %DT(0)="-NOW" D ^%DT I "^^"[X S GMRAOUT=$L(X) Q
150 S DATE=Y,ASK=1
151 Q
Note: See TracBrowser for help on using the repository browser.