- GMRAPER0 ; HIRMFO/WAA - REACTIONS SELECT ROUTINE ;May 11, 2021@12:02:09
- ;;4.0;Adverse Reaction Tracking;**7,21,23,63**;Mar 29, 1996;Build 34
- EN1 ; ENTRY POINT TO SELECT SIGNS/SYMPTOMS
- K GMRARAD,GMRAROT,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,GMRAROTT,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
- 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"",$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
- 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:$P(GMRAPA(0),U,6)="h" %DT("B")=$S(DATE="":"",1:$$FMTE^XLFDT(DATE,1))
- S %DT(0)="-NOW" D ^%DT I "^^"[X S GMRAOUT=$L(X) Q
- S DATE=Y,ASK=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPER0 7645 printed Feb 18, 2025@23:06:26 Page 2
- GMRAPER0 ; HIRMFO/WAA - REACTIONS SELECT ROUTINE ;May 11, 2021@12:02:09
- +1 ;;4.0;Adverse Reaction Tracking;**7,21,23,63**;Mar 29, 1996;Build 34
- EN1 ; ENTRY POINT TO SELECT SIGNS/SYMPTOMS
- +1 KILL GMRARAD,GMRAROT,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,GMRAROTT,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 ;Delete date associated with this sign/symptom
- KILL GMADATE
- +23 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"",$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
- +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 if $PIECE(GMRAPA(0),U,6)="h"
- SET %DT("B")=$SELECT(DATE="":"",1:$$FMTE^XLFDT(DATE,1))
- +6 SET %DT(0)="-NOW"
- DO ^%DT
- IF "^^"[X
- SET GMRAOUT=$LENGTH(X)
- QUIT
- +7 SET DATE=Y
- SET ASK=1
- +8 QUIT