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