GMRAPEM3.m

GMRAPEM3 ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER ;3/20/06  14:55

 ;;4.0;Adverse Reaction Tracking;**36**;Mar 29, 1996;Build 9

UPOUT ; If the user uparrows out of the process

 I GMRAOUT S GMRAOUT=2-GMRAOUT D:GMRAOUT&($D(^TMP($J,"GMRASF"))) ALERT^GMRASIGN K ^TMP($J,"GMRASF"),GMRACNT,GMRANAM,GMRAPA

 K GMRANAM,GMRAPA

 D CLEAN

 Q

ERR ; If the reaction that is entered in error

 D UNLOCK^GMRAUTL(120.8,GMRAPA)

 N GMRACNT Q:'$D(^TMP($J,"GMRASF","B",GMRAPA))

 S GMRACNT=0 S GMRACNT=$O(^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)) Q:GMRACNT<1

 K ^TMP($J,"GMRASF",GMRACNT,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)

 D CLEAN

 Q

SIGNED ; If the reaction is already signed

 D CLEAN

 Q

UPDATE ; Unlock global and prep for next allergy

 I '$G(GMRAVER,0),'$D(^TMP($J,"GMRASF","B",GMRAPA)) S ^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)=$G(GMRANEW),^TMP($J,"GMRASF",GMRACNT,GMRAPA)=$G(GMRANEW) ;36

 D CLEAN

 Q

CLEAN ; Clean the account for the next reaction.

 K %,DA,DIC,DIE,DIK,DR,GMRACHC,GMRAERR,GMRADRUG,GMRAIV,GMRANEW,GMRAOTH,GMRAPG,GMRAPRNT,GMRAREQ,GMRASEX,GMRASWH,GMRATYPE,GMRAVEDT,X,Y,GMRAVER

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRAPEM3   1116     printed  Apr 09, 2024@20:45:48                                                                                                                                                                                                    Page 2

GMRAPEM3  ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER ;3/20/06  14:55

 +1       ;;4.0;Adverse Reaction Tracking;**36**;Mar 29, 1996;Build 9

UPOUT     ; If the user uparrows out of the process

 +1        IF GMRAOUT

               SET GMRAOUT=2-GMRAOUT

               if GMRAOUT&($DATA(^TMP($JOB,"GMRASF")))

                   DO ALERT^GMRASIGN

               KILL ^TMP($JOB,"GMRASF"),GMRACNT,GMRANAM,GMRAPA

 +2        KILL GMRANAM,GMRAPA

 +3        DO CLEAN

 +4        QUIT 

ERR       ; If the reaction that is entered in error

 +1        DO UNLOCK^GMRAUTL(120.8,GMRAPA)

 +2        NEW GMRACNT

           if '$DATA(^TMP($JOB,"GMRASF","B",GMRAPA))

               QUIT 

 +3        SET GMRACNT=0

           SET GMRACNT=$ORDER(^TMP($JOB,"GMRASF","B",GMRAPA,GMRACNT))

           if GMRACNT<1

               QUIT 

 +4        KILL ^TMP($JOB,"GMRASF",GMRACNT,GMRAPA),^TMP($JOB,"GMRASF","B",GMRAPA,GMRACNT)

 +5        DO CLEAN

 +6        QUIT 

SIGNED    ; If the reaction is already signed

 +1        DO CLEAN

 +2        QUIT 

UPDATE    ; Unlock global and prep for next allergy

 +1       ;36

           IF '$GET(GMRAVER,0)

               IF '$DATA(^TMP($JOB,"GMRASF","B",GMRAPA))

                   SET ^TMP($JOB,"GMRASF","B",GMRAPA,GMRACNT)=$GET(GMRANEW)

                   SET ^TMP($JOB,"GMRASF",GMRACNT,GMRAPA)=$GET(GMRANEW)

 +2        DO CLEAN

 +3        QUIT 

CLEAN     ; Clean the account for the next reaction.

 +1        KILL %,DA,DIC,DIE,DIK,DR,GMRACHC,GMRAERR,GMRADRUG,GMRAIV,GMRANEW,GMRAOTH,GMRAPG,GMRAPRNT,GMRAREQ,GMRASEX,GMRASWH,GMRATYPE,GMRAVEDT,X,Y,GMRAVER

 +2        QUIT