- GMRAFUT0 ;HIRMFO/YMP,RFM,WAA-ALLERGY/ADVERSE REACTION FILE UTILITIES ;3/14/05 12:21
- ;;4.0;Adverse Reaction Tracking;**23,62**;Mar 29, 1996;Build 2
- EN1 ; Entry for GMRA LOCAL ALLERGIES EDIT option
- D PROCESS Q ;23
- K DR,DIC,DLAYGO,X,Y,DA,GMRAIEN
- W ! S DLAYGO=120.82,DIC="^GMRD(120.82,",DIC("A")="Select a LOCAL ALLERGY/ADVERSE REACTION: ",DIC(0)="AEQML",DIC("DR")="1" D ^DIC K DIC,DLAYGO G:+Y'>0 EXIT S (DA,GMRAIEN)=+Y
- L +^GMRD(120.82,GMRAIEN):1 I '$T W !,"THIS ENTRY IS BEING EDITED BY SOMEONE ELSE",$C(7) D EXIT Q
- N GMRALN,DIE,GMRACT
- S GMRALN=$G(^GMRD(120.82,GMRAIEN,0))
- S DIE="^GMRD(120.82,",DR="",GMRACT=1
- I +$P(GMRALN,U,3) S DR(1,120.82,1)="@1;W !!,$C(7),""CANNOT EDIT NAME FIELD OF A NATIONAL ALLERGY."",!;3;"
- E D
- . S DR(1,120.82,1)=".01;3;"
- . S DR(1,120.82,2)="S (GMRAY,GMRAX)=$P(GMRALN,U,2) D EDTTYPE^GMRAUTL(.GMRAX);"
- . S DR(1,120.82,3)="S:GMRAX=GMRAY!(""^^""[GMRAX) X=GMRAX,Y=$S(""^^""[GMRAX:""@3"",1:""@4"");1///^S X=GMRAX;@4;4;5;@3;"
- . Q
- D ^DIE K DIE,DA,DR,DLAYGO,GMRAX,GMRAY
- L -^GMRD(120.82,GMRAIEN)
- G:'$D(Y) EN1
- D EXIT Q
- EN2 ; Entry for GMRA LOCAL REACTIONS EDIT option
- D PROCESS Q ;23
- W ! S DLAYGO=120.83,DIC="^GMRD(120.83,",DIC("A")="Select a LOCAL SIGN/SYMPTOM: ",DIC(0)="AEQML",DIC("DR")="" D ^DIC K DIC,DLAYGO G:+Y'>0 EXIT S (DA,GMRAY)=+Y
- L +^GMRD(120.83,GMRAY):1 I '$T W !,"THIS ENTRY IS BEING EDITED BY SOMEONE ELSE",$C(7) D EXIT Q
- S DIE="^GMRD(120.83,",DR="S Y=""@""_+$P($G(^GMRD(120.83,DA,0)),U,2);@0;.01;S Y=""@2"";@1;W !,""NAME: ""_$P($G(^GMRD(120.83,DA,0)),U)_"" (no editing)"";@2;2" D ^DIE K DA,DIE,DR
- L -^GMRD(120.83,GMRAY)
- G:'$D(Y) EN2
- D EXIT Q
- EN3 ; Entry for GMRA SITE FILE EDIT option
- S DLAYGO=120.84,DIC="^GMRD(120.84,",DIC(0)="AEQL" D ^DIC K DIC,DLAYGO G:+Y'>0 EXIT S GMRASITE=+Y
- L +^GMRD(120.84,GMRASITE):1 I '$T W !,"THIS ENTRY IS BEING EDITED BY SOMEONE ELSE",$C(7) D EXIT Q
- I $P(Y,"^",2)="HOSPITAL" W !,"NAME: HOSPITAL// (No editing)"
- E S DA=GMRASITE,DIE="^GMRD(120.84,",DR=".01" D ^DIE I $D(Y) L -^GMRD(120.84,GMRASITE) G EXIT
- I '$D(^GMRD(120.84,GMRASITE,0)) L -^GMRD(120.84,GMRASITE) G EN3
- S DA=GMRASITE,DIE="^GMRD(120.84,",DR=6 D ^DIE I $D(Y) L -^GMRD(120.84,GMRASITE) G EXIT
- RE10 S (GMRACTR,GMRARECN,GMRABRK,GMRAMID)=0,GMRALLER=""
- W !!,"The following are the ten most common signs/symptoms:"
- F GMRAX=1:1:5 D PRT10
- RRD W !,"Enter the number of the sign/symptom that you would like to edit: "
- R GMRANS:DTIME S:'$T GMRANS="^^" I "^^"[GMRANS L:(GMRANS["^") -^GMRD(120.84,GMRASITE) G EXIT:(GMRANS["^"),EDCON
- I GMRANS'=+GMRANS!(GMRANS<1)!(GMRANS>10)!(GMRANS\1'=GMRANS) W !?4,$C(7),"ENTER THE CORRECT NUMBER (1-10) OF THE SIGN/SYMPTOM TO BE EDITED" G RRD
- S:'$D(^GMRD(120.84,GMRASITE,1,0)) ^(0)="^120.841P^^" S (GMRAX,GMRAY)=$G(^GMRD(120.84,GMRASITE,1,0)) I '$D(^GMRD(120.84,GMRASITE,1,+GMRANS,0)) S ^(0)="",$P(GMRAY,"^",3,4)=+GMRANS_"^"_($P(GMRAY,"^",4)+1)
- S DIE="^GMRD(120.84,DA(1),1,",DA(1)=GMRASITE,DA=+GMRANS,DR=".01" D ^DIE
- I $G(^GMRD(120.84,GMRASITE,1,+GMRANS,0))="" K ^(0) S GMRAY=GMRAX
- I GMRAY'=GMRAX S ^GMRD(120.84,GMRASITE,1,0)=GMRAY
- G RE10:'$D(Y) L -^GMRD(120.84,GMRASITE) G EXIT
- EDCON S DIE="^GMRD(120.84,",DA=GMRASITE,DR="2;3;3.5;4;7;7.1;7.2;7.3SEND CHART MARK BULLETIN FOR NEW ADMISSIONS;10;10.1ENABLE COMMENTS FIELD FOR REACTIONS THAT ARE ENTERED IN ERROR" D ^DIE
- I $D(Y) L -^GMRD(120.84,GMRASITE) G EXIT
- S X=$G(^GMRD(120.84,GMRASITE,"RPT"))
- W !!,"REPORTER NAME: ",$P(X,U),!?6,"ADDRESS: ",$P(X,U,2) W:$L($P(X,U,3)) !?15,$P(X,U,3) W:$L($P(X,U,4)) !?15,$P(X,U,4) W !?9,"CITY: ",$P(X,U,5),!?8,"STATE: ",$P($G(^DIC(5,+$P(X,U,6),0)),U),!?10,"ZIP: ",$P(X,U,7),!?8,"PHONE: ",$P(X,U,8)
- W !,?3,"OCCUPATION: ",$P(X,U,11)
- F S %=2 W !,"Do you want to edit Reporter Information shown above" D YN^DICN S:%=-1 %=2 Q:% W !?3,"ENTER YES TO CHANGE/ADD THE SITE'S DEFAULT REPORTER INFORMATION",!?3,"THAT WILL APPEAR ON THE FDA ADR REPORTS, ELSE ANSWER NO."
- I %'=1 L -^GMRD(120.84,GMRASITE) G EXIT
- S DIE="^GMRD(120.84,",DA=GMRASITE,DR="11:19" D ^DIE
- L -^GMRD(120.84,GMRASITE)
- EXIT ;
- D KILL^XUSCLEAN
- Q
- PRT10 ;
- S GMRAY=$S($D(^GMRD(120.84,GMRASITE,1,GMRAX,0)):+^(0),1:0),GMRAZ=$S($D(^GMRD(120.84,GMRASITE,1,GMRAX+5,0)):+^(0),1:0)
- W !,$J(GMRAX,2),".",?4,$S($D(^GMRD(120.83,GMRAY,0)):$P(^(0),"^"),1:""),?35,$J(GMRAX+5,2),".",?39,$S($D(^GMRD(120.83,GMRAZ,0)):$P(^(0),"^"),1:"")
- Q
- EN4 ; ENTRY FROM INPUT TRANSFORM FOR FIELDS .01 AND 22 OF FILE
- ; 120.85, WHERE GMRA=FIELD NUMBER, X IS DATA TO BE TRANSFORMED.
- S %DT="ETX",%DT(0)="-NOW" D ^%DT S X=Y I Y<1 W !?5,"DATE MUST BE IN THE PAST, AND TIME IS NOT A REQUIRED RESPONSE." G K4
- S GMRA(0)=$G(^GMR(120.85,+$G(DA),0)),GMRA("HELP")="DATE MUST BE "_$P("GREATER THAN DATE/TIME OBSERVED^LESS THAN DATE/TIME MD NOTIFIED","^",GMRA=.01+1),%DT(0)=+($E("-",GMRA=.01)_$P(GMRA(0),U,$E(12,1,GMRA=.01+1)))
- G:%DT(0)=0 Q4 S %DT="TX" D ^%DT S X=Y W:Y<1 !?5,GMRA("HELP") G:Y>0 Q4
- K4 K X
- Q4 K %DT,GMRA
- Q
- ;PROCESS section added with patch 23
- PROCESS ;Additions to 120.82 and 120.83 are no longer allowed
- ;GMRA*4.0*62 Put NTRT message in this routine for display instead
- ;of calling the HDI routine
- ;I $L($T(NTRTMSG^HDISVAP)) D NTRTMSG^HDISVAP() Q
- ;New Term Rapid Turnaround (NTRT) Message
- N HDISLNE,HDISTXT
- F HDISLNE=1:1 S HDISTXT=$P($T(MSG+HDISLNE),";;",2) Q:HDISTXT="END" W !?3,HDISTXT
- Q
- ;GMRA*4.0*62 comment out unnecessary code - NTRT message will always display now
- ;W !!,"The addition of local reactants and sign/symptoms are no longer"
- ;W !,"allowed. Requests for new terms/concepts should be made through"
- ;W !,"the New Term Rapid Turn-around (NTRT) process.",!
- Q
- MSG ;NTRT message text
- ;;
- ;;In support of national standardization of the contents of this file,
- ;;local site addition and modification functions are no longer available.
- ;;If you wish to contact Standards & Terminology Services (STS), request
- ;;a new term, or modify an existing term, please refer to the New
- ;;Term Rapid Turnaround (NTRT) web site located at
- ;;https://vaww.vashare.domain.ext/sites/ntrt/SitePages/Home.aspx
- ;;
- ;;END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAFUT0 6048 printed Feb 18, 2025@23:05:37 Page 2
- GMRAFUT0 ;HIRMFO/YMP,RFM,WAA-ALLERGY/ADVERSE REACTION FILE UTILITIES ;3/14/05 12:21
- +1 ;;4.0;Adverse Reaction Tracking;**23,62**;Mar 29, 1996;Build 2
- EN1 ; Entry for GMRA LOCAL ALLERGIES EDIT option
- +1 ;23
- DO PROCESS
- QUIT
- +2 KILL DR,DIC,DLAYGO,X,Y,DA,GMRAIEN
- +3 WRITE !
- SET DLAYGO=120.82
- SET DIC="^GMRD(120.82,"
- SET DIC("A")="Select a LOCAL ALLERGY/ADVERSE REACTION: "
- SET DIC(0)="AEQML"
- SET DIC("DR")="1"
- DO ^DIC
- KILL DIC,DLAYGO
- if +Y'>0
- GOTO EXIT
- SET (DA,GMRAIEN)=+Y
- +4 LOCK +^GMRD(120.82,GMRAIEN):1
- IF '$TEST
- WRITE !,"THIS ENTRY IS BEING EDITED BY SOMEONE ELSE",$CHAR(7)
- DO EXIT
- QUIT
- +5 NEW GMRALN,DIE,GMRACT
- +6 SET GMRALN=$GET(^GMRD(120.82,GMRAIEN,0))
- +7 SET DIE="^GMRD(120.82,"
- SET DR=""
- SET GMRACT=1
- +8 IF +$PIECE(GMRALN,U,3)
- SET DR(1,120.82,1)="@1;W !!,$C(7),""CANNOT EDIT NAME FIELD OF A NATIONAL ALLERGY."",!;3;"
- +9 IF '$TEST
- Begin DoDot:1
- +10 SET DR(1,120.82,1)=".01;3;"
- +11 SET DR(1,120.82,2)="S (GMRAY,GMRAX)=$P(GMRALN,U,2) D EDTTYPE^GMRAUTL(.GMRAX);"
- +12 SET DR(1,120.82,3)="S:GMRAX=GMRAY!(""^^""[GMRAX) X=GMRAX,Y=$S(""^^""[GMRAX:""@3"",1:""@4"");1///^S X=GMRAX;@4;4;5;@3;"
- +13 QUIT
- End DoDot:1
- +14 DO ^DIE
- KILL DIE,DA,DR,DLAYGO,GMRAX,GMRAY
- +15 LOCK -^GMRD(120.82,GMRAIEN)
- +16 if '$DATA(Y)
- GOTO EN1
- +17 DO EXIT
- QUIT
- EN2 ; Entry for GMRA LOCAL REACTIONS EDIT option
- +1 ;23
- DO PROCESS
- QUIT
- +2 WRITE !
- SET DLAYGO=120.83
- SET DIC="^GMRD(120.83,"
- SET DIC("A")="Select a LOCAL SIGN/SYMPTOM: "
- SET DIC(0)="AEQML"
- SET DIC("DR")=""
- DO ^DIC
- KILL DIC,DLAYGO
- if +Y'>0
- GOTO EXIT
- SET (DA,GMRAY)=+Y
- +3 LOCK +^GMRD(120.83,GMRAY):1
- IF '$TEST
- WRITE !,"THIS ENTRY IS BEING EDITED BY SOMEONE ELSE",$CHAR(7)
- DO EXIT
- QUIT
- +4 SET DIE="^GMRD(120.83,"
- SET DR="S Y=""@""_+$P($G(^GMRD(120.83,DA,0)),U,2);@0;.01;S Y=""@2"";@1;W !,""NAME: ""_$P($G(^GMRD(120.83,DA,0)),U)_"" (no editing)"";@2;2"
- DO ^DIE
- KILL DA,DIE,DR
- +5 LOCK -^GMRD(120.83,GMRAY)
- +6 if '$DATA(Y)
- GOTO EN2
- +7 DO EXIT
- QUIT
- EN3 ; Entry for GMRA SITE FILE EDIT option
- +1 SET DLAYGO=120.84
- SET DIC="^GMRD(120.84,"
- SET DIC(0)="AEQL"
- DO ^DIC
- KILL DIC,DLAYGO
- if +Y'>0
- GOTO EXIT
- SET GMRASITE=+Y
- +2 LOCK +^GMRD(120.84,GMRASITE):1
- IF '$TEST
- WRITE !,"THIS ENTRY IS BEING EDITED BY SOMEONE ELSE",$CHAR(7)
- DO EXIT
- QUIT
- +3 IF $PIECE(Y,"^",2)="HOSPITAL"
- WRITE !,"NAME: HOSPITAL// (No editing)"
- +4 IF '$TEST
- SET DA=GMRASITE
- SET DIE="^GMRD(120.84,"
- SET DR=".01"
- DO ^DIE
- IF $DATA(Y)
- LOCK -^GMRD(120.84,GMRASITE)
- GOTO EXIT
- +5 IF '$DATA(^GMRD(120.84,GMRASITE,0))
- LOCK -^GMRD(120.84,GMRASITE)
- GOTO EN3
- +6 SET DA=GMRASITE
- SET DIE="^GMRD(120.84,"
- SET DR=6
- DO ^DIE
- IF $DATA(Y)
- LOCK -^GMRD(120.84,GMRASITE)
- GOTO EXIT
- RE10 SET (GMRACTR,GMRARECN,GMRABRK,GMRAMID)=0
- SET GMRALLER=""
- +1 WRITE !!,"The following are the ten most common signs/symptoms:"
- +2 FOR GMRAX=1:1:5
- DO PRT10
- RRD WRITE !,"Enter the number of the sign/symptom that you would like to edit: "
- +1 READ GMRANS:DTIME
- if '$TEST
- SET GMRANS="^^"
- IF "^^"[GMRANS
- if (GMRANS["^")
- LOCK -^GMRD(120.84,GMRASITE)
- if (GMRANS["^")
- GOTO EXIT
- GOTO EDCON
- +2 IF GMRANS'=+GMRANS!(GMRANS<1)!(GMRANS>10)!(GMRANS\1'=GMRANS)
- WRITE !?4,$CHAR(7),"ENTER THE CORRECT NUMBER (1-10) OF THE SIGN/SYMPTOM TO BE EDITED"
- GOTO RRD
- +3 if '$DATA(^GMRD(120.84,GMRASITE,1,0))
- SET ^(0)="^120.841P^^"
- SET (GMRAX,GMRAY)=$GET(^GMRD(120.84,GMRASITE,1,0))
- IF '$DATA(^GMRD(120.84,GMRASITE,1,+GMRANS,0))
- SET ^(0)=""
- SET $PIECE(GMRAY,"^",3,4)=+GMRANS_"^"_($PIECE(GMRAY,"^",4)+1)
- +4 SET DIE="^GMRD(120.84,DA(1),1,"
- SET DA(1)=GMRASITE
- SET DA=+GMRANS
- SET DR=".01"
- DO ^DIE
- +5 IF $GET(^GMRD(120.84,GMRASITE,1,+GMRANS,0))=""
- KILL ^(0)
- SET GMRAY=GMRAX
- +6 IF GMRAY'=GMRAX
- SET ^GMRD(120.84,GMRASITE,1,0)=GMRAY
- +7 if '$DATA(Y)
- GOTO RE10
- LOCK -^GMRD(120.84,GMRASITE)
- GOTO EXIT
- EDCON SET DIE="^GMRD(120.84,"
- SET DA=GMRASITE
- SET DR="2;3;3.5;4;7;7.1;7.2;7.3SEND CHART MARK BULLETIN FOR NEW ADMISSIONS;10;10.1ENABLE COMMENTS FIELD FOR REACTIONS THAT ARE ENTERED IN ERROR"
- DO ^DIE
- +1 IF $DATA(Y)
- LOCK -^GMRD(120.84,GMRASITE)
- GOTO EXIT
- +2 SET X=$GET(^GMRD(120.84,GMRASITE,"RPT"))
- +3 WRITE !!,"REPORTER NAME: ",$PIECE(X,U),!?6,"ADDRESS: ",$PIECE(X,U,2)
- if $LENGTH($PIECE(X,U,3))
- WRITE !?15,$PIECE(X,U,3)
- if $LENGTH($PIECE(X,U,4))
- WRITE !?15,$PIECE(X,U,4)
- WRITE !?9,"CITY: ",$PIECE(X,U,5),!?8,"STATE: ",$PIECE($GET(^DIC(5,+$PIECE(X,U,6),0)),U),!?10,"ZIP: ",$PIECE(X,U,7),!?8,"PHONE: ",$PIECE(X,U,8)
- +4 WRITE !,?3,"OCCUPATION: ",$PIECE(X,U,11)
- +5 FOR
- SET %=2
- WRITE !,"Do you want to edit Reporter Information shown above"
- DO YN^DICN
- if %=-1
- SET %=2
- if %
- QUIT
- WRITE !?3,"ENTER YES TO CHANGE/ADD THE SITE'S DEFAULT REPORTER INFORMATION",!?3,"THAT WILL APPEAR ON THE FDA ADR REPORTS, ELSE ANSWER NO."
- +6 IF %'=1
- LOCK -^GMRD(120.84,GMRASITE)
- GOTO EXIT
- +7 SET DIE="^GMRD(120.84,"
- SET DA=GMRASITE
- SET DR="11:19"
- DO ^DIE
- +8 LOCK -^GMRD(120.84,GMRASITE)
- EXIT ;
- +1 DO KILL^XUSCLEAN
- +2 QUIT
- PRT10 ;
- +1 SET GMRAY=$SELECT($DATA(^GMRD(120.84,GMRASITE,1,GMRAX,0)):+^(0),1:0)
- SET GMRAZ=$SELECT($DATA(^GMRD(120.84,GMRASITE,1,GMRAX+5,0)):+^(0),1:0)
- +2 WRITE !,$JUSTIFY(GMRAX,2),".",?4,$SELECT($DATA(^GMRD(120.83,GMRAY,0)):$PIECE(^(0),"^"),1:""),?35,$JUSTIFY(GMRAX+5,2),".",?39,$SELECT($DATA(^GMRD(120.83,GMRAZ,0)):$PIECE(^(0),"^"),1:"")
- +3 QUIT
- EN4 ; ENTRY FROM INPUT TRANSFORM FOR FIELDS .01 AND 22 OF FILE
- +1 ; 120.85, WHERE GMRA=FIELD NUMBER, X IS DATA TO BE TRANSFORMED.
- +2 SET %DT="ETX"
- SET %DT(0)="-NOW"
- DO ^%DT
- SET X=Y
- IF Y<1
- WRITE !?5,"DATE MUST BE IN THE PAST, AND TIME IS NOT A REQUIRED RESPONSE."
- GOTO K4
- +3 SET GMRA(0)=$GET(^GMR(120.85,+$GET(DA),0))
- SET GMRA("HELP")="DATE MUST BE "_$PIECE("GREATER THAN DATE/TIME OBSERVED^LESS THAN DATE/TIME MD NOTIFIED","^",GMRA=.01+1)
- SET %DT(0)=+($EXTRACT("-",GMRA=.01)_$PIECE(GMRA(0),U,$EXTRACT(12,1,GMRA=.01+1)))
- +4 if %DT(0)=0
- GOTO Q4
- SET %DT="TX"
- DO ^%DT
- SET X=Y
- if Y<1
- WRITE !?5,GMRA("HELP")
- if Y>0
- GOTO Q4
- K4 KILL X
- Q4 KILL %DT,GMRA
- +1 QUIT
- +2 ;PROCESS section added with patch 23
- PROCESS ;Additions to 120.82 and 120.83 are no longer allowed
- +1 ;GMRA*4.0*62 Put NTRT message in this routine for display instead
- +2 ;of calling the HDI routine
- +3 ;I $L($T(NTRTMSG^HDISVAP)) D NTRTMSG^HDISVAP() Q
- +4 ;New Term Rapid Turnaround (NTRT) Message
- +5 NEW HDISLNE,HDISTXT
- +6 FOR HDISLNE=1:1
- SET HDISTXT=$PIECE($TEXT(MSG+HDISLNE),";;",2)
- if HDISTXT="END"
- QUIT
- WRITE !?3,HDISTXT
- +7 QUIT
- +8 ;GMRA*4.0*62 comment out unnecessary code - NTRT message will always display now
- +9 ;W !!,"The addition of local reactants and sign/symptoms are no longer"
- +10 ;W !,"allowed. Requests for new terms/concepts should be made through"
- +11 ;W !,"the New Term Rapid Turn-around (NTRT) process.",!
- +12 QUIT
- MSG ;NTRT message text
- +1 ;;
- +2 ;;In support of national standardization of the contents of this file,
- +3 ;;local site addition and modification functions are no longer available.
- +4 ;;If you wish to contact Standards & Terminology Services (STS), request
- +5 ;;a new term, or modify an existing term, please refer to the New
- +6 ;;Term Rapid Turnaround (NTRT) web site located at
- +7 ;;https://vaww.vashare.domain.ext/sites/ntrt/SitePages/Home.aspx
- +8 ;;
- +9 ;;END