GMRAPER0 ;HIRMFO/WAA-REACTIONS SELECT ROUTINE ;21-Jun-2012 11:15;DU
;;4.0;Adverse Reaction Tracking;**7,21,23,1002,1005,1006**;Mar 29, 1996;Build 29
EN1 ; ENTRY POINT TO SELECT SIGNS/SYMPTOMS
K GMRARAD,GMRAROT,GMRAWHO,GMRARDL,GMRAROTD S GMRAR10(11)=GMRAOTH_"^OTHER SIGN/SYMPTOM"
LIST ; Display Signs/Symptoms
W #
I $O(GMRARPR(""))="" W !!,"No signs/symptoms have been specified. Please add some now."
RELIST D DSPREAC
;This is to handle historical events
I 'GMRAOUT,($O(GMRARPR(""))=""&($P(GMRAPA(0),U,6)="h")) G Q1
;This is to handle observed events
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
G:'GMRAOUT LIST S:GMRAOUT GMRAOUT=2-GMRAOUT
Q1 ; Exit from program
K %,DIC,GMADATE,GMRACTR,GMRADO,GMRAOK,GMRAPC,GMRAR10,GMRADATE,GMRAREAC,GMRARECN,GMRARPR,GMRAX,GMRAY,GMRARADD,GMRAWHOD,GMRAROTT,GMRASRC,X,Y
Q
DSPREAC ; Display all the patient reactions
I $O(GMRARPR(""))="" G NOREAC
W !!,"The following is the list of reported signs/symptoms for this reaction:"
; GMRACHC(Y) is the reaction that the user can change
S GMRAREAC="",GMRACTR=0 K GMRACHC
F S GMRAREAC=$O(GMRARPR(GMRAREAC)) Q:GMRAREAC="" D
.S GMRARECN=0 F S GMRARECN=$O(GMRARPR(GMRAREAC,GMRARECN)) Q:GMRARECN'>0 D
..S Y=$$CHC,GMRACHC(Y,GMRAREAC,GMRARECN)=""
..S:Y GMRACHC(Y)=GMRARECN_U_GMRAREAC
..Q
.Q
;v=reaction that this user did not enter
I $D(GMRACHC(0)) D
.W !!," These reactions were entered by another user:"
.W !," Signs/Symptoms " W:'$G(GMRANDT) "Date Observed"
.W !,$$REPEAT^XLFSTR("-",75)
.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
..S GMRARECN=Y
..S GMRAREAC=X
..D:$G(GMRAPRP(GMRAREAC,GMRARECN))="" PRTREAC
..Q
.W !
.Q
;v===Reaction that this user entered
S X=0 F S X=$O(GMRACHC(X)) Q:X<1 D
.S GMRARECN=$P(GMRACHC(X),U)
.S GMRAREAC=$P(GMRACHC(X),U,2)
.D:$G(GMRAPRP(GMRAREAC,GMRARECN))="" PRTREAC
.Q
MANIL ;
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
S:X?1L X=$C($A(X)-32)
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
I X="D" D DELREAC^GMRAPER1 Q
NOREAC D ADREAC
Q:'$D(GMRARPR)
;v---Ask the date then loop through the RPR array and put the date in 3
Q:GMRAOUT
S GMRAASK=0
S GMADATE=$G(GMADATE)
I GMADATE="",$G(GMRAODT)>0 S GMADATE=GMRAODT
I '$G(GMRANDT) D DATE(.GMADATE,.GMRAASK) Q:GMRAOUT D
.N GMRAX
.;Add the data to the new reaction unless it has a date
.;Reaction from the reaction file 120.8
.S GMRAX=0 F S GMRAX=$O(GMRARAD(GMRAX)) Q:GMRAX<1 D
..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
..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
..S $P(GMRARPR($P(GMRARAD(GMRAX),U),GMRAX),U,3)=GMADATE
..Q
.;Other Reaction
.S GMRAX="" F S GMRAX=$O(GMRAROT(GMRAX)) Q:GMRAX="" D
..I $P(GMRAROT(GMRAX),U,2)'=""!($D(GMRAROTT("DONE",GMRAX))) Q ;Date had been added to this reaction or sign has already been processed.
..S $P(GMRAROT(GMRAX),U,2)=GMADATE,GMRAROTT("DONE",GMRAX)="" ;entries processed will not be overwritten by other sign/symptoms during same editing session
..S $P(GMRARPR($P(GMRAROT(GMRAX),U),GMRAOTH),U,3)=GMADATE
.Q
D SOURCE(.GMRASRC) Q:GMRAOUT D
.N GMRAX
.;IHS/MSC/MGH Add the source to the new reaction
.S GMRAX="" F S GMRAX=$O(GMRAWHO(GMRAX)) Q:GMRAX="" D
..I $P(GMRAWHO(GMRAX),U,2)'=""!($D(GMRAWHOD("DONE",GMRAX))) Q ;Src already added or processed has already been processed.
..S $P(GMRAWHO(GMRAX),U,2)=GMRASRC,GMRAWHOD("DONE",GMRAX)="" ;entries processed will not be overwritten by other sign/symptoms during same editing session
..S $P(GMRARPR($P(GMRAWHO(GMRAX),U),GMRAX),U,4)=GMRASRC
.Q
K GMADATE ;Delete date associated with this sign/symptom
Q
ADREAC ;This is the site parameter's top ten most common signs/symptoms
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
W !!,"The following are the top ten most common signs/symptoms:"
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)
W !?1,"6.",?4,$P(GMRAR10(6),U,2)
RRD ;
K DIR S DIR(0)="LOA^1:11"
S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
S DIR("A")="Enter from the list above : "
S DIR("?",1)="PLEASE ENTER THE NUMBERS OF THE SIGNS/SYMPTOMS YOU WOULD LIKE TO ADD."
S DIR("?",2)="RANGES CAN BE SEPARATED BY A HYPHEN (-) AND GROUPS OF NUMBERS,"
S DIR("?")="SEPARATED BY A COMMA (,)."
D ^DIR K DIR
S:$D(DTOUT) GMRAOUT=1
S:$D(DUOUT) GMRAOUT=1
Q:GMRAOUT!(Y="")
S GMRADO=Y K Y,GMRAY
S GMRAASK=0
F Y=1:1:$L(GMRADO,",") S GMRAY=$P(GMRADO,",",Y) I +GMRAY D
.I +GMRAY=11 D ADD Q ;23 Handle request for "other" separately
.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
.D ADD ;23
I $G(ERR) G ADREAC ;23
Q
CHC() ; Check reaction to see if user can see and edit this reaction
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
Q 0
PRTREAC ;
N GMRAPDAT
I X=1 D
.W !!," Signs/Symptoms " W:'$G(GMRANDT) "Date Observed"
.W !,$$REPEAT^XLFSTR("-",75)
.Q
W !?1,$S(X:$J(X,2),1:""),?5,$E($P(GMRARPR(GMRAREAC,GMRARECN),U),1,45)
S GMRAPDAT=$S($P(GMRARPR(GMRAREAC,GMRARECN),U,3)'="":$P(GMRARPR(GMRAREAC,GMRARECN),U,3),$G(GMRADATE)>0:GMADATE,1:"")
I '$G(GMRANDT) W ?53 W:GMRAPDAT'="" $$FMTE^XLFDT(GMRAPDAT,1)
Q
ADD ;
N Y
I GMRAY=11 D Q
.F D Q:+Y<0
..S DIC=120.83,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U)'=""OTHER REACTION""&('$$CHECKS^GMRAPER0(Y))&($S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.83,.01,Y_"",""),1:1))" D ^DIC
..I +Y>0 D SETT
S Y=GMRAR10(GMRAY) D SETT
Q
SETT ;
Q:'$L(Y)
S GMRAREAC=$P(Y,U,2),GMRARECN=$P(Y,U) K GMRARDL(GMRARECN)
S:'$D(GMRARPR(GMRAREAC,GMRARECN)) GMRARAD(GMRARECN)=GMRAREAC,GMRARPR(GMRAREAC,GMRARECN)=GMRAREAC,GMRAWHO(GMRARECN)=GMRAREAC
Q
STRIN ;This will handle a string input
W !!,"Enter OTHER SIGN/SYMPTOM: " R X:DTIME S:'$T X="^^" I "^^"[X S:X="^^"!(X=U) GMRAOUT=1 Q
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
I +Y'>0 S:$D(DTOUT)!$D(DUOUT) GMRAOUT=1 Q:GMRAOUT D ADDG Q:GMRAOUT G STRIN:%=2,ASKAN
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
I %=-1 S GMRAOUT=1 Q
I %=2 S X=GMRAREAC G STRIN:X=$P(Y,U,2) D ADDG Q:GMRAOUT G STRIN:%=2,ASKAN
D SETT
ASKAN ;
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
S:%=-1 GMRAOUT=1 Q:%=2!GMRAOUT
G STRIN
Q
ADDG ;
I $L(X)<3!($L(X)>30) W " ??",$C(7) S %=2 Q
W !,X," is not in the Sign/Symptoms file." S %=2 D:$L($T(NTRTMSG^HDISVAP)) NTRTMSG^HDISVAP() Q ;
S:%=-1 GMRAOUT=1
I %=1 N % I 'GMRAOUT S:'$D(GMRARPR(X,GMRAOTH)) GMRAROT(X)=X,GMRARPR(X,GMRAOTH)=X K GMRAROTD(X)
Q
DATE(DATE,ASK) ; Enter the date for a reaction
Q:ASK
N %DT,X,Y
S DATE=$G(DATE,""),%DT="AEPT",%DT("A")="Date(Time Optional) of appearance of Sign/Symptom(s): "
S:$P(GMRAPA(0),U,6)="o" %DT("B")=$S(DATE="":"NOW",1:$$FMTE^XLFDT(DATE,1))
S %DT(0)="-NOW" D ^%DT I "^^"[X S GMRAOUT=$L(X) Q
S DATE=Y,ASK=1
Q
SOURCE(SRC) ;Get the source
N DA,DIC,DR,Y
S DIC=90460.05
S DIC(0)="AEMQ"
S DIC("S")="I $P(^(0),U,2)=""S"""
S DIC("A")="Select source: "
D ^DIC I $D(DIRUT) K DIRUT S GMRAOUT=1
S SRC=Y
Q
CHECKS(SGN) ;Check to see if SIGN/SYMPTOM is active)
;IHS/MSC/MGH for patch 1005
N VALUE,STAT,STATUS,SIGNDT
S VALUE=0,SIGNDT=""
S SIGNDT=$O(^GMRD(120.83,SGN,"TERMSTATUS","B",$C(0)),-1) I SIGNDT'="" D
.S STAT=$O(^GMRD(120.83,SGN,"TERMSTATUS","B",SIGNDT,$C(0)),-1) I STAT'="" D
..S STATUS=$P($G(^GMRD(120.83,SGN,"TERMSTATUS",STAT,0)),U,2)
..I STATUS=0 S VALUE=1
Q VALUE
GMRAPER0 ;HIRMFO/WAA-REACTIONS SELECT ROUTINE ;21-Jun-2012 11:15;DU
+1 ;;4.0;Adverse Reaction Tracking;**7,21,23,1002,1005,1006**;Mar 29, 1996;Build 29
EN1 ; ENTRY POINT TO SELECT SIGNS/SYMPTOMS
+1 KILL GMRARAD,GMRAROT,GMRAWHO,GMRARDL,GMRAROTD
SET GMRAR10(11)=GMRAOTH_"^OTHER SIGN/SYMPTOM"
LIST ; Display Signs/Symptoms
+1 WRITE #
+2 IF $ORDER(GMRARPR(""))=""
WRITE !!,"No signs/symptoms have been specified. Please add some now."
RELIST DO DSPREAC
+1 ;This is to handle historical events
+2 IF 'GMRAOUT
IF ($ORDER(GMRARPR(""))=""&($PIECE(GMRAPA(0),U,6)="h"))
GOTO Q1
+3 ;This is to handle observed events
+4 IF 'GMRAOUT
IF ($ORDER(GMRARPR(""))=""&($PIECE(GMRAPA(0),U,6)="o"))
WRITE !!,$CHAR(7),"SIGNS/SYMPTOMS MUST BE SPECIFIED. THIS IS A REQUIRED RESPONSE."
GOTO RELIST
+5 IF 'GMRAOUT
GOTO LIST
IF GMRAOUT
SET GMRAOUT=2-GMRAOUT
Q1 ; Exit from program
+1 KILL %,DIC,GMADATE,GMRACTR,GMRADO,GMRAOK,GMRAPC,GMRAR10,GMRADATE,GMRAREAC,GMRARECN,GMRARPR,GMRAX,GMRAY,GMRARADD,GMRAWHOD,GMRAROTT,GMRASRC,X,Y
+2 QUIT
DSPREAC ; Display all the patient reactions
+1 IF $ORDER(GMRARPR(""))=""
GOTO NOREAC
+2 WRITE !!,"The following is the list of reported signs/symptoms for this reaction:"
+3 ; GMRACHC(Y) is the reaction that the user can change
+4 SET GMRAREAC=""
SET GMRACTR=0
KILL GMRACHC
+5 FOR
SET GMRAREAC=$ORDER(GMRARPR(GMRAREAC))
IF GMRAREAC=""
QUIT
Begin DoDot:1
+6 SET GMRARECN=0
FOR
SET GMRARECN=$ORDER(GMRARPR(GMRAREAC,GMRARECN))
IF GMRARECN'>0
QUIT
Begin DoDot:2
+7 SET Y=$$CHC
SET GMRACHC(Y,GMRAREAC,GMRARECN)=""
+8 IF Y
SET GMRACHC(Y)=GMRARECN_U_GMRAREAC
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 ;v=reaction that this user did not enter
+12 IF $DATA(GMRACHC(0))
Begin DoDot:1
+13 WRITE !!," These reactions were entered by another user:"
+14 WRITE !," Signs/Symptoms "
IF '$GET(GMRANDT)
WRITE "Date Observed"
+15 WRITE !,$$REPEAT^XLFSTR("-",75)
+16 SET X=""
FOR
SET X=$ORDER(GMRACHC(0,X))
IF X=""
QUIT
SET Y=0
FOR
SET Y=$ORDER(GMRACHC(0,X,Y))
IF Y<1
QUIT
Begin DoDot:2
+17 SET GMRARECN=Y
+18 SET GMRAREAC=X
+19 IF $GET(GMRAPRP(GMRAREAC,GMRARECN))=""
DO PRTREAC
+20 QUIT
End DoDot:2
+21 WRITE !
+22 QUIT
End DoDot:1
+23 ;v===Reaction that this user entered
+24 SET X=0
FOR
SET X=$ORDER(GMRACHC(X))
IF X<1
QUIT
Begin DoDot:1
+25 SET GMRARECN=$PIECE(GMRACHC(X),U)
+26 SET GMRAREAC=$PIECE(GMRACHC(X),U,2)
+27 IF $GET(GMRAPRP(GMRAREAC,GMRARECN))=""
DO PRTREAC
+28 QUIT
End DoDot:1
MANIL ;
+1 WRITE !!,"Select Action (A)DD",$SELECT(GMRACTR>0:", (D)ELETE ",1:" "),"OR <RET>: "
READ X:DTIME
IF '$TEST
SET X="^^"
IF "^^"[X
SET GMRAOUT=2-(X'="")
QUIT
+2 IF X?1L
SET X=$CHAR($ASCII(X)-32)
+3 IF '(X="A"!(X="D"))
WRITE !?4,$CHAR(7),"ENTER AN A TO ADD SIGNS/SYMPTOMS TO THIS LIST,"
IF GMRACTR
WRITE !?10,"OR D TO DELETE SIGNS/SYMPTOMS FROM THIS LIST,"
WRITE !?10,"OR <RET> TO ACCEPT THIS LIST OF SIGNS/SYMPTOMS."
GOTO MANIL
+4 IF X="D"
DO DELREAC^GMRAPER1
QUIT
NOREAC DO ADREAC
+1 IF '$DATA(GMRARPR)
QUIT
+2 ;v---Ask the date then loop through the RPR array and put the date in 3
+3 IF GMRAOUT
QUIT
+4 SET GMRAASK=0
+5 SET GMADATE=$GET(GMADATE)
+6 IF GMADATE=""
IF $GET(GMRAODT)>0
SET GMADATE=GMRAODT
+7 IF '$GET(GMRANDT)
DO DATE(.GMADATE,.GMRAASK)
IF GMRAOUT
QUIT
Begin DoDot:1
+8 NEW GMRAX
+9 ;Add the data to the new reaction unless it has a date
+10 ;Reaction from the reaction file 120.8
+11 SET GMRAX=0
FOR
SET GMRAX=$ORDER(GMRARAD(GMRAX))
IF GMRAX<1
QUIT
Begin DoDot:2
+12 ;Date had been added to this reaction or reaction has already been processed. Allows null entry
IF $PIECE(GMRARAD(GMRAX),U,2)'=""!($DATA(GMRARADD("DONE",GMRAX)))
QUIT
+13 ;keeps track of entries edited so null dates aren't over written during same session
SET $PIECE(GMRARAD(GMRAX),U,2)=GMADATE
SET GMRARADD("DONE",GMRAX)=""
+14 SET $PIECE(GMRARPR($PIECE(GMRARAD(GMRAX),U),GMRAX),U,3)=GMADATE
+15 QUIT
End DoDot:2
+16 ;Other Reaction
+17 SET GMRAX=""
FOR
SET GMRAX=$ORDER(GMRAROT(GMRAX))
IF GMRAX=""
QUIT
Begin DoDot:2
+18 ;Date had been added to this reaction or sign has already been processed.
IF $PIECE(GMRAROT(GMRAX),U,2)'=""!($DATA(GMRAROTT("DONE",GMRAX)))
QUIT
+19 ;entries processed will not be overwritten by other sign/symptoms during same editing session
SET $PIECE(GMRAROT(GMRAX),U,2)=GMADATE
SET GMRAROTT("DONE",GMRAX)=""
+20 SET $PIECE(GMRARPR($PIECE(GMRAROT(GMRAX),U),GMRAOTH),U,3)=GMADATE
End DoDot:2
+21 QUIT
End DoDot:1
+22 DO SOURCE(.GMRASRC)
IF GMRAOUT
QUIT
Begin DoDot:1
+23 NEW GMRAX
+24 ;IHS/MSC/MGH Add the source to the new reaction
+25 SET GMRAX=""
FOR
SET GMRAX=$ORDER(GMRAWHO(GMRAX))
IF GMRAX=""
QUIT
Begin DoDot:2
+26 ;Src already added or processed has already been processed.
IF $PIECE(GMRAWHO(GMRAX),U,2)'=""!($DATA(GMRAWHOD("DONE",GMRAX)))
QUIT
+27 ;entries processed will not be overwritten by other sign/symptoms during same editing session
SET $PIECE(GMRAWHO(GMRAX),U,2)=GMRASRC
SET GMRAWHOD("DONE",GMRAX)=""
+28 SET $PIECE(GMRARPR($PIECE(GMRAWHO(GMRAX),U),GMRAX),U,4)=GMRASRC
End DoDot:2
+29 QUIT
End DoDot:1
+30 ;Delete date associated with this sign/symptom
KILL GMADATE
+31 QUIT
ADREAC ;This is the site parameter's top ten most common signs/symptoms
+1 ;23
IF $GET(ERR)
WRITE !!,"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."
KILL ERR
+2 WRITE !!,"The following are the top ten most common signs/symptoms:"
+3 FOR GMRAREAC=1:1:5
WRITE !,$JUSTIFY(GMRAREAC,2),".",?4,$PIECE(GMRAR10(GMRAREAC),U,2),?35,$JUSTIFY(GMRAREAC+6,2),".",?39,$PIECE(GMRAR10(GMRAREAC+6),U,2)
+4 WRITE !?1,"6.",?4,$PIECE(GMRAR10(6),U,2)
RRD ;
+1 KILL DIR
SET DIR(0)="LOA^1:11"
+2 SET DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
+3 SET DIR("A")="Enter from the list above : "
+4 SET DIR("?",1)="PLEASE ENTER THE NUMBERS OF THE SIGNS/SYMPTOMS YOU WOULD LIKE TO ADD."
+5 SET DIR("?",2)="RANGES CAN BE SEPARATED BY A HYPHEN (-) AND GROUPS OF NUMBERS,"
+6 SET DIR("?")="SEPARATED BY A COMMA (,)."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)
SET GMRAOUT=1
+9 IF $DATA(DUOUT)
SET GMRAOUT=1
+10 IF GMRAOUT!(Y="")
QUIT
+11 SET GMRADO=Y
KILL Y,GMRAY
+12 SET GMRAASK=0
+13 FOR Y=1:1:$LENGTH(GMRADO,",")
SET GMRAY=$PIECE(GMRADO,",",Y)
IF +GMRAY
Begin DoDot:1
+14 ;23 Handle request for "other" separately
IF +GMRAY=11
DO ADD
QUIT
+15 ;23
IF $LENGTH($TEXT(SCREEN^XTID))
IF $$SCREEN^XTID(120.83,.01,$PIECE(GMRAR10(+GMRAY),U)_",")
WRITE !!,$PIECE(GMRAR10(+GMRAY),U,2)," is inactive and may not be used."
SET ERR=1
QUIT
+16 ;23
DO ADD
End DoDot:1
+17 ;23
IF $GET(ERR)
GOTO ADREAC
+18 QUIT
CHC() ; Check reaction to see if user can see and edit this reaction
+1 IF $PIECE(GMRARPR(GMRAREAC,GMRARECN),U,2)=DUZ!'$LENGTH($PIECE(GMRARPR(GMRAREAC,GMRARECN),U,2))
IF '$PIECE(GMRAPA(0),U,12)!$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
SET GMRACTR=GMRACTR+1
QUIT GMRACTR
+2 QUIT 0
PRTREAC ;
+1 NEW GMRAPDAT
+2 IF X=1
Begin DoDot:1
+3 WRITE !!," Signs/Symptoms "
IF '$GET(GMRANDT)
WRITE "Date Observed"
+4 WRITE !,$$REPEAT^XLFSTR("-",75)
+5 QUIT
End DoDot:1
+6 WRITE !?1,$SELECT(X:$JUSTIFY(X,2),1:""),?5,$EXTRACT($PIECE(GMRARPR(GMRAREAC,GMRARECN),U),1,45)
+7 SET GMRAPDAT=$SELECT($PIECE(GMRARPR(GMRAREAC,GMRARECN),U,3)'="":$PIECE(GMRARPR(GMRAREAC,GMRARECN),U,3),$GET(GMRADATE)>0:GMADATE,1:"")
+8 IF '$GET(GMRANDT)
WRITE ?53
IF GMRAPDAT'=""
WRITE $$FMTE^XLFDT(GMRAPDAT,1)
+9 QUIT
ADD ;
+1 NEW Y
+2 IF GMRAY=11
Begin DoDot:1
+3 FOR
Begin DoDot:2
+4 SET DIC=120.83
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U)'=""OTHER REACTION""&('$$CHECKS^GMRAPER0(Y))&($S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.83,.01,Y_"",""),1:1))"
DO ^DIC
+5 IF +Y>0
DO SETT
End DoDot:2
IF +Y<0
QUIT
End DoDot:1
QUIT
+6 SET Y=GMRAR10(GMRAY)
DO SETT
+7 QUIT
SETT ;
+1 IF '$LENGTH(Y)
QUIT
+2 SET GMRAREAC=$PIECE(Y,U,2)
SET GMRARECN=$PIECE(Y,U)
KILL GMRARDL(GMRARECN)
+3 IF '$DATA(GMRARPR(GMRAREAC,GMRARECN))
SET GMRARAD(GMRARECN)=GMRAREAC
SET GMRARPR(GMRAREAC,GMRARECN)=GMRAREAC
SET GMRAWHO(GMRARECN)=GMRAREAC
+4 QUIT
STRIN ;This will handle a string input
+1 WRITE !!,"Enter OTHER SIGN/SYMPTOM: "
READ X:DTIME
IF '$TEST
SET X="^^"
IF "^^"[X
IF X="^^"!(X=U)
SET GMRAOUT=1
QUIT
+2 ;21,23
SET DIC="^GMRD(120.83,"
SET DIC("S")="I $P(^(0),U)'=""OTHER REACTION"",$S($L($T(SCREEN^XTID)):'$$SCREEN^XTID(120.83,.01,Y_"",""),1:1)"
SET DIC(0)="EM"
SET D="B^D"
SET GMRAREAC=X
KILL DTOUT,DUOUT
DO MIX^DIC1
KILL DIC
IF X?1"?".E
GOTO STRIN
+3 IF +Y'>0
IF $DATA(DTOUT)!$DATA(DUOUT)
SET GMRAOUT=1
IF GMRAOUT
QUIT
DO ADDG
IF GMRAOUT
QUIT
IF %=2
GOTO STRIN
GOTO ASKAN
YNOK WRITE !,$PIECE(Y,U,2)_" OK "
SET %=1
DO YN^DICN
IF '%
WRITE !?4,$CHAR(7),"ANSWER YES IF THE DATA ABOVE IS CORRECT, ELSE ANSWER NO."
GOTO YNOK
+1 IF %=-1
SET GMRAOUT=1
QUIT
+2 IF %=2
SET X=GMRAREAC
IF X=$PIECE(Y,U,2)
GOTO STRIN
DO ADDG
IF GMRAOUT
QUIT
IF %=2
GOTO STRIN
GOTO ASKAN
+3 DO SETT
ASKAN ;
+1 WRITE !,"Would you like to add another sign/symptom"
SET %=2
DO YN^DICN
IF '%
WRITE !?4,$CHAR(7),"ANSWER YES TO ADD ANOTHER SIGN/SYMPTOM, ELSE ANSWER NO."
GOTO ASKAN
+2 IF %=-1
SET GMRAOUT=1
IF %=2!GMRAOUT
QUIT
+3 GOTO STRIN
+4 QUIT
ADDG ;
+1 IF $LENGTH(X)<3!($LENGTH(X)>30)
WRITE " ??",$CHAR(7)
SET %=2
QUIT
+2 ;
WRITE !,X," is not in the Sign/Symptoms file."
SET %=2
IF $LENGTH($TEXT(NTRTMSG^HDISVAP))
DO NTRTMSG^HDISVAP()
QUIT
+3 IF %=-1
SET GMRAOUT=1
+4 IF %=1
NEW %
IF 'GMRAOUT
IF '$DATA(GMRARPR(X,GMRAOTH))
SET GMRAROT(X)=X
SET GMRARPR(X,GMRAOTH)=X
KILL GMRAROTD(X)
+5 QUIT
DATE(DATE,ASK) ; Enter the date for a reaction
+1 IF ASK
QUIT
+2 NEW %DT,X,Y
+3 SET DATE=$GET(DATE,"")
SET %DT="AEPT"
SET %DT("A")="Date(Time Optional) of appearance of Sign/Symptom(s): "
+4 IF $PIECE(GMRAPA(0),U,6)="o"
SET %DT("B")=$SELECT(DATE="":"NOW",1:$$FMTE^XLFDT(DATE,1))
+5 SET %DT(0)="-NOW"
DO ^%DT
IF "^^"[X
SET GMRAOUT=$LENGTH(X)
QUIT
+6 SET DATE=Y
SET ASK=1
+7 QUIT
SOURCE(SRC) ;Get the source
+1 NEW DA,DIC,DR,Y
+2 SET DIC=90460.05
+3 SET DIC(0)="AEMQ"
+4 SET DIC("S")="I $P(^(0),U,2)=""S"""
+5 SET DIC("A")="Select source: "
+6 DO ^DIC
IF $DATA(DIRUT)
KILL DIRUT
SET GMRAOUT=1
+7 SET SRC=Y
+8 QUIT
CHECKS(SGN) ;Check to see if SIGN/SYMPTOM is active)
+1 ;IHS/MSC/MGH for patch 1005
+2 NEW VALUE,STAT,STATUS,SIGNDT
+3 SET VALUE=0
SET SIGNDT=""
+4 SET SIGNDT=$ORDER(^GMRD(120.83,SGN,"TERMSTATUS","B",$CHAR(0)),-1)
IF SIGNDT'=""
Begin DoDot:1
+5 SET STAT=$ORDER(^GMRD(120.83,SGN,"TERMSTATUS","B",SIGNDT,$CHAR(0)),-1)
IF STAT'=""
Begin DoDot:2
+6 SET STATUS=$PIECE($GET(^GMRD(120.83,SGN,"TERMSTATUS",STAT,0)),U,2)
+7 IF STATUS=0
SET VALUE=1
End DoDot:2
End DoDot:1
+8 QUIT VALUE
