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

HLEVAPI2.m

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