PSODGAL.m

PSODGAL ;BIR/LC-DRUG ALLERGY REACTION CHECKING ;03-Oct-2012 16:10;DU

 ;;7.0;OUTPATIENT PHARMACY;**26,243,1015**;DEC 1997;Build 62

 ;External reference to ^GMRADPT supported by DBIA 10099

 ;External reference to ORCHK^GMRAOR supported by DBIA 2378

 ;External reference to $P(^GMR(120.8,LP,3),"^",3) supp. by DBIA 2214

 ;External reference to ^PS(50.605 supported by DBIA 696

 ;External reference to EN1^GMRAOR2 supported by DBIA 2422

 ;External reference to GETDATA^GMRAOR supported by DBIA 4847

 ;External reference to ^TMP("GMRAOC" supported by DBIA 4848

 ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076

 ;Modified - IHS/MSC/MGH - 04/06/2012 - Allergy reactions added patch 1014

CHK(DFN,TYP,PTR) ;matched to ndf

 ;IHS/MSC/MGH - 04/06/2012

 ;K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR) D:$G(PSOACK)=1

 K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR,"",1,1) D:$G(PSOACK)=1

 .Q:$D(^XUSEC("PSORPH",DUZ))

 .S ^TMP("PSODAI",$J,0)=1

 .S I=0 F  S I=$O(GMRAING(I)) Q:'I  S ^TMP("PSODAI",$J,I,0)=GMRAING(I)

 D:$G(PSOACK)=1 DSPLY

 ;IHS/MSC/MGH - 04/06/12

 ;K PSOACK,GMRAING,I

 K PSOACK,GMRAING,GMRAREAC,I,GMRACOM

 Q

CHK1(DFN) ;not matched to ndf

 K ^TMP("PSODAI",$J)

 S GMRA="0^0^001" D ^GMRADPT F LP=0:0 S LP=$O(GMRAL(LP)) Q:'LP!($G(PSOACK))  D:$D(^GMR(120.8,LP,0))

 .S:'$D(PSOACK) APTR=$P(^GMR(120.8,LP,0),"^",3)

 .I $P(APTR,";",2)="PSDRUG(",$P(APTR,";")=PSODRUG("IEN") S PSOACK=1

 .Q:$D(^XUSEC("PSORPH",DUZ))  S:$G(PSOACK)=1 ^TMP("PSODAI",$J,0)=1

 .;IHS/MSC/MGH Updated for reactions patch 1015

 .D GETREAC^GMRAOR(LP)

 .D GETCOM^GMRAOR(LP)

 D:$G(PSOACK)=1 DSPLY

 K APTR,GMRA,GMRAL,LP,PSOACK

 Q

 ;

CLASS(DFN) ;

 N CPT,CLCHK,CT,AGNL,CC,GMRA,LEN

 S LEN=4

 I $E(PSODRUG("VA CLASS"),1,4)="CN10" S LEN=5 ;look at 5 chars if ANALGESICS

 K ^TMP($J,"PSODRCLS")

 I $T(GETDATA^GMRAOR)]"" G CLASS2 ; CHECK FOR EXISTENCE OF NEW ENTRY POINT BEFORE USING

 S CLCHK=""

 S GMRA="0^0^111" D ^GMRADPT F CC=0:0 S CC=$O(GMRAL(CC)) Q:'CC  D

 .K AGNL D EN1^GMRAOR2(CC,"AGNL")

 .I $D(AGNL("V")) F CT=0:1 S CPT=$O(AGNL("V",CT)) Q:'CPT  I $E($P($G(AGNL("V",CPT)),"^"),1,LEN)=$E(PSODRUG("VA CLASS"),1,LEN) D

 ..S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=$P($G(AGNL("V",CPT)),"^")_" "_$P($G(AGNL("V",CPT)),"^",2)

 ..;IHS/MSC/MGH Updated for reactions Patch 1015

 ..N K S K=0 S K=$O(AGNL("S",K)) Q:'+K  D

 ...I K=1 S ^TMP($J,"PSODRCLS","REAC",K)="Reactions: "_$G(AGNL("S",K))

 ...E  S ^TMP($J,"PSODRCLS","REAC",K)=$G(AGNL("S",K))

 ..;IHS/MSC/MGH Updated for reactions Patch 1015

 ..N K S K=0 S K=$O(AGNL("C",K)) Q:'+K  D

 ...I K=1 S ^TMP($J,"PSODRCLS","COM",K)="Comments: "_$G(AGNL("C",K))

 ...E  S ^TMP($J,"PSODRCLS","COM",K)=$G(AGNL("C",K))

 ..;END MOD

 G CLASSDSP

