- GMRAPEE0 ;HIRMFO/YMP,RM-ENTERRED IN ERROR CHECK ; 10/16/91
- ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
- EN1 ; ENTRY TO SET GMRAERR IF THIS ALLERGY HAS BEEN ENTERED IN ERROR
- S GMRAERR=0
- K GMRAHEAD S GMRAPRNT=0 D EN1^GMRADSP2
- S:GMRAOUT GMRAOUT=GMRAOUT-1 Q:GMRAOUT
- I $P(^GMR(120.8,GMRAPA,0),U,16),$P(^(0),U,18)'="",'$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q
- YNEE K GMRAEIE W !,"Is the reaction information correct" S %=1 D YN^DICN I '% W !?4,$C(7),"ANSWER NO IF THIS ALLERGY IS INCORRECT AND NEEDS TO BE MARKED",!?4,"AS ENTERED IN ERROR, ELSE ANSWER YES." G YNEE
- I %=-1 S GMRAOUT=1 K GMRAPRCT Q
- I %=2 D I $G(GMRAEIE)=1 G YNEE
- .K DIR S DIR(0)="Y",DIR("A")="Mark this reaction as 'Entered-in-Error'"
- .D ^DIR K DIR I $D(DIRUT)!(Y=0) S GMRAEIE=1 Q
- .S GMRAERR=1,DIE="^GMR(120.8,",DA=GMRAPA,DR="22///1;23///NOW;24////"_DUZ D ^DIE
- .D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0))
- .I $P(GMRASITE(0),U,11) S GMRAVCM="E" D ENDING^GMRAPEM1
- .; This patch (#2) will loop through the patient reactions
- .; and ensure that the patient's NKA information is marked
- .; based on the existence of patient reactions.
- .I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D ; true NKA
- ..S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
- ..D ^DIK ; purge the NKA node from 120.86
- ..Q
- .D EN1^GMRAPET0($P(^GMR(120.8,GMRAPA,0),U),GMRAPA,"E",.GMRAOUT)
- .D EN1^GMRAEAB
- .D ; Execute the event point for this reaction
- ..Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
- ..N OROLD,DFN S DFN=$P(GMRAPA(0),U)
- ..D INP^VADPT S X=$O(^ORD(101,"B","GMRA ENTERED IN ERROR",0))_";ORD(101," D EN^XQOR:X K VAIN,X
- ..Q
- .Q
- K %,DA,DIE,DR,GMRASITE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPEE0 1688 printed Jan 18, 2025@02:41:07 Page 2
- GMRAPEE0 ;HIRMFO/YMP,RM-ENTERRED IN ERROR CHECK ; 10/16/91
- +1 ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
- EN1 ; ENTRY TO SET GMRAERR IF THIS ALLERGY HAS BEEN ENTERED IN ERROR
- +1 SET GMRAERR=0
- +2 KILL GMRAHEAD
- SET GMRAPRNT=0
- DO EN1^GMRADSP2
- +3 if GMRAOUT
- SET GMRAOUT=GMRAOUT-1
- if GMRAOUT
- QUIT
- +4 IF $PIECE(^GMR(120.8,GMRAPA,0),U,16)
- IF $PIECE(^(0),U,18)'=""
- IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- QUIT
- YNEE KILL GMRAEIE
- WRITE !,"Is the reaction information correct"
- SET %=1
- DO YN^DICN
- IF '%
- WRITE !?4,$CHAR(7),"ANSWER NO IF THIS ALLERGY IS INCORRECT AND NEEDS TO BE MARKED",!?4,"AS ENTERED IN ERROR, ELSE ANSWER YES."
- GOTO YNEE
- +1 IF %=-1
- SET GMRAOUT=1
- KILL GMRAPRCT
- QUIT
- +2 IF %=2
- Begin DoDot:1
- +3 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Mark this reaction as 'Entered-in-Error'"
- +4 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!(Y=0)
- SET GMRAEIE=1
- QUIT
- +5 SET GMRAERR=1
- SET DIE="^GMR(120.8,"
- SET DA=GMRAPA
- SET DR="22///1;23///NOW;24////"_DUZ
- DO ^DIE
- +6 DO SITE^GMRAUTL
- SET GMRASITE(0)=$GET(^GMRD(120.84,GMRASITE,0))
- +7 IF $PIECE(GMRASITE(0),U,11)
- SET GMRAVCM="E"
- DO ENDING^GMRAPEM1
- +8 ; This patch (#2) will loop through the patient reactions
- +9 ; and ensure that the patient's NKA information is marked
- +10 ; based on the existence of patient reactions.
- +11 ; true NKA
- IF $$NKASCR^GMRANKA($PIECE(^GMR(120.8,GMRAPA,0),U))
- Begin DoDot:2
- +12 SET DIK="^GMR(120.86,"
- SET DA=$PIECE(^GMR(120.8,GMRAPA,0),U)
- +13 ; purge the NKA node from 120.86
- DO ^DIK
- +14 QUIT
- End DoDot:2
- +15 DO EN1^GMRAPET0($PIECE(^GMR(120.8,GMRAPA,0),U),GMRAPA,"E",.GMRAOUT)
- +16 DO EN1^GMRAEAB
- +17 ; Execute the event point for this reaction
- Begin DoDot:2
- +18 if '$DATA(GMRAPA)
- QUIT
- SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- if GMRAPA(0)=""
- QUIT
- +19 NEW OROLD,DFN
- SET DFN=$PIECE(GMRAPA(0),U)
- +20 DO INP^VADPT
- SET X=$ORDER(^ORD(101,"B","GMRA ENTERED IN ERROR",0))_";ORD(101,"
- if X
- DO EN^XQOR
- KILL VAIN,X
- +21 QUIT
- End DoDot:2
- +22 QUIT
- End DoDot:1
- IF $GET(GMRAEIE)=1
- GOTO YNEE
- +23 KILL %,DA,DIE,DR,GMRASITE
- +24 QUIT