BEHOARMU ;MSC/IND/MGH - ART Enhancements for meaningful use ;06-Jul-2012 08:29;DU
;;1.1;BEH COMPONENTS;**045004,045006**;Sep 18, 2007;Build 1
;=================================================================
;Return the values that can be selected for the chosen field
;Inp=file^field
;Return= Array of values that can be used for this field in this file
REASONS(RET,FLG) ;EP List of reasons
N IEN,CNT,X,Y
S RET=$$TMPGBL()
S CNT=0
S IEN=0 F S IEN=$O(^BEHOAR(90460.05,IEN)) Q:'+IEN D
.I $P($G(^BEHOAR(90460.05,IEN,0)),U,2)=FLG D
..S CNT=CNT+1
..S X=$P($G(^BEHOAR(90460.05,IEN,0)),U,3)
..S @RET@(CNT,0)=IEN_U_$P($G(^BEHOAR(90460.05,IEN,0)),U,1)_U_$S(X="Y":1,X="N":0,1:0)
Q
SNOMED(RET) ;EP List of snomed codes
N IEN,CNT,NAME
S RET=$$TMPGBL()
S CNT=0
S NAME="" F S NAME=$O(^BEHOAR(90460.06,"B",NAME)) Q:NAME="" D
.S IEN=0 F S IEN=$O(^BEHOAR(90460.06,"B",NAME,IEN)) Q:IEN="" D
..Q:+$P($G(^BEHOAR(90460.06,IEN,0)),U,4)
..S CNT=CNT+1
..S @RET@(CNT,0)=IEN_U_$P($G(^BEHOAR(90460.06,IEN,0)),U,1)_U_$P($G(^BEHOAR(90460.06,IEN,0)),U,2)
Q
;Mark an allergy as entered in error
;Input
; IEN=Entry number in the 120.8 file
; DFN=Patient's internal entry number
; VAL=Array of values to be stored
; ("GMRAERR")=Indicates this entry is to be marked EIE
; ("GMRAERRBY")=User marking it (optional,will set to DUZ)
; ("GMRAERRDT")=Date/time EIE (option,will set to NOW)
; ("GMRAERCMTS")=N Comment lines for entering in error
; ("GMRAERRCMTS",n)
; OUPUT = error message or IEN of entry marked in error
EIE(DATA,IEN,DFN,VAL) ;entered in error
N NOW,ORNODE,GMR0
S GMR0=$P($G(^GMR(120.8,IEN,0)),U),DATA=""
I '$L(GMR0) S DATA="-1^Entry not found" Q
D CKIN(DFN)
S NOW=$$NOW^XLFDT
I $G(VAL("GMRAERRBY"))="" S VAL("GMRAERRBY")=DUZ
I $G(VAL("GMRAERRDT"))="" S VAL("GMRAERRDT")=NOW
S ORNODE=$NAME(^TMP("GMRA",$J))
K @ORNODE M @ORNODE=VAL
D EIE^GMRAGUI1(IEN,DFN,ORNODE)
S DATA=IEN
D FIREEVT^BEHOART(DFN,2,IEN)
Q
;Mark an allergy as inactivated
;Input
; IEN=Entry number in the 120.8 file
; DFN=Patient's internal entry number
; VAL=Array of values to be stored
; ("GMRAINACT")=Date entry marked inactive (required)
; ("GMRAINACBY")=User marking it (optional,will set to DUZ)
; ("GMRAINWHY")=Reason marked inactive^comment if OTHER
; OUPUT = error message or IEN of entry marked inactive
INACT(DATA,IEN,DFN,VAL) ;inactive allergies
N X,Y,STOP,FNUM,AIEN,ERR,WHY,WHYIEN
I IEN="" S DATA="-1^Missing entry to inactivate" Q
D CKIN(DFN)
S STOP=0,FNUM=120.899999912
S AIEN="+1,"_IEN_","
S FDA(120.899999912,AIEN,.01)=$G(VAL("GMRAINACT"))
S WHY=$G(VAL("GMRAINWHY"))
S WHYIEN=$$REASON(WHY)
I WHYIEN S FDA(120.899999912,AIEN,1)=$P(WHYIEN,U,1)
I $G(VAL("GMRAINACBY"))="" S VAL("GMRAINACBY")=DUZ
S FDA(120.899999912,AIEN,2)=$G(VAL("GMRAINACBY"))
I $D(VAL("GMRACMTS")) D GMRACMTS^BEHOART
D UPDATE^DIE(,"FDA","IEN","ERR")
S DATA=+IEN
D FIREEVT^BEHOART(DFN,1,IEN)
K FDA,ERR
Q
;Input
; IEN=Entry number in the 120.8 file
; DFN=Patient's internal entry number
; VAL=Array of values to be stored
; ("GMRAINRE")=Date/Time to reactivate (required to reactivate)
; ("GMRAINREBY")=User reactivating (optional,will set to DUZ)
; OUPUT = error message or IEN of entry marked inactive
REACT(DATA,IEN,DFN,VAL) ;reactivate allergy
N X,Y,STOP,FNUM,AIEN,BIEN,ERR,SIEN,SIEN,MIEN,CANVER
I IEN="" S DATA="-1^Missing entry to reactivate" Q
D CKIN(DFN)
S STOP=0,FNUM=120.899999912,BIEN=IEN
S SIEN=$O(^GMR(120.8,IEN,9999999.12,$C(0)),-1)
I STOP!'SIEN S DATA="-1^Unable to find entry to reactivate" Q
S AIEN=SIEN_","_IEN_","
I $G(VAL("GMRAINREBY"))="" S VAL("GMRAINREBY")=DUZ
I $G(VAL("GMRAINRE"))="" S VAL("GMRAINRE")=$$NOW^XLFDT
;S FDA(120.899999912,AIEN,.01)=$G(VAL("GMRAINACT"))
S FDA(120.899999912,AIEN,3)=$G(VAL("GMRAINRE"))
S FDA(120.899999912,AIEN,4)=$G(VAL("GMRAINREBY"))
D UPDATE^DIE(,"FDA","IEN","ERR")
K FDA,ERR
;Remove the verification, must be redone
S AIEN=BIEN_","
S FDA(120.8,AIEN,15)="@"
S FDA(120.8,AIEN,19)="@"
S FDA(120.8,AIEN,20)="@"
S FDA(120.8,AIEN,21)="@"
D FILE^DIE("","FDA","ERR")
S DATA=IEN
D FIREEVT^BEHOART(DFN,1,IEN)
;Patch 11 changed to autosign
S CANVER=$$HASKEY^BEHOUSCX("GMRA-ALLERGY VERIFY")
D:$$CANSIGN^BEHOART(DATA) SIGN^BEHOART(.SIG,DATA,CANVER) ;AUTOSIGN
;D SNDALR^BEHOART(DATA,1)
K FDA,ERR
Q
;
;Add or release an allergy assessment of unassessable
;Input
; IEN=Entry in the 120.86 file (Blank if pt not in file)
; DFN=Patient's internal entry number
; VAL=array of values to be stored
; ("GMRAACC")=Date entry marked unassessable
; ("GMRAACRE")=Reason marked unassessable
; ("GMRAACCBY")=User marking record as unassessable
; OUPUT = error messagte or IEN of entry marked unassessable
ASSESS(DATA,IEN,DFN,VAL) ;mark unassessible
N FNUM,NEW,X,ATIME,FDA,BIEN,AIEN,FDA2,AIEN2,WHY,WHYIEN,IEN,ACTION
S FNUM=120.869999911
I '$D(^GMR(120.86,DFN,0)) D
.S AIEN="+1,",FDA(120.86,AIEN,.01)=DFN
.S IEN(1)=DFN
.D UPDATE^DIE(,"FDA","IEN","ERR")
.I 'IEN(1) S DATA="-1^Unable to update allergy assessment"
;See if there are any earlier unable to assess nodes not closed out
S ACTION=1
K FDA,IEN,ERR,AIEN
D CKIN(DFN)
S WHY=$G(VAL("GMRAACRE"))
S WHYIEN=$$REASON(WHY)
I 'WHYIEN D Q
.S DATA="-1^A valid reason was not submitted"
S AIEN="+1,"_DFN_","
S FDA(120.869999911,AIEN,.01)=VAL("GMRAACC")
S FDA(120.869999911,AIEN,1)=$P(WHYIEN,U,1)
I $P(WHYIEN,U,2)'="" S FDA(120.869999911,AIEN,5)=$P(WHYIEN,U,2)
I $G(VAL("GMRAACCBY"))="" S VAL("GMRAACBY")=DUZ
S FDA(120.869999911,AIEN,2)=VAL("GMRAACCBY")
D UPDATE^DIE(,"FDA","IEN","ERR")
S DATA=+$G(IEN(1))
D QUEUE^CIANBEVT("GMRA."_DFN,ACTION)
Q
;Input
; IEN=Entry in the 120.86 file (Blank if pt not in file)
; DFN=Patient's internal entry number
; VAL=array of values to be stored
; ("GMRAACC")=Date entry marked unassessable
; ("GMRAACCRE")="Date unassessible resolved"
; ("GMRAACCBY")="User unmarking the unacessable"
; OUPUT = error messagte or IEN of entry marked unassessable
REASSESS(DATA,IEN,DFN,VAL) ;reactivate
;Find node to close out
N AIEN,STOP,BIEN,ATIME
S STOP=0
S ATIME=9999999 F S ATIME=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME),-1) Q:'ATIME!(STOP=1) D
.S AIEN="" F S AIEN=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME,AIEN)) Q:'+AIEN!(STOP=1) D
..I ATIME=VAL("GMRAACC") S STOP=1
..S BIEN=AIEN_","_DFN_","
..I $G(VAL("GMRAACRE"))="" S VAL("GMRAACRE")=$$NOW^XLFDT
..S FDA(120.869999911,BIEN,3)=VAL("GMRAACRE")
..I $G(VAL("GMRAACCBY"))="" S VAL("GMRAACCBY")=DUZ
..S FDA(120.869999911,BIEN,4)=VAL("GMRAACCBY")
..D UPDATE^DIE(,"FDA","IEN","ERR")
..I '$D(ERR) S DATA=IEN
..K FDA,IEN,ERR
..D FIREEVT^BEHOART(DFN,2,"")
Q
;See if there are any earlier unable to assess nodes not closed out
;If so, close them out
CKIN(DFN) ;
N ATIME,AIEN,BIEN,FDA2,IEN,ERR
S ATIME=9999999 F S ATIME=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME),-1) Q:ATIME="" D
.S BIEN="" F S BIEN=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME,BIEN)) Q:BIEN="" D
..I $P($G(^GMR(120.86,DFN,9999999.11,BIEN,0)),U,4)="" D
...S AIEN=BIEN_","_DFN_","
...S FDA2(120.869999911,AIEN,3)=$$NOW^XLFDT
...S FDA2(120.869999911,AIEN,4)=DUZ
...D UPDATE^DIE(,"FDA2","IEN","ERR")
...K FDA2,IEN,ERR
Q
; Return IEN to BEH ALLERGY VALUES file
REASON(VAL) ; EP -
N X,RET,COM
I +VAL>0 S RET=+VAL
E S X=$P(VAL,U,2) S RET=$O(^BEHOAR(90460.05,"B",X,""))
S COM=$P(VAL,U,4)
I COM'="" S RET=RET_U_COM
Q RET
;
TMPGBL() K ^TMP("BEHOART",$J) Q $NA(^($J))
BEHOARMU ;MSC/IND/MGH - ART Enhancements for meaningful use ;06-Jul-2012 08:29;DU
+1 ;;1.1;BEH COMPONENTS;**045004,045006**;Sep 18, 2007;Build 1
+2 ;=================================================================
+3 ;Return the values that can be selected for the chosen field
+4 ;Inp=file^field
+5 ;Return= Array of values that can be used for this field in this file
REASONS(RET,FLG) ;EP List of reasons
+1 NEW IEN,CNT,X,Y
+2 SET RET=$$TMPGBL()
+3 SET CNT=0
+4 SET IEN=0
FOR
SET IEN=$ORDER(^BEHOAR(90460.05,IEN))
IF '+IEN
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^BEHOAR(90460.05,IEN,0)),U,2)=FLG
Begin DoDot:2
+6 SET CNT=CNT+1
+7 SET X=$PIECE($GET(^BEHOAR(90460.05,IEN,0)),U,3)
+8 SET @RET@(CNT,0)=IEN_U_$PIECE($GET(^BEHOAR(90460.05,IEN,0)),U,1)_U_$SELECT(X="Y":1,X="N":0,1:0)
End DoDot:2
End DoDot:1
+9 QUIT
SNOMED(RET) ;EP List of snomed codes
+1 NEW IEN,CNT,NAME
+2 SET RET=$$TMPGBL()
+3 SET CNT=0
+4 SET NAME=""
FOR
SET NAME=$ORDER(^BEHOAR(90460.06,"B",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^BEHOAR(90460.06,"B",NAME,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+6 IF +$PIECE($GET(^BEHOAR(90460.06,IEN,0)),U,4)
QUIT
+7 SET CNT=CNT+1
+8 SET @RET@(CNT,0)=IEN_U_$PIECE($GET(^BEHOAR(90460.06,IEN,0)),U,1)_U_$PIECE($GET(^BEHOAR(90460.06,IEN,0)),U,2)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;Mark an allergy as entered in error
+11 ;Input
+12 ; IEN=Entry number in the 120.8 file
+13 ; DFN=Patient's internal entry number
+14 ; VAL=Array of values to be stored
+15 ; ("GMRAERR")=Indicates this entry is to be marked EIE
+16 ; ("GMRAERRBY")=User marking it (optional,will set to DUZ)
+17 ; ("GMRAERRDT")=Date/time EIE (option,will set to NOW)
+18 ; ("GMRAERCMTS")=N Comment lines for entering in error
+19 ; ("GMRAERRCMTS",n)
+20 ; OUPUT = error message or IEN of entry marked in error
EIE(DATA,IEN,DFN,VAL) ;entered in error
+1 NEW NOW,ORNODE,GMR0
+2 SET GMR0=$PIECE($GET(^GMR(120.8,IEN,0)),U)
SET DATA=""
+3 IF '$LENGTH(GMR0)
SET DATA="-1^Entry not found"
QUIT
+4 DO CKIN(DFN)
+5 SET NOW=$$NOW^XLFDT
+6 IF $GET(VAL("GMRAERRBY"))=""
SET VAL("GMRAERRBY")=DUZ
+7 IF $GET(VAL("GMRAERRDT"))=""
SET VAL("GMRAERRDT")=NOW
+8 SET ORNODE=$NAME(^TMP("GMRA",$JOB))
+9 KILL @ORNODE
MERGE @ORNODE=VAL
+10 DO EIE^GMRAGUI1(IEN,DFN,ORNODE)
+11 SET DATA=IEN
+12 DO FIREEVT^BEHOART(DFN,2,IEN)
+13 QUIT
+14 ;Mark an allergy as inactivated
+15 ;Input
+16 ; IEN=Entry number in the 120.8 file
+17 ; DFN=Patient's internal entry number
+18 ; VAL=Array of values to be stored
+19 ; ("GMRAINACT")=Date entry marked inactive (required)
+20 ; ("GMRAINACBY")=User marking it (optional,will set to DUZ)
+21 ; ("GMRAINWHY")=Reason marked inactive^comment if OTHER
+22 ; OUPUT = error message or IEN of entry marked inactive
INACT(DATA,IEN,DFN,VAL) ;inactive allergies
+1 NEW X,Y,STOP,FNUM,AIEN,ERR,WHY,WHYIEN
+2 IF IEN=""
SET DATA="-1^Missing entry to inactivate"
QUIT
+3 DO CKIN(DFN)
+4 SET STOP=0
SET FNUM=120.899999912
+5 SET AIEN="+1,"_IEN_","
+6 SET FDA(120.899999912,AIEN,.01)=$GET(VAL("GMRAINACT"))
+7 SET WHY=$GET(VAL("GMRAINWHY"))
+8 SET WHYIEN=$$REASON(WHY)
+9 IF WHYIEN
SET FDA(120.899999912,AIEN,1)=$PIECE(WHYIEN,U,1)
+10 IF $GET(VAL("GMRAINACBY"))=""
SET VAL("GMRAINACBY")=DUZ
+11 SET FDA(120.899999912,AIEN,2)=$GET(VAL("GMRAINACBY"))
+12 IF $DATA(VAL("GMRACMTS"))
DO GMRACMTS^BEHOART
+13 DO UPDATE^DIE(,"FDA","IEN","ERR")
+14 SET DATA=+IEN
+15 DO FIREEVT^BEHOART(DFN,1,IEN)
+16 KILL FDA,ERR
+17 QUIT
+18 ;Input
+19 ; IEN=Entry number in the 120.8 file
+20 ; DFN=Patient's internal entry number
+21 ; VAL=Array of values to be stored
+22 ; ("GMRAINRE")=Date/Time to reactivate (required to reactivate)
+23 ; ("GMRAINREBY")=User reactivating (optional,will set to DUZ)
+24 ; OUPUT = error message or IEN of entry marked inactive
REACT(DATA,IEN,DFN,VAL) ;reactivate allergy
+1 NEW X,Y,STOP,FNUM,AIEN,BIEN,ERR,SIEN,SIEN,MIEN,CANVER
+2 IF IEN=""
SET DATA="-1^Missing entry to reactivate"
QUIT
+3 DO CKIN(DFN)
+4 SET STOP=0
SET FNUM=120.899999912
SET BIEN=IEN
+5 SET SIEN=$ORDER(^GMR(120.8,IEN,9999999.12,$CHAR(0)),-1)
+6 IF STOP!'SIEN
SET DATA="-1^Unable to find entry to reactivate"
QUIT
+7 SET AIEN=SIEN_","_IEN_","
+8 IF $GET(VAL("GMRAINREBY"))=""
SET VAL("GMRAINREBY")=DUZ
+9 IF $GET(VAL("GMRAINRE"))=""
SET VAL("GMRAINRE")=$$NOW^XLFDT
+10 ;S FDA(120.899999912,AIEN,.01)=$G(VAL("GMRAINACT"))
+11 SET FDA(120.899999912,AIEN,3)=$GET(VAL("GMRAINRE"))
+12 SET FDA(120.899999912,AIEN,4)=$GET(VAL("GMRAINREBY"))
+13 DO UPDATE^DIE(,"FDA","IEN","ERR")
+14 KILL FDA,ERR
+15 ;Remove the verification, must be redone
+16 SET AIEN=BIEN_","
+17 SET FDA(120.8,AIEN,15)="@"
+18 SET FDA(120.8,AIEN,19)="@"
+19 SET FDA(120.8,AIEN,20)="@"
+20 SET FDA(120.8,AIEN,21)="@"
+21 DO FILE^DIE("","FDA","ERR")
+22 SET DATA=IEN
+23 DO FIREEVT^BEHOART(DFN,1,IEN)
+24 ;Patch 11 changed to autosign
+25 SET CANVER=$$HASKEY^BEHOUSCX("GMRA-ALLERGY VERIFY")
+26 ;AUTOSIGN
IF $$CANSIGN^BEHOART(DATA)
DO SIGN^BEHOART(.SIG,DATA,CANVER)
+27 ;D SNDALR^BEHOART(DATA,1)
+28 KILL FDA,ERR
+29 QUIT
+30 ;
+31 ;Add or release an allergy assessment of unassessable
+32 ;Input
+33 ; IEN=Entry in the 120.86 file (Blank if pt not in file)
+34 ; DFN=Patient's internal entry number
+35 ; VAL=array of values to be stored
+36 ; ("GMRAACC")=Date entry marked unassessable
+37 ; ("GMRAACRE")=Reason marked unassessable
+38 ; ("GMRAACCBY")=User marking record as unassessable
+39 ; OUPUT = error messagte or IEN of entry marked unassessable
ASSESS(DATA,IEN,DFN,VAL) ;mark unassessible
+1 NEW FNUM,NEW,X,ATIME,FDA,BIEN,AIEN,FDA2,AIEN2,WHY,WHYIEN,IEN,ACTION
+2 SET FNUM=120.869999911
+3 IF '$DATA(^GMR(120.86,DFN,0))
Begin DoDot:1
+4 SET AIEN="+1,"
SET FDA(120.86,AIEN,.01)=DFN
+5 SET IEN(1)=DFN
+6 DO UPDATE^DIE(,"FDA","IEN","ERR")
+7 IF 'IEN(1)
SET DATA="-1^Unable to update allergy assessment"
End DoDot:1
+8 ;See if there are any earlier unable to assess nodes not closed out
+9 SET ACTION=1
+10 KILL FDA,IEN,ERR,AIEN
+11 DO CKIN(DFN)
+12 SET WHY=$GET(VAL("GMRAACRE"))
+13 SET WHYIEN=$$REASON(WHY)
+14 IF 'WHYIEN
Begin DoDot:1
+15 SET DATA="-1^A valid reason was not submitted"
End DoDot:1
QUIT
+16 SET AIEN="+1,"_DFN_","
+17 SET FDA(120.869999911,AIEN,.01)=VAL("GMRAACC")
+18 SET FDA(120.869999911,AIEN,1)=$PIECE(WHYIEN,U,1)
+19 IF $PIECE(WHYIEN,U,2)'=""
SET FDA(120.869999911,AIEN,5)=$PIECE(WHYIEN,U,2)
+20 IF $GET(VAL("GMRAACCBY"))=""
SET VAL("GMRAACBY")=DUZ
+21 SET FDA(120.869999911,AIEN,2)=VAL("GMRAACCBY")
+22 DO UPDATE^DIE(,"FDA","IEN","ERR")
+23 SET DATA=+$GET(IEN(1))
+24 DO QUEUE^CIANBEVT("GMRA."_DFN,ACTION)
+25 QUIT
+26 ;Input
+27 ; IEN=Entry in the 120.86 file (Blank if pt not in file)
+28 ; DFN=Patient's internal entry number
+29 ; VAL=array of values to be stored
+30 ; ("GMRAACC")=Date entry marked unassessable
+31 ; ("GMRAACCRE")="Date unassessible resolved"
+32 ; ("GMRAACCBY")="User unmarking the unacessable"
+33 ; OUPUT = error messagte or IEN of entry marked unassessable
REASSESS(DATA,IEN,DFN,VAL) ;reactivate
+1 ;Find node to close out
+2 NEW AIEN,STOP,BIEN,ATIME
+3 SET STOP=0
+4 SET ATIME=9999999
FOR
SET ATIME=$ORDER(^GMR(120.86,DFN,9999999.11,"B",ATIME),-1)
IF 'ATIME!(STOP=1)
QUIT
Begin DoDot:1
+5 SET AIEN=""
FOR
SET AIEN=$ORDER(^GMR(120.86,DFN,9999999.11,"B",ATIME,AIEN))
IF '+AIEN!(STOP=1)
QUIT
Begin DoDot:2
+6 IF ATIME=VAL("GMRAACC")
SET STOP=1
+7 SET BIEN=AIEN_","_DFN_","
+8 IF $GET(VAL("GMRAACRE"))=""
SET VAL("GMRAACRE")=$$NOW^XLFDT
+9 SET FDA(120.869999911,BIEN,3)=VAL("GMRAACRE")
+10 IF $GET(VAL("GMRAACCBY"))=""
SET VAL("GMRAACCBY")=DUZ
+11 SET FDA(120.869999911,BIEN,4)=VAL("GMRAACCBY")
+12 DO UPDATE^DIE(,"FDA","IEN","ERR")
+13 IF '$DATA(ERR)
SET DATA=IEN
+14 KILL FDA,IEN,ERR
+15 DO FIREEVT^BEHOART(DFN,2,"")
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;See if there are any earlier unable to assess nodes not closed out
+18 ;If so, close them out
CKIN(DFN) ;
+1 NEW ATIME,AIEN,BIEN,FDA2,IEN,ERR
+2 SET ATIME=9999999
FOR
SET ATIME=$ORDER(^GMR(120.86,DFN,9999999.11,"B",ATIME),-1)
IF ATIME=""
QUIT
Begin DoDot:1
+3 SET BIEN=""
FOR
SET BIEN=$ORDER(^GMR(120.86,DFN,9999999.11,"B",ATIME,BIEN))
IF BIEN=""
QUIT
Begin DoDot:2
+4 IF $PIECE($GET(^GMR(120.86,DFN,9999999.11,BIEN,0)),U,4)=""
Begin DoDot:3
+5 SET AIEN=BIEN_","_DFN_","
+6 SET FDA2(120.869999911,AIEN,3)=$$NOW^XLFDT
+7 SET FDA2(120.869999911,AIEN,4)=DUZ
+8 DO UPDATE^DIE(,"FDA2","IEN","ERR")
+9 KILL FDA2,IEN,ERR
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ; Return IEN to BEH ALLERGY VALUES file
REASON(VAL) ; EP -
+1 NEW X,RET,COM
+2 IF +VAL>0
SET RET=+VAL
+3 IF '$TEST
SET X=$PIECE(VAL,U,2)
SET RET=$ORDER(^BEHOAR(90460.05,"B",X,""))
+4 SET COM=$PIECE(VAL,U,4)
+5 IF COM'=""
SET RET=RET_U_COM
+6 QUIT RET
+7 ;
TMPGBL() KILL ^TMP("BEHOART",$JOB)
QUIT $NAME(^($JOB))