CLASS2 ;

 N RET,K,L

 S RET=$$DRCL(DFN)

 I '$G(RET) Q

 S CLCHK="",CT="" F  S CT=$O(GMRADRCL(CT)) Q:CT=""  D

 .I $E(PSODRUG("VA CLASS"),1,LEN)=$E(CT,1,LEN) D

 ..S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=CT_" "_$P(GMRADRCL(CT),"^",2)

 ..;IHS/MSC/MGH Modified for adding reactions patch 1015

 ..S K=0 F  S K=$O(GMRAREAC(CT,K)) Q:'+K  D

 ...I K=1 S ^TMP($J,"PSODRCLS","REAC",K)="Reactions: "_$G(GMRAREAC(CT,K))

 ...E  S ^TMP($J,"PSODRCLS",CLCHK,"REAC",K)=$G(GMRAREAC(CT,K))

 ..;IHS/MSC/MGH Modified for adding comments patch 1015

 ..S K=0 F  S K=$O(GMRACOM(CT,K)) Q:'+K  D

 ...I K=1 S ^TMP($J,"PSODRCLS",CLCHK,"COM",K)="Comments: "_$G(GMRACOM(CT,K))

 ...E  S ^TMP($J,"PSODRCLS",CLCHK,"COM",K)=$G(GMRACOM(CT,K))

 ..;END MOD

CLASSDSP ;

 I '$D(^TMP($J,"PSODRCLS")) Q

 W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!

 W !,"Drug: "_PSODRUG("NAME")

 S CT="" F  S CT=$O(^TMP($J,"PSODRCLS",CT)) Q:'CT  W !,"Drug Class: "_^TMP($J,"PSODRCLS",CT)

 ;IHS/MSC/MGH added patch 1015 for reactions

 S K=0 F  S K=$O(^TMP($J,"PSODRCLS","REAC",K)) Q:K=""  D

 .W !,$G(^TMP($J,"PSODRCLS","REAC",K))

 ;IHS/MSC/MGH added patch 1015 for comments

 S K=0 F  S K=$O(^TMP($J,"PSODRCLS","COM",K)) Q:K=""  D

 .W !,$G(^TMP($J,"PSODRCLS","COM",K))

 ;END MOD

 K ^TMP($J,"PSODRCLS")

 S DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"

 S DIR("?")="       'NO' if you DON'T want to enter a reaction for this medication,"

 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR

 I Y D ^PSORXI

 I '$G(Y) K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q

 Q

DSPLY ;

 W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!

 I $D(^XUSEC("PSORPH",DUZ)) D

 .W !,"Drug: "_PSODRUG("NAME") I $O(GMRAING(0)) W !,?6,"Ingredients: "

 .S DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"

 .S DIR("?")="       'NO' if you DON'T want to enter a reaction for this medication,"

 .W ?19 S I=0 F  S I=$O(GMRAING(I)) Q:'I  W:$X+$L($G(GMRAING(I)))+2>IOM !?19 W $G(GMRAING(I))_", "

 .;IHS/MSC/MGH Added for reactions

 .I $O(GMRAREAC(0)) D

 ..W !,?6,"Reactions: "

 ..W ?19 S I=0 F  S I=$O(GMRAREAC(I)) Q:'I  W:$X+$L($G(GMRAREAC(I)))+2>IOM !?19 W $G(GMRAREAC(I))_", "

 .;IHS/MSC/MGH Added for comments

 .I $O(GMRACOM(0)) D

 ..W !,?6,"Comments: "

 ..S K=0 F  S K=$O(GMRACOM(K)) Q:'+K  D

 ...S L=0 F  S L=$O(GMRACOM(K,L)) Q:'+L  D

 ....W ?19,$G(GMRACOM(K,L,0))_" "

 .;END MOD

 .S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR

 .I 'Y K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q

 .I Y D ^PSORXI

 K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,I,K,L

 Q

 ;

