GMRAFUT0 ;HIRMFO/YMP,RFM,WAA-ALLERGY/ADVERSE REACTION FILE UTILITIES ;05-Jun-2012 10:30;DU
;;4.0;Adverse Reaction Tracking;**23,1002,1006**;Mar 29, 1996;Build 29
;IHS/MSC/MGH Modified warning for IHS sites
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
;I $L($T(NTRTMSG^HDISVAP)) D NTRTMSG^HDISVAP() Q
W !!!!,"In support of national standardization of the contents of this file,"
W !,"local site addition and modification functions are no longer available."
W !,"If you wish to request a new term or modify an existing term, please request"
W !,"through the IHS RPMS Feedback web site located at http://www.ihs.gov/RPMS."
W !,"Once at the IHS RPMS Feedback page, select the RPMS Application 'Pharmacy-"
W !,"new Reactant/Symptom Request(PRSR)' to ensure these are reviewed in a timely"
W !,"manner. If you have any questions regarding this new term request process,"
W !,"please contact your local Adverse Reaction Tracking package coordinator.",!
Q
GMRAFUT0 ;HIRMFO/YMP,RFM,WAA-ALLERGY/ADVERSE REACTION FILE UTILITIES ;05-Jun-2012 10:30;DU
+1 ;;4.0;Adverse Reaction Tracking;**23,1002,1006**;Mar 29, 1996;Build 29
+2 ;IHS/MSC/MGH Modified warning for IHS sites
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 ;I $L($T(NTRTMSG^HDISVAP)) D NTRTMSG^HDISVAP() Q
+2 WRITE !!!!,"In support of national standardization of the contents of this file,"
+3 WRITE !,"local site addition and modification functions are no longer available."
+4 WRITE !,"If you wish to request a new term or modify an existing term, please request"
+5 WRITE !,"through the IHS RPMS Feedback web site located at http://www.ihs.gov/RPMS."
+6 WRITE !,"Once at the IHS RPMS Feedback page, select the RPMS Application 'Pharmacy-"
+7 WRITE !,"new Reactant/Symptom Request(PRSR)' to ensure these are reviewed in a timely"
+8 WRITE !,"manner. If you have any questions regarding this new term request process,"
+9 WRITE !,"please contact your local Adverse Reaction Tracking package coordinator.",!
+10 QUIT
