GMRAPEH0.m

GMRAPEH0 ;HIRMFO/WAA,RM-EDIT A/AR DATA FOR A HISTORICAL ALLERGY ;21-Jan-2011 15:17;DU

 ;;4.0;Adverse Reaction Tracking;**1002**;Mar 29, 1996;Build 32

EN1 ; ENTRY FROM MAIN A/AR EDIT TO EDIT HISTORICAL A/AR

 D EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT) G:GMRAOUT EXIT

 ;IHS/MSC/MGH Mechanism is now calulated form snomed codes

 ;I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D MECH^GMRAPED0

 G EXIT:GMRAOUT

 ;Add the SNOMED event IHS/MSC/MGH

 D EVENT^GMRAPED0

 G EXIT:GMRAOUT

COM S GMRAVCM="O" D ENDING^GMRAPEM1

 I $D(DTOUT)!$D(Y) S GMRAOUT=1

 I 'GMRAOUT D COMCHECK

 I 'GMRAOUT G:GMRAREQ COM

 S GMRAOUT=0

 K DA,DR,DIE,DUOUT,DTOUT

 Q

COMCHECK ; CHECK TO SEE IF COMMENTS ARE REQUIRED

 S GMRAREQ=($P($G(^GMRD(120.84,+GMRASITE,0)),"^",4)=1) Q:'GMRAREQ

 S X=0,X=$O(^GMR(120.8,GMRAPA,26,X)),GMRAREQ=(X'>0)

 I GMRAREQ W !!,$C(7),"COMMENTS ARE REQUIRED." D HANGT

 I $D(DIRUT) S GMRAOUT=1

 K DIRUT

 Q

HANGT ;Hang for TIMEOUT or press return

 N DIR

 S DIR(0)="EA",DIR("A")="Press RETURN to continue"

 D ^DIR

 Q

EXIT ;

 K DA,DIK,DR,GMRADT,GMRAR10,GMRAPA1,GMRARAD,GMRARDL,GMRAREC,GMRADATE,GMRARODT,GMRAROT,GMRARPR,GMRAX,GMRAY,GMRAZN

 Q

GMRAPEH0  ;HIRMFO/WAA,RM-EDIT A/AR DATA FOR A HISTORICAL ALLERGY ;21-Jan-2011 15:17;DU

 +1       ;;4.0;Adverse Reaction Tracking;**1002**;Mar 29, 1996;Build 32

EN1       ; ENTRY FROM MAIN A/AR EDIT TO EDIT HISTORICAL A/AR

 +1        DO EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT)

           IF GMRAOUT

               GOTO EXIT

 +2       ;IHS/MSC/MGH Mechanism is now calulated form snomed codes

 +3       ;I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D MECH^GMRAPED0

 +4        IF GMRAOUT

               GOTO EXIT

 +5       ;Add the SNOMED event IHS/MSC/MGH

 +6        DO EVENT^GMRAPED0

 +7        IF GMRAOUT

               GOTO EXIT

COM        SET GMRAVCM="O"

           DO ENDING^GMRAPEM1

 +1        IF $DATA(DTOUT)!$DATA(Y)

               SET GMRAOUT=1

 +2        IF 'GMRAOUT

               DO COMCHECK

 +3        IF 'GMRAOUT

               IF GMRAREQ

                   GOTO COM

 +4        SET GMRAOUT=0

 +5        KILL DA,DR,DIE,DUOUT,DTOUT

 +6        QUIT 

COMCHECK  ; CHECK TO SEE IF COMMENTS ARE REQUIRED

 +1        SET GMRAREQ=($PIECE($GET(^GMRD(120.84,+GMRASITE,0)),"^",4)=1)

           IF 'GMRAREQ

               QUIT 

 +2        SET X=0

           SET X=$ORDER(^GMR(120.8,GMRAPA,26,X))

           SET GMRAREQ=(X'>0)

 +3        IF GMRAREQ

               WRITE !!,$CHAR(7),"COMMENTS ARE REQUIRED."

               DO HANGT

 +4        IF $DATA(DIRUT)

               SET GMRAOUT=1

 +5        KILL DIRUT

 +6        QUIT 

HANGT     ;Hang for TIMEOUT or press return

 +1        NEW DIR

 +2        SET DIR(0)="EA"

           SET DIR("A")="Press RETURN to continue"

 +3        DO ^DIR

 +4        QUIT 

EXIT      ;

 +1        KILL DA,DIK,DR,GMRADT,GMRAR10,GMRAPA1,GMRARAD,GMRARDL,GMRAREC,GMRADATE,GMRARODT,GMRAROT,GMRARPR,GMRAX,GMRAY,GMRAZN

 +2        QUIT