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

INHOQT1.m

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