- 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 Feb 18, 2025@23:24:28 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