- 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 Jan 18, 2025@02:58:58 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