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))