Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAGUI1.m

    r613 r623  
    1 GMRAGUI1        ;SLC/DAN - CPRS GUI support ;11/17/06  09:50
    2         ;;4.0;Adverse Reaction Tracking;**21,25,36,38**;Mar 29, 1996;Build 2
    3         ;
    4         Q
    5 EN1     ; GETREC, cont'd
    6 OBSV    ;  Get OBSERVATIONS from file 120.85
    7         S STRING="~OBSERVATIONS" D NEXT
    8         S OBSIEN=0
    9 OBSLOOP S OBSIEN=$O(^GMR(120.85,"C",GMRAIEN,OBSIEN)) G:OBSIEN<1 EXIT
    10         S GMRA(1)=$G(^GMR(120.85,OBSIEN,0)) Q:'$L(GMRA(1))
    11         S STRING="tRecord            : "_OBSIEN D NEXT
    12         S USRNAM=""
    13         S USR=$P(GMRA(1),U,13) I USR'="" D GETUSR
    14         S Y=$P(GMRA(1),U,1) X ^DD("DD")
    15         S STRING="tDate/Time of Event: "_Y D NEXT
    16         S STRING="tObserver          : "_USRNAM D NEXT
    17         S SEVCOD=$P(GMRA(1),U,14)
    18         S SEVER=$S(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"")
    19         S STRING="tSeverity          : "_SEVER D NEXT
    20         S Y=$P(GMRA(1),U,18) X ^DD("DD")
    21         S STRING="tDate Reported     : "_Y D NEXT
    22         S USRNAM=""
    23         S USR=$P(GMRA(1),U,19) I USR'="" D GETUSR
    24         S STRING="tReporting User    : "_USRNAM D NEXT
    25         S STRING="t" F I=1:1:60 S STRING=STRING_"-"
    26         D NEXT
    27         G OBSLOOP
    28 EXIT    Q
    29 NEXT    ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
    30         S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING=""
    31         Q
    32 GETUSR  S USRNAM=$$GET1^DIQ(200,USR_",",".01")
    33         Q
    34         ;
    35 EIE(GMRAIEN,GMRADFN,GMRARRAY)   ;Mark individual entry as entered in error
    36         N DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA
    37         L +^XTMP("GMRAED",GMRADFN):1 I '$T D MESS Q
    38         S GMRAPA=GMRAIEN
    39         S DIE="^GMR(120.8,",DA=GMRAPA,DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$G(@GMRARRAY@("GMRAERRBY"),.5) ;36
    40         D ^DIE ;Entered in error on date/time by user
    41         I $D(@GMRARRAY@("GMRAERRCMTS")) D ADCOM(GMRAPA,"E",$NA(@GMRARRAY@("GMRAERRCMTS"))) ;add comments
    42         I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D
    43         .S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
    44         .D ^DIK ;If patient's last allergy marked as entered in error then delete assessment
    45         S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
    46         S GMRAOUT=0
    47         D EN1^GMRAEAB ;Sends entered in error bulletin to appropriate mail groups
    48         D EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT) ;21 File Progress Note
    49         S DFN=GMRADFN
    50         D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101,"
    51         D:X EN^XQOR ;Process protocols hanging off of "entered in error" protocol
    52         L -^XTMP("GMRAED",GMRADFN)
    53         S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 Return IEN of progress note if created
    54         Q
    55         ;
    56 ADCOM(ENTRY,TYPE,GMRACOM)       ;Add comments to allergies
    57         ;
    58         N FDA,GMRAI,X,DIWL,DIWR
    59         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
    60         S GMRACOM="^UTILITY($J,""W"",1)"
    61         S FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT
    62         S FDA(120.826,"+1,"_ENTRY_",",1)=DUZ
    63         S FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE
    64         S FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM
    65         D UPDATE^DIE("","FDA")
    66         Q
    67         ;
    68 NKA     ;Change patient assessment to NKA
    69         ;
    70         N DA,DR,DIE,NKA,DFN
    71         S DFN=ORDFN
    72         L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
    73         S NKA=$$NKA^GMRANKA(DFN)
    74         I NKA=0 Q  ;Patient is already NKA
    75         I NKA=1 S ORY="-1^Patient has active allergies - can't mark as NKA" Q
    76         L +^GMR(120.86,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
    77         I '$D(^GMR(120.86,DFN,0)) D  ;Add assessment entry
    78         .S $P(^GMR(120.86,0),U,3,4)=(DFN_"^"_($P(^GMR(120.86,0),U,4)+1))
    79         .S ^GMR(120.86,DFN,0)=DFN_U,^GMR(120.86,"B",DFN,DFN)=""
    80         L -^GMR(120.86,0) L +^GMR(120.86,DFN,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
    81         S DIE="^GMR(120.86,",DA=DFN,DR="1////0;2////"_DUZ_";3///NOW" D ^DIE
    82         S ORY=0
    83         L -^XTMP("GMRAED",DFN)
    84         Q
    85         ;
    86 UPDATE(GMRAIEN,DFN,GMRARRAY)    ;Add/edit allergies
    87         N NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT
    88         S NEW='$G(GMRAIEN)
    89         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
    90         L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
    91         D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
    92         S NKA='$$NKA^GMRANKA(DFN) ;is patient NKA?
    93         I NKA,NEW D
    94         .S FDA(120.86,"?+"_DFN_",",.01)=DFN
    95         .S FDA(120.86,"?+"_DFN_",",1)=1
    96         .S FDA(120.86,"?+"_DFN_",",2)=DUZ
    97         .S FDA(120.86,"?+"_DFN_",",3)=$G(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT)
    98         .S IEN(DFN)=DFN
    99         .D UPDATE^DIE("","FDA","IEN")
    100         K FDA,IEN
    101         S NODE=$S($G(NEW):"+1,",1:(GMRAIEN_","))
    102         S:$G(NEW) FDA(120.8,NODE,.01)=DFN
    103         I $P($G(@GMRARRAY@("GMRAGNT")),U,2)["50.67" S $P(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($P(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6,"
    104         F SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6" D
    105         .S FDA(120.8,NODE,$P(SUB,";",2))=$P(@GMRARRAY@($P(SUB,";")),U)
    106         .I (SUB["GMRAGNT"),NEW S FDA(120.8,NODE,1)=$P(@GMRARRAY@($P(SUB,";")),U,2)
    107         D UPDATE^DIE("","FDA","IEN")
    108         S:NEW GMRAIEN=IEN(1)
    109         K FDA
    110         F SUB="GMRACHT","GMRAIDBN" D
    111         .Q:'$D(@GMRARRAY@(SUB))  ;Stop if no updates
    112         .S FILE=$S(SUB="GMRACHT":120.813,1:120.814)
    113         .S FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1)
    114         .S FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ
    115         .D UPDATE^DIE("","FDA")
    116         I $D(@GMRARRAY@("GMRACMTS")) D ADCOM(GMRAIEN,"O",$NA(@GMRARRAY@("GMRACMTS"))) ;Add comments if included
    117         K FDA
    118         S SUB=0 F  S SUB=$O(@GMRARRAY@("GMRASYMP",SUB)) Q:'+SUB  D
    119         .S GMRAS0=^(SUB) ;Naked from above
    120         .Q:$P(^(SUB),U)=""  ;25 No text or free text entered so don't store
    121         .S SIEN=$O(^GMR(120.8,GMRAIEN,10,"B",$P(GMRAS0,U),0))
    122         .I SIEN,$P(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$P(GMRAS0,U,3) Q  ;Exists and nothing has changed
    123         .I SIEN,$P(GMRAS0,U,5)="@" S DIK="^GMR(120.8,"_GMRAIEN_",",DA(1)=GMRAIEN,DA=SIEN D ^DIK Q  ;Sign/symptom deleted
    124         .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))
    125         .S NODE=$S(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",")
    126         .S:$P(GMRAS0,U)="FT" FDA(120.81,NODE,1)=$P(GMRAS0,U,2)
    127         .S FDA(120.81,NODE,2)=DUZ
    128         .S FDA(120.81,NODE,3)=$P(GMRAS0,U,3)
    129         .D UPDATE^DIE("","FDA","","ERR")
    130         .S GMRAROT($P(GMRAS0,U,2))="" ;21 record s/s added
    131         I NEW D
    132         .S GMRALL(GMRAIEN)="" D VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM) D EN7^GMRAMCB ;Send mark chart/ID band bulletin if needed.
    133         .I $P(@GMRARRAY@("GMRAOBHX"),U)="o" D  ;if observed reaction add data to 120.85
    134         ..S GMRAOUT=0 ;21
    135         ..S GMRAL(GMRAIEN,"O",GMRAIEN)=$G(@GMRARRAY@("GMRARDT"))_"^"_$G(@GMRARRAY@("GMRASEVR"))
    136         ..S GMRADFN=DFN
    137         ..S GMRAL(GMRAIEN)="^^"_$P($G(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$G(@GMRARRAY@("GMRAORIG"))
    138         ..M GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP")
    139         ..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))
    140         ..S GMRAL=GMRAIEN
    141         ..D ADVERSE^GMRAOR7(GMRAIEN,.GMRAL) ;adds entry to 120.85
    142         ..S GMRAIEN(GMRAIEN)="" ;21
    143         ..D EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT) ;21 File progress note
    144         ..I $G(@GMRARRAY@("GMRATYPE"))["D" S GMRAPA=GMRAIEN D EN1^GMRAPTB ;21 Send med-watch update
    145         .S GMRAAR=$P($G(@GMRARRAY@("GMRAGNT")),U,2),GMRAPA=GMRAIEN
    146         .D EN1^GMRAOR9 S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;add ingredients/classes send appropriate bulletins
    147         S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 If note was created send back IEN
    148         L -^XTMP("GMRAED",DFN)
    149         Q
    150         ;
    151 MESS    ;Give out locked message
    152         N GMRAXBOS,GMRAL1,GMRAL2
    153         S GMRAXBOS=$$BROKER^XWBLIB ;In GUI?
    154         S GMRAL1="Another user is editing this patient's allergy information."
    155         S GMRAL2="Please refresh/review the patient's information before proceeding."
    156         I 'GMRAXBOS W !,GMRAL1,!,GMRAL2 D WAIT^GMRAFX3 Q
    157         S ORY="-1^"_GMRAL1_"  "_GMRAL2
    158         Q
     1GMRAGUI1 ;SLC/DAN - CPRS GUI support ;7/13/06  14:32
     2 ;;4.0;Adverse Reaction Tracking;**21,25,36**;Mar 29, 1996;Build 9
     3 ;
     4 Q
     5EN1 ; GETREC, cont'd
     6OBSV ;  Get OBSERVATIONS from file 120.85
     7 S STRING="~OBSERVATIONS" D NEXT
     8 S OBSIEN=0
     9OBSLOOP S OBSIEN=$O(^GMR(120.85,"C",GMRAIEN,OBSIEN)) G:OBSIEN<1 EXIT
     10 S GMRA(1)=$G(^GMR(120.85,OBSIEN,0)) Q:'$L(GMRA(1))
     11 S STRING="tRecord            : "_OBSIEN D NEXT
     12 S USRNAM=""
     13 S USR=$P(GMRA(1),U,13) I USR'="" D GETUSR
     14 S Y=$P(GMRA(1),U,1) X ^DD("DD")
     15 S STRING="tDate/Time of Event: "_Y D NEXT
     16 S STRING="tObserver          : "_USRNAM D NEXT
     17 S SEVCOD=$P(GMRA(1),U,14)
     18 S SEVER=$S(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"")
     19 S STRING="tSeverity          : "_SEVER D NEXT
     20 S Y=$P(GMRA(1),U,18) X ^DD("DD")
     21 S STRING="tDate Reported     : "_Y D NEXT
     22 S USRNAM=""
     23 S USR=$P(GMRA(1),U,19) I USR'="" D GETUSR
     24 S STRING="tReporting User    : "_USRNAM D NEXT
     25 S STRING="t" F I=1:1:60 S STRING=STRING_"-"
     26 D NEXT
     27 G OBSLOOP
     28EXIT Q
     29NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
     30 S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING=""
     31 Q
     32GETUSR S USRNAM=$$GET1^DIQ(200,USR_",",".01")
     33 Q
     34 ;
     35EIE(GMRAIEN,GMRADFN,GMRARRAY) ;Mark individual entry as entered in error
     36 N DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA
     37 L +^XTMP("GMRAED",GMRADFN):1 I '$T D MESS Q
     38 S GMRAPA=GMRAIEN
     39 S DIE="^GMR(120.8,",DA=GMRAPA,DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$G(@GMRARRAY@("GMRAERRBY"),.5) ;36
     40 D ^DIE ;Entered in error on date/time by user
     41 I $D(@GMRARRAY@("GMRAERRCMTS")) D ADCOM(GMRAPA,"E",$NA(@GMRARRAY@("GMRAERRCMTS"))) ;add comments
     42 I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D
     43 .S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
     44 .D ^DIK ;If patient's last allergy marked as entered in error then delete assessment
     45 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
     46 S GMRAOUT=0
     47 D EN1^GMRAEAB ;Sends entered in error bulletin to appropriate mail groups
     48 D EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT) ;21 File Progress Note
     49 S DFN=GMRADFN
     50 D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101,"
     51 D:X EN^XQOR ;Process protocols hanging off of "entered in error" protocol
     52 L -^XTMP("GMRAED",GMRADFN)
     53 Q
     54 ;
     55ADCOM(ENTRY,TYPE,GMRACOM) ;Add comments to allergies
     56 ;
     57 N FDA,GMRAI,X,DIWL,DIWR
     58 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
     59 S GMRACOM="^UTILITY($J,""W"",1)"
     60 S FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT
     61 S FDA(120.826,"+1,"_ENTRY_",",1)=DUZ
     62 S FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE
     63 S FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM
     64 D UPDATE^DIE("","FDA")
     65 Q
     66 ;
     67NKA ;Change patient assessment to NKA
     68 ;
     69 N DA,DR,DIE,NKA,DFN
     70 S DFN=ORDFN
     71 L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
     72 S NKA=$$NKA^GMRANKA(DFN)
     73 I NKA=0 Q  ;Patient is already NKA
     74 I NKA=1 S ORY="-1^Patient has active allergies - can't mark as NKA" Q
     75 L +^GMR(120.86,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
     76 I '$D(^GMR(120.86,DFN,0)) D  ;Add assessment entry
     77 .S $P(^GMR(120.86,0),U,3,4)=(DFN_"^"_($P(^GMR(120.86,0),U,4)+1))
     78 .S ^GMR(120.86,DFN,0)=DFN_U,^GMR(120.86,"B",DFN,DFN)=""
     79 L -^GMR(120.86,0) L +^GMR(120.86,DFN,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
     80 S DIE="^GMR(120.86,",DA=DFN,DR="1////0;2////"_DUZ_";3///NOW" D ^DIE
     81 S ORY=0
     82 L -^XTMP("GMRAED",DFN)
     83 Q
     84 ;
     85UPDATE(GMRAIEN,DFN,GMRARRAY) ;Add/edit allergies
     86 N NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT
     87 S NEW='$G(GMRAIEN)
     88 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
     89 L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
     90 D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
     91 S NKA='$$NKA^GMRANKA(DFN) ;is patient NKA?
     92 I NKA,NEW D
     93 .S FDA(120.86,"?+"_DFN_",",.01)=DFN
     94 .S FDA(120.86,"?+"_DFN_",",1)=1
     95 .S FDA(120.86,"?+"_DFN_",",2)=DUZ
     96 .S FDA(120.86,"?+"_DFN_",",3)=$G(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT)
     97 .S IEN(DFN)=DFN
     98 .D UPDATE^DIE("","FDA","IEN")
     99 K FDA,IEN
     100 S NODE=$S($G(NEW):"+1,",1:(GMRAIEN_","))
     101 S:$G(NEW) FDA(120.8,NODE,.01)=DFN
     102 I $P($G(@GMRARRAY@("GMRAGNT")),U,2)["50.67" S $P(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($P(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6,"
     103 F SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6" D
     104 .S FDA(120.8,NODE,$P(SUB,";",2))=$P(@GMRARRAY@($P(SUB,";")),U)
     105 .I (SUB["GMRAGNT"),NEW S FDA(120.8,NODE,1)=$P(@GMRARRAY@($P(SUB,";")),U,2)
     106 D UPDATE^DIE("","FDA","IEN")
     107 S:NEW GMRAIEN=IEN(1)
     108 K FDA
     109 F SUB="GMRACHT","GMRAIDBN" D
     110 .Q:'$D(@GMRARRAY@(SUB))  ;Stop if no updates
     111 .S FILE=$S(SUB="GMRACHT":120.813,1:120.814)
     112 .S FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1)
     113 .S FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ
     114 .D UPDATE^DIE("","FDA")
     115 I $D(@GMRARRAY@("GMRACMTS")) D ADCOM(GMRAIEN,"O",$NA(@GMRARRAY@("GMRACMTS"))) ;Add comments if included
     116 K FDA
     117 S SUB=0 F  S SUB=$O(@GMRARRAY@("GMRASYMP",SUB)) Q:'+SUB  D
     118 .S GMRAS0=^(SUB) ;Naked from above
     119 .Q:$P(^(SUB),U)=""  ;25 No text or free text entered so don't store
     120 .S SIEN=$O(^GMR(120.8,GMRAIEN,10,"B",$P(GMRAS0,U),0))
     121 .I SIEN,$P(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$P(GMRAS0,U,3) Q  ;Exists and nothing has changed
     122 .I SIEN,$P(GMRAS0,U,5)="@" S DIK="^GMR(120.8,"_GMRAIEN_",",DA(1)=GMRAIEN,DA=SIEN D ^DIK Q  ;Sign/symptom deleted
     123 .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))
     124 .S NODE=$S(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",")
     125 .S:$P(GMRAS0,U)="FT" FDA(120.81,NODE,1)=$P(GMRAS0,U,2)
     126 .S FDA(120.81,NODE,2)=DUZ
     127 .S FDA(120.81,NODE,3)=$P(GMRAS0,U,3)
     128 .D UPDATE^DIE("","FDA","","ERR")
     129 .S GMRAROT($P(GMRAS0,U,2))="" ;21 record s/s added
     130 I NEW D
     131 .S GMRALL(GMRAIEN)="" D VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM) D EN7^GMRAMCB ;Send mark chart/ID band bulletin if needed.
     132 .I $P(@GMRARRAY@("GMRAOBHX"),U)="o" D  ;if observed reaction add data to 120.85
     133 ..S GMRAOUT=0 ;21
     134 ..S GMRAL(GMRAIEN,"O",GMRAIEN)=$G(@GMRARRAY@("GMRARDT"))_"^"_$G(@GMRARRAY@("GMRASEVR"))
     135 ..S GMRADFN=DFN
     136 ..S GMRAL(GMRAIEN)="^^"_$P($G(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$G(@GMRARRAY@("GMRAORIG"))
     137 ..M GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP")
     138 ..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))
     139 ..S GMRAL=GMRAIEN
     140 ..D ADVERSE^GMRAOR7(GMRAIEN,.GMRAL) ;adds entry to 120.85
     141 ..S GMRAIEN(GMRAIEN)="" ;21
     142 ..D EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT) ;21 File progress note
     143 ..I $G(@GMRARRAY@("GMRATYPE"))["D" S GMRAPA=GMRAIEN D EN1^GMRAPTB ;21 Send med-watch update
     144 .S GMRAAR=$P($G(@GMRARRAY@("GMRAGNT")),U,2),GMRAPA=GMRAIEN
     145 .D EN1^GMRAOR9 S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;add ingredients/classes send appropriate bulletins
     146 S ORY=0
     147 L -^XTMP("GMRAED",DFN)
     148 Q
     149 ;
     150MESS ;Give out locked message
     151 N GMRAXBOS,GMRAL1,GMRAL2
     152 S GMRAXBOS=$$BROKER^XWBLIB ;In GUI?
     153 S GMRAL1="Another user is editing this patient's allergy information."
     154 S GMRAL2="Please refresh/review the patient's information before proceeding."
     155 I 'GMRAXBOS W !,GMRAL1,!,GMRAL2 D WAIT^GMRAFX3 Q
     156 S ORY="-1^"_GMRAL1_"  "_GMRAL2
     157 Q
Note: See TracChangeset for help on using the changeset viewer.