DRCL(DFN) ;

 ;IHS/MSC/MGH - 04/06/12

 ;N RET

 N RET,J

 S RET=0

 K GMRADRCL

 D GETDATA^GMRAOR(DFN)

 Q:'$D(^TMP("GMRAOC",$J,"APC")) 0

 N GMRACL

 S GMRACL="" F  S GMRACL=$O(^TMP("GMRAOC",$J,"APC",GMRACL)) Q:'$L(GMRACL)  D

 .N GMRANM,GMRALOC

 .S GMRALOC=^TMP("GMRAOC",$J,"APC",GMRACL)

 .S GMRANM=$P(^PS(50.605,+$O(^PS(50.605,"B",GMRACL,0)),0),U,2)

 .S GMRADRCL(GMRACL)=GMRACL_U_GMRANM_" ("_GMRALOC_")"

 .;IHS/MSC/MGH added for reaction data

 .S J=0 F  S J=$O(^TMP("GMRAOC",$J,"APC",GMRACL,"REAC",J)) Q:'+J  D

 ..S GMRAREAC(GMRACL,J)=$G(^TMP("GMRAOC",$J,"APC",GMRACL,"REAC",J))

 .;IHS/MSC/MGH added for comment data

 .S J=0 F  S J=$O(^TMP("GMRAOC",$J,"APC",GMRACL,"COM",J)) Q:'+J  D

 ..S GMRACOM(GMRACL,J)=$G(^TMP("GMRAOC",$J,"APC",GMRACL,"COM",J))

 .;END MOD

 .S RET=RET+1

 K ^TMP("GMRAOC",$J)

 Q RET

PSODGAL   ;BIR/LC-DRUG ALLERGY REACTION CHECKING ;03-Oct-2012 16:10;DU

 +1       ;;7.0;OUTPATIENT PHARMACY;**26,243,1015**;DEC 1997;Build 62

 +2       ;External reference to ^GMRADPT supported by DBIA 10099

 +3       ;External reference to ORCHK^GMRAOR supported by DBIA 2378

 +4       ;External reference to $P(^GMR(120.8,LP,3),"^",3) supp. by DBIA 2214

 +5       ;External reference to ^PS(50.605 supported by DBIA 696

 +6       ;External reference to EN1^GMRAOR2 supported by DBIA 2422

 +7       ;External reference to GETDATA^GMRAOR supported by DBIA 4847

 +8       ;External reference to ^TMP("GMRAOC" supported by DBIA 4848

 +9       ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076

 +10      ;Modified - IHS/MSC/MGH - 04/06/2012 - Allergy reactions added patch 1014

CHK(DFN,TYP,PTR) ;matched to ndf

 +1       ;IHS/MSC/MGH - 04/06/2012

 +2       ;K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR) D:$G(PSOACK)=1

 +3        KILL ^TMP("PSODAI",$JOB)

           SET PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR,"",1,1)

           IF $GET(PSOACK)=1

               Begin DoDot:1

 +4                IF $DATA(^XUSEC("PSORPH",DUZ))

                       QUIT 

 +5                SET ^TMP("PSODAI",$JOB,0)=1

 +6                SET I=0

                   FOR 

                       SET I=$ORDER(GMRAING(I))

                       IF 'I

                           QUIT 

                       SET ^TMP("PSODAI",$JOB,I,0)=GMRAING(I)

               End DoDot:1

 +7        IF $GET(PSOACK)=1

               DO DSPLY

 +8       ;IHS/MSC/MGH - 04/06/12

 +9       ;K PSOACK,GMRAING,I

 +10       KILL PSOACK,GMRAING,GMRAREAC,I,GMRACOM

 +11       QUIT 

