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

INHOTM.m

Go to the documentation of this file. 
  1. INHOTM ; DGH,FRW,JSH,JPD ; 17 Oct 97 08:56; Output Controller background processor 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ; Input:
  1.  ;   INBPN - ien of output controller
  1.  ;   INHSRVR - Server number
  1.  ; Local:
  1.  ;   DA - IEN of transaction
  1.  ;   DTTM - DATE AND TIME OF TRANSACTION
  1.  ;
  1.  N X
  1.  S ^INRHB("RUN",INBPN)=$H
  1.  S X=$G(^INRHSITE(1,0)),INHANG=$P(X,U,4) S:'INHANG INHANG=10
  1.  S MODE=+$P(X,U,7),INTHROT=+$P(X,U,9)
  1.  S INCUTOFF=$P(X,U,15) S:INCUTOFF="" INCUTOFF=99999
  1.  S INHSRVMO=+$P($G(^INRHSITE(1,2)),U,1),INAVJ=$G(^%ZOSF("AVJ"))
  1.  S INFSHNG=+$P(^INRHSITE(1,2),U,2)/4 S:INFSHNG>90 INFSHNG=90
  1.  S JOB=^INTHOS(1,1)
  1.  S INHJOB(4)=$$REPLACE^UTIL(JOB,"*","SRVR^INHOTM(INBPN,INHSRVNO)")
  1.  ;note - recover transaction process at some future time
  1.  ;loop until server shutdown.
  1.  F  Q:'$$RUN  D LOOP H 1
  1.  ;
  1. END ;Exit here
  1.  K ^INRHB("RUN",+$G(INBPN))
  1.  Q
  1.  ;
  1. LOOP ;Main loop
  1.  D INRHB(INBPN,"Processing Transaction")
  1.  ;Get next transaction from queue
  1.  S DA=$$NEXTDA(.PRIO,.DTTM),N=DTTM
  1.  I 'DA D INRHB(INBPN,"Idle") H INHANG Q
  1.  E  I $$RUN D NEWSRV
  1.  Q
  1. NEWSRV ;Try to start new server
  1.  N INLKFLG S INLKFLG=0
  1.  Q:'$$RUN
  1.  F INHSRVNO=1:1:MODE L +^INRHB("RUN","SRVR",INBPN,INHSRVNO):0 I $T D  Q
  1.  .S INLKFLG=1
  1.  .;start a new job/server process
  1.  .X INAVJ
  1.  .I Y>1 D
  1.  ..S ^INRHB("RUN","SRVR",INBPN,INHSRVNO)=""
  1.  ..L -^INRHB("RUN","SRVR",INBPN,INHSRVNO) X INHJOB(4) I $T H INTHROT
  1.  .L -^INRHB("RUN","SRVR",INBPN,INHSRVNO)
  1.  ;Hang if nothing got locked since all servers in use
  1.  I 'INLKFLG D
  1.  .D INRHB(INBPN,"Idle")
  1.  .F X=1:1:INFSHNG H 2 Q:'$$RUN
  1.  Q
  1. RUN() ;Function to decide if routine should continue to run
  1.  ;Returns 1 = YES    0 = NO
  1.  L +^INRHB("RUN",INBPN):0,-^INRHB("RUN",INBPN)
  1.  Q:'$G(^INRHSITE(1,"ACT")) 0
  1.  Q:'$D(^INRHB("RUN",INBPN)) 0
  1.  I $D(^%ZOSF("SIGNOFF")) X ^("SIGNOFF") I  K ^INRHB("RUN") Q 0
  1.  Q 1
  1. TYPE(DA) ;Return type of transaction
  1.  ; Input: DA - ien of transaction
  1.  S DEST=$P($G(^INTHU(DA,0)),U,2) I 'DEST S TYPE="" Q ""
  1.  S DOM=$G(^INRHD(DEST,0)),TYPE=$S($P(DOM,U,2):1,$P(DOM,U,3)]"":2,$P(DOM,U,4)]"":3,1:0)
  1.  Q TYPE
  1. SRVR(INBPN,INHSRVR) ;Output controller background processor - server
  1.  ;INPUT
  1.  ;   INHSRVR - server number
  1.  ;   INBPN - ien for output controller
  1.  ;
  1.  Q:'$G(INBPN)!'$G(INHSRVR)
  1.  L +^INRHB("RUN","SRVR",INBPN,INHSRVR):5 E  Q
  1.  X $G(^INTHOS(1,2))
  1.  Q:'$$RUN
  1.  K INHER S X="ERROR^INHOTM",@^%ZOSF("TRAP")
  1.  S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$H
  1.  D SETENV^INHUT7
  1.  S X=$$PRIO^INHB1 X:X ^%ZOSF("PRIORITY")
  1.  ;Start GIS Background process audit if flag is set in Site Parms File
  1.  N INPNAME S INPNAME=$P(^INTHPC(INBPN,0),U)
  1.  D AUDCHK^XUSAUD D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME,INHSRVR)
  1.  ;Set up control variables
  1.  S INHANG=$P($G(^INRHSITE(1,0)),U,4) S:'INHANG INHANG=10
  1.  S INCUTOFF=$P($G(^INRHSITE(1,0)),U,15) S:'INCUTOFF INCUTOFF=99999
  1.  ;set max wait time
  1.  S INHMWAIT=$P($G(^INRHSITE(1,2)),U,2) S:'INHMWAIT INHMWAIT=60
  1.  ;set server shutdown time
  1.  S INSHTDN=INHMWAIT*3
  1.  S:INSHTDN>3600 INSHTDN=3600 S:INSHTDN<900 INSHTDN=900
  1.  S MODE=0,INHWAIT=-INHANG,INSHTDN1=0
  1.  F  S DEV="" Q:'$$RUN!'$$WAIT  D SVLOOP
  1. HALT ;Halt process
  1.  K ^INRHB("RUN","SRVR",INBPN,INHSRVR)
  1.  L -^INRHB("RUN","SRVR",INBPN,INHSRVR)
  1.  K ^DIJUSV(DUZ)
  1.  ;Stop background process audit
  1.  D:$D(XUAUDIT) AUDSTP^XUSAUD
  1.  H
  1. SVLOOP ;Loop through transactions in the server queue
  1.  S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$H
  1.  ;Get next transaction from queue
  1.  L +^INLHSCH:3 E  H INHANG Q
  1.  ;Update background process audit
  1.  D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME,INHSRVR)
  1.  S DA=$$NEXTDA(.PRIO,.DTTM),H=DTTM I 'DA L -^INLHSCH H INHANG Q
  1.  ;Determine how to process transaction
  1.  S TYPE=$$TYPE(DA),INHWAIT=0
  1.  D KILL
  1.  L -^INLHSCH
  1.  I '$$TRANSOK Q
  1.  E  D
  1.  .;Single Thread Process transaction new variables needed later
  1.  .N U,INHO,MODE,INAVJ,INJOB,INHANG,INTHROT,INCUTOFF,INHMWAIT,INHWAIT,PRIO,INSHTDN1,INSHTDN,DTTM,SV,BP
  1.  .;DUZ("AG") needed for IHS
  1.  .N INDUZ M INDUZ=DUZ N DUZ S DUZ("AG")=$G(INDUZ("AG"))
  1.  .S BP=+$G(INBPN),SV=+$G(INHSRVR)
  1.  .N INBPN,INHSRVR S INBPN=BP,INHSRVR=SV
  1.  .;Start up a job for entry with a Transceiver Routine
  1.  .I TYPE=2 D ^INHOT(DA,1,DEV) Q
  1.  .;Start up a job for entry with a Transaction Type
  1.  .I TYPE=1 D ^INHOS(DA) Q
  1.  .;Start up a job for entry with a Mail recipient
  1.  .I TYPE=3 D ^INHOM(DA) Q
  1.  H INHANG
  1.  Q
  1. WAIT() ;max wait time before shutting down
  1.  ; Return 0 to shut down 1 to not shut down
  1.  S INHWAIT=INHWAIT+INHANG,INSHTDN1=INSHTDN1+INSHTDN
  1.  Q INHWAIT'>INHMWAIT!(INSHTDN1'>INSHTDN)
  1. NEXTDA(PRIO,DTTM,NO) ;Get next transaction off queue
  1.  ; Output: PRIO
  1.  ;         DTTM - Date,Time of transaction
  1.  ;     opt NO - Node to $Q 
  1.  ; Returns: DA - next transaction
  1.  N DAY,TIME K DA
  1.  S DAY=+$H,TIME=$P($H,",",2),(DTTM,DA)=""
  1.  S:$G(NO)="" NO="^INLHSCH"
  1.  S NO=$Q(@NO)
  1.  I NO'="" D
  1.  .S P=$QS(NO,1),DTTM=$QS(NO,2),ND=+DTTM,NT=$P(DTTM,",",2)
  1.  .I '(P'?1.NP) D
  1.  ..I P'>INCUTOFF,(ND=DAY&(NT'>TIME)!(ND<DAY)) S DA=$QS(NO,3),PRIO=P Q
  1.  ..S NO="^INLHSCH("_P_",""99999,99999"")"
  1.  ..S DA=$$NEXTDA(.PRIO,.DTTM,NO)
  1.  Q +DA
  1. TRANSOK() ;Verify transaction is ok to process
  1.  L +^INTHU(DA):1 E  Q 0
  1.  S %=$$TYPE(DA)
  1.  L -^INTHU(DA)
  1.  I 'DEST K ^INLHSCH(PRIO,DTTM,DA) S MES="Transaction has no destination." D ENO^INHE("",DA,"",MES),ULOG^INHU(DA,"E",MES) K MES Q 0
  1.  I 'TYPE D KILL S MES="Destination has no method of processing." D ENO^INHE("",DA,DEST,MES),ULOG^INHU(DA,"E",MES) K MES Q 0
  1.  Q 1
  1. KILL ;Kill entry from INLHSCH
  1.  K ^INLHSCH(PRIO,DTTM,DA),^INLHSCH("DEST",+DEST,PRIO,DA)
  1.  Q
  1.  ;
  1. INRHB(INBPN,MESS,SRVR,UPDT) ;Update background process file
  1.  ; Input:
  1.  ; INBPN-Background process ien
  1.  ; MESS-Text
  1.  ; SRVR-Server #
  1.  ; LAST- 1 Update 3rd piece to $H, 0 leave 3rd piece
  1.  S UPDT=$G(UPDT)
  1.  I $G(SRVR) S $P(^INRHB("RUN","SRVR",INBPN,SRVR),U,1,2)=$H_U_MESS S:UPDT $P(^(SRVR),U,3)=$H Q
  1.  S $P(^INRHB("RUN",INBPN),U,1,2)=$H_U_MESS S:UPDT $P(^(INBPN),U,3)=$H
  1.  Q
  1. ERROR ;Error module for server
  1.  S X="HALT^INHOTM",@^%ZOSF("TRAP")
  1.  X ^INTHOS(1,3)
  1.  D ENO^INHE("",.DA,.DEST,$S($D(INHER):INHER,1:$$ERRMSG^INHU1))
  1.  ;*** SHOULD ALSO NOTE TRANSACTION IF DA EXISTS - MAY NOT BE CORRECT - MAY BE LAST DA PROCESSED
  1.  G HALT