- 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 ---[H[J[2J[HGMRAPEM3 1116 printed Jan 18, 2025@02:41:13 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