GMRAPEM4.m

GMRAPEM4 ;HIRMFO/WAA-EDIT OF DATA TO HISTORICAL STORAGE ; 12/24/91

 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EDIT ; Add/Edit Reaction data

 W @IOF

 D SITE^GMRAUTL

 S GMRADRUG=$S($P(GMRAPA(0),U,20)["D":1,1:0),GMRACNT=GMRACNT+1

 G:GMRANEW NEW

 I '$P(GMRAPA(0),"^",12),$P(GMRAPA(0),"^",5)'=DUZ,'$D(^XUSEC("GMRA-SUPERVISOR",DUZ)),'$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D  Q

 .W !,$C(7),"THE PERSON INITIALLY ENTERING THIS ALLERGY/ADVERSE REACTION HAS NOT",!,"FINISHED ENTERING THE MANDATORY FIELDS, YOU CANNOT EDIT"

 .D UNLOCK^GMRAUTL(120.8,GMRAPA)

 .Q

 I $P(GMRAPA(0),"^",12) D UNLOCK^GMRAUTL(120.8,GMRAPA) Q

NEW S DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction",DIE="^GMR(120.8,",DA=GMRAPA D ^DIE I $D(Y) S GMRAOUT=1 Q

 S GMRANEW(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"") W:$P(GMRANEW(0),"^",6)']"" $C(7),"  Required??"

 G NEW:$P(GMRANEW(0),"^",6)']"",EDAT:$P(GMRANEW(0),"^",6)=$P(GMRAPA(0),"^",6)

YNNW I $P(GMRAPA(0),"^",6)]"" W !,"Are you sure you want to make that change" S %=1 D YN^DICN I '% W !?4,$C(7),"ANSWER YES IF THE CHANGE IS OK, ELSE ANSWER NO." G YNNW

 I $P(GMRAPA(0),"^",6)]"" I %'=1 S GMRAOUT=(%=-1),DIE="^GMR(120.8,",DR="6////"_$P(GMRAPA(0),"^",6),DA=GMRAPA D ^DIE G NEW:%=2 Q

 S $P(GMRAPA(0),"^",6)=$P(GMRANEW(0),"^",6)

EDAT I $P(GMRAPA(0),"^",6)="o" D EN1^GMRAPEO0

 I $P(GMRAPA(0),"^",6)="h" D EN1^GMRAPEH0

 K GMRAVER S GMRAVER=0

 I 'GMRAOUT D

 .I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q 

 .I $$VFY^GMRASIGN(.GMRAPA) W !,"This Causative Agent will be Auto-verified when it is signed off." Q

 .N GMRAPRNT

 .D EN1^GMRAVFY K GMRALLER,GMRAMEC,GMRAY

 .Q

 Q

GMRAPEM4  ;HIRMFO/WAA-EDIT OF DATA TO HISTORICAL STORAGE ; 12/24/91

 +1       ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EDIT      ; Add/Edit Reaction data

 +1        WRITE @IOF

 +2        DO SITE^GMRAUTL

 +3        SET GMRADRUG=$SELECT($PIECE(GMRAPA(0),U,20)["D":1,1:0)

           SET GMRACNT=GMRACNT+1

 +4        IF GMRANEW

               GOTO NEW

 +5        IF '$PIECE(GMRAPA(0),"^",12)

               IF $PIECE(GMRAPA(0),"^",5)'=DUZ

                   IF '$DATA(^XUSEC("GMRA-SUPERVISOR",DUZ))

                       IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))

                           Begin DoDot:1

 +6                            WRITE !,$CHAR(7),"THE PERSON INITIALLY ENTERING THIS ALLERGY/ADVERSE REACTION HAS NOT",!,"FINISHED ENTERING THE MANDATORY FIELDS, YOU CANNOT EDIT"

 +7                            DO UNLOCK^GMRAUTL(120.8,GMRAPA)

 +8                            QUIT 

                           End DoDot:1

                           QUIT 

 +9        IF $PIECE(GMRAPA(0),"^",12)

               DO UNLOCK^GMRAUTL(120.8,GMRAPA)

               QUIT 

NEW        SET DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction"

           SET DIE="^GMR(120.8,"

           SET DA=GMRAPA

           DO ^DIE

           IF $DATA(Y)

               SET GMRAOUT=1

               QUIT 

 +1        SET GMRANEW(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")

           IF $PIECE(GMRANEW(0),"^",6)']""

               WRITE $CHAR(7),"  Required??"

 +2        IF $PIECE(GMRANEW(0),"^",6)']""

               GOTO NEW

           IF $PIECE(GMRANEW(0),"^",6)=$PIECE(GMRAPA(0),"^",6)

               GOTO EDAT

YNNW       IF $PIECE(GMRAPA(0),"^",6)]""

               WRITE !,"Are you sure you want to make that change"

               SET %=1

               DO YN^DICN

               IF '%

                   WRITE !?4,$CHAR(7),"ANSWER YES IF THE CHANGE IS OK, ELSE ANSWER NO."

                   GOTO YNNW

 +1        IF $PIECE(GMRAPA(0),"^",6)]""

               IF %'=1

                   SET GMRAOUT=(%=-1)

                   SET DIE="^GMR(120.8,"

                   SET DR="6////"_$PIECE(GMRAPA(0),"^",6)

                   SET DA=GMRAPA

                   DO ^DIE

                   IF %=2

                       GOTO NEW

                   QUIT 

 +2        SET $PIECE(GMRAPA(0),"^",6)=$PIECE(GMRANEW(0),"^",6)

EDAT       IF $PIECE(GMRAPA(0),"^",6)="o"

               DO EN1^GMRAPEO0

 +1        IF $PIECE(GMRAPA(0),"^",6)="h"

               DO EN1^GMRAPEH0

 +2        KILL GMRAVER

           SET GMRAVER=0

 +3        IF 'GMRAOUT

               Begin DoDot:1

 +4                IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))

                       QUIT 

 +5                IF $$VFY^GMRASIGN(.GMRAPA)

                       WRITE !,"This Causative Agent will be Auto-verified when it is signed off."

                       QUIT 

 +6                NEW GMRAPRNT

 +7                DO EN1^GMRAVFY

                   KILL GMRALLER,GMRAMEC,GMRAY

 +8                QUIT 

               End DoDot:1

 +9        QUIT