HLEVX003 ;O-OIFO/LJA - VistA HL7 Event Monitor Code ;02/04/2004 15:25
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
REPDINUM ; Create event log entry(s) for DINUM problems. (Use the
; condensed report text instead of making one event for every DINUM
; problem.)
;
; {01/16/04 - Added so wouldn't create thousands of events.}
;
N LINK,LN,NO,PROB,QUIT,TAG,TXT,WAY
;
KILL ^TMP($J,"HLEVDINUM")
;
S LN=0,PROB="",QUIT=0,WAY="",LINK=""
F S LN=$O(^TMP($J,"HLEVREP",LN)) Q:'LN!(QUIT) D
. S TXT=^TMP($J,"HLEVREP",LN)
. I $P(TXT," ")="DINUM" S PROB="DINUM",WAY="",LINK=""
. QUIT:PROB'="DINUM" ;-> No DINUMs, or not to them yet...
. ; $$RDT returns LINK and WAY...
. S TXT=$$RDT(TXT) QUIT:TXT']""!(LINK']"")!(WAY']"") ;->
. F NO=1:1:$L(TXT,",") D
. . S TXT(1)=$P(TXT,",",NO) QUIT:TXT(1)']"" ;->
. . S ^TMP($J,"HLEVDINUM",LINK,WAY,TXT(1))=""
;
; No DINUM problems exist...
S LINK=""
F S LINK=$O(^TMP($J,"HLEVDINUM",LINK)) Q:LINK']"" D
. S WAY=""
. F S WAY=$O(^TMP($J,"HLEVDINUM",LINK,WAY)) Q:WAY']"" D
. . S MIENS=""
. . F S MIENS=$O(^TMP($J,"HLEVDINUM",LINK,WAY,MIENS)) Q:MIENS']"" D
. . . S X=$$LOG^HLEVAPI2("870-DINUM","LINK^WAY^MIENS")
;
KILL ^TMP($J,"HLEVDINUM")
;
Q
;
RDT(TXT) ; Strip down TXT to include only DINUM report details...
; Returns LINK & WAY...
;
; {01/16/04 - See REPDINUM}
;
; First line of DINUM INCOMING or OUTGOING...
I TXT[" INCOMING " D QUIT $P(TXT,"COMING ",2,99) ;->
. S LINK=$P($E(TXT,16,99),"]")_"]"
. S WAY="INCOMING"
.
I TXT[" OUTGOING " D QUIT $P(TXT,"GOING ",2,99) ;->
. S LINK=$P($E(TXT,16,99),"]")_"]"
. S WAY="OUTGOING"
;
; Strip spaces and check pattern match...
S TXT=$TR(TXT," ","") QUIT:TXT']"" "" ;->
QUIT:TXT'?1.N1":"1.N1"(#"1.N1")".E "" ;->
;
Q TXT
;
EOR ;HLEVX003 - VistA HL7 Event Monitor Code ;5/30/03 15:25
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEVX003 1901 printed Nov 22, 2024@17:08:15 Page 2
HLEVX003 ;O-OIFO/LJA - VistA HL7 Event Monitor Code ;02/04/2004 15:25
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
REPDINUM ; Create event log entry(s) for DINUM problems. (Use the
+1 ; condensed report text instead of making one event for every DINUM
+2 ; problem.)
+3 ;
+4 ; {01/16/04 - Added so wouldn't create thousands of events.}
+5 ;
+6 NEW LINK,LN,NO,PROB,QUIT,TAG,TXT,WAY
+7 ;
+8 KILL ^TMP($JOB,"HLEVDINUM")
+9 ;
+10 SET LN=0
SET PROB=""
SET QUIT=0
SET WAY=""
SET LINK=""
+11 FOR
SET LN=$ORDER(^TMP($JOB,"HLEVREP",LN))
if 'LN!(QUIT)
QUIT
Begin DoDot:1
+12 SET TXT=^TMP($JOB,"HLEVREP",LN)
+13 IF $PIECE(TXT," ")="DINUM"
SET PROB="DINUM"
SET WAY=""
SET LINK=""
+14 ;-> No DINUMs, or not to them yet...
if PROB'="DINUM"
QUIT
+15 ; $$RDT returns LINK and WAY...
+16 ;->
SET TXT=$$RDT(TXT)
if TXT']""!(LINK']"")!(WAY']"")
QUIT
+17 FOR NO=1:1:$LENGTH(TXT,",")
Begin DoDot:2
+18 ;->
SET TXT(1)=$PIECE(TXT,",",NO)
if TXT(1)']""
QUIT
+19 SET ^TMP($JOB,"HLEVDINUM",LINK,WAY,TXT(1))=""
End DoDot:2
End DoDot:1
+20 ;
+21 ; No DINUM problems exist...
+22 SET LINK=""
+23 FOR
SET LINK=$ORDER(^TMP($JOB,"HLEVDINUM",LINK))
if LINK']""
QUIT
Begin DoDot:1
+24 SET WAY=""
+25 FOR
SET WAY=$ORDER(^TMP($JOB,"HLEVDINUM",LINK,WAY))
if WAY']""
QUIT
Begin DoDot:2
+26 SET MIENS=""
+27 FOR
SET MIENS=$ORDER(^TMP($JOB,"HLEVDINUM",LINK,WAY,MIENS))
if MIENS']""
QUIT
Begin DoDot:3
+28 SET X=$$LOG^HLEVAPI2("870-DINUM","LINK^WAY^MIENS")
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
+30 KILL ^TMP($JOB,"HLEVDINUM")
+31 ;
+32 QUIT
+33 ;
RDT(TXT) ; Strip down TXT to include only DINUM report details...
+1 ; Returns LINK & WAY...
+2 ;
+3 ; {01/16/04 - See REPDINUM}
+4 ;
+5 ; First line of DINUM INCOMING or OUTGOING...
+6 ;->
IF TXT[" INCOMING "
Begin DoDot:1
+7 SET LINK=$PIECE($EXTRACT(TXT,16,99),"]")_"]"
+8 SET WAY="INCOMING"
+9 End DoDot:1
QUIT $PIECE(TXT,"COMING ",2,99)
+10 ;->
IF TXT[" OUTGOING "
Begin DoDot:1
+11 SET LINK=$PIECE($EXTRACT(TXT,16,99),"]")_"]"
+12 SET WAY="OUTGOING"
End DoDot:1
QUIT $PIECE(TXT,"GOING ",2,99)
+13 ;
+14 ; Strip spaces and check pattern match...
+15 ;->
SET TXT=$TRANSLATE(TXT," ","")
if TXT']""
QUIT ""
+16 ;->
if TXT'?1.N1"
QUIT ""
+17 ;
+18 QUIT TXT
+19 ;
EOR ;HLEVX003 - VistA HL7 Event Monitor Code ;5/30/03 15:25
