- 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 Jan 18, 2025@02:40:33 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