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 Oct 16, 2024@17:40:05 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
