HLEVAPI2 ;O-OIFO/LJA - Event Monitor APIs ;02/04/2004 14:42
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
VARLIST(HLEVIENJ,SUB) ; Return event variable information in ^TMP($J,SUB)...
N CT,DATA,EXP,MIEN,VAL,VAR
;
QUIT:$G(^HLEV(776,+$G(HLEVIENJ),0))']"" "" ;->
;
S MIEN=0,CT=""
F S MIEN=$O(^HLEV(776,HLEVIENJ,52,MIEN)) Q:MIEN'>0 D
. S CT=CT+1
. S DATA=$G(^HLEV(776,+HLEVIENJ,52,+MIEN,0))
. S VAR=$P(DATA,U),EXP=$P(DATA,U,2)
. S VAL=$G(^HLEV(776,+HLEVIENJ,52,+MIEN,52))
. S ^TMP($J,SUB,VAR,"V")=VAL
. I EXP]"" S ^TMP($J,SUB,VAR,"E")=EXP
;
Q CT
;
PREVENT(HLEVIENE,SUB,STATUS) ; Return <PR>evious <event> runs in ^TMP($J,SUB)
N CT,DATA,IEN
;
S HLEVIENE=$G(HLEVIENE) QUIT:HLEVIENE']"" "" ;->
QUIT:$G(SUB)']"" "" ;->
;
S STATUS=$$UP^XLFSTR($E($G(STATUS)))
;
; Maybe passed in the event name...
I HLEVIENE'=+HLEVIENE D QUIT:HLEVIENE'>0 "" ;->
. S HLEVIENE=$O(^HLEV(776.1,"B",HLEVIENE,0))
;
; Loop thru entries...
S IEN=0,CT=0
F S IEN=$O(^HLEV(776,"M",+HLEVIENE,IEN)) Q:IEN'>0 D
. S DATA=$G(^HLEV(776,+IEN,0)) QUIT:DATA']"" ;->
. I STATUS]"",$P(DATA,U,4)'=STATUS QUIT ;->
. S CT=CT+1
. S X=$P(DATA,U,4),STATUS(1)=$S(X]"":X,1:"?")
. S ^TMP($J,SUB,"D",IEN)=DATA
. S ^TMP($J,SUB,"S",STATUS(1),IEN)=""
;
Q CT
;
EVCHKD(HLEVIENM,HLEVIENE,HLEVIENJ,STATUS) ; Event code finished. Mark event check multiple in 776.2 done...
; ZTSK -- req
N DATA,MIEN
;
QUIT:HLEVIENM=9999999 ;-> No master job...
; Not usually passed. But, passed by ABORT^HLEVAPI...
S STATUS=$S($G(STATUS)]"":$E(STATUS),1:"F")
;
S MIEN=$O(^HLEV(776.2,+$G(HLEVIENM),51,"B",+$G(HLEVIENE),":"),-1) QUIT:MIEN'>0 ;->
S DATA=$G(^HLEV(776.2,+HLEVIENM,51,+MIEN,0)) QUIT:$P(DATA,U,4)'=$G(ZTSK) ;->
S $P(DATA,U,5)=STATUS,$P(DATA,U,6)=$$NOW^XLFDT,$P(DATA,U,8)=$G(HLEVIENJ)
S ^HLEV(776.2,+HLEVIENM,51,+MIEN,0)=DATA
Q
;
ADDXMYS(HLEVIENE,XTMP) ; Set up XMY()s...
N DATA,MIEN,MONM,NODE,RECIP
;
; Any recipients built into monitor?
F NODE=60,61,62 D
. S MIEN=0
. F S MIEN=$O(^HLEV(776.1,+HLEVIENE,+NODE,MIEN)) Q:MIEN'>0 D
. . S DATA=$P($G(^HLEV(776.1,+HLEVIENE,+NODE,+MIEN,0)),U) QUIT:DATA']"" ;->
. . I NODE=60 S DATA=$P($G(^XMB(3.8,+DATA,0)),U),DATA=$S(DATA]"":"G."_DATA,1:"") QUIT:DATA']"" ;->
. . S XMY(DATA)=""
;
; Any recipients passed in in data request?
QUIT:$G(XTMP)']"" ;->
S MONM=$P($G(^HLEV(776.1,+HLEVIENE,0)),U) QUIT:MONM']"" ;->
S RECIP=""
F S RECIP=$O(^XTMP(XTMP,"MONREQ","MON",+HLEVIENE,RECIP)) Q:RECIP']"" D
. S XMY(RECIP)=""
;
Q
;
MGRP(HLEVIENE) ; Return G.MAIL-GROUP...
N MGRP
S MGRP=$P($G(^HLEV(776.1,+$G(HLEVIENE),0)),U,5)
S MGRP=$P($G(^XMB(3.8,+MGRP,0)),U) QUIT:MGRP']"" "" ;->
Q "G."_MGRP
;
LOADBODY(HLEVIENJ,SVSUB) ; Load body into global to mail...
N END,NODE,P1,P2,P3,P4,P5,P6,P7,PCE,START,TXT
;
S SVSUB=$S($G(SVSUB)]"":SVSUB,1:"HLMAILMSG")
;
S NODE=$G(^HLEV(776,+HLEVIENJ,0))
F PCE=1:1:7 S @("P"_PCE)=$P(NODE,U,PCE)
;
; START - END
S START=$$FMTE^XLFDT(P1),END=$$FMTE^XLFDT(P2)
S TXT(1)=$E("Start time: "_START_$$REPEAT^XLFSTR(" ",40),1,34)_" "
S TXT(2)="End time: "_END
D ADD^HLEVAPI1(TXT(1)_TXT(2))
;
; STATUS-RUN - STATUS-APPL
S P4=$S(P4="E":"ERROR",P4="F":"FINISHED",P4="Q":"QUEUED (NOT RUNNING YE T)",1:"??")
S TXT(1)=$E("Status: "_P4_$$REPEAT^XLFSTR(" ",40),1,34)_" "
S TXT(2)=$S(P5]"":"Status-Appl: "_P5,1:"")
D ADD^HLEVAPI1(TXT(1)_TXT(2))
;
Q
;
LOADDGBL(HLEVIENJ,SUBDD,SVSUB) ; Load event text into global to mail...
N HDR,MIEN
S HDR=$S(SUBDD=50:"Run Diary",SUBDD=51:"Additional Text",1:"")
S SVSUB=$S($G(SVSUB)]"":SVSUB,1:"HLMAILMSG")
I $O(^HLEV(776,+HLEVIENJ,SUBDD,0))>0 D
. D ADD^HLEVAPI1("") ; Always add a blank line...
. I HDR]"" D ADD^HLEVAPI1(HDR),ADD^HLEVAPI1($$REPEAT^XLFSTR("-",$L(HDR)))
S MIEN=0
F S MIEN=$O(^HLEV(776,+HLEVIENJ,SUBDD,MIEN)) Q:'MIEN D
. D ADD^HLEVAPI1($G(^HLEV(776,+HLEVIENJ,SUBDD,+MIEN,0)))
Q
;
DEBUGSET ; Set debugging on/off for a tag...
N CUT,TAG
DSET1 ;
I $O(^XTMP("HLEV DEBUG",0))']"" D
. KILL ^XTMP("HLEV DEBUG")
;
I $O(^XTMP("HLEV DEBUG",""))]"" D
. W !!,"Current debug sets..."
. W !
. S TAG=0
. F S TAG=$O(^XTMP("HLEV DEBUG",TAG)) Q:TAG']"" D
. . S CUT=$G(^XTMP("HLEV DEBUG",TAG)) QUIT:CUT']"" ;->
. . W !,TAG,?20,CUT,"..."
;
R !!,"Tag: ",TAG:99 Q:TAG']"" ;->
S CUT=$G(^XTMP("HLEV DEBUG",TAG))
I CUT]"" W " ... set to ",CUT," ..."
R !,"Cutoff time (FM): ",CUT:99
;
I CUT="@" D
. KILL ^XTMP("HLEV DEBUG",TAG)
. W " removing data..."
. I $O(^XTMP("HLEV DEBUG",0))']"" KILL ^XTMP("HLEV DEBUG")
;
I CUT?7N1"."1.N D DSET2(TAG,CUT) W " setting cutoff time..."
;
G DSET1 ;->
;
DSET2(TAG,CUT) ;
S ^XTMP("HLEV DEBUG",0)=$$FMADD^XLFDT($$NOW^XLFDT,0,1)_U_$$NOW^XLFDT_U_"HL7 event monitor debug data"
S ^XTMP("HLEV DEBUG",TAG)=CUT ; Cutoff time after which not to store...
Q
;
DEBUG(TAG,TMPSUB) ; Conditionally store ^XTMP debug data...
; Pass-by-reference references to save by merging...
; TMPSUB(SAVESUB)=REFERENCE
; (E.g., TMPSUB("HLEVREP")=$NA(^TMP($J,"HLEVREP")))
N DATE,NO,SUB,REF,X
;
; Is debugging enabled?
S DATE=$G(^XTMP("HLEV DEBUG",TAG)) QUIT:DATE<$$NOW^XLFDT ;->
;
; There must be a task number...
I $G(ZTSK)'>0 N ZTSK S ZTSK=9999999
;
; Save data...
S NO=$O(^XTMP("HLEV DEBUG",TAG,ZTSK,":"),-1)+1
S ^XTMP("HLEV DEBUG",TAG,ZTSK,+NO)=$$NOW^XLFDT
S X="^XTMP(""HLEV DEBUG"","""_TAG_""","_ZTSK_","_NO_"," D DOLRO^%ZOSV
;
; Save reference data by merging...
S SUB=""
F S SUB=$O(TMPSUB(SUB)) Q:SUB']"" D
. S REF=TMPSUB(SUB) QUIT:REF']"" ;->
. MERGE ^XTMP("HLEV DEBUG",TAG,ZTSK,NO,SUB)=@REF
;
; Remove all but last 20 entries for TAG...
F NO(1)=NO-20:-1:1 KILL ^XTMP("HLEV DEBUG",TAG,ZTSK,NO(1))
;
Q
;
ASKDATE(DATEPMT,PARM,DEFAULT) ; Select date...
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="DO^::"_$S($G(PARM):PARM,1:"EXT")
S DIR("A")=$S($G(DATEPMT)]"":DATEPMT,1:"Select DATE")
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
D ^DIR
I $G(PARM)]"",PARM'["T" QUIT:+Y?7N +Y ;->
I +Y?7N1"."1.N Q +Y
Q ""
;
LOG(ETYPE,STORE) ; Log event type, record variables, create index...
;
; STORE = variables to store, separated by up-arrows. (At the time
; of call to LOG, the value of the variables must be set to
; the value to be stored!)
;
; Returns: Piece 1 -- 0 -> No new log entry made
; 1 -> New log entry made
; Piece 2 -- 776.4 IEN
;
N IEN1,IEN2,LIEN,LIST,LOG,PCE,VAR,X,XRF
;
; Quit if no event type passed. (Event type always used for APPNAME)
QUIT:$G(ETYPE)']"" "" ;->
;
; Defaults...
S LOG="",STORE=$G(STORE)
;
; Extract out the variables used for index (and stored below)...
F PCE=1:1:$L($G(STORE),U) D
. S VAR=$P(STORE,U,+PCE) QUIT:VAR']""!('($D(@VAR)#2)) ;->
. S LIST(PCE)=@VAR
;
; Quit if this problem has already been logged?
I STORE]"" D QUIT:+LOG=1 "^"_$P(LOG,U,2) ;->
. S LOG=$$LOGGED^HLEME1(ETYPE,.LIST)
;
; Make a log entry...
S LIEN=$$EVENT^HLEME(ETYPE,"HEALTH LEVEL SEVEN") QUIT:'LIEN "" ;->
;
; Store event in log, log in event, and create xref...
I $G(HLEVIENJ) D
.
. N LIST
.
. ; Store event in log...
. S X=$$ADDNOTE^HLEME(+LIEN,"Event monitor# "_HLEVIENJ_" created this log entry.")
. ; Store log in event...
. KILL ^TMP($J,"HLZZ")
. S ^TMP($J,"HLZZ",1)="Log# "_LIEN_" was created by this event monitor.)"
. D RUNDIARY^HLEVAPI1($NA(^TMP($J,"HLZZ")))
. KILL ^TMP($J,"HLZZ")
.
. ; Add Xrefs...
. S LIST(1)="X776",LIST(2)=HLEVIENJ,LIST(3)=LIEN
. S X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
.
. S LIST(1)="X7764",LIST(2)=LIEN,LIST(3)=HLEVIENJ
. S X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
;
; If no variables to store, stop now...
I STORE']"" QUIT 1_U_LIEN ;->
;
; Re-extract variables, get values, and store in log entry...
F PCE=1:1:$L($G(STORE),U) D
. S VAR=$P(STORE,U,+PCE) QUIT:VAR']""!('($D(@VAR)#2)) ;->
. S X=$$STOREVAR^HLEME(+LIEN,@VAR,VAR) ; Store variable
. S LIST(PCE)=@VAR
;
; Make a new index...
S X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
;
Q 1_U_LIEN
;
LOGVAR(IEN,VAR) ; Store variable in 776.4...
N CT,MIEN,ZERO
;
QUIT:$G(^HLEV(776.4,+$G(IEN),0))']""!('$D(@VAR)) ;->
S ZERO=$G(^HLEV(776.4,+IEN,3,0)),$P(ZERO,U,2)=776.43
;
S CT=0
;
; Individual variable...
I $D(VAR)#2 D SV(VAR,@VAR) QUIT:'CT ;->
;
S ^HLEV(776.4,+IEN,3,0)=ZERO
;
Q
;
LOGQUERY(IEN,QUERYBEG,QUERYEND) ; Store ARR() in 776.4...
N CT,MIEN,ZERO
;
QUIT:$G(^HLEV(776.4,+$G(IEN),0))']"" ;->
S ZERO=$G(^HLEV(776.4,+IEN,3,0)),$P(ZERO,U,2)=776.43
;
S CT=0
F S QUERYBEG=$Q(@QUERYBEG) Q:QUERYBEG'[QUERYEND D
. D SV(QUERYBEG,@QUERYBEG)
;
QUIT:CT'>0 ;->
;
S ^HLEV(776.4,+IEN,3,0)=ZERO
;
Q
;
SV(VAR,VAL) ; Store individual variable... (Increments CT, updates ZERO,
; and creates MIEN.)
; CT,IEN,ZERO -- req --> CT,MIEN,ZERO
S CT=CT+1
S MIEN=$O(^HLEV(776.4,+IEN,3,":"),-1)+1
S ^HLEV(776.4,+IEN,3,+MIEN,0)=VAR_"="_VAL
S $P(ZERO,U,3)=MIEN,$P(ZERO,U,4)=MIEN
Q
;
EOR ;HLEVAPI2 - Event Monitor APIs ;5/16/03 14:42
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEVAPI2 9194 printed Sep 15, 2024@21:21:55 Page 2
HLEVAPI2 ;O-OIFO/LJA - Event Monitor APIs ;02/04/2004 14:42
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
VARLIST(HLEVIENJ,SUB) ; Return event variable information in ^TMP($J,SUB)...
+1 NEW CT,DATA,EXP,MIEN,VAL,VAR
+2 ;
+3 ;->
if $GET(^HLEV(776,+$GET(HLEVIENJ),0))']""
QUIT ""
+4 ;
+5 SET MIEN=0
SET CT=""
+6 FOR
SET MIEN=$ORDER(^HLEV(776,HLEVIENJ,52,MIEN))
if MIEN'>0
QUIT
Begin DoDot:1
+7 SET CT=CT+1
+8 SET DATA=$GET(^HLEV(776,+HLEVIENJ,52,+MIEN,0))
+9 SET VAR=$PIECE(DATA,U)
SET EXP=$PIECE(DATA,U,2)
+10 SET VAL=$GET(^HLEV(776,+HLEVIENJ,52,+MIEN,52))
+11 SET ^TMP($JOB,SUB,VAR,"V")=VAL
+12 IF EXP]""
SET ^TMP($JOB,SUB,VAR,"E")=EXP
End DoDot:1
+13 ;
+14 QUIT CT
+15 ;
PREVENT(HLEVIENE,SUB,STATUS) ; Return <PR>evious <event> runs in ^TMP($J,SUB)
+1 NEW CT,DATA,IEN
+2 ;
+3 ;->
SET HLEVIENE=$GET(HLEVIENE)
if HLEVIENE']""
QUIT ""
+4 ;->
if $GET(SUB)']""
QUIT ""
+5 ;
+6 SET STATUS=$$UP^XLFSTR($EXTRACT($GET(STATUS)))
+7 ;
+8 ; Maybe passed in the event name...
+9 ;->
IF HLEVIENE'=+HLEVIENE
Begin DoDot:1
+10 SET HLEVIENE=$ORDER(^HLEV(776.1,"B",HLEVIENE,0))
End DoDot:1
if HLEVIENE'>0
QUIT ""
+11 ;
+12 ; Loop thru entries...
+13 SET IEN=0
SET CT=0
+14 FOR
SET IEN=$ORDER(^HLEV(776,"M",+HLEVIENE,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+15 ;->
SET DATA=$GET(^HLEV(776,+IEN,0))
if DATA']""
QUIT
+16 ;->
IF STATUS]""
IF $PIECE(DATA,U,4)'=STATUS
QUIT
+17 SET CT=CT+1
+18 SET X=$PIECE(DATA,U,4)
SET STATUS(1)=$SELECT(X]"":X,1:"?")
+19 SET ^TMP($JOB,SUB,"D",IEN)=DATA
+20 SET ^TMP($JOB,SUB,"S",STATUS(1),IEN)=""
End DoDot:1
+21 ;
+22 QUIT CT
+23 ;
EVCHKD(HLEVIENM,HLEVIENE,HLEVIENJ,STATUS) ; Event code finished. Mark event check multiple in 776.2 done...
+1 ; ZTSK -- req
+2 NEW DATA,MIEN
+3 ;
+4 ;-> No master job...
if HLEVIENM=9999999
QUIT
+5 ; Not usually passed. But, passed by ABORT^HLEVAPI...
+6 SET STATUS=$SELECT($GET(STATUS)]"":$EXTRACT(STATUS),1:"F")
+7 ;
+8 ;->
SET MIEN=$ORDER(^HLEV(776.2,+$GET(HLEVIENM),51,"B",+$GET(HLEVIENE),":"),-1)
if MIEN'>0
QUIT
+9 ;->
SET DATA=$GET(^HLEV(776.2,+HLEVIENM,51,+MIEN,0))
if $PIECE(DATA,U,4)'=$GET(ZTSK)
QUIT
+10 SET $PIECE(DATA,U,5)=STATUS
SET $PIECE(DATA,U,6)=$$NOW^XLFDT
SET $PIECE(DATA,U,8)=$GET(HLEVIENJ)
+11 SET ^HLEV(776.2,+HLEVIENM,51,+MIEN,0)=DATA
+12 QUIT
+13 ;
ADDXMYS(HLEVIENE,XTMP) ; Set up XMY()s...
+1 NEW DATA,MIEN,MONM,NODE,RECIP
+2 ;
+3 ; Any recipients built into monitor?
+4 FOR NODE=60,61,62
Begin DoDot:1
+5 SET MIEN=0
+6 FOR
SET MIEN=$ORDER(^HLEV(776.1,+HLEVIENE,+NODE,MIEN))
if MIEN'>0
QUIT
Begin DoDot:2
+7 ;->
SET DATA=$PIECE($GET(^HLEV(776.1,+HLEVIENE,+NODE,+MIEN,0)),U)
if DATA']""
QUIT
+8 ;->
IF NODE=60
SET DATA=$PIECE($GET(^XMB(3.8,+DATA,0)),U)
SET DATA=$SELECT(DATA]"":"G."_DATA,1:"")
if DATA']""
QUIT
+9 SET XMY(DATA)=""
End DoDot:2
End DoDot:1
+10 ;
+11 ; Any recipients passed in in data request?
+12 ;->
if $GET(XTMP)']""
QUIT
+13 ;->
SET MONM=$PIECE($GET(^HLEV(776.1,+HLEVIENE,0)),U)
if MONM']""
QUIT
+14 SET RECIP=""
+15 FOR
SET RECIP=$ORDER(^XTMP(XTMP,"MONREQ","MON",+HLEVIENE,RECIP))
if RECIP']""
QUIT
Begin DoDot:1
+16 SET XMY(RECIP)=""
End DoDot:1
+17 ;
+18 QUIT
+19 ;
MGRP(HLEVIENE) ; Return G.MAIL-GROUP...
+1 NEW MGRP
+2 SET MGRP=$PIECE($GET(^HLEV(776.1,+$GET(HLEVIENE),0)),U,5)
+3 ;->
SET MGRP=$PIECE($GET(^XMB(3.8,+MGRP,0)),U)
if MGRP']""
QUIT ""
+4 QUIT "G."_MGRP
+5 ;
LOADBODY(HLEVIENJ,SVSUB) ; Load body into global to mail...
+1 NEW END,NODE,P1,P2,P3,P4,P5,P6,P7,PCE,START,TXT
+2 ;
+3 SET SVSUB=$SELECT($GET(SVSUB)]"":SVSUB,1:"HLMAILMSG")
+4 ;
+5 SET NODE=$GET(^HLEV(776,+HLEVIENJ,0))
+6 FOR PCE=1:1:7
SET @("P"_PCE)=$PIECE(NODE,U,PCE)
+7 ;
+8 ; START - END
+9 SET START=$$FMTE^XLFDT(P1)
SET END=$$FMTE^XLFDT(P2)
+10 SET TXT(1)=$EXTRACT("Start time: "_START_$$REPEAT^XLFSTR(" ",40),1,34)_" "
+11 SET TXT(2)="End time: "_END
+12 DO ADD^HLEVAPI1(TXT(1)_TXT(2))
+13 ;
+14 ; STATUS-RUN - STATUS-APPL
+15 SET P4=$SELECT(P4="E":"ERROR",P4="F":"FINISHED",P4="Q":"QUEUED (NOT RUNNING YE T)",1:"??")
+16 SET TXT(1)=$EXTRACT("Status: "_P4_$$REPEAT^XLFSTR(" ",40),1,34)_" "
+17 SET TXT(2)=$SELECT(P5]"":"Status-Appl: "_P5,1:"")
+18 DO ADD^HLEVAPI1(TXT(1)_TXT(2))
+19 ;
+20 QUIT
+21 ;
LOADDGBL(HLEVIENJ,SUBDD,SVSUB) ; Load event text into global to mail...
+1 NEW HDR,MIEN
+2 SET HDR=$SELECT(SUBDD=50:"Run Diary",SUBDD=51:"Additional Text",1:"")
+3 SET SVSUB=$SELECT($GET(SVSUB)]"":SVSUB,1:"HLMAILMSG")
+4 IF $ORDER(^HLEV(776,+HLEVIENJ,SUBDD,0))>0
Begin DoDot:1
+5 ; Always add a blank line...
DO ADD^HLEVAPI1("")
+6 IF HDR]""
DO ADD^HLEVAPI1(HDR)
DO ADD^HLEVAPI1($$REPEAT^XLFSTR("-",$LENGTH(HDR)))
End DoDot:1
+7 SET MIEN=0
+8 FOR
SET MIEN=$ORDER(^HLEV(776,+HLEVIENJ,SUBDD,MIEN))
if 'MIEN
QUIT
Begin DoDot:1
+9 DO ADD^HLEVAPI1($GET(^HLEV(776,+HLEVIENJ,SUBDD,+MIEN,0)))
End DoDot:1
+10 QUIT
+11 ;
DEBUGSET ; Set debugging on/off for a tag...
+1 NEW CUT,TAG
DSET1 ;
+1 IF $ORDER(^XTMP("HLEV DEBUG",0))']""
Begin DoDot:1
+2 KILL ^XTMP("HLEV DEBUG")
End DoDot:1
+3 ;
+4 IF $ORDER(^XTMP("HLEV DEBUG",""))]""
Begin DoDot:1
+5 WRITE !!,"Current debug sets..."
+6 WRITE !
+7 SET TAG=0
+8 FOR
SET TAG=$ORDER(^XTMP("HLEV DEBUG",TAG))
if TAG']""
QUIT
Begin DoDot:2
+9 ;->
SET CUT=$GET(^XTMP("HLEV DEBUG",TAG))
if CUT']""
QUIT
+10 WRITE !,TAG,?20,CUT,"..."
End DoDot:2
End DoDot:1
+11 ;
+12 ;->
READ !!,"Tag: ",TAG:99
if TAG']""
QUIT
+13 SET CUT=$GET(^XTMP("HLEV DEBUG",TAG))
+14 IF CUT]""
WRITE " ... set to ",CUT," ..."
+15 READ !,"Cutoff time (FM): ",CUT:99
+16 ;
+17 IF CUT="@"
Begin DoDot:1
+18 KILL ^XTMP("HLEV DEBUG",TAG)
+19 WRITE " removing data..."
+20 IF $ORDER(^XTMP("HLEV DEBUG",0))']""
KILL ^XTMP("HLEV DEBUG")
End DoDot:1
+21 ;
+22 IF CUT?7N1"."1.N
DO DSET2(TAG,CUT)
WRITE " setting cutoff time..."
+23 ;
+24 ;->
GOTO DSET1
+25 ;
DSET2(TAG,CUT) ;
+1 SET ^XTMP("HLEV DEBUG",0)=$$FMADD^XLFDT($$NOW^XLFDT,0,1)_U_$$NOW^XLFDT_U_"HL7 event monitor debug data"
+2 ; Cutoff time after which not to store...
SET ^XTMP("HLEV DEBUG",TAG)=CUT
+3 QUIT
+4 ;
DEBUG(TAG,TMPSUB) ; Conditionally store ^XTMP debug data...
+1 ; Pass-by-reference references to save by merging...
+2 ; TMPSUB(SAVESUB)=REFERENCE
+3 ; (E.g., TMPSUB("HLEVREP")=$NA(^TMP($J,"HLEVREP")))
+4 NEW DATE,NO,SUB,REF,X
+5 ;
+6 ; Is debugging enabled?
+7 ;->
SET DATE=$GET(^XTMP("HLEV DEBUG",TAG))
if DATE<$$NOW^XLFDT
QUIT
+8 ;
+9 ; There must be a task number...
+10 IF $GET(ZTSK)'>0
NEW ZTSK
SET ZTSK=9999999
+11 ;
+12 ; Save data...
+13 SET NO=$ORDER(^XTMP("HLEV DEBUG",TAG,ZTSK,":"),-1)+1
+14 SET ^XTMP("HLEV DEBUG",TAG,ZTSK,+NO)=$$NOW^XLFDT
+15 SET X="^XTMP(""HLEV DEBUG"","""_TAG_""","_ZTSK_","_NO_","
DO DOLRO^%ZOSV
+16 ;
+17 ; Save reference data by merging...
+18 SET SUB=""
+19 FOR
SET SUB=$ORDER(TMPSUB(SUB))
if SUB']""
QUIT
Begin DoDot:1
+20 ;->
SET REF=TMPSUB(SUB)
if REF']""
QUIT
+21 MERGE ^XTMP("HLEV DEBUG",TAG,ZTSK,NO,SUB)=@REF
End DoDot:1
+22 ;
+23 ; Remove all but last 20 entries for TAG...
+24 FOR NO(1)=NO-20:-1:1
KILL ^XTMP("HLEV DEBUG",TAG,ZTSK,NO(1))
+25 ;
+26 QUIT
+27 ;
ASKDATE(DATEPMT,PARM,DEFAULT) ; Select date...
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="DO^::"_$SELECT($GET(PARM):PARM,1:"EXT")
+3 SET DIR("A")=$SELECT($GET(DATEPMT)]"":DATEPMT,1:"Select DATE")
+4 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+5 DO ^DIR
+6 ;->
IF $GET(PARM)]""
IF PARM'["T"
if +Y?7N
QUIT +Y
+7 IF +Y?7N1"."1.N
QUIT +Y
+8 QUIT ""
+9 ;
LOG(ETYPE,STORE) ; Log event type, record variables, create index...
+1 ;
+2 ; STORE = variables to store, separated by up-arrows. (At the time
+3 ; of call to LOG, the value of the variables must be set to
+4 ; the value to be stored!)
+5 ;
+6 ; Returns: Piece 1 -- 0 -> No new log entry made
+7 ; 1 -> New log entry made
+8 ; Piece 2 -- 776.4 IEN
+9 ;
+10 NEW IEN1,IEN2,LIEN,LIST,LOG,PCE,VAR,X,XRF
+11 ;
+12 ; Quit if no event type passed. (Event type always used for APPNAME)
+13 ;->
if $GET(ETYPE)']""
QUIT ""
+14 ;
+15 ; Defaults...
+16 SET LOG=""
SET STORE=$GET(STORE)
+17 ;
+18 ; Extract out the variables used for index (and stored below)...
+19 FOR PCE=1:1:$LENGTH($GET(STORE),U)
Begin DoDot:1
+20 ;->
SET VAR=$PIECE(STORE,U,+PCE)
if VAR']""!('($DATA(@VAR)#2))
QUIT
+21 SET LIST(PCE)=@VAR
End DoDot:1
+22 ;
+23 ; Quit if this problem has already been logged?
+24 ;->
IF STORE]""
Begin DoDot:1
+25 SET LOG=$$LOGGED^HLEME1(ETYPE,.LIST)
End DoDot:1
if +LOG=1
QUIT "^"_$PIECE(LOG,U,2)
+26 ;
+27 ; Make a log entry...
+28 ;->
SET LIEN=$$EVENT^HLEME(ETYPE,"HEALTH LEVEL SEVEN")
if 'LIEN
QUIT ""
+29 ;
+30 ; Store event in log, log in event, and create xref...
+31 IF $GET(HLEVIENJ)
Begin DoDot:1
+32 +33 NEW LIST
+34 +35 ; Store event in log...
+36 SET X=$$ADDNOTE^HLEME(+LIEN,"Event monitor# "_HLEVIENJ_" created this log entry.")
+37 ; Store log in event...
+38 KILL ^TMP($JOB,"HLZZ")
+39 SET ^TMP($JOB,"HLZZ",1)="Log# "_LIEN_" was created by this event monitor.)"
+40 DO RUNDIARY^HLEVAPI1($NAME(^TMP($JOB,"HLZZ")))
+41 KILL ^TMP($JOB,"HLZZ")
+42 +43 ; Add Xrefs...
+44 SET LIST(1)="X776"
SET LIST(2)=HLEVIENJ
SET LIST(3)=LIEN
+45 SET X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
+46 +47 SET LIST(1)="X7764"
SET LIST(2)=LIEN
SET LIST(3)=HLEVIENJ
+48 SET X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
End DoDot:1
+49 ;
+50 ; If no variables to store, stop now...
+51 ;->
IF STORE']""
QUIT 1_U_LIEN
+52 ;
+53 ; Re-extract variables, get values, and store in log entry...
+54 FOR PCE=1:1:$LENGTH($GET(STORE),U)
Begin DoDot:1
+55 ;->
SET VAR=$PIECE(STORE,U,+PCE)
if VAR']""!('($DATA(@VAR)#2))
QUIT
+56 ; Store variable
SET X=$$STOREVAR^HLEME(+LIEN,@VAR,VAR)
+57 SET LIST(PCE)=@VAR
End DoDot:1
+58 ;
+59 ; Make a new index...
+60 SET X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
+61 ;
+62 QUIT 1_U_LIEN
+63 ;
LOGVAR(IEN,VAR) ; Store variable in 776.4...
+1 NEW CT,MIEN,ZERO
+2 ;
+3 ;->
if $GET(^HLEV(776.4,+$GET(IEN),0))']""!('$DATA(@VAR))
QUIT
+4 SET ZERO=$GET(^HLEV(776.4,+IEN,3,0))
SET $PIECE(ZERO,U,2)=776.43
+5 ;
+6 SET CT=0
+7 ;
+8 ; Individual variable...
+9 ;->
IF $DATA(VAR)#2
DO SV(VAR,@VAR)
if 'CT
QUIT
+10 ;
+11 SET ^HLEV(776.4,+IEN,3,0)=ZERO
+12 ;
+13 QUIT
+14 ;
LOGQUERY(IEN,QUERYBEG,QUERYEND) ; Store ARR() in 776.4...
+1 NEW CT,MIEN,ZERO
+2 ;
+3 ;->
if $GET(^HLEV(776.4,+$GET(IEN),0))']""
QUIT
+4 SET ZERO=$GET(^HLEV(776.4,+IEN,3,0))
SET $PIECE(ZERO,U,2)=776.43
+5 ;
+6 SET CT=0
+7 FOR
SET QUERYBEG=$QUERY(@QUERYBEG)
if QUERYBEG'[QUERYEND
QUIT
Begin DoDot:1
+8 DO SV(QUERYBEG,@QUERYBEG)
End DoDot:1
+9 ;
+10 ;->
if CT'>0
QUIT
+11 ;
+12 SET ^HLEV(776.4,+IEN,3,0)=ZERO
+13 ;
+14 QUIT
+15 ;
SV(VAR,VAL) ; Store individual variable... (Increments CT, updates ZERO,
+1 ; and creates MIEN.)
+2 ; CT,IEN,ZERO -- req --> CT,MIEN,ZERO
+3 SET CT=CT+1
+4 SET MIEN=$ORDER(^HLEV(776.4,+IEN,3,":"),-1)+1
+5 SET ^HLEV(776.4,+IEN,3,+MIEN,0)=VAR_"="_VAL
+6 SET $PIECE(ZERO,U,3)=MIEN
SET $PIECE(ZERO,U,4)=MIEN
+7 QUIT
+8 ;
EOR ;HLEVAPI2 - Event Monitor APIs ;5/16/03 14:42
