GMRAGUI1 ; SLC/DAN - CPRS GUI support ;May 11, 2021@12:02:23
;;4.0;Adverse Reaction Tracking;**21,25,36,38,42,50,59,63**;Mar 29, 1996;Build 34
;
Q
EN1 ; GETREC, cont'd
OBSV ; Get OBSERVATIONS from file 120.85
S STRING="~OBSERVATIONS" D NEXT
S OBSIEN=0
OBSLOOP S OBSIEN=$O(^GMR(120.85,"C",GMRAIEN,OBSIEN)) G:OBSIEN<1 EXIT
S GMRA(1)=$G(^GMR(120.85,OBSIEN,0)) Q:'$L(GMRA(1))
S STRING="tRecord : "_OBSIEN D NEXT
S USRNAM=""
S USR=$P(GMRA(1),U,13) I USR'="" D GETUSR
S Y=$P(GMRA(1),U,1) X ^DD("DD")
S STRING="tDate/Time of Event: "_Y D NEXT
S STRING="tObserver : "_USRNAM D NEXT
S SEVCOD=$P(GMRA(1),U,14)
S SEVER=$S(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"")
S STRING="tSeverity : "_SEVER D NEXT
S Y=$P(GMRA(1),U,18) X ^DD("DD")
S STRING="tDate Reported : "_Y D NEXT
S USRNAM=""
S USR=$P(GMRA(1),U,19) I USR'="" D GETUSR
S STRING="tReporting User : "_USRNAM D NEXT
S STRING="t" F I=1:1:60 S STRING=STRING_"-"
D NEXT
G OBSLOOP
EXIT Q
NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING=""
Q
GETUSR S USRNAM=$$GET1^DIQ(200,USR_",",".01")
Q
;
EIE(GMRAIEN,GMRADFN,GMRARRAY) ;Mark individual entry as entered in error
N DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA
L +^XTMP("GMRAED",GMRADFN):1 I '$T D MESS Q
S GMRAPA=GMRAIEN
S DIE="^GMR(120.8,",DA=GMRAPA,DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$G(@GMRARRAY@("GMRAERRBY"),.5) ;36
D ^DIE ;Entered in error on date/time by user
I $D(@GMRARRAY@("GMRAERRCMTS")) D ADCOM(GMRAPA,"E",$NA(@GMRARRAY@("GMRAERRCMTS"))) ;add comments
I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D
.S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
.D ^DIK ;If patient's last allergy marked as entered in error then delete assessment
S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
S GMRAOUT=0
D EN1^GMRAEAB ;Sends entered in error bulletin to appropriate mail groups
D EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT) ;21 File Progress Note
S DFN=GMRADFN
D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101,"
D:X EN^XQOR ;Process protocols hanging off of "entered in error" protocol
L -^XTMP("GMRAED",GMRADFN)
S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 Return IEN of progress note if created
Q
;
ADCOM(ENTRY,TYPE,GMRACOM) ;Add comments to allergies
;
N FDA,GMRAI,X,DIWL,DIWR
K ^UTILITY($J,"W") S DIWL=1,DIWR=60 S GMRAI=0 F S GMRAI=$O(@GMRACOM@(GMRAI)) Q:'+GMRAI S X=@GMRACOM@(GMRAI) D ^DIWP
S GMRACOM="^UTILITY($J,""W"",1)"
S FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT
S FDA(120.826,"+1,"_ENTRY_",",1)=DUZ
S FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE
S FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM
D UPDATE^DIE("","FDA")
Q
;
NKA ;Change patient assessment to NKA
;
N DA,DR,DIE,NKA,DFN
S DFN=ORDFN
L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
S NKA=$$NKA^GMRANKA(DFN)
I NKA=0 Q ;Patient is already NKA
I NKA=1 S ORY="-1^Patient has active allergies - can't mark as NKA" Q
L +^GMR(120.86,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
I '$D(^GMR(120.86,DFN,0)) D ;Add assessment entry
.S $P(^GMR(120.86,0),U,3,4)=(DFN_"^"_($P(^GMR(120.86,0),U,4)+1))
.S ^GMR(120.86,DFN,0)=DFN_U,^GMR(120.86,"B",DFN,DFN)=""
L -^GMR(120.86,0) L +^GMR(120.86,DFN,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
S DIE="^GMR(120.86,",DA=DFN,DR="1////0;2////"_DUZ_";3///NOW" D ^DIE
S ORY=0
L -^XTMP("GMRAED",DFN)
Q
;
UPDATE(GMRAIEN,DFN,GMRARRAY) ;Add/edit allergies
N NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT,GMRAPN
S NEW='$G(GMRAIEN)
I NEW,$$DUPCHK^GMRAOR0(DFN,$P(@GMRARRAY@("GMRAGNT"),U))=1 S ORY="-1^Patient already has a "_$P(@GMRARRAY@("GMRAGNT"),U)_" reaction entered. No duplicates allowed." Q
L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
S NKA='$$NKA^GMRANKA(DFN) ;is patient NKA?
I NKA,NEW D
.S FDA(120.86,"?+"_DFN_",",.01)=DFN
.S FDA(120.86,"?+"_DFN_",",1)=1
.S FDA(120.86,"?+"_DFN_",",2)=DUZ
.S FDA(120.86,"?+"_DFN_",",3)=$G(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT)
.S IEN(DFN)=DFN
.D UPDATE^DIE("","FDA","IEN")
K FDA,IEN
S NODE=$S($G(NEW):"+1,",1:(GMRAIEN_","))
S:$G(NEW) FDA(120.8,NODE,.01)=DFN
I $P($G(@GMRARRAY@("GMRAGNT")),U,2)["50.67" S $P(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($P(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6,"
F SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6" D
.S FDA(120.8,NODE,$P(SUB,";",2))=$P(@GMRARRAY@($P(SUB,";")),U)
.I (SUB["GMRAGNT"),NEW S FDA(120.8,NODE,1)=$P(@GMRARRAY@($P(SUB,";")),U,2)
.I SUB["GMRAOBHX",$P(@GMRARRAY@("GMRAOBHX"),U)="h" D
..S FDA(120.8,NODE,8)=$G(@GMRARRAY@("GMRASEVR"))
..S FDA(120.8,NODE,9)=$G(@GMRARRAY@("GMRARDT"))
D UPDATE^DIE("","FDA","IEN")
S:NEW GMRAIEN=IEN(1)
K FDA
F SUB="GMRACHT","GMRAIDBN" D
.;GMRA*4.0*59 - begin changes
.K:SUB="GMRACHT" @GMRARRAY@(SUB) ; end of changes for *59
.Q:'$D(@GMRARRAY@(SUB)) ;Stop if no updates
.S FILE=$S(SUB="GMRACHT":120.813,1:120.814)
.S FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1)
.S FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ
.D UPDATE^DIE("","FDA")
I $D(@GMRARRAY@("GMRACMTS")) D ADCOM(GMRAIEN,"O",$NA(@GMRARRAY@("GMRACMTS"))) ;Add comments if included
K FDA
S SUB=0 F S SUB=$O(@GMRARRAY@("GMRASYMP",SUB)) Q:'+SUB D
.S GMRAS0=^(SUB) ;Naked from above
.Q:$P(^(SUB),U)="" ;25 No text or free text entered so don't store
.S SIEN=$O(^GMR(120.8,GMRAIEN,10,"B",$P(GMRAS0,U),0))
.I SIEN,$P(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$P(GMRAS0,U,3) Q ;Exists and nothing has changed
.I SIEN,$P(GMRAS0,U,5)="@" S DIK="^GMR(120.8,"_GMRAIEN_",",DA(1)=GMRAIEN,DA=SIEN D ^DIK Q ;Sign/symptom deleted
.S:'SIEN FDA(120.81,"+1,"_GMRAIEN_",",.01)=$S($P(GMRAS0,U)="FT":$O(^GMRD(120.83,"B","OTHER REACTION",0)),1:$P(GMRAS0,U))
.S NODE=$S(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",")
.S:$P(GMRAS0,U)="FT" FDA(120.81,NODE,1)=$P(GMRAS0,U,2)
.S FDA(120.81,NODE,2)=DUZ
.S FDA(120.81,NODE,3)=$P(GMRAS0,U,3)
.D UPDATE^DIE("","FDA","","ERR")
.S GMRAROT($P(GMRAS0,U,2))="" ;21 record s/s added
I NEW D
.S GMRALL(GMRAIEN)="" D VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM) D EN7^GMRAMCB ;Send mark chart/ID band bulletin if needed.
.I $P(@GMRARRAY@("GMRAOBHX"),U)="o" D ;if observed reaction add data to 120.85
..S GMRAOUT=0 ;21
..S GMRAL(GMRAIEN,"O",GMRAIEN)=$G(@GMRARRAY@("GMRARDT"))_"^"_$G(@GMRARRAY@("GMRASEVR"))
..S GMRADFN=DFN
..S GMRAL(GMRAIEN)="^^"_$P($G(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$G(@GMRARRAY@("GMRAORIG"))
..M GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP")
..S SUB=0 F S SUB=$O(GMRAL(GMRAIEN,"S",SUB)) Q:'+SUB S $P(GMRAL(GMRAIEN,"S",SUB),U,2)=$P(GMRAL(GMRAIEN,"S",SUB),U,2)_"^" S:$P(GMRAL(GMRAIEN,"S",SUB),U)="FT" $P(GMRAL(GMRAIEN,"S",SUB),U)=$O(^GMRD(120.83,"B","OTHER REACTION",0))
..S GMRAL=GMRAIEN
..D ADVERSE^GMRAOR7(GMRAIEN,.GMRAL) ;adds entry to 120.85
..S GMRAIEN(GMRAIEN)="" ;21
..D EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT) ;21 File progress note
..I $G(@GMRARRAY@("GMRATYPE"))["D" S GMRAPA=GMRAIEN D EN1^GMRAPTB ;21 Send med-watch update
.S GMRAAR=$P($G(@GMRARRAY@("GMRAGNT")),U,2),GMRAPA=GMRAIEN
.D EN1^GMRAOR9 S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;add ingredients/classes send appropriate bulletins
.D GMRACHK^GMRAPEM0(GMRAPA)
S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 If note was created send back IEN
L -^XTMP("GMRAED",DFN)
Q
;
MESS ;Give out locked message
N GMRAXBOS,GMRAL1,GMRAL2
S GMRAXBOS=$$BROKER^XWBLIB ;In GUI?
S GMRAL1="Another user is editing this patient's allergy information."
S GMRAL2="Please refresh/review the patient's information before proceeding."
I 'GMRAXBOS W !,GMRAL1,!,GMRAL2 D WAIT^GMRAFX3 Q
S ORY="-1^"_GMRAL1_" "_GMRAL2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAGUI1 7904 printed Sep 23, 2025@19:15:18 Page 2
GMRAGUI1 ; SLC/DAN - CPRS GUI support ;May 11, 2021@12:02:23
+1 ;;4.0;Adverse Reaction Tracking;**21,25,36,38,42,50,59,63**;Mar 29, 1996;Build 34
+2 ;
+3 QUIT
EN1 ; GETREC, cont'd
OBSV ; Get OBSERVATIONS from file 120.85
+1 SET STRING="~OBSERVATIONS"
DO NEXT
+2 SET OBSIEN=0
OBSLOOP SET OBSIEN=$ORDER(^GMR(120.85,"C",GMRAIEN,OBSIEN))
if OBSIEN<1
GOTO EXIT
+1 SET GMRA(1)=$GET(^GMR(120.85,OBSIEN,0))
if '$LENGTH(GMRA(1))
QUIT
+2 SET STRING="tRecord : "_OBSIEN
DO NEXT
+3 SET USRNAM=""
+4 SET USR=$PIECE(GMRA(1),U,13)
IF USR'=""
DO GETUSR
+5 SET Y=$PIECE(GMRA(1),U,1)
XECUTE ^DD("DD")
+6 SET STRING="tDate/Time of Event: "_Y
DO NEXT
+7 SET STRING="tObserver : "_USRNAM
DO NEXT
+8 SET SEVCOD=$PIECE(GMRA(1),U,14)
+9 SET SEVER=$SELECT(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"")
+10 SET STRING="tSeverity : "_SEVER
DO NEXT
+11 SET Y=$PIECE(GMRA(1),U,18)
XECUTE ^DD("DD")
+12 SET STRING="tDate Reported : "_Y
DO NEXT
+13 SET USRNAM=""
+14 SET USR=$PIECE(GMRA(1),U,19)
IF USR'=""
DO GETUSR
+15 SET STRING="tReporting User : "_USRNAM
DO NEXT
+16 SET STRING="t"
FOR I=1:1:60
SET STRING=STRING_"-"
+17 DO NEXT
+18 GOTO OBSLOOP
EXIT QUIT
NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
+1 SET @GMRARRAY@(ND)=STRING
SET ND=ND+1
SET STRING=""
+2 QUIT
GETUSR SET USRNAM=$$GET1^DIQ(200,USR_",",".01")
+1 QUIT
+2 ;
EIE(GMRAIEN,GMRADFN,GMRARRAY) ;Mark individual entry as entered in error
+1 NEW DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA
+2 LOCK +^XTMP("GMRAED",GMRADFN):1
IF '$TEST
DO MESS
QUIT
+3 SET GMRAPA=GMRAIEN
+4 ;36
SET DIE="^GMR(120.8,"
SET DA=GMRAPA
SET DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$GET(@GMRARRAY@("GMRAERRBY"),.5)
+5 ;Entered in error on date/time by user
DO ^DIE
+6 ;add comments
IF $DATA(@GMRARRAY@("GMRAERRCMTS"))
DO ADCOM(GMRAPA,"E",$NAME(@GMRARRAY@("GMRAERRCMTS")))
+7 IF $$NKASCR^GMRANKA($PIECE(^GMR(120.8,GMRAPA,0),U))
Begin DoDot:1
+8 SET DIK="^GMR(120.86,"
SET DA=$PIECE(^GMR(120.8,GMRAPA,0),U)
+9 ;If patient's last allergy marked as entered in error then delete assessment
DO ^DIK
End DoDot:1
+10 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+11 SET GMRAOUT=0
+12 ;Sends entered in error bulletin to appropriate mail groups
DO EN1^GMRAEAB
+13 ;21 File Progress Note
DO EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT)
+14 SET DFN=GMRADFN
+15 DO INP^VADPT
SET X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101,"
+16 ;Process protocols hanging off of "entered in error" protocol
if X
DO EN^XQOR
+17 LOCK -^XTMP("GMRAED",GMRADFN)
+18 ;38 Return IEN of progress note if created
SET ORY=0_$SELECT(+$GET(GMRAPN)>0:("^"_+$GET(GMRAPN)),1:"")
+19 QUIT
+20 ;
ADCOM(ENTRY,TYPE,GMRACOM) ;Add comments to allergies
+1 ;
+2 NEW FDA,GMRAI,X,DIWL,DIWR
+3 KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=60
SET GMRAI=0
FOR
SET GMRAI=$ORDER(@GMRACOM@(GMRAI))
if '+GMRAI
QUIT
SET X=@GMRACOM@(GMRAI)
DO ^DIWP
+4 SET GMRACOM="^UTILITY($J,""W"",1)"
+5 SET FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT
+6 SET FDA(120.826,"+1,"_ENTRY_",",1)=DUZ
+7 SET FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE
+8 SET FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM
+9 DO UPDATE^DIE("","FDA")
+10 QUIT
+11 ;
NKA ;Change patient assessment to NKA
+1 ;
+2 NEW DA,DR,DIE,NKA,DFN
+3 SET DFN=ORDFN
+4 LOCK +^XTMP("GMRAED",DFN):1
IF '$TEST
DO MESS
QUIT
+5 SET NKA=$$NKA^GMRANKA(DFN)
+6 ;Patient is already NKA
IF NKA=0
QUIT
+7 IF NKA=1
SET ORY="-1^Patient has active allergies - can't mark as NKA"
QUIT
+8 LOCK +^GMR(120.86,0):5
IF '$TEST
SET ORY="-1^Unable to update assessment - try again."
QUIT
+9 ;Add assessment entry
IF '$DATA(^GMR(120.86,DFN,0))
Begin DoDot:1
+10 SET $PIECE(^GMR(120.86,0),U,3,4)=(DFN_"^"_($PIECE(^GMR(120.86,0),U,4)+1))
+11 SET ^GMR(120.86,DFN,0)=DFN_U
SET ^GMR(120.86,"B",DFN,DFN)=""
End DoDot:1
+12 LOCK -^GMR(120.86,0)
LOCK +^GMR(120.86,DFN,0):5
IF '$TEST
SET ORY="-1^Unable to update assessment - try again."
QUIT
+13 SET DIE="^GMR(120.86,"
SET DA=DFN
SET DR="1////0;2////"_DUZ_";3///NOW"
DO ^DIE
+14 SET ORY=0
+15 LOCK -^XTMP("GMRAED",DFN)
+16 QUIT
+17 ;
UPDATE(GMRAIEN,DFN,GMRARRAY) ;Add/edit allergies
+1 NEW NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT,GMRAPN
+2 SET NEW='$GET(GMRAIEN)
+3 IF NEW
IF $$DUPCHK^GMRAOR0(DFN,$PIECE(@GMRARRAY@("GMRAGNT"),U))=1
SET ORY="-1^Patient already has a "_$PIECE(@GMRARRAY@("GMRAGNT"),U)_" reaction entered. No duplicates allowed."
QUIT
+4 LOCK +^XTMP("GMRAED",DFN):1
IF '$TEST
DO MESS
QUIT
+5 DO SITE^GMRAUTL
SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))
+6 ;is patient NKA?
SET NKA='$$NKA^GMRANKA(DFN)
+7 IF NKA
IF NEW
Begin DoDot:1
+8 SET FDA(120.86,"?+"_DFN_",",.01)=DFN
+9 SET FDA(120.86,"?+"_DFN_",",1)=1
+10 SET FDA(120.86,"?+"_DFN_",",2)=DUZ
+11 SET FDA(120.86,"?+"_DFN_",",3)=$GET(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT)
+12 SET IEN(DFN)=DFN
+13 DO UPDATE^DIE("","FDA","IEN")
End DoDot:1
+14 KILL FDA,IEN
+15 SET NODE=$SELECT($GET(NEW):"+1,",1:(GMRAIEN_","))
+16 if $GET(NEW)
SET FDA(120.8,NODE,.01)=DFN
+17 IF $PIECE($GET(@GMRARRAY@("GMRAGNT")),U,2)["50.67"
SET $PIECE(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($PIECE(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6,"
+18 FOR SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6"
Begin DoDot:1
+19 SET FDA(120.8,NODE,$PIECE(SUB,";",2))=$PIECE(@GMRARRAY@($PIECE(SUB,";")),U)
+20 IF (SUB["GMRAGNT")
IF NEW
SET FDA(120.8,NODE,1)=$PIECE(@GMRARRAY@($PIECE(SUB,";")),U,2)
+21 IF SUB["GMRAOBHX"
IF $PIECE(@GMRARRAY@("GMRAOBHX"),U)="h"
Begin DoDot:2
+22 SET FDA(120.8,NODE,8)=$GET(@GMRARRAY@("GMRASEVR"))
+23 SET FDA(120.8,NODE,9)=$GET(@GMRARRAY@("GMRARDT"))
End DoDot:2
End DoDot:1
+24 DO UPDATE^DIE("","FDA","IEN")
+25 if NEW
SET GMRAIEN=IEN(1)
+26 KILL FDA
+27 FOR SUB="GMRACHT","GMRAIDBN"
Begin DoDot:1
+28 ;GMRA*4.0*59 - begin changes
+29 ; end of changes for *59
if SUB="GMRACHT"
KILL @GMRARRAY@(SUB)
+30 ;Stop if no updates
if '$DATA(@GMRARRAY@(SUB))
QUIT
+31 SET FILE=$SELECT(SUB="GMRACHT":120.813,1:120.814)
+32 SET FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1)
+33 SET FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ
+34 DO UPDATE^DIE("","FDA")
End DoDot:1
+35 ;Add comments if included
IF $DATA(@GMRARRAY@("GMRACMTS"))
DO ADCOM(GMRAIEN,"O",$NAME(@GMRARRAY@("GMRACMTS")))
+36 KILL FDA
+37 SET SUB=0
FOR
SET SUB=$ORDER(@GMRARRAY@("GMRASYMP",SUB))
if '+SUB
QUIT
Begin DoDot:1
+38 ;Naked from above
SET GMRAS0=^(SUB)
+39 ;25 No text or free text entered so don't store
if $PIECE(^(SUB),U)=""
QUIT
+40 SET SIEN=$ORDER(^GMR(120.8,GMRAIEN,10,"B",$PIECE(GMRAS0,U),0))
+41 ;Exists and nothing has changed
IF SIEN
IF $PIECE(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$PIECE(GMRAS0,U,3)
QUIT
+42 ;Sign/symptom deleted
IF SIEN
IF $PIECE(GMRAS0,U,5)="@"
SET DIK="^GMR(120.8,"_GMRAIEN_","
SET DA(1)=GMRAIEN
SET DA=SIEN
DO ^DIK
QUIT
+43 if 'SIEN
SET FDA(120.81,"+1,"_GMRAIEN_",",.01)=$SELECT($PIECE(GMRAS0,U)="FT":$ORDER(^GMRD(120.83,"B","OTHER REACTION",0)),1:$PIECE(GMRAS0,U))
+44 SET NODE=$SELECT(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",")
+45 if $PIECE(GMRAS0,U)="FT"
SET FDA(120.81,NODE,1)=$PIECE(GMRAS0,U,2)
+46 SET FDA(120.81,NODE,2)=DUZ
+47 SET FDA(120.81,NODE,3)=$PIECE(GMRAS0,U,3)
+48 DO UPDATE^DIE("","FDA","","ERR")
+49 ;21 record s/s added
SET GMRAROT($PIECE(GMRAS0,U,2))=""
End DoDot:1
+50 IF NEW
Begin DoDot:1
+51 ;Send mark chart/ID band bulletin if needed.
SET GMRALL(GMRAIEN)=""
DO VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM)
DO EN7^GMRAMCB
+52 ;if observed reaction add data to 120.85
IF $PIECE(@GMRARRAY@("GMRAOBHX"),U)="o"
Begin DoDot:2
+53 ;21
SET GMRAOUT=0
+54 SET GMRAL(GMRAIEN,"O",GMRAIEN)=$GET(@GMRARRAY@("GMRARDT"))_"^"_$GET(@GMRARRAY@("GMRASEVR"))
+55 SET GMRADFN=DFN
+56 SET GMRAL(GMRAIEN)="^^"_$PIECE($GET(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$GET(@GMRARRAY@("GMRAORIG"))
+57 MERGE GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP")
+58 SET SUB=0
FOR
SET SUB=$ORDER(GMRAL(GMRAIEN,"S",SUB))
if '+SUB
QUIT
SET $PIECE(GMRAL(GMRAIEN,"S",SUB),U,2)=$PIECE(GMRAL(GMRAIEN,"S",SUB),U,2)_"^"
if $PIECE(GMRAL(GMRAIEN,"S",SUB),U)="FT"
SET $PIECE(GMRAL(GMRAIEN,"S",SUB),U)=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+59 SET GMRAL=GMRAIEN
+60 ;adds entry to 120.85
DO ADVERSE^GMRAOR7(GMRAIEN,.GMRAL)
+61 ;21
SET GMRAIEN(GMRAIEN)=""
+62 ;21 File progress note
DO EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT)
+63 ;21 Send med-watch update
IF $GET(@GMRARRAY@("GMRATYPE"))["D"
SET GMRAPA=GMRAIEN
DO EN1^GMRAPTB
End DoDot:2
+64 SET GMRAAR=$PIECE($GET(@GMRARRAY@("GMRAGNT")),U,2)
SET GMRAPA=GMRAIEN
+65 ;add ingredients/classes send appropriate bulletins
DO EN1^GMRAOR9
SET ^TMP($JOB,"GMRASF",1,GMRAPA)=""
DO RANGE^GMRASIGN(1)
+66 DO GMRACHK^GMRAPEM0(GMRAPA)
End DoDot:1
+67 ;38 If note was created send back IEN
SET ORY=0_$SELECT(+$GET(GMRAPN)>0:("^"_+$GET(GMRAPN)),1:"")
+68 LOCK -^XTMP("GMRAED",DFN)
+69 QUIT
+70 ;
MESS ;Give out locked message
+1 NEW GMRAXBOS,GMRAL1,GMRAL2
+2 ;In GUI?
SET GMRAXBOS=$$BROKER^XWBLIB
+3 SET GMRAL1="Another user is editing this patient's allergy information."
+4 SET GMRAL2="Please refresh/review the patient's information before proceeding."
+5 IF 'GMRAXBOS
WRITE !,GMRAL1,!,GMRAL2
DO WAIT^GMRAFX3
QUIT
+6 SET ORY="-1^"_GMRAL1_" "_GMRAL2
+7 QUIT
