HLEVUTIL ;O-OIFO/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
;;1.6;HEALTH LEVEL SEVEN;**109,173**;Oct 13, 1995;Build 14
;
SLM() ; Return info to Systems Link Monitor [HLCSMON1]...
N BAD,DATA,DATE,DAY,DOWN,FIEN,HR,IEN,IOBON,IOBOFF,LASTDT,MIN,SEC,X
;
S X="IOBOFF;IOBON" D ENDR^%ZISS
S DOWN="Monitor "_IOBON_"DOWN"_IOBOFF
;
I $P($G(^HLEV(776.999,1,0)),U,2)'="A" D QUIT DOWN ;->
. S DOWN="Monitor "_IOBON_"STOPPED"_IOBOFF
;
S LASTDT=":",FIEN=0
F S LASTDT=$O(^HLEV(776.2,"B",LASTDT),-1) Q:'LASTDT!(FIEN) D
. S IEN=":"
. F S IEN=$O(^HLEV(776.2,"B",+LASTDT,IEN),-1) Q:'IEN!(FIEN) D
. . S DATA=$G(^HLEV(776.2,+IEN,0)) QUIT:$P(DATA,U,4)'="Q" ;->
. . S FIEN=IEN
I 'FIEN QUIT DOWN ;->
S DATA=$G(^HLEV(776.2,+FIEN,0))
S DATE=$P(DATA,U,6) QUIT:DATE'?7N1"."1.N DOWN ;->
S DATE=$$FMTH^XLFDT(DATE),DATE(1)=$$SEC^HLEVMST0(DATE)
S NOW=$H,NOW(1)=$$SEC^HLEVMST0(NOW)
I DATE(1)<NOW(1) D QUIT $S(BAD:DOWN,1:"Monitor current") ;->
. S BAD=0
. QUIT:(NOW(1)-DATE(1))<(5*60) ;-> OK if less than 5 minutes old
. S BAD=1,DOWN="Monitor "_IOBON_"OVERDUE"_IOBOFF
S DIFF=$$DIFFDH^HLCSFMN1(NOW,DATE)
S DAY=+DIFF,DIFF=$TR($P(DIFF,U,2),":",U)
S HR=+DIFF+(DAY*24),MIN=+$P(DIFF,U,2),SEC=+$P(DIFF,U,3)
S:SEC>30 MIN=MIN+1
S HR=HR+MIN/60,HR=$J(HR,"",1)
Q "Monitor current [next job "_HR_" hr]"
;
DHMSFM(DTFM,NOW,LONG) ; Convert Fileman d/t to Days-Hr-Min-Sec
N HORO
QUIT:$G(DTFM)'?7N.1".".10N "" ;->
S NOW=$$FMTH^XLFDT($S($G(NOW)?7N.E:NOW,1:$$NOW^XLFDT)) ; Default
S HORO=$$FMTH^XLFDT(DTFM)
Q $$DHMSH(HORO,NOW,LONG)
;
DHMSH(DTH,NOW,LONG) ; Convert HORO d/t to Days-Hr-Min-Sec
N DIFF,FUTURE,TIME,X
S LONG=+$G(LONG)
QUIT:$G(DTH)'?5N1","1.N "" ;->
S NOW=$S($G(NOW)]"":NOW,1:$H),FUTURE=0
I +NOW<DTH!(+NOW=+DTH&($P(NOW,",",2)<$P(DTH,",",2))) D
. S X=DTH,DTH=NOW,NOW=X,FUTURE=1
S DIFF=$$DIFFDH^HLCSFMN1(DTH,NOW)
S TIME=""
D C($P(DIFF,U),$S(LONG:$S(+$P(DIFF,U)>1:" days",1:" day"),1:"d"))
D C($P($P(DIFF,U,2),":"),$S(LONG:" hr",1:"h"))
D C($P($P(DIFF,U,2),":",2),$S(LONG:" min",1:"m"))
D C($P($P(DIFF,U,2),":",3),$S(LONG:" sec",1:"s"))
F Q:$E(TIME)'=" " S TIME=$E(TIME,2,999)
F Q:$E(TIME,$L(TIME))'=" " S TIME=$E(TIME,1,$L(TIME)-1)
I FUTURE,TIME]"" S TIME="["_TIME_"]"
Q TIME
;
C(NO,UN) ; Convert to #[UN]...
I NO'>0 QUIT ;->
S TIME=TIME_$S(TIME]"":" ",1:"")_" "_+NO_UN
Q
;
WPTXT(FILE,IEN,NODE,DDNO,TXT) ; Add text to multiple WP field...
N NO
QUIT:$G(^HLEV(+FILE,+IEN,0))']"" ;->
S NO=$O(^HLEV(+FILE,+IEN,NODE,":"),-1)+1
S ^HLEV(+FILE,+IEN,NODE,+NO,0)=$G(TXT)
S ^HLEV(+FILE,+IEN,NODE,0)=U_DDNO_U_NO_U_NO
Q
;
DOLRO(SUB,KILL,DAYS) ; Store data in ^XTMP("HLEV-"_SUB)...
N NO,NOW,X
;
; Defaults and setup variables...
S:$E(SUB,1,5)'="HLEV-" SUB="HLEV-"_SUB
S:$G(DAYS)'>0 DAYS=2
S NOW=$$NOW^XLFDT
;
; KILL?
I $G(KILL)=1 KILL ^XTMP(SUB)
;
; Always reset 0 node...
S ^XTMP(SUB,0)=$$FMADD^XLFDT(NOW,DAYS)_U_NOW_"^HL7 Event Monitoring debug code (LJA)"
;
; Store data...
S NO=$O(^XTMP(SUB,":"),-1)+1
S X=$NA(^XTMP(SUB,NO)),X=$E(X,1,$L(X)-1)_"," D DOLRO^%ZOSV
;
Q
;
UNQUEUE ; Unqueue any future master jobs...
N CT,DATA,IEN,LASTDT
S LASTDT=":",CT=0
F S LASTDT=$O(^HLEV(776.2,"B",LASTDT),-1) Q:'LASTDT!(CT>4) D
. S IEN=":"
. F S IEN=$O(^HLEV(776.2,"B",+LASTDT,IEN),-1) Q:'IEN!(CT>4) D
. . S DATA=$G(^HLEV(776.2,+IEN,0)) QUIT:DATA']"" ;->
. . QUIT:$P(DATA,U,4)'="Q" ;-> Not queued for future...
. . S TASKNO=$P(DATA,U,5) QUIT:TASKNO'>0 ;->
. . D UNQ(+IEN,+TASKNO,"Aborted by installation pre-init.")
Q
;
UNQ(IEN7762,TASKNO,REASON) ; Unqueue Taskman task and mark 776.2 properly...
N ZTSK
S ZTSK=+TASKNO
D DQ^%ZTLOAD
D UPDFLDM^HLEVMST(+IEN7762,4,"A")
D UPDFLDM^HLEVMST(+IEN7762,50,REASON)
Q
;
PURGEV(HLEVIENM) ; Purge master job entries...
N CUTIME,IEN,LOOPTM,NOPURG,RETHRM,HLPRGTM
;
S NOPURG=0
;
; Get retention time (HR) for master job data...
S RETHRM=$O(^HLEV(776.999,":"),-1)
S RETHRM=$P($G(^HLEV(776.999,+RETHRM,0)),U,4)
S RETHRM=$S(RETHRM>0:RETHRM,1:96) ; Default to 96 hours
;
; Cutoff time...
S CUTIME=$$FMADD^XLFDT($$NOW^XLFDT,0,-RETHRM),HLPRGTM=CUTIME
;
F S CUTIME=$O(^HLEV(776,"B",CUTIME),-1) Q:CUTIME'>0 D
. S IEN=0
. F S IEN=$O(^HLEV(776,"B",CUTIME,IEN)) Q:IEN'>0 D
. . I $G(HLPRGTM),$P($G(^HLEV(776,+IEN,0)),U)>HLPRGTM Q ;HL*1.6*173 - Ensure a newer recycled IEN is not purged
. . S NOPURG=NOPURG+1
. . D DELETE(776,+IEN)
;
Q NOPURG
;
PURGEME(IEN7762) ; Purge events "pointed to" by 776.2...
; NOPURG -- req
N DATA,IEN776,MIEN
S MIEN=0
F S MIEN=$O(^HLEV(776.2,+IEN7762,51,MIEN)) Q:'MIEN D
. S DATA=$G(^HLEV(776.2,+IEN7762,51,MIEN,0)) Q:DATA']"" ;->
. S IEN776=+DATA QUIT:$G(^HLEV(776,+IEN776,0))']"" ;->
. I $G(RETHRM),$P($G(^HLEV(776,+IEN776,0)),U)>RETHRM Q ;HL*1.6*173 - Ensure a newer recycled IEN is not purged
. D DELETE(776,+IEN776)
. S NOPURG=$G(NOPURG)+1
Q
;
;
;
;
;
; GENERAL CODE
PURGEALL(HLEVIENM) ; Purge all EVENT MONITORing files...
N NOPURGE,NOPURGM,TXT
;
QUIT:$G(^HLEV(776.2,+$G(HLEVIENM),0))']"" ;->
;
; Check parameter...
QUIT:$P($G(^HLEV(776.999,1,0)),U,2)'="A" ;->
;
S NOPURGM=$$PURGEM^HLEVMST(HLEVIENM) ; Master job data...
S NOPURGE=$$PURGEV(HLEVIENM) ; Event job data...
QUIT:(NOPURGE+NOPURGM)'>0 ;->
S TXT="Purges: "_$S(NOPURGE:"#"_NOPURGE_" events. ",1:"")_$S(NOPURGM:"#"_NOPURGM_" master jobs. ",1:"")
D UPDFLDM^HLEVMST(+HLEVIENM,50,TXT)
;
Q
;
DELETE(FILE,IEN) ; Delete entry...
N DA,DIK
QUIT:$G(^HLEV(+$G(FILE),+$G(IEN),0))']"" ;->
S DA=+IEN,DIK="^HLEV("_$G(FILE)_","
D ^DIK
Q
;
REMOVALL ; Remove all Event Monitor Job (#776) and HL7 Monitor Master
; Job (#776.2) data. Leave only setup file (#776.1 & 776.999)
; data untouched.
N FILE,NODE
W @IOF,$$CJ^XLFSTR("Purging of 776 and 776.2 (non-setup) Data",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
W !
I $O(^HLEV(776,0))'>0&($O(^HLEV(776.2,0))'>0) D QUIT ;->
. W !,"There is no data to delete..."
F FILE=776,776.2 D
. I $O(^HLEV(+FILE,0))'>0 D QUIT ;->
. . W !,"No data to delete for file ",FILE,"..."
. S X=$$YN^HLCSRPT4("OK to delete file "_FILE_" data","No") I 'X D QUIT ;->
. . W " ... not deleted ..."
. W " ... deleting!!"
. S NODE=$P($G(^HLEV(+FILE,0)),U,1,2)
. KILL ^HLEV(+FILE)
. S ^HLEV(+FILE,0)=NODE
Q
;
YN(PMT,DEF,FF) ; Generic YES/NO DIR call... ;HL*1.6*85
N DIR,DIRUT,DTOUT,DUOUT,X,Y
F X=1:1:$G(FF) W !
S DIR(0)="Y",DIR("A")=PMT
S:$G(DEF)]"" DIR("B")=DEF
D ^DIR
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) U ;->
QUIT $S(Y=1:1,1:"")
;
ENDIQ1(FILE,IEN,GBLSV) ; Create ^TMP($J,GBLSV,) data...
N DA,DIC,DIQ,DR
;
KILL ^TMP($J,GBLSV),^UTILITY("DIQ1",$J)
;
; Sets...
S DIC=$G(FILE) QUIT:FILE']"" ;->
S DR=$$DICDR(FILE) QUIT:DR']"" ;->
S DA=+IEN
S GBLSV=$S($G(GBLSV)]"":GBLSV,1:"HLEVDIQ")
S DIQ(0)="E"
;
; Generate data...
D EN^DIQ1
;
; Add more data (usually multiples)...
D ADDIQ(FILE,IEN)
;
QUIT:'$D(^UTILITY("DIQ1",$J)) ;->
;
; Prep fields and move into ^TMP...
D MOVETMP^HLEVUTI3(FILE,IEN,GBLSV)
;
KILL ^UTILITY("DIQ1",$J)
;
Q
;
ADDIQ(FILE,IEN,GBLSV) ; Add more data to ^TMP($J,GBLSV)
I FILE=772 D ADDMULT(FILE,"^HL(772,"_IEN_",""IN"")",IEN,10,"MESSAGE TEXT",200)
I FILE=773 D ADDMULT(FILE,"^HLMA("_IEN_",""MSH"")",IEN,10,"MSH",200)
Q
;
ADDMULT(FILE,GBL,IEN,LIM,FLDNM,FLD) ; Add LIM number of lines of multiple...
N MIEN,NO
S NO=0,MIEN=0,LIM=$S($G(LIM):LIM,1:10)
F S MIEN=$O(@GBL@(MIEN)) Q:MIEN'>0!(NO>LIM) D
. S DATA=$G(@GBL@(MIEN,0)) QUIT:$TR(DATA," ","")']"" ;->
. S NO=NO+1
. S ^UTILITY("DIQ1",$J,FILE,IEN,FLD,"E",NO)=DATA
Q
;
DICDR(FILE) ; Return fields for display by EN^DIQ1...
I FILE=772 QUIT ".01:199" ;->
I FILE=773 QUIT ".01:999" ;->
I FILE=776 QUIT ".01:20" ;->
I FILE=776.1 QUIT ".01:20" ;->
I FILE=776.2 QUIT ".01:20" ;->
I FILE=776.3 QUIT ".01:20" ;->
I FILE=776.4 QUIT ".01:20" ;->
I FILE=776.999 QUIT ".01:20" ;->
I FILE=870 QUIT ".01:18;21;100:499" ;->
QUIT ""
;
LAST D LASTIEN^HLEVUTI3 Q
LASTIEN D LASTIEN^HLEVUTI3 Q
LAST772 D LASTIEN^HLEVUTI3 Q
LAST773 D LASTIEN^HLEVUTI3 Q
;
EOR ;HLEVUTIL - Event Monitor UTILITIES ;5/16/03 14:42
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEVUTIL 8307 printed Oct 16, 2024@17:58:51 Page 2
HLEVUTIL ;O-OIFO/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
+1 ;;1.6;HEALTH LEVEL SEVEN;**109,173**;Oct 13, 1995;Build 14
+2 ;
SLM() ; Return info to Systems Link Monitor [HLCSMON1]...
+1 NEW BAD,DATA,DATE,DAY,DOWN,FIEN,HR,IEN,IOBON,IOBOFF,LASTDT,MIN,SEC,X
+2 ;
+3 SET X="IOBOFF;IOBON"
DO ENDR^%ZISS
+4 SET DOWN="Monitor "_IOBON_"DOWN"_IOBOFF
+5 ;
+6 ;->
IF $PIECE($GET(^HLEV(776.999,1,0)),U,2)'="A"
Begin DoDot:1
+7 SET DOWN="Monitor "_IOBON_"STOPPED"_IOBOFF
End DoDot:1
QUIT DOWN
+8 ;
+9 SET LASTDT=":"
SET FIEN=0
+10 FOR
SET LASTDT=$ORDER(^HLEV(776.2,"B",LASTDT),-1)
if 'LASTDT!(FIEN)
QUIT
Begin DoDot:1
+11 SET IEN=":"
+12 FOR
SET IEN=$ORDER(^HLEV(776.2,"B",+LASTDT,IEN),-1)
if 'IEN!(FIEN)
QUIT
Begin DoDot:2
+13 ;->
SET DATA=$GET(^HLEV(776.2,+IEN,0))
if $PIECE(DATA,U,4)'="Q"
QUIT
+14 SET FIEN=IEN
End DoDot:2
End DoDot:1
+15 ;->
IF 'FIEN
QUIT DOWN
+16 SET DATA=$GET(^HLEV(776.2,+FIEN,0))
+17 ;->
SET DATE=$PIECE(DATA,U,6)
if DATE'?7N1"."1.N
QUIT DOWN
+18 SET DATE=$$FMTH^XLFDT(DATE)
SET DATE(1)=$$SEC^HLEVMST0(DATE)
+19 SET NOW=$HOROLOG
SET NOW(1)=$$SEC^HLEVMST0(NOW)
+20 ;->
IF DATE(1)<NOW(1)
Begin DoDot:1
+21 SET BAD=0
+22 ;-> OK if less than 5 minutes old
if (NOW(1)-DATE(1))<(5*60)
QUIT
+23 SET BAD=1
SET DOWN="Monitor "_IOBON_"OVERDUE"_IOBOFF
End DoDot:1
QUIT $SELECT(BAD:DOWN,1:"Monitor current")
+24 SET DIFF=$$DIFFDH^HLCSFMN1(NOW,DATE)
+25 SET DAY=+DIFF
SET DIFF=$TRANSLATE($PIECE(DIFF,U,2),":",U)
+26 SET HR=+DIFF+(DAY*24)
SET MIN=+$PIECE(DIFF,U,2)
SET SEC=+$PIECE(DIFF,U,3)
+27 if SEC>30
SET MIN=MIN+1
+28 SET HR=HR+MIN/60
SET HR=$JUSTIFY(HR,"",1)
+29 QUIT "Monitor current [next job "_HR_" hr]"
+30 ;
DHMSFM(DTFM,NOW,LONG) ; Convert Fileman d/t to Days-Hr-Min-Sec
+1 NEW HORO
+2 ;->
if $GET(DTFM)'?7N.1".".10N
QUIT ""
+3 ; Default
SET NOW=$$FMTH^XLFDT($SELECT($GET(NOW)?7N.E:NOW,1:$$NOW^XLFDT))
+4 SET HORO=$$FMTH^XLFDT(DTFM)
+5 QUIT $$DHMSH(HORO,NOW,LONG)
+6 ;
DHMSH(DTH,NOW,LONG) ; Convert HORO d/t to Days-Hr-Min-Sec
+1 NEW DIFF,FUTURE,TIME,X
+2 SET LONG=+$GET(LONG)
+3 ;->
if $GET(DTH)'?5N1","1.N
QUIT ""
+4 SET NOW=$SELECT($GET(NOW)]"":NOW,1:$HOROLOG)
SET FUTURE=0
+5 IF +NOW<DTH!(+NOW=+DTH&($PIECE(NOW,",",2)<$PIECE(DTH,",",2)))
Begin DoDot:1
+6 SET X=DTH
SET DTH=NOW
SET NOW=X
SET FUTURE=1
End DoDot:1
+7 SET DIFF=$$DIFFDH^HLCSFMN1(DTH,NOW)
+8 SET TIME=""
+9 DO C($PIECE(DIFF,U),$SELECT(LONG:$SELECT(+$PIECE(DIFF,U)>1:" days",1:" day"),1:"d"))
+10 DO C($PIECE($PIECE(DIFF,U,2),":"),$SELECT(LONG:" hr",1:"h"))
+11 DO C($PIECE($PIECE(DIFF,U,2),":",2),$SELECT(LONG:" min",1:"m"))
+12 DO C($PIECE($PIECE(DIFF,U,2),":",3),$SELECT(LONG:" sec",1:"s"))
+13 FOR
if $EXTRACT(TIME)'=" "
QUIT
SET TIME=$EXTRACT(TIME,2,999)
+14 FOR
if $EXTRACT(TIME,$LENGTH(TIME))'=" "
QUIT
SET TIME=$EXTRACT(TIME,1,$LENGTH(TIME)-1)
+15 IF FUTURE
IF TIME]""
SET TIME="["_TIME_"]"
+16 QUIT TIME
+17 ;
C(NO,UN) ; Convert to #[UN]...
+1 ;->
IF NO'>0
QUIT
+2 SET TIME=TIME_$SELECT(TIME]"":" ",1:"")_" "_+NO_UN
+3 QUIT
+4 ;
WPTXT(FILE,IEN,NODE,DDNO,TXT) ; Add text to multiple WP field...
+1 NEW NO
+2 ;->
if $GET(^HLEV(+FILE,+IEN,0))']""
QUIT
+3 SET NO=$ORDER(^HLEV(+FILE,+IEN,NODE,":"),-1)+1
+4 SET ^HLEV(+FILE,+IEN,NODE,+NO,0)=$GET(TXT)
+5 SET ^HLEV(+FILE,+IEN,NODE,0)=U_DDNO_U_NO_U_NO
+6 QUIT
+7 ;
DOLRO(SUB,KILL,DAYS) ; Store data in ^XTMP("HLEV-"_SUB)...
+1 NEW NO,NOW,X
+2 ;
+3 ; Defaults and setup variables...
+4 if $EXTRACT(SUB,1,5)'="HLEV-"
SET SUB="HLEV-"_SUB
+5 if $GET(DAYS)'>0
SET DAYS=2
+6 SET NOW=$$NOW^XLFDT
+7 ;
+8 ; KILL?
+9 IF $GET(KILL)=1
KILL ^XTMP(SUB)
+10 ;
+11 ; Always reset 0 node...
+12 SET ^XTMP(SUB,0)=$$FMADD^XLFDT(NOW,DAYS)_U_NOW_"^HL7 Event Monitoring debug code (LJA)"
+13 ;
+14 ; Store data...
+15 SET NO=$ORDER(^XTMP(SUB,":"),-1)+1
+16 SET X=$NAME(^XTMP(SUB,NO))
SET X=$EXTRACT(X,1,$LENGTH(X)-1)_","
DO DOLRO^%ZOSV
+17 ;
+18 QUIT
+19 ;
UNQUEUE ; Unqueue any future master jobs...
+1 NEW CT,DATA,IEN,LASTDT
+2 SET LASTDT=":"
SET CT=0
+3 FOR
SET LASTDT=$ORDER(^HLEV(776.2,"B",LASTDT),-1)
if 'LASTDT!(CT>4)
QUIT
Begin DoDot:1
+4 SET IEN=":"
+5 FOR
SET IEN=$ORDER(^HLEV(776.2,"B",+LASTDT,IEN),-1)
if 'IEN!(CT>4)
QUIT
Begin DoDot:2
+6 ;->
SET DATA=$GET(^HLEV(776.2,+IEN,0))
if DATA']""
QUIT
+7 ;-> Not queued for future...
if $PIECE(DATA,U,4)'="Q"
QUIT
+8 ;->
SET TASKNO=$PIECE(DATA,U,5)
if TASKNO'>0
QUIT
+9 DO UNQ(+IEN,+TASKNO,"Aborted by installation pre-init.")
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
UNQ(IEN7762,TASKNO,REASON) ; Unqueue Taskman task and mark 776.2 properly...
+1 NEW ZTSK
+2 SET ZTSK=+TASKNO
+3 DO DQ^%ZTLOAD
+4 DO UPDFLDM^HLEVMST(+IEN7762,4,"A")
+5 DO UPDFLDM^HLEVMST(+IEN7762,50,REASON)
+6 QUIT
+7 ;
PURGEV(HLEVIENM) ; Purge master job entries...
+1 NEW CUTIME,IEN,LOOPTM,NOPURG,RETHRM,HLPRGTM
+2 ;
+3 SET NOPURG=0
+4 ;
+5 ; Get retention time (HR) for master job data...
+6 SET RETHRM=$ORDER(^HLEV(776.999,":"),-1)
+7 SET RETHRM=$PIECE($GET(^HLEV(776.999,+RETHRM,0)),U,4)
+8 ; Default to 96 hours
SET RETHRM=$SELECT(RETHRM>0:RETHRM,1:96)
+9 ;
+10 ; Cutoff time...
+11 SET CUTIME=$$FMADD^XLFDT($$NOW^XLFDT,0,-RETHRM)
SET HLPRGTM=CUTIME
+12 ;
+13 FOR
SET CUTIME=$ORDER(^HLEV(776,"B",CUTIME),-1)
if CUTIME'>0
QUIT
Begin DoDot:1
+14 SET IEN=0
+15 FOR
SET IEN=$ORDER(^HLEV(776,"B",CUTIME,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+16 ;HL*1.6*173 - Ensure a newer recycled IEN is not purged
IF $GET(HLPRGTM)
IF $PIECE($GET(^HLEV(776,+IEN,0)),U)>HLPRGTM
QUIT
+17 SET NOPURG=NOPURG+1
+18 DO DELETE(776,+IEN)
End DoDot:2
End DoDot:1
+19 ;
+20 QUIT NOPURG
+21 ;
PURGEME(IEN7762) ; Purge events "pointed to" by 776.2...
+1 ; NOPURG -- req
+2 NEW DATA,IEN776,MIEN
+3 SET MIEN=0
+4 FOR
SET MIEN=$ORDER(^HLEV(776.2,+IEN7762,51,MIEN))
if 'MIEN
QUIT
Begin DoDot:1
+5 ;->
SET DATA=$GET(^HLEV(776.2,+IEN7762,51,MIEN,0))
if DATA']""
QUIT
+6 ;->
SET IEN776=+DATA
if $GET(^HLEV(776,+IEN776,0))']""
QUIT
+7 ;HL*1.6*173 - Ensure a newer recycled IEN is not purged
IF $GET(RETHRM)
IF $PIECE($GET(^HLEV(776,+IEN776,0)),U)>RETHRM
QUIT
+8 DO DELETE(776,+IEN776)
+9 SET NOPURG=$GET(NOPURG)+1
End DoDot:1
+10 QUIT
+11 ;
+12 ;
+13 ;
+14 ;
+15 ;
+16 ; GENERAL CODE
PURGEALL(HLEVIENM) ; Purge all EVENT MONITORing files...
+1 NEW NOPURGE,NOPURGM,TXT
+2 ;
+3 ;->
if $GET(^HLEV(776.2,+$GET(HLEVIENM),0))']""
QUIT
+4 ;
+5 ; Check parameter...
+6 ;->
if $PIECE($GET(^HLEV(776.999,1,0)),U,2)'="A"
QUIT
+7 ;
+8 ; Master job data...
SET NOPURGM=$$PURGEM^HLEVMST(HLEVIENM)
+9 ; Event job data...
SET NOPURGE=$$PURGEV(HLEVIENM)
+10 ;->
if (NOPURGE+NOPURGM)'>0
QUIT
+11 SET TXT="Purges: "_$SELECT(NOPURGE:"#"_NOPURGE_" events. ",1:"")_$SELECT(NOPURGM:"#"_NOPURGM_" master jobs. ",1:"")
+12 DO UPDFLDM^HLEVMST(+HLEVIENM,50,TXT)
+13 ;
+14 QUIT
+15 ;
DELETE(FILE,IEN) ; Delete entry...
+1 NEW DA,DIK
+2 ;->
if $GET(^HLEV(+$GET(FILE),+$GET(IEN),0))']""
QUIT
+3 SET DA=+IEN
SET DIK="^HLEV("_$GET(FILE)_","
+4 DO ^DIK
+5 QUIT
+6 ;
REMOVALL ; Remove all Event Monitor Job (#776) and HL7 Monitor Master
+1 ; Job (#776.2) data. Leave only setup file (#776.1 & 776.999)
+2 ; data untouched.
+3 NEW FILE,NODE
+4 WRITE @IOF,$$CJ^XLFSTR("Purging of 776 and 776.2 (non-setup) Data",IOM)
+5 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+6 WRITE !
+7 ;->
IF $ORDER(^HLEV(776,0))'>0&($ORDER(^HLEV(776.2,0))'>0)
Begin DoDot:1
+8 WRITE !,"There is no data to delete..."
End DoDot:1
QUIT
+9 FOR FILE=776,776.2
Begin DoDot:1
+10 ;->
IF $ORDER(^HLEV(+FILE,0))'>0
Begin DoDot:2
+11 WRITE !,"No data to delete for file ",FILE,"..."
End DoDot:2
QUIT
+12 ;->
SET X=$$YN^HLCSRPT4("OK to delete file "_FILE_" data","No")
IF 'X
Begin DoDot:2
+13 WRITE " ... not deleted ..."
End DoDot:2
QUIT
+14 WRITE " ... deleting!!"
+15 SET NODE=$PIECE($GET(^HLEV(+FILE,0)),U,1,2)
+16 KILL ^HLEV(+FILE)
+17 SET ^HLEV(+FILE,0)=NODE
End DoDot:1
+18 QUIT
+19 ;
YN(PMT,DEF,FF) ; Generic YES/NO DIR call... ;HL*1.6*85
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 FOR X=1:1:$GET(FF)
WRITE !
+3 SET DIR(0)="Y"
SET DIR("A")=PMT
+4 if $GET(DEF)]""
SET DIR("B")=DEF
+5 DO ^DIR
+6 ;->
if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT U
+7 QUIT $SELECT(Y=1:1,1:"")
+8 ;
ENDIQ1(FILE,IEN,GBLSV) ; Create ^TMP($J,GBLSV,) data...
+1 NEW DA,DIC,DIQ,DR
+2 ;
+3 KILL ^TMP($JOB,GBLSV),^UTILITY("DIQ1",$JOB)
+4 ;
+5 ; Sets...
+6 ;->
SET DIC=$GET(FILE)
if FILE']""
QUIT
+7 ;->
SET DR=$$DICDR(FILE)
if DR']""
QUIT
+8 SET DA=+IEN
+9 SET GBLSV=$SELECT($GET(GBLSV)]"":GBLSV,1:"HLEVDIQ")
+10 SET DIQ(0)="E"
+11 ;
+12 ; Generate data...
+13 DO EN^DIQ1
+14 ;
+15 ; Add more data (usually multiples)...
+16 DO ADDIQ(FILE,IEN)
+17 ;
+18 ;->
if '$DATA(^UTILITY("DIQ1",$JOB))
QUIT
+19 ;
+20 ; Prep fields and move into ^TMP...
+21 DO MOVETMP^HLEVUTI3(FILE,IEN,GBLSV)
+22 ;
+23 KILL ^UTILITY("DIQ1",$JOB)
+24 ;
+25 QUIT
+26 ;
ADDIQ(FILE,IEN,GBLSV) ; Add more data to ^TMP($J,GBLSV)
+1 IF FILE=772
DO ADDMULT(FILE,"^HL(772,"_IEN_",""IN"")",IEN,10,"MESSAGE TEXT",200)
+2 IF FILE=773
DO ADDMULT(FILE,"^HLMA("_IEN_",""MSH"")",IEN,10,"MSH",200)
+3 QUIT
+4 ;
ADDMULT(FILE,GBL,IEN,LIM,FLDNM,FLD) ; Add LIM number of lines of multiple...
+1 NEW MIEN,NO
+2 SET NO=0
SET MIEN=0
SET LIM=$SELECT($GET(LIM):LIM,1:10)
+3 FOR
SET MIEN=$ORDER(@GBL@(MIEN))
if MIEN'>0!(NO>LIM)
QUIT
Begin DoDot:1
+4 ;->
SET DATA=$GET(@GBL@(MIEN,0))
if $TRANSLATE(DATA," ","")']""
QUIT
+5 SET NO=NO+1
+6 SET ^UTILITY("DIQ1",$JOB,FILE,IEN,FLD,"E",NO)=DATA
End DoDot:1
+7 QUIT
+8 ;
DICDR(FILE) ; Return fields for display by EN^DIQ1...
+1 ;->
IF FILE=772
QUIT ".01:199"
+2 ;->
IF FILE=773
QUIT ".01:999"
+3 ;->
IF FILE=776
QUIT ".01:20"
+4 ;->
IF FILE=776.1
QUIT ".01:20"
+5 ;->
IF FILE=776.2
QUIT ".01:20"
+6 ;->
IF FILE=776.3
QUIT ".01:20"
+7 ;->
IF FILE=776.4
QUIT ".01:20"
+8 ;->
IF FILE=776.999
QUIT ".01:20"
+9 ;->
IF FILE=870
QUIT ".01:18;21;100:499"
+10 QUIT ""
+11 ;
LAST DO LASTIEN^HLEVUTI3
QUIT
LASTIEN DO LASTIEN^HLEVUTI3
QUIT
LAST772 DO LASTIEN^HLEVUTI3
QUIT
LAST773 DO LASTIEN^HLEVUTI3
QUIT
+1 ;
EOR ;HLEVUTIL - Event Monitor UTILITIES ;5/16/03 14:42
