Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BEHOARMU

BEHOARMU.m

Go to the documentation of this file. 
  1. 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
  1.  ;=================================================================
  1.  ;Return the values that can be selected for the chosen field
  1.  ;Inp=file^field
  1.  ;Return= Array of values that can be used for this field in this file
  1. REASONS(RET,FLG) ;EP List of reasons
  1.  N IEN,CNT,X,Y
  1.  S RET=$$TMPGBL()
  1.  S CNT=0
  1.  S IEN=0 F  S IEN=$O(^BEHOAR(90460.05,IEN)) Q:'+IEN  D
  1.  .I $P($G(^BEHOAR(90460.05,IEN,0)),U,2)=FLG D
  1.  ..S CNT=CNT+1
  1.  ..S X=$P($G(^BEHOAR(90460.05,IEN,0)),U,3)
  1.  ..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)
  1.  Q
  1. SNOMED(RET) ;EP List of snomed codes
  1.  N IEN,CNT,NAME
  1.  S RET=$$TMPGBL()
  1.  S CNT=0
  1.  S NAME="" F  S NAME=$O(^BEHOAR(90460.06,"B",NAME)) Q:NAME=""  D
  1.  .S IEN=0 F  S IEN=$O(^BEHOAR(90460.06,"B",NAME,IEN)) Q:IEN=""  D
  1.  ..Q:+$P($G(^BEHOAR(90460.06,IEN,0)),U,4)
  1.  ..S CNT=CNT+1
  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)
  1.  Q
  1.  ;Mark an allergy as entered in error
  1.  ;Input
  1.  ;  IEN=Entry number in the 120.8 file
  1.  ;  DFN=Patient's internal entry number
  1.  ;  VAL=Array of values to be stored
  1.  ;    ("GMRAERR")=Indicates this entry is to be marked EIE
  1.  ;    ("GMRAERRBY")=User marking it (optional,will set to DUZ)
  1.  ;    ("GMRAERRDT")=Date/time EIE (option,will set to NOW)
  1.  ;    ("GMRAERCMTS")=N  Comment lines for entering in error
  1.  ;    ("GMRAERRCMTS",n)
  1.  ;  OUPUT = error message or IEN of entry marked in error
  1. EIE(DATA,IEN,DFN,VAL) ;entered in error
  1.  N NOW,ORNODE,GMR0
  1.  S GMR0=$P($G(^GMR(120.8,IEN,0)),U),DATA=""
  1.  I '$L(GMR0) S DATA="-1^Entry not found" Q
  1.  D CKIN(DFN)
  1.  S NOW=$$NOW^XLFDT
  1.  I $G(VAL("GMRAERRBY"))="" S VAL("GMRAERRBY")=DUZ
  1.  I $G(VAL("GMRAERRDT"))="" S VAL("GMRAERRDT")=NOW
  1.  S ORNODE=$NAME(^TMP("GMRA",$J))
  1.  K @ORNODE M @ORNODE=VAL
  1.  D EIE^GMRAGUI1(IEN,DFN,ORNODE)
  1.  S DATA=IEN
  1.  D FIREEVT^BEHOART(DFN,2,IEN)
  1.  Q
  1.  ;Mark an allergy as inactivated
  1.  ;Input
  1.  ;  IEN=Entry number in the 120.8 file
  1.  ;  DFN=Patient's internal entry number
  1.  ;  VAL=Array of values to be stored
  1.  ;    ("GMRAINACT")=Date entry marked inactive (required)
  1.  ;    ("GMRAINACBY")=User marking it (optional,will set to DUZ)
  1.  ;    ("GMRAINWHY")=Reason marked inactive^comment if OTHER
  1.  ;  OUPUT = error message or IEN of entry marked inactive
  1. INACT(DATA,IEN,DFN,VAL) ;inactive allergies
  1.  N X,Y,STOP,FNUM,AIEN,ERR,WHY,WHYIEN
  1.  I IEN="" S DATA="-1^Missing entry to inactivate" Q
  1.  D CKIN(DFN)
  1.  S STOP=0,FNUM=120.899999912
  1.  S AIEN="+1,"_IEN_","
  1.  S FDA(120.899999912,AIEN,.01)=$G(VAL("GMRAINACT"))
  1.  S WHY=$G(VAL("GMRAINWHY"))
  1.  S WHYIEN=$$REASON(WHY)
  1.  I WHYIEN S FDA(120.899999912,AIEN,1)=$P(WHYIEN,U,1)
  1.  I $G(VAL("GMRAINACBY"))="" S VAL("GMRAINACBY")=DUZ
  1.  S FDA(120.899999912,AIEN,2)=$G(VAL("GMRAINACBY"))
  1.  I $D(VAL("GMRACMTS")) D GMRACMTS^BEHOART
  1.  D UPDATE^DIE(,"FDA","IEN","ERR")
  1.  S DATA=+IEN
  1.  D FIREEVT^BEHOART(DFN,1,IEN)
  1.  K FDA,ERR
  1.  Q
  1.  ;Input
  1.  ;  IEN=Entry number in the 120.8 file
  1.  ;  DFN=Patient's internal entry number
  1.  ;  VAL=Array of values to be stored
  1.  ;    ("GMRAINRE")=Date/Time to reactivate (required to reactivate)
  1.  ;    ("GMRAINREBY")=User reactivating (optional,will set to DUZ)
  1.  ;  OUPUT = error message or IEN of entry marked inactive
  1. REACT(DATA,IEN,DFN,VAL) ;reactivate allergy
  1.  N X,Y,STOP,FNUM,AIEN,BIEN,ERR,SIEN,SIEN,MIEN,CANVER
  1.  I IEN="" S DATA="-1^Missing entry to reactivate" Q
  1.  D CKIN(DFN)
  1.  S STOP=0,FNUM=120.899999912,BIEN=IEN
  1.  S SIEN=$O(^GMR(120.8,IEN,9999999.12,$C(0)),-1)
  1.  I STOP!'SIEN S DATA="-1^Unable to find entry to reactivate" Q
  1.  S AIEN=SIEN_","_IEN_","
  1.  I $G(VAL("GMRAINREBY"))="" S VAL("GMRAINREBY")=DUZ
  1.  I $G(VAL("GMRAINRE"))="" S VAL("GMRAINRE")=$$NOW^XLFDT
  1.  ;S FDA(120.899999912,AIEN,.01)=$G(VAL("GMRAINACT"))
  1.  S FDA(120.899999912,AIEN,3)=$G(VAL("GMRAINRE"))
  1.  S FDA(120.899999912,AIEN,4)=$G(VAL("GMRAINREBY"))
  1.  D UPDATE^DIE(,"FDA","IEN","ERR")
  1.  K FDA,ERR
  1.  ;Remove the verification, must be redone
  1.  S AIEN=BIEN_","
  1.  S FDA(120.8,AIEN,15)="@"
  1.  S FDA(120.8,AIEN,19)="@"
  1.  S FDA(120.8,AIEN,20)="@"
  1.  S FDA(120.8,AIEN,21)="@"
  1.  D FILE^DIE("","FDA","ERR")
  1.  S DATA=IEN
  1.  D FIREEVT^BEHOART(DFN,1,IEN)
  1.  ;Patch 11 changed to autosign
  1.  S CANVER=$$HASKEY^BEHOUSCX("GMRA-ALLERGY VERIFY")
  1.  D:$$CANSIGN^BEHOART(DATA) SIGN^BEHOART(.SIG,DATA,CANVER)  ;AUTOSIGN
  1.  ;D SNDALR^BEHOART(DATA,1)
  1.  K FDA,ERR
  1.  Q
  1.  ;
  1.  ;Add or release an allergy assessment of unassessable
  1.  ;Input
  1.  ; IEN=Entry in the 120.86 file (Blank if pt not in file)
  1.  ; DFN=Patient's internal entry number
  1.  ; VAL=array of values to be stored
  1.  ;  ("GMRAACC")=Date entry marked unassessable
  1.  ;  ("GMRAACRE")=Reason marked unassessable
  1.  ;  ("GMRAACCBY")=User marking record as unassessable
  1.  ; OUPUT = error messagte or IEN of entry marked unassessable
  1. ASSESS(DATA,IEN,DFN,VAL) ;mark unassessible
  1.  N FNUM,NEW,X,ATIME,FDA,BIEN,AIEN,FDA2,AIEN2,WHY,WHYIEN,IEN,ACTION
  1.  S FNUM=120.869999911
  1.  I '$D(^GMR(120.86,DFN,0)) D
  1.  .S AIEN="+1,",FDA(120.86,AIEN,.01)=DFN
  1.  .S IEN(1)=DFN
  1.  .D UPDATE^DIE(,"FDA","IEN","ERR")
  1.  .I 'IEN(1) S DATA="-1^Unable to update allergy assessment"
  1.  ;See if there are any earlier unable to assess nodes not closed out
  1.  S ACTION=1
  1.  K FDA,IEN,ERR,AIEN
  1.  D CKIN(DFN)
  1.  S WHY=$G(VAL("GMRAACRE"))
  1.  S WHYIEN=$$REASON(WHY)
  1.  I 'WHYIEN D  Q
  1.  .S DATA="-1^A valid reason was not submitted"
  1.  S AIEN="+1,"_DFN_","
  1.  S FDA(120.869999911,AIEN,.01)=VAL("GMRAACC")
  1.  S FDA(120.869999911,AIEN,1)=$P(WHYIEN,U,1)
  1.  I $P(WHYIEN,U,2)'="" S FDA(120.869999911,AIEN,5)=$P(WHYIEN,U,2)
  1.  I $G(VAL("GMRAACCBY"))="" S VAL("GMRAACBY")=DUZ
  1.  S FDA(120.869999911,AIEN,2)=VAL("GMRAACCBY")
  1.  D UPDATE^DIE(,"FDA","IEN","ERR")
  1.  S DATA=+$G(IEN(1))
  1.  D QUEUE^CIANBEVT("GMRA."_DFN,ACTION)
  1.  Q
  1.  ;Input
  1.  ; IEN=Entry in the 120.86 file (Blank if pt not in file)
  1.  ; DFN=Patient's internal entry number
  1.  ; VAL=array of values to be stored
  1.  ;  ("GMRAACC")=Date entry marked unassessable
  1.  ;  ("GMRAACCRE")="Date unassessible resolved"
  1.  ;  ("GMRAACCBY")="User unmarking the unacessable"
  1.  ; OUPUT = error messagte or IEN of entry marked unassessable
  1. REASSESS(DATA,IEN,DFN,VAL) ;reactivate
  1.  ;Find node to close out
  1.  N AIEN,STOP,BIEN,ATIME
  1.  S STOP=0
  1.  S ATIME=9999999 F  S ATIME=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME),-1) Q:'ATIME!(STOP=1)  D
  1.  .S AIEN="" F  S AIEN=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME,AIEN)) Q:'+AIEN!(STOP=1)  D
  1.  ..I ATIME=VAL("GMRAACC") S STOP=1
  1.  ..S BIEN=AIEN_","_DFN_","
  1.  ..I $G(VAL("GMRAACRE"))="" S VAL("GMRAACRE")=$$NOW^XLFDT
  1.  ..S FDA(120.869999911,BIEN,3)=VAL("GMRAACRE")
  1.  ..I $G(VAL("GMRAACCBY"))="" S VAL("GMRAACCBY")=DUZ
  1.  ..S FDA(120.869999911,BIEN,4)=VAL("GMRAACCBY")
  1.  ..D UPDATE^DIE(,"FDA","IEN","ERR")
  1.  ..I '$D(ERR) S DATA=IEN
  1.  ..K FDA,IEN,ERR
  1.  ..D FIREEVT^BEHOART(DFN,2,"")
  1.  Q
  1.  ;See if there are any earlier unable to assess nodes not closed out
  1.  ;If so, close them out
  1. CKIN(DFN) ;
  1.  N ATIME,AIEN,BIEN,FDA2,IEN,ERR
  1.  S ATIME=9999999 F  S ATIME=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME),-1) Q:ATIME=""  D
  1.  .S BIEN="" F  S BIEN=$O(^GMR(120.86,DFN,9999999.11,"B",ATIME,BIEN)) Q:BIEN=""  D
  1.  ..I $P($G(^GMR(120.86,DFN,9999999.11,BIEN,0)),U,4)=""  D
  1.  ...S AIEN=BIEN_","_DFN_","
  1.  ...S FDA2(120.869999911,AIEN,3)=$$NOW^XLFDT
  1.  ...S FDA2(120.869999911,AIEN,4)=DUZ
  1.  ...D UPDATE^DIE(,"FDA2","IEN","ERR")
  1.  ...K FDA2,IEN,ERR
  1.  Q
  1.  ; Return IEN to BEH ALLERGY VALUES file
  1. REASON(VAL) ; EP -
  1.  N X,RET,COM
  1.  I +VAL>0 S RET=+VAL
  1.  E  S X=$P(VAL,U,2) S RET=$O(^BEHOAR(90460.05,"B",X,""))
  1.  S COM=$P(VAL,U,4)
  1.  I COM'="" S RET=RET_U_COM
  1.  Q RET
  1.  ;
  1. TMPGBL() K ^TMP("BEHOART",$J) Q $NA(^($J))