- GMRAPEM4 ;HIRMFO/WAA-EDIT OF DATA TO HISTORICAL STORAGE ; 12/24/91
- ;;4.0;Adverse Reaction Tracking;**51**;Mar 29, 1996;Build 189
- EDIT ; Add/Edit Reaction data
- N GMRAOUT1
- 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" S GMRAOUT1=0 D EN1^GMRAPEH0 I GMRAOUT1 S GMRAOUT=1
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPEM4 1678 printed Jan 18, 2025@02:41:14 Page 2
- GMRAPEM4 ;HIRMFO/WAA-EDIT OF DATA TO HISTORICAL STORAGE ; 12/24/91
- +1 ;;4.0;Adverse Reaction Tracking;**51**;Mar 29, 1996;Build 189
- EDIT ; Add/Edit Reaction data
- +1 NEW GMRAOUT1
- +2 WRITE @IOF
- +3 DO SITE^GMRAUTL
- +4 SET GMRADRUG=$SELECT($PIECE(GMRAPA(0),U,20)["D":1,1:0)
- SET GMRACNT=GMRACNT+1
- +5 if GMRANEW
- GOTO NEW
- +6 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
- +7 WRITE !,$CHAR(7),"THE PERSON INITIALLY ENTERING THIS ALLERGY/ADVERSE REACTION HAS NOT",!,"FINISHED ENTERING THE MANDATORY FIELDS, YOU CANNOT EDIT"
- +8 DO UNLOCK^GMRAUTL(120.8,GMRAPA)
- +9 QUIT
- End DoDot:1
- QUIT
- +10 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"
- SET GMRAOUT1=0
- DO EN1^GMRAPEH0
- IF GMRAOUT1
- SET GMRAOUT=1
- +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