CHK1(DFN) ;not matched to ndf

 +1        KILL ^TMP("PSODAI",$JOB)

 +2        SET GMRA="0^0^001"

           DO ^GMRADPT

           FOR LP=0:0

               SET LP=$ORDER(GMRAL(LP))

               IF 'LP!($GET(PSOACK))

                   QUIT 

               IF $DATA(^GMR(120.8,LP,0))

                   Begin DoDot:1

 +3                    IF '$DATA(PSOACK)

                           SET APTR=$PIECE(^GMR(120.8,LP,0),"^",3)

 +4                    IF $PIECE(APTR,";",2)="PSDRUG("

                           IF $PIECE(APTR,";")=PSODRUG("IEN")

                               SET PSOACK=1

 +5                    IF $DATA(^XUSEC("PSORPH",DUZ))

                           QUIT 

                       IF $GET(PSOACK)=1

                           SET ^TMP("PSODAI",$JOB,0)=1

 +6       ;IHS/MSC/MGH Updated for reactions patch 1015

 +7                    DO GETREAC^GMRAOR(LP)

 +8                    DO GETCOM^GMRAOR(LP)

                   End DoDot:1

 +9        IF $GET(PSOACK)=1

               DO DSPLY

 +10       KILL APTR,GMRA,GMRAL,LP,PSOACK

 +11       QUIT 

 +12      ;

CLASS(DFN) ;

 +1        NEW CPT,CLCHK,CT,AGNL,CC,GMRA,LEN

 +2        SET LEN=4

 +3       ;look at 5 chars if ANALGESICS

           IF $EXTRACT(PSODRUG("VA CLASS"),1,4)="CN10"

               SET LEN=5

 +4        KILL ^TMP($JOB,"PSODRCLS")

 +5       ; CHECK FOR EXISTENCE OF NEW ENTRY POINT BEFORE USING

           IF $TEXT(GETDATA^GMRAOR)]""

               GOTO CLASS2

 +6        SET CLCHK=""

 +7        SET GMRA="0^0^111"

           DO ^GMRADPT

           FOR CC=0:0

               SET CC=$ORDER(GMRAL(CC))

               IF 'CC

                   QUIT 

               Begin DoDot:1

 +8                KILL AGNL

                   DO EN1^GMRAOR2(CC,"AGNL")

 +9                IF $DATA(AGNL("V"))

                       FOR CT=0:1

                           SET CPT=$ORDER(AGNL("V",CT))

                           IF 'CPT

                               QUIT 

                           IF $EXTRACT($PIECE($GET(AGNL("V",CPT)),"^"),1,LEN)=$EXTRACT(PSODRUG("VA CLASS"),1,LEN)

                               Begin DoDot:2

 +10                               SET CLCHK=$GET(CLCHK)+1

                                   SET ^TMP($JOB,"PSODRCLS",CLCHK)=$PIECE($GET(AGNL("V",CPT)),"^")_" "_$PIECE($GET(AGNL("V",CPT)),"^",2)

 +11      ;IHS/MSC/MGH Updated for reactions Patch 1015

 +12                               NEW K

                                   SET K=0

                                   SET K=$ORDER(AGNL("S",K))

                                   IF '+K

                                       QUIT 

                                   Begin DoDot:3

 +13                                   IF K=1

                                           SET ^TMP($JOB,"PSODRCLS","REAC",K)="Reactions: "_$GET(AGNL("S",K))

 +14                                  IF '$TEST

                                           SET ^TMP($JOB,"PSODRCLS","REAC",K)=$GET(AGNL("S",K))

                                   End DoDot:3

 +15      ;IHS/MSC/MGH Updated for reactions Patch 1015

 +16                               NEW K

                                   SET K=0

                                   SET K=$ORDER(AGNL("C",K))

                                   IF '+K

                                       QUIT 

                                   Begin DoDot:3

 +17                                   IF K=1

                                           SET ^TMP($JOB,"PSODRCLS","COM",K)="Comments: "_$GET(AGNL("C",K))

 +18                                  IF '$TEST

                                           SET ^TMP($JOB,"PSODRCLS","COM",K)=$GET(AGNL("C",K))

                                   End DoDot:3

 +19      ;END MOD

                               End DoDot:2

               End DoDot:1

 +20       GOTO CLASSDSP

