INHOQT1 ; FRW/JMB ; 01 Oct 1999 14:49 ; Show top entries in queues, cont.
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
EN ;Initialize report variables
;New statements
N BP,BP0,INDAT,INDEST,INQ
N BPC,DATA,GL,H,HT,INC,INCO,INEXIT,INIEN,INITER,INQUEUE,INRUN
N INRUNASC,INRUNAVG,INTOTAL,INSIZE
N T,TAB,M,P,SAR,SOP,TOP
;
S INEXIT=0,INPAR("START")=$H,INITER=0
;Initialize Tabs
S TAB(1)=7,TAB(2)=19,TAB(3)=28,TAB(4)=40,TAB(5)=51
;Intialize data array
D INIARR^INHOQT
;
ENRPT ;Repeat entry point
;
;
;Init scan variables
S INTOTAL=0,INQUEUE=0,INITER=INITER+1 D INIT
;Format controller
G:'$$QUEUE("^INLHFTSK(""AH"")",2) EXIT
;Output Controller
G:'$$QUEUE("^INLHSCH",1) EXIT
;Destination queues
S BPC=2
F S BPC=$O(INDEST(BPC)) Q:'BPC!INEXIT Q:'$$QUEUE(U_$P(INDEST(BPC),U,2),BPC)
G:INEXIT EXIT
;
;display report
D DISP
;
;hang until next iteration
G:$$QUIT EXIT
F X=1:1:INPAR("REPAINT") Q:$$QUIT!INEXIT H 1
G:INEXIT EXIT
G ENRPT
;
Q
;
QUEUE(GL,INQ) ;Store top entry in queue
;INPUT:
; GL - location (global) of queue
; queue in format -> @GL@( priority , time to process , ien )
; INQ - subscript (usually ien) of queue in INDAT array
;OUTPUT:
; function - complete processing ( 0 - no ; 1 - yes )
; updated INDAT array with top queue entry
;
N P
S P=""
F S P=$O(@GL@(P)) Q:+P'=P&(P'="PEND") D Q1(GL,INQ,P) Q:'INPAR("DETAIL")
Q 'INEXIT
;
Q1(GL,INQ,P) ;Determine top entry (stat and/or non-stat) for priority P
;
I $G(P)="PEND" D PENDQ1(GL,INQ) Q
N H,HT,INC,INZE,INIEN
S H="",INC=0
;If stat and non-stat are present, first pass on L1
; finds top stat, second pass top non-stat.
L1 S HT=H
S H=$O(@GL@(P,H)) Q:'$L(H) ;No non-stat entry
S TOP=$$TOP(GL,P,H),INIEN=+TOP
;if we need to repeat entry, reset H to previous value
I $$CHK(INQ,INIEN,.INC) S H=HT G L1
I INQ'=2 S INZE=$G(^INTHU(INIEN,0)),TOP=TOP_U_$P(INZE,U,11)_U_$P(INZE,U,5)
I INQ=2 S INZE=$G(^INLHFTSK(INIEN,0)),TOP=TOP_U_$P(INZE,U)
D STAT(INQ,P,H,TOP)
Q:'INPAR("DETAIL")
I 'H S INC=0 G L1 ; H: non-stat 'H: stat
Q ;non stat
;
PENDQ1(GL,INQ) ;Get the first entry for the pending queue
; Note: no concept of priority in the pending queues
;
N H,INC,INZE,INIEN,INBPN,INSEQ
S INC=0,(H,INBPN,INSEQ)=""
S INBPN=$O(@GL@("PEND",INBPN)) Q:'$L(INBPN)
S INSEQ=$O(@GL@("PEND",INBPN,INSEQ)) Q:'$L(INSEQ)
S TOP="",TOP=$O(@GL@("PEND",INBPN,INSEQ,TOP))
S INIEN=+TOP,H=$G(@GL@("PEND",INBPN,INSEQ,TOP)),H=$P(H,"^")
I INQ'=2 S INZE=$G(^INTHU(INIEN,0)),TOP=TOP_U_$P(INZE,U,11)_U_$P(INZE,U,5)
I INQ=2 S INZE=$G(^INLHFTSK(INIEN,0)),TOP=TOP_U_$P(INZE,U)
D STAT(INQ,P,H,TOP)
Q
;
CHK(INQ,INIEN,INCO) ;Recalculate top entry
;INPUT
; INCO - Counter, passed by reference
;OUTPUT: function
; 1 - Recalculate top entry
; 0 - Do not recalculate top entry
S INCO=INCO+1
I INQ=2,INIEN Q 0
I INQ'=2,INIEN,$D(^INTHU(INIEN,0)) Q 0
I INCO>INPAR("ITERT") Q 0
Q 1
;
TOP(GL,P,H) ;Get top entry from queue
N M
S M="",M=$O(@GL@(P,H,M))
Q M
;
STAT(INQ,P,H,DATA) ;Build statistics
; INQ - subscript (usually ien) of queue in INDAT array
; NAME - name of queue
; DATA - queue entry data
; format: DATA = record# ^ transaction type# ^ message ID
;OUTPUT:
; updated INDAT array
N INH,INNOW
Q:'$L(P)!('$L(H))
;Schedule
I 'H S T="ST",INDAT(INQ,P,T)="STAT",INDAT(INQ,P,T,"DIFF")=""
E S T="STN",INDAT(INQ,P,T)=$$FT0^INHUTS(H) D
.;Age
.S INH=$$CDATH2F^%ZTFDT(H),INNOW=$$NOW^%ZTFDT()
.I INH<INNOW S INDAT(INQ,P,T,"DIFF")=$$TDIF^INHUTS(INH,INNOW,0),INDAT(INQ,P,T,"DIFF")=$$FT1^INHUTS(INDAT(INQ,P,T,"DIFF"),1)
.I INH'<INNOW S INDAT(INQ,P,T,"DIFF")=$$TDIF^INHUTS(INNOW,INH,0),INDAT(INQ,P,T,"DIFF")="+"_$$FT1^INHUTS(INDAT(INQ,P,T,"DIFF"),1)
;Message ID
S INDAT(INQ,P,T,"MSGID")=$P(DATA,U,3)
;Record
S INDAT(INQ,P,T,"DA")=$P(DATA,U)
;Transation type
S INDAT(INQ,P,T,"TT")=$P($G(^INRHT(+$P(DATA,U,2),0)),U)
Q
;
DISP ;Display Report
N INQ,IN1
;Paint header
D HDR
;Display data
;Work through INDAT array
; IN1 - Flag to display queue name only once
S INQ=0 F S INQ=$O(INDAT(INQ)) Q:'INQ D OV(INQ,0) W !,INDAT(INQ,"NAME") D
.S P="" F S P=$O(INDAT(INQ,P)) Q:+P'=P&(P'="PEND") D
..S T="" F S T=$O(INDAT(INQ,P,T)) Q:'$L(T) D
... W !,$J(P,3),?TAB(1),$J(INDAT(INQ,P,T),10)
... W ?TAB(2),$J(INDAT(INQ,P,T,"DIFF"),7)
... W ?TAB(3),$J($E(INDAT(INQ,P,T,"MSGID"),1,10),10)
... W ?TAB(4),$J(INDAT(INQ,P,T,"DA"),9)
... W ?TAB(5),$E(INDAT(INQ,P,T,"TT"),1,29)
... D:$L($O(INDAT(INQ,P,T)))!($O(INDAT(INQ,P))) OV(INQ,1)
;Paint footer
D FTR
Q
;
OV(INQ,IN1) ;Handle overflow
;INPUT
; INQ - Process Id
; IN1 - 1 Repeat process name
; - 0 Do not repeat process name
Q:$Y<(IOSL-4)
W !!,"More..." F X=1:1:INPAR("REPAINT") R *%:1 Q:$T
D HDR
;Repeat process name
W:IN1 !,INDAT(INQ,"NAME")," Cont."
Q
;
INIT ;Initialize INDAT array for next scan
; Kill data, leave queue name intact (INDAT(INQ,"NAME")=Queue Name)
N INQ,P
S INQ=0 F S INQ=$O(INDAT(INQ)) Q:'INQ D
. S P="" F S P=$O(INDAT(INQ,P)) Q:+P'=P&(P'="PEND") K INDAT(INQ,P)
Q
;
QUIT() ;Determine if program should quit
;INPUT:
; INEXIT - quit flag
;OUTPUT:
; INEXIT - quit flag
; function - 1 - time to exit ; 0 - continue
;
;Quit If:
;user presses <any key>
S INEXIT=$$QUIT^INHUTS
Q INEXIT
;
EXIT ;Primary exit point
;Close device
D ^%ZISC
Q
;
HDR ;Diplay header
;
;Calculate run time = now-start
S INRUN=$$TDIF^INHUTS(INPAR("START"),$H),INRUNASC=$$FORMAT^INHUTS(INRUN)
;Calculate average run time per iteration
S INRUNAVG=$$FORMAT^INHUTS(INRUN\INITER,2)
;Clear screen
W @IOF
W "Top Entries" W:INPAR("DETAIL") " by priority"
W ?55,$$CDATASC^UTDT($$NOW^UTDT,1,1)
W !,?5,"Start Time: ",$$CDATASC^UTDT(INPAR("START"),1,1),?40," Number of Iterations: ",INITER
W !,?5," Run Time: ",INRUNASC,?40,"Avg Time per Iteration: ",INRUNAVG
W !
;
W !,"Background Process"
W !," Prio",?TAB(1),"Scheduled",?TAB(2)," Age",?TAB(3),"Message Id"
W ?TAB(4)," Record",?TAB(5),"Transaction Type"
W !," ----",?TAB(1),"----------",?TAB(2),"-------",?TAB(3),"----------",?TAB(4),"---------",?TAB(5),"-----------------------------"
Q
;
FTR ;Display footer
;
W !!,"Press any key to exit: "
Q
INHOQT1 ; FRW/JMB ; 01 Oct 1999 14:49 ; Show top entries in queues, cont.
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
EN ;Initialize report variables
+1 ;New statements
+2 NEW BP,BP0,INDAT,INDEST,INQ
+3 NEW BPC,DATA,GL,H,HT,INC,INCO,INEXIT,INIEN,INITER,INQUEUE,INRUN
+4 NEW INRUNASC,INRUNAVG,INTOTAL,INSIZE
+5 NEW T,TAB,M,P,SAR,SOP,TOP
+6 ;
+7 SET INEXIT=0
SET INPAR("START")=$HOROLOG
SET INITER=0
+8 ;Initialize Tabs
+9 SET TAB(1)=7
SET TAB(2)=19
SET TAB(3)=28
SET TAB(4)=40
SET TAB(5)=51
+10 ;Intialize data array
+11 DO INIARR^INHOQT
+12 ;
ENRPT ;Repeat entry point
+1 ;
+2 ;
+3 ;Init scan variables
+4 SET INTOTAL=0
SET INQUEUE=0
SET INITER=INITER+1
DO INIT
+5 ;Format controller
+6 IF '$$QUEUE("^INLHFTSK(""AH"")",2)
GOTO EXIT
+7 ;Output Controller
+8 IF '$$QUEUE("^INLHSCH",1)
GOTO EXIT
+9 ;Destination queues
+10 SET BPC=2
+11 FOR
SET BPC=$ORDER(INDEST(BPC))
IF 'BPC!INEXIT
QUIT
IF '$$QUEUE(U_$PIECE(INDEST(BPC),U,2),BPC)
QUIT
+12 IF INEXIT
GOTO EXIT
+13 ;
+14 ;display report
+15 DO DISP
+16 ;
+17 ;hang until next iteration
+18 IF $$QUIT
GOTO EXIT
+19 FOR X=1:1:INPAR("REPAINT")
IF $$QUIT!INEXIT
QUIT
HANG 1
+20 IF INEXIT
GOTO EXIT
+21 GOTO ENRPT
+22 ;
+23 QUIT
+24 ;
QUEUE(GL,INQ) ;Store top entry in queue
+1 ;INPUT:
+2 ; GL - location (global) of queue
+3 ; queue in format -> @GL@( priority , time to process , ien )
+4 ; INQ - subscript (usually ien) of queue in INDAT array
+5 ;OUTPUT:
+6 ; function - complete processing ( 0 - no ; 1 - yes )
+7 ; updated INDAT array with top queue entry
+8 ;
+9 NEW P
+10 SET P=""
+11 FOR
SET P=$ORDER(@GL@(P))
IF +P'=P&(P'="PEND")
QUIT
DO Q1(GL,INQ,P)
IF 'INPAR("DETAIL")
QUIT
+12 QUIT 'INEXIT
+13 ;
Q1(GL,INQ,P) ;Determine top entry (stat and/or non-stat) for priority P
+1 ;
+2 IF $GET(P)="PEND"
DO PENDQ1(GL,INQ)
QUIT
+3 NEW H,HT,INC,INZE,INIEN
+4 SET H=""
SET INC=0
+5 ;If stat and non-stat are present, first pass on L1
+6 ; finds top stat, second pass top non-stat.
L1 SET HT=H
+1 ;No non-stat entry
SET H=$ORDER(@GL@(P,H))
IF '$LENGTH(H)
QUIT
+2 SET TOP=$$TOP(GL,P,H)
SET INIEN=+TOP
+3 ;if we need to repeat entry, reset H to previous value
+4 IF $$CHK(INQ,INIEN,.INC)
SET H=HT
GOTO L1
+5 IF INQ'=2
SET INZE=$GET(^INTHU(INIEN,0))
SET TOP=TOP_U_$PIECE(INZE,U,11)_U_$PIECE(INZE,U,5)
+6 IF INQ=2
SET INZE=$GET(^INLHFTSK(INIEN,0))
SET TOP=TOP_U_$PIECE(INZE,U)
+7 DO STAT(INQ,P,H,TOP)
+8 IF 'INPAR("DETAIL")
QUIT
+9 ; H: non-stat 'H: stat
IF 'H
SET INC=0
GOTO L1
+10 ;non stat
QUIT
+11 ;
PENDQ1(GL,INQ) ;Get the first entry for the pending queue
+1 ; Note: no concept of priority in the pending queues
+2 ;
+3 NEW H,INC,INZE,INIEN,INBPN,INSEQ
+4 SET INC=0
SET (H,INBPN,INSEQ)=""
+5 SET INBPN=$ORDER(@GL@("PEND",INBPN))
IF '$LENGTH(INBPN)
QUIT
+6 SET INSEQ=$ORDER(@GL@("PEND",INBPN,INSEQ))
IF '$LENGTH(INSEQ)
QUIT
+7 SET TOP=""
SET TOP=$ORDER(@GL@("PEND",INBPN,INSEQ,TOP))
+8 SET INIEN=+TOP
SET H=$GET(@GL@("PEND",INBPN,INSEQ,TOP))
SET H=$PIECE(H,"^")
+9 IF INQ'=2
SET INZE=$GET(^INTHU(INIEN,0))
SET TOP=TOP_U_$PIECE(INZE,U,11)_U_$PIECE(INZE,U,5)
+10 IF INQ=2
SET INZE=$GET(^INLHFTSK(INIEN,0))
SET TOP=TOP_U_$PIECE(INZE,U)
+11 DO STAT(INQ,P,H,TOP)
+12 QUIT
+13 ;
CHK(INQ,INIEN,INCO) ;Recalculate top entry
+1 ;INPUT
+2 ; INCO - Counter, passed by reference
+3 ;OUTPUT: function
+4 ; 1 - Recalculate top entry
+5 ; 0 - Do not recalculate top entry
+6 SET INCO=INCO+1
+7 IF INQ=2
IF INIEN
QUIT 0
+8 IF INQ'=2
IF INIEN
IF $DATA(^INTHU(INIEN,0))
QUIT 0
+9 IF INCO>INPAR("ITERT")
QUIT 0
+10 QUIT 1
+11 ;
TOP(GL,P,H) ;Get top entry from queue
+1 NEW M
+2 SET M=""
SET M=$ORDER(@GL@(P,H,M))
+3 QUIT M
+4 ;
STAT(INQ,P,H,DATA) ;Build statistics
+1 ; INQ - subscript (usually ien) of queue in INDAT array
+2 ; NAME - name of queue
+3 ; DATA - queue entry data
+4 ; format: DATA = record# ^ transaction type# ^ message ID
+5 ;OUTPUT:
+6 ; updated INDAT array
+7 NEW INH,INNOW
+8 IF '$LENGTH(P)!('$LENGTH(H))
QUIT
+9 ;Schedule
+10 IF 'H
SET T="ST"
SET INDAT(INQ,P,T)="STAT"
SET INDAT(INQ,P,T,"DIFF")=""
+11 IF '$TEST
SET T="STN"
SET INDAT(INQ,P,T)=$$FT0^INHUTS(H)
Begin DoDot:1
+12 ;Age
+13 SET INH=$$CDATH2F^%ZTFDT(H)
SET INNOW=$$NOW^%ZTFDT()
+14 IF INH<INNOW
SET INDAT(INQ,P,T,"DIFF")=$$TDIF^INHUTS(INH,INNOW,0)
SET INDAT(INQ,P,T,"DIFF")=$$FT1^INHUTS(INDAT(INQ,P,T,"DIFF"),1)
+15 IF INH'<INNOW
SET INDAT(INQ,P,T,"DIFF")=$$TDIF^INHUTS(INNOW,INH,0)
SET INDAT(INQ,P,T,"DIFF")="+"_$$FT1^INHUTS(INDAT(INQ,P,T,"DIFF"),1)
End DoDot:1
+16 ;Message ID
+17 SET INDAT(INQ,P,T,"MSGID")=$PIECE(DATA,U,3)
+18 ;Record
+19 SET INDAT(INQ,P,T,"DA")=$PIECE(DATA,U)
+20 ;Transation type
+21 SET INDAT(INQ,P,T,"TT")=$PIECE($GET(^INRHT(+$PIECE(DATA,U,2),0)),U)
+22 QUIT
+23 ;
DISP ;Display Report
+1 NEW INQ,IN1
+2 ;Paint header
+3 DO HDR
+4 ;Display data
+5 ;Work through INDAT array
+6 ; IN1 - Flag to display queue name only once
+7 SET INQ=0
FOR
SET INQ=$ORDER(INDAT(INQ))
IF 'INQ
QUIT
DO OV(INQ,0)
WRITE !,INDAT(INQ,"NAME")
Begin DoDot:1
+8 SET P=""
FOR
SET P=$ORDER(INDAT(INQ,P))
IF +P'=P&(P'="PEND")
QUIT
Begin DoDot:2
+9 SET T=""
FOR
SET T=$ORDER(INDAT(INQ,P,T))
IF '$LENGTH(T)
QUIT
Begin DoDot:3
+10 WRITE !,$JUSTIFY(P,3),?TAB(1),$JUSTIFY(INDAT(INQ,P,T),10)
+11 WRITE ?TAB(2),$JUSTIFY(INDAT(INQ,P,T,"DIFF"),7)
+12 WRITE ?TAB(3),$JUSTIFY($EXTRACT(INDAT(INQ,P,T,"MSGID"),1,10),10)
+13 WRITE ?TAB(4),$JUSTIFY(INDAT(INQ,P,T,"DA"),9)
+14 WRITE ?TAB(5),$EXTRACT(INDAT(INQ,P,T,"TT"),1,29)
+15 IF $LENGTH($ORDER(INDAT(INQ,P,T)))!($ORDER(INDAT(INQ,P)))
DO OV(INQ,1)
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;Paint footer
+17 DO FTR
+18 QUIT
+19 ;
OV(INQ,IN1) ;Handle overflow
+1 ;INPUT
+2 ; INQ - Process Id
+3 ; IN1 - 1 Repeat process name
+4 ; - 0 Do not repeat process name
+5 IF $Y<(IOSL-4)
QUIT
+6 WRITE !!,"More..."
FOR X=1:1:INPAR("REPAINT")
READ *%:1
IF $TEST
QUIT
+7 DO HDR
+8 ;Repeat process name
+9 IF IN1
WRITE !,INDAT(INQ,"NAME")," Cont."
+10 QUIT
+11 ;
INIT ;Initialize INDAT array for next scan
+1 ; Kill data, leave queue name intact (INDAT(INQ,"NAME")=Queue Name)
+2 NEW INQ,P
+3 SET INQ=0
FOR
SET INQ=$ORDER(INDAT(INQ))
IF 'INQ
QUIT
Begin DoDot:1
+4 SET P=""
FOR
SET P=$ORDER(INDAT(INQ,P))
IF +P'=P&(P'="PEND")
QUIT
KILL INDAT(INQ,P)
End DoDot:1
+5 QUIT
+6 ;
QUIT() ;Determine if program should quit
+1 ;INPUT:
+2 ; INEXIT - quit flag
+3 ;OUTPUT:
+4 ; INEXIT - quit flag
+5 ; function - 1 - time to exit ; 0 - continue
+6 ;
+7 ;Quit If:
+8 ;user presses <any key>
+9 SET INEXIT=$$QUIT^INHUTS
+10 QUIT INEXIT
+11 ;
EXIT ;Primary exit point
+1 ;Close device
+2 DO ^%ZISC
+3 QUIT
+4 ;
HDR ;Diplay header
+1 ;
+2 ;Calculate run time = now-start
+3 SET INRUN=$$TDIF^INHUTS(INPAR("START"),$HOROLOG)
SET INRUNASC=$$FORMAT^INHUTS(INRUN)
+4 ;Calculate average run time per iteration
+5 SET INRUNAVG=$$FORMAT^INHUTS(INRUN\INITER,2)
+6 ;Clear screen
+7 WRITE @IOF
+8 WRITE "Top Entries"
IF INPAR("DETAIL")
WRITE " by priority"
+9 WRITE ?55,$$CDATASC^UTDT($$NOW^UTDT,1,1)
+10 WRITE !,?5,"Start Time: ",$$CDATASC^UTDT(INPAR("START"),1,1),?40," Number of Iterations: ",INITER
+11 WRITE !,?5," Run Time: ",INRUNASC,?40,"Avg Time per Iteration: ",INRUNAVG
+12 WRITE !
+13 ;
+14 WRITE !,"Background Process"
+15 WRITE !," Prio",?TAB(1),"Scheduled",?TAB(2)," Age",?TAB(3),"Message Id"
+16 WRITE ?TAB(4)," Record",?TAB(5),"Transaction Type"
+17 WRITE !," ----",?TAB(1),"----------",?TAB(2),"-------",?TAB(3),"----------",?TAB(4),"---------",?TAB(5),"-----------------------------"
+18 QUIT
+19 ;
FTR ;Display footer
+1 ;
+2 WRITE !!,"Press any key to exit: "
+3 QUIT
