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

HLEMDD.m

Go to the documentation of this file. 
  1. HLEMDD ;ALB/CJM-HL7 - M CODE FOUND IN THE DD'S ;02/04/2004
  1.  ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
  1.  ;
  1.  ;
  1. KILLAH(IEN) ;kills the AH x~ref on file 776.4 or a particular event=ien
  1.  Q:'$G(IEN)
  1.  N NEXT,LOCATION
  1.  S NEXT=""
  1.  F  S NEXT=$O(^HLEV(776.4,"AH KILL",IEN,NEXT)) Q:'$L(NEXT)  D
  1.  .S LOCATION="^HLEV(776.4,""AH"","_NEXT
  1.  .K @LOCATION
  1.  K ^HLEV(776.4,"AH KILL",IEN)
  1.  Q
  1.  ;
  1. SETID(IEN) ;sets the value of the ID field in the EVENT
  1.  ;Input:  IEN is the ien of the Monitor Event
  1.  ;Output: none
  1.  ;
  1.  Q:'$G(IEN)
  1.  Q:'$D(^HLEV(776.4,IEN,0))
  1.  S $P(^HLEV(776.4,IEN,0),"^",4)=$$STATNUM^HLEMU_"-"_IEN
  1.  Q
  1.  ;
  1. STATUS(IEN,STATUS) ;
  1.  ;if the REVIEW STATUS is REQUIRED ONLY IF ACTION FAILS then  when the ACTION STATUS field changes the REVIEW STATUS is updated appropriately
  1.  ;
  1.  ;
  1.  Q:'$G(IEN)
  1.  Q:($G(STATUS)<3)
  1.  N NODE,REVIEW
  1.  S NODE=$G(^HLEV(776.4,IEN,0))
  1.  S REVIEW=$P(NODE,"^",6)
  1.  I REVIEW=2 D
  1.  .I STATUS=3 S $P(^HLEV(776.4,IEN,0),"^",6)=0
  1.  .I STATUS=4 S $P(^HLEV(776.4,IEN,0),"^",6)=1
  1.  Q
  1.  ;
  1. ADDSTAT(NEWTIME,OLDSITE,SITE,TYPE,STATUS,COUNT) ;
  1.  ;Description - add logic for the AF x~ref on the Monitor Event file.
  1.  ;Maintains statistics for events.
  1.  ;Input:
  1.  ;  NEWTIME - new value of the .01 field (DT/TM)
  1.  ;  OLDSITE - old value of the SITE field
  1.  ;  SITE - new value of the SITE field
  1.  ;  TYPE - new value of the TYPE field
  1.  ;  STATUS - new value of the REVIEW STATUS field
  1.  ;  COUNT - the new value of the COUNT field
  1.  ;Output:  see DD for description of the AF x~ref
  1.  ;
  1.  Q:'($G(NEWTIME)&$G(SITE)&$G(TYPE)&$L($G(STATUS)))
  1.  ;
  1.  N INDEX
  1.  S INDEX="^HLEV(776.4,""AF"",SITE,TYPE)"
  1.  ;
  1.  ;COUNT must be ast least 1
  1.  S COUNT=$G(COUNT,1)
  1.  ;
  1.  I '$G(OLDSITE) D
  1.  .N YEAR,MONTH,DAY,HOUR
  1.  .S YEAR=$$YEAR(NEWTIME),MONTH=$$MONTH(NEWTIME),DAY=$$DAY(NEWTIME),HOUR=$$HOUR(NEWTIME)
  1.  .I YEAR,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR)),COUNT) D
  1.  ..I MONTH,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR,"MONTH",MONTH)),COUNT) D
  1.  ...I DAY,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY)),COUNT) D
  1.  ....I HOUR,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY,"HOUR",HOUR)),COUNT)
  1.  I $$I^HLEMU($NA(@INDEX@(STATUS)),COUNT)
  1.  Q
  1.  ;
  1. DELSTAT(SITE,TYPE,STATUS,COUNT) ;
  1.  ;Description - delete logic for the AF x~ref on the Monitor Event file.
  1.  ;Maintains statistics for events.
  1.  ;Input:
  1.  ;  SITE - old value of the SITE field
  1.  ;  TYPE - old value of the TYPE field
  1.  ;  STATUS - old value of the REVIEW STATUS field
  1.  ;  COUNT - old value fo the COUNT field
  1.  ;Output:  see DD for description of the AF x~ref
  1.  ;
  1.  Q:'($G(SITE)&$G(TYPE)&$L($G(STATUS)))
  1.  ;
  1.  ;COUNT must be at least 1
  1.  S COUNT=$G(COUNT,1)
  1.  ;
  1.  N INDEX
  1.  S INDEX="^HLEV(776.4,""AF"",SITE,TYPE,STATUS)"
  1.  I $$I^HLEMU($NA(@INDEX),-COUNT)
  1.  Q
  1.  ;
  1. YEAR(FMDATE) ;returns the year (i.e., "2003", not in FM format)
  1.  Q $S($G(FMDATE):1700+$E(FMDATE,1,3),1:"")
  1. MONTH(FMDATE) ;returns the month (1-12)
  1.  Q $S($G(FMDATE):+$E(FMDATE,4,5),1:"")
  1. DAY(FMDATE) ;returns the day (1 - 31)
  1.  Q $S($G(FMDATE):+$E(FMDATE,6,7),1:"")
  1. HOUR(FMDATE) ;returns the hour (1-24
  1.  Q $S($G(FMDATE):+$E($P(FMDATE,".",2),1,2),1:"")
  1.  ;
  1. URGENCY(EVENT,URGENT,ACTION,REVIEW) ;
  1.  ;Description- changes the urgency as the action status and review status change.
  1.  ;
  1.  Q:'$G(EVENT)
  1.  I $G(URGENT)=2,$G(ACTION)=4 S $P(^HLEV(776.4,EVENT,0),"^",12)=1
  1.  I $G(URGENT)=2,$G(ACTION)=3 S $P(^HLEV(776.4,EVENT,0),"^",12)=0
  1.  I $G(REVIEW)=4 S $P(^HLEV(776.4,EVENT,0),"^",12)=0
  1.  Q
  1.  ;
  1. DEFAULT(PROFILE,DUZ,DEFAULT) ;
  1.  ;Description - maintains the "AC" x~ref on file 776.5, Event Log Prfofiles, insuring that each use has only one profile marked his default
  1.  ;
  1.  Q:'$G(PROFILE)
  1.  Q:'$G(DUZ)
  1.  Q:'$D(DEFAULT)
  1.  I $G(DEFAULT) D
  1.  .N PROF
  1.  .S PROF=""
  1.  .F  S PROF=$O(^HLEV(776.5,"AC",DUZ,PROF)) Q:'PROF  D
  1.  ..S $P(^HLEV(776.5,PROF,0),"^",3)=0
  1.  ..K ^HLEV(776.5,"AC",DUZ,PROF)
  1.  .S ^HLEV(776.5,"AC",DUZ,PROFILE)=""
  1.  E  D
  1.  .K ^HLEV(776.5,"AC",DUZ,PROFILE)
  1.  Q
  1.  ;
  1. CSTATUS(EVENT,STATUS) ;
  1.  ;This is the trigger logic of the AI index for file 776.4. If the event
  1.  ;status changes to COMPLETED, the DT/TM REVIEWED field is set to NOW
  1.  ;and the REVIEWER field is set to DUZ, if defined.
  1.  ;
  1.  Q:'$G(EVENT)
  1.  Q:$G(STATUS)'=4
  1.  S $P(^HLEV(776.4,EVENT,0),"^",7)=$$NOW^XLFDT
  1.  S $P(^HLEV(776.4,EVENT,0),"^",8)=$G(DUZ)
  1.  Q 
  1.  ;
  1. SETPURGE(EVENT,WHEN,TYPE) ;
  1.  ;Sets the earliest purge date into the AJ index on file 776.4
  1.  ;Input:
  1.  ;  EVENT - IEN of the event
  1.  ;  WHEN - .01 FIELD (DT/TM)
  1.  ;  TYPE - .02 field - event type
  1.  ;
  1.  Q:'$G(EVENT)
  1.  Q:'$G(WHEN)
  1.  Q:'$G(TYPE)
  1.  ;
  1.  N WAIT,PWHEN
  1.  S WAIT=$P($G(^HLEV(776.3,TYPE,0)),"^",9)
  1.  Q:'WAIT
  1.  S PDATE=$$FMADD^XLFDT(WHEN,WAIT\1)
  1.  S ^HLEV(776.4,"AJ",PDATE,EVENT)=""
  1.  Q
  1.  ;
  1. DELPURGE(EVENT,WHEN,TYPE) ;
  1.  ;kill logic fo the AJ index of file 776.4
  1.  ;Input:
  1.  ;  EVENT - IEN of the event
  1.  ;  WHEN - .01 FIELD (DT/TM)
  1.  ;  TYPE - .02 field - event type
  1.  ;
  1.  Q:'$G(EVENT)
  1.  Q:'$G(WHEN)
  1.  Q:'$G(TYPE)
  1.  ;
  1.  N WAIT,PWHEN
  1.  S WAIT=$P($G(^HLEV(776.3,TYPE,0)),"^",9)
  1.  Q:'WAIT
  1.  S PDATE=$$FMADD^XLFDT(WHEN,WAIT\1)
  1.  K ^HLEV(776.4,"AJ",PDATE,EVENT)
  1.  Q
  1.  ;
  1. SETPKG(ETYPE,PACKAGE,OLDNAME) ;
  1.  ;Given a ptr to the event type and package, it sets the PACKAGE NAME
  1.  ;field to the name of the package.  Also maintains the index that 
  1.  ;PACKAGE NAME is part of
  1.  ;
  1.  Q:'$G(ETYPE)
  1.  Q:'$G(PACKAGE)
  1.  N NAME,NODE
  1.  S NAME=$P($G(^DIC(9.4,PACKAGE,0)),"^")
  1.  S $P(^HLEV(776.3,ETYPE,0),"^",8)=NAME
  1.  S NODE=$G(^HLEV(776.3,ETYPE,0))
  1.  I $L($G(OLDNAME)),$L($P(NODE,"^")) K ^HLEV("AC",$P(NODE,"^"),OLDNAME)
  1.  I $L(NAME),$L($P(NODE,"^")) S ^HLEV("AC",$P(NODE,"^"),NAME)=ETYPE
  1.  Q