CLASS2    ;

 +1        NEW RET,K,L

 +2        SET RET=$$DRCL(DFN)

 +3        IF '$GET(RET)

               QUIT 

 +4        SET CLCHK=""

           SET CT=""

           FOR 

               SET CT=$ORDER(GMRADRCL(CT))

               IF CT=""

                   QUIT 

               Begin DoDot:1

 +5                IF $EXTRACT(PSODRUG("VA CLASS"),1,LEN)=$EXTRACT(CT,1,LEN)

                       Begin DoDot:2

 +6                        SET CLCHK=$GET(CLCHK)+1

                           SET ^TMP($JOB,"PSODRCLS",CLCHK)=CT_" "_$PIECE(GMRADRCL(CT),"^",2)

 +7       ;IHS/MSC/MGH Modified for adding reactions patch 1015

 +8                        SET K=0

                           FOR 

                               SET K=$ORDER(GMRAREAC(CT,K))

                               IF '+K

                                   QUIT 

                               Begin DoDot:3

 +9                                IF K=1

                                       SET ^TMP($JOB,"PSODRCLS","REAC",K)="Reactions: "_$GET(GMRAREAC(CT,K))

 +10                              IF '$TEST

                                       SET ^TMP($JOB,"PSODRCLS",CLCHK,"REAC",K)=$GET(GMRAREAC(CT,K))

                               End DoDot:3

 +11      ;IHS/MSC/MGH Modified for adding comments patch 1015

 +12                       SET K=0

                           FOR 

                               SET K=$ORDER(GMRACOM(CT,K))

                               IF '+K

                                   QUIT 

                               Begin DoDot:3

 +13                               IF K=1

                                       SET ^TMP($JOB,"PSODRCLS",CLCHK,"COM",K)="Comments: "_$GET(GMRACOM(CT,K))

 +14                              IF '$TEST

                                       SET ^TMP($JOB,"PSODRCLS",CLCHK,"COM",K)=$GET(GMRACOM(CT,K))

                               End DoDot:3

 +15      ;END MOD

                       End DoDot:2

               End DoDot:1

CLASSDSP  ;

 +1        IF '$DATA(^TMP($JOB,"PSODRCLS"))

               QUIT 

 +2        WRITE $CHAR(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!

 +3        WRITE !,"Drug: "_PSODRUG("NAME")

 +4        SET CT=""

           FOR 

               SET CT=$ORDER(^TMP($JOB,"PSODRCLS",CT))

               IF 'CT

                   QUIT 

               WRITE !,"Drug Class: "_^TMP($JOB,"PSODRCLS",CT)

 +5       ;IHS/MSC/MGH added patch 1015 for reactions

 +6        SET K=0

           FOR 

               SET K=$ORDER(^TMP($JOB,"PSODRCLS","REAC",K))

               IF K=""

                   QUIT 

               Begin DoDot:1

 +7                WRITE !,$GET(^TMP($JOB,"PSODRCLS","REAC",K))

               End DoDot:1

 +8       ;IHS/MSC/MGH added patch 1015 for comments

 +9        SET K=0

           FOR 

               SET K=$ORDER(^TMP($JOB,"PSODRCLS","COM",K))

               IF K=""

                   QUIT 

               Begin DoDot:1

 +10               WRITE !,$GET(^TMP($JOB,"PSODRCLS","COM",K))

               End DoDot:1

 +11      ;END MOD

 +12       KILL ^TMP($JOB,"PSODRCLS")

 +13       SET DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"

 +14       SET DIR("?")="       'NO' if you DON'T want to enter a reaction for this medication,"

 +15       SET DIR(0)="SA^1:YES;0:NO"

           SET DIR("A")="Do you want to Intervene? "

           SET DIR("B")="Y"

           WRITE !

           DO ^DIR

 +16       IF Y

               DO ^PSORXI

 +17       IF '$GET(Y)

               KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y

               QUIT 

 +18       QUIT 

DSPLY     ;

 +1        WRITE $CHAR(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!

 +2        IF $DATA(^XUSEC("PSORPH",DUZ))

               Begin DoDot:1

 +3                WRITE !,"Drug: "_PSODRUG("NAME")

                   IF $ORDER(GMRAING(0))

                       WRITE !,?6,"Ingredients: "

 +4                SET DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"

 +5                SET DIR("?")="       'NO' if you DON'T want to enter a reaction for this medication,"

 +6                WRITE ?19

                   SET I=0

                   FOR 

                       SET I=$ORDER(GMRAING(I))

                       IF 'I

                           QUIT 

                       IF $X+$LENGTH($GET(GMRAING(I)))+2>IOM

                           WRITE !?19

                       WRITE $GET(GMRAING(I))_", "

 +7       ;IHS/MSC/MGH Added for reactions

 +8                IF $ORDER(GMRAREAC(0))

                       Begin DoDot:2

 +9                        WRITE !,?6,"Reactions: "

 +10                       WRITE ?19

                           SET I=0

                           FOR 

                               SET I=$ORDER(GMRAREAC(I))

                               IF 'I

                                   QUIT 

                               IF $X+$LENGTH($GET(GMRAREAC(I)))+2>IOM

                                   WRITE !?19

                               WRITE $GET(GMRAREAC(I))_", "

                       End DoDot:2

 +11      ;IHS/MSC/MGH Added for comments

 +12               IF $ORDER(GMRACOM(0))

                       Begin DoDot:2

 +13                       WRITE !,?6,"Comments: "

 +14                       SET K=0

                           FOR 

                               SET K=$ORDER(GMRACOM(K))

                               IF '+K

                                   QUIT 

                               Begin DoDot:3

 +15                               SET L=0

                                   FOR 

                                       SET L=$ORDER(GMRACOM(K,L))

                                       IF '+L

                                           QUIT 

                                       Begin DoDot:4

 +16                                       WRITE ?19,$GET(GMRACOM(K,L,0))_" "

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +17      ;END MOD

 +18               SET DIR(0)="SA^1:YES;0:NO"

                   SET DIR("A")="Do you want to Intervene? "

                   SET DIR("B")="Y"

                   WRITE !

                   DO ^DIR

 +19               IF 'Y

                       KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y

                       QUIT 

 +20               IF Y

                       DO ^PSORXI

               End DoDot:1

 +21       KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,I,K,L

 +22       QUIT 

 +23      ;

DRCL(DFN) ;

 +1       ;IHS/MSC/MGH - 04/06/12

 +2       ;N RET

 +3        NEW RET,J

 +4        SET RET=0

 +5        KILL GMRADRCL

 +6        DO GETDATA^GMRAOR(DFN)

 +7        IF '$DATA(^TMP("GMRAOC",$JOB,"APC"))

               QUIT 0

 +8        NEW GMRACL

 +9        SET GMRACL=""

           FOR 

               SET GMRACL=$ORDER(^TMP("GMRAOC",$JOB,"APC",GMRACL))

               IF '$LENGTH(GMRACL)

                   QUIT 

               Begin DoDot:1

 +10               NEW GMRANM,GMRALOC

 +11               SET GMRALOC=^TMP("GMRAOC",$JOB,"APC",GMRACL)

 +12               SET GMRANM=$PIECE(^PS(50.605,+$ORDER(^PS(50.605,"B",GMRACL,0)),0),U,2)

 +13               SET GMRADRCL(GMRACL)=GMRACL_U_GMRANM_" ("_GMRALOC_")"

 +14      ;IHS/MSC/MGH added for reaction data

 +15               SET J=0

                   FOR 

                       SET J=$ORDER(^TMP("GMRAOC",$JOB,"APC",GMRACL,"REAC",J))

                       IF '+J

                           QUIT 

                       Begin DoDot:2

 +16                       SET GMRAREAC(GMRACL,J)=$GET(^TMP("GMRAOC",$JOB,"APC",GMRACL,"REAC",J))

                       End DoDot:2

 +17      ;IHS/MSC/MGH added for comment data

 +18               SET J=0

                   FOR 

                       SET J=$ORDER(^TMP("GMRAOC",$JOB,"APC",GMRACL,"COM",J))

                       IF '+J

                           QUIT 

                       Begin DoDot:2

 +19                       SET GMRACOM(GMRACL,J)=$GET(^TMP("GMRAOC",$JOB,"APC",GMRACL,"COM",J))

                       End DoDot:2

 +20      ;END MOD

 +21               SET RET=RET+1

               End DoDot:1

 +22       KILL ^TMP("GMRAOC",$JOB)

 +23       QUIT RET