| 1 | GMRAPER0 ;HIRMFO/WAA-REACTIONS SELECT ROUTINE ;6/9/05 11:12
|
---|
| 2 | ;;4.0;Adverse Reaction Tracking;**7,21,23**;Mar 29, 1996
|
---|
| 3 | EN1 ; ENTRY POINT TO SELECT SIGNS/SYMPTOMS
|
---|
| 4 | K GMRARAD,GMRAROT,GMRARDL,GMRAROTD S GMRAR10(11)=GMRAOTH_"^OTHER SIGN/SYMPTOM"
|
---|
| 5 | LIST ; Display Signs/Symptoms
|
---|
| 6 | W #
|
---|
| 7 | I $O(GMRARPR(""))="" W !!,"No signs/symptoms have been specified. Please add some now."
|
---|
| 8 | RELIST 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
|
---|
| 14 | Q1 ; Exit from program
|
---|
| 15 | K %,DIC,GMADATE,GMRACTR,GMRADO,GMRAOK,GMRAPC,GMRAR10,GMRADATE,GMRAREAC,GMRARECN,GMRARPR,GMRAX,GMRAY,GMRARADD,GMRAROTT,X,Y
|
---|
| 16 | Q
|
---|
| 17 | DSPREAC ; 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
|
---|
| 46 | MANIL ;
|
---|
| 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
|
---|
| 51 | NOREAC 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
|
---|
| 75 | ADREAC ;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)
|
---|
| 80 | RRD ;
|
---|
| 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
|
---|
| 99 | CHC() ; 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
|
---|
| 102 | PRTREAC ;
|
---|
| 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
|
---|
| 112 | ADD ;
|
---|
| 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
|
---|
| 120 | SETT ;
|
---|
| 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
|
---|
| 125 | STRIN ;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
|
---|
| 129 | YNOK 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
|
---|
| 133 | ASKAN ;
|
---|
| 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
|
---|
| 138 | ADDG ;
|
---|
| 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
|
---|
| 144 | DATE(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
|
---|