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

INHFTNTM.m

Go to the documentation of this file. 
  1. INHFTNTM ;DGH,FRW,JSH,JPD; 10 Dec 97 12:26; GIS Formatter background controller 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TLS_4603; GEN 1; 21-MAY-1999
  1.  ;COPYRIGHT 1997 SAIC
  1.  ;Background process to scan ^INLHFTSK for entries to process
  1.  ;
  1.  ; Input: 
  1.  ;   INBPN - Background Process ien
  1.  ;   INHSRVR - Server number
  1.  ;LOCAL:
  1.  ;   INAVJ    -  executable code to indicate number of available 
  1.  ;               jobs on system, from ^%ZOSF("AVJ")
  1.  ;   INHANG   -  time to hang after starting a new job, 
  1.  ;               from file #4002 field #.05
  1.  ;   INFSHNG  -  Format Server Hang Time for starting new server
  1.  ;   INHSRVMO  -  flag for server/non-server processing mode, 
  1.  ;               from file #4002 field #2.03
  1.  ;   IN       -  transaction to process (ien) in ^INLHFTSK
  1.  ;   JOB(1)   -  executable code to initiate a server
  1.  ;   MODE     -  maximum number of output jobs, 
  1.  ;               from file #4002 field #.1
  1.  ;   DTTM     -  time transaction should be processed at ($H format)
  1.  ;
  1.  ;Intialize local and global variables
  1.  S ^INRHB("RUN",INBPN)=$H,^INLHFTSK("COUNT")=0
  1.  S INHSRVMO=1,MODE=+$P(^INRHSITE(1,0),U,10),INAVJ=^%ZOSF("AVJ")
  1.  S INHANG=$P(^INRHSITE(1,0),U,5) S:'INHANG INHANG=10
  1.  S INFSHNG=+$P(^INRHSITE(1,2),U,4)/4 S:INFSHNG>180 INFSHNG=180
  1.  S JOB(1)=$$REPLACE^UTIL(^INTHOS(1,1),"*","SRVR^INHFTM(INBPN,INHSRVR)")
  1.  D REQUE
  1.  F  Q:'$$RUN  D TMLOOP
  1.  Q  ;exit here
  1. TMLOOP ;Main loop to process transactions
  1.  ;Lock and unlock to flush cache
  1.  D INRHB(INBPN,"Process Transaction")
  1.  L +^INRHB("RUN",INBPN):0
  1.  L -^INRHB("RUN",INBPN)
  1.  S ^INRHB("RUN",INBPN)=$H
  1.  ;get next transaction
  1.  S IN=$$NEXTDA(.PRIO,.DTTM),N=DTTM
  1.  ;If no transaction Hang otherwise process it
  1.  I 'IN D INRHB(INBPN,"Idle") H INHANG Q
  1.  E  I $$RUN D NEWSRV(JOB(1))
  1.  Q
  1.  ;
  1. NEWSRV(INJCODE) ;Attempt to start a new server
  1.  ;INPUT:
  1.  ;   INJCODE  -  Code to initiate new server
  1.  ;Variables just hanging around
  1.  ;   INBPN    -  Background process ien (file #4004)
  1.  ;   INAVJ    -  Code to indicate number of available jobs on system
  1.  ;   MODE     -  Maximum number of servers
  1.  ;LOCAL:
  1.  ;   INHSRVR  -  Server number
  1.  ;
  1.  N Y,INHSRVR,INLK
  1.  S INLK=0
  1.  F INHSRVR=1:1:MODE L +^INRHB("RUN","SRVR",INBPN,INHSRVR):0 I $T D  Q
  1.  .S INLK=1
  1.  .X INAVJ I Y>1 D
  1.  ..S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=""
  1.  ..L -^INRHB("RUN","SRVR",INBPN,INHSRVR)
  1.  ..X INJCODE I $T H INHANG
  1.  .L -^INRHB("RUN","SRVR",INBPN,INHSRVR)
  1.  I 'INLK D
  1.  .D INRHB(INBPN,"Idle")
  1.  .F X=1:1:INFSHNG H 2 Q:'$$RUN
  1.  Q
  1. RUN() ;should process continue to run
  1.  ;OUTPUT:
  1.  ;   function value - 1 => continue, 0 => stop
  1.  Q:'$D(^INRHB("RUN",INBPN))!('$G(^INRHSITE(1,"ACT"))) 0
  1.  I $D(^%ZOSF("SIGNOFF")) X ^("SIGNOFF") I $T K ^INRHB("RUN") Q 0
  1.  Q 1
  1. REQUE ;Look for queue entries that were "in process" at prior shut-down
  1.  ;**Need to add if task is older than certain time don't reque
  1.  N TSK,TIME,PRIO,CNT
  1.  S TSK=0,CNT=0 F  S TSK=$O(^INLHFTSK(TSK)) Q:'TSK!(CNT>100)  D
  1.  .S TIME=$P(^INLHFTSK(TSK,0),U,4),PRIO=+$P(^(0),U,6) Q:TIME=""
  1.  .S CNT=CNT+1 Q:$D(^INLHFTSK("AH",PRIO,TIME,TSK))
  1.  .S ^INLHFTSK("AH",PRIO,TIME,TSK)=""
  1.  Q
  1. SRVR(INBPN,INHSRVR) ; Format Controller background process - server
  1.  ;Main entry point
  1.  ;INPUT:
  1.  ;   INHSRVR   -  server number
  1.  ;   INBPN     -  ien for output controller
  1.  ;LOCAL:
  1.  ;   DA        -  transaction to process (ien) in ^INLHFTSK
  1.  ;   INHANG    -  time to hang after processing a task, 
  1.  ;                from file #4002 field #.05
  1.  ;   INHER     -  error message
  1.  ;   INHMWAIT  -  maximum time a server should wait for 
  1.  ;                something to process before shutting down, 
  1.  ;                from file #4002 field #2.04
  1.  ;   INHWAIT   -  time since a trascation was processed
  1.  ;   MODE      -  always set to zero (0), used in BACK
  1.  ;
  1.  L +^INRHB("RUN","SRVR",INBPN,INHSRVR):5 E  Q
  1.  X $G(^INTHOS(1,2))
  1.  Q:'$G(INBPN)!'$G(INHSRVR)!'$$RUN
  1.  K INHER S X="ERROR^INHFTM",@^%ZOSF("TRAP")
  1.  S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$H
  1.  D SETENV
  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.  X:$$PRIO^INHB1 ^%ZOSF("PRIORITY")
  1.  ;Set up control variables
  1.  S INHANG=$P($G(^INRHSITE(1,0)),U,5) S:'INHANG INHANG=10
  1.  S INHMWAIT=$P($G(^INRHSITE(1,2)),U,4) S:'INHMWAIT INHMWAIT=60
  1.  S INSHTDN=INHMWAIT*3 S:INSHTDN>3600 INSHTDN=3600 S:INSHTDN<900 INSHTDN=900
  1.  S MODE=0,INHWAIT=-INHANG,INSHTDN1=0
  1.  F  Q:'$$RUN!'$$WAIT  D LOOP
  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. LOOP ;Main loop to process transactions
  1.  D INRHB(INBPN,"SRVR, Process Transaction",INHSRVR)
  1.  S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$H
  1.  ;Update background process audit
  1.  D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME,INHSRVR)
  1.  L +^INLHFTSK("AH"):3 E  H INHANG Q
  1.  S DA=$$NEXTDA(.PRIO,.DTTM)
  1.  I 'DA D  Q
  1.  .L -^INLHFTSK("AH")
  1.  .D INRHB(INBPN,"Idle",INHSRVR)
  1.  .H INHANG
  1.  K ^INLHFTSK("AH",PRIO,DTTM,DA)
  1.  L -^INLHFTSK("AH")
  1.  S INHWAIT=0
  1.  D BACK(DA,1)
  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,NOD) ;Get next transaction off queue
  1.  ;Output: (ref) PRIO - priority
  1.  ;        (ref) DTTM - date,time $H format
  1.  ;        (opt) NOD  - node to $Q
  1.  ;Returns:  DA - function value - next transaction to process
  1.  ;
  1.  N DAY,TIME,INCREF K DA
  1.  ;current date and time, initialize DA="" and NOD=prioriy x-ref
  1.  S DAY=+$H,TIME=$P($H,",",2),DA=""
  1.  S:$G(NOD)="" NOD="^INLHFTSK(""AH"")"
  1.  ;get cross ref., priority, Date and Time
  1.  S NOD=$Q(@NOD)
  1.  I NOD'="" D
  1.  .S INCREF=$$QS(NOD,1),PRIO=$$QS(NOD,2),DTTM=$$QS(NOD,3)
  1.  .;set tran time and tran date
  1.  .S ND=+DTTM,NT=$P(DTTM,",",2)
  1.  .;if PRIO'="",piece 1="AH",transday'>today,(trantime '> now)
  1.  .I PRIO'="",INCREF="AH" D
  1.  ..I (ND=DAY&(NT'>TIME)!(ND<DAY)) S DA=$$QS(NOD,4) Q
  1.  ..S NOD="^INLHFTSK(""AH"","_PRIO_",""99999,99999"")"
  1.  ..S DA=$$NEXTDA(.PRIO,.DTTM,NOD)
  1.  Q +DA
  1. SETENV ;Set up environment
  1.  S U="^",DUZ=.5,DUZ(0)="@",IO=""
  1.  D SETDT^UTDT
  1.  Q
  1. ERROR ;Error module for server
  1.  S X="HALT^INHFTM",@^%ZOSF("TRAP")
  1.  X ^INTHOS(1,3)
  1.  S INHER(1)=$S($D(INHER)#2:INHER,1:$$ERRMSG^INHU1)
  1.  S INHER(2)="in format controller background server for task "_$G(DA)
  1.  ;***DA may not be the transaction being processed - it may have been the previous transaction processed
  1.  S %="" I +$G(DA) S %=$G(^INLHFTSK(DA,0))
  1.  D ENF^INHE($P(%,U,1),$P(%,U,2),$P(%,U,3),"",.INHER)
  1.  G HALT
  1. BACK(INTSK,INHSRVMO) ;Background program entry point
  1.  N INHANG,INHMWAIT,INHWAIT,MODE,BP,SV
  1.  S BP=+$G(INBPN),SV=+$G(INHSRVR)
  1.  N INBPN,INHSRVR S INBPN=BP,INHSRVR=SV
  1.  S X="ERR^INHF",@^%ZOSF("TRAP") X $G(^INTHOS(1,2)) N INDIPA,INIDA,X,INJ
  1.  S U="^" L +^INLHFTSK(INTSK):5 E  Q   ;***SHOULD REQUE TASK
  1.  S X=$P(^INRHSITE(1,0),U,6) X:X ^%ZOSF("PRIORITY")
  1.  I '$D(^INLHFTSK(INTSK,0)) D ERROR^INHF("Task deleted from INLHFTSK - "_INTSK) Q
  1.  S X=^INLHFTSK(INTSK,0),INTT=+X,INIDA=$P(X,U,2),DUZ=$P(X,U,3)
  1.  S:$P(X,U,5) DUZ(2)=$P(X,U,5)
  1.  D SETDT^UTDT
  1.  X $G(^INRHSITE(1,1))
  1.  ;Load INDIPA array
  1.  I $D(^INLHFTSK(INTSK,2))>9 M INDIPA=^INLHFTSK(INTSK,2)
  1.  I $D(^INLHFTSK(INTSK,1)) M INIDA=^INLHFTSK(INTSK,1)
  1.  L -^INLHFTSK(INTSK)
  1.  S I="" F  S I=$O(^INRHT("AC",INTT,I)) Q:'I  I $D(^INRHT(I)),$P($G(^(I,0)),U,5) S INJ(+$P(^INRHT(I,0),U,7),I)=""
  1.  I $D(INJ) D
  1.  .S PRIO=.9 F  S PRIO=$O(INJ(PRIO)) Q:'PRIO  D JL
  1.  .S PRIO=0 D JL
  1.  Q
  1. JL ;Loop through jobs at priority PRIO
  1.  S TRT=0 F  S TRT=$O(INJ(PRIO,TRT)) Q:'TRT  D
  1.  .;Preserve values of INIDA (INDA) and INDIPA (INA)
  1.  .N INA,INDA
  1.  .M INA=INDIPA,INDA=INIDA
  1.  .K INV,UIF
  1.  .S SCR=$P(^INRHT(TRT,0),U,3),DEST=+$P(^INRHT(TRT,0),U,2),INTNAME=$P(^(0),U)
  1.  .;Avoid "no program" error if script is missing
  1.  .I 'SCR S ER=1,ERROR(1)="No script for transaction type "_$P(^INRHT(TRT,0),U)_"  Formatter Task "_$G(INTSK)
  1.  .;Start transaction audit
  1.  .D:$D(XUAUDIT) TTSTRT^XUSAUD(INTNAME,"",$P(^INTHPC(INBPN,0),U),INHSRVR,"SCRIPT")
  1.  .K ^UTILITY("INDA",$J) M ^UTILITY("INDA",$J)=INDA
  1.  .S Z="S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_")"
  1.  .I SCR D
  1.  ..X Z I $G(UIF)>0 D
  1.  ...M ^INTHU(UIF,6)=^UTILITY("INDA",$J)
  1.  ...I $D(INA("DMISID")) M ^INTHU(UIF,7,"DMISID")=INA("DMISID")
  1.  ...I $D(INA("MSGTYPE")) M ^INTHU(UIF,7,"MSGTYPE")=INA("MSGTYPE")
  1.  .K ^UTILITY("INDA",$J)
  1.  .;Stop transaction audit
  1.  .D:$D(XUAUDIT) TTSTP^XUSAUD(0)
  1.  .K ^INLHFTSK(INTSK),^INLHFTSK("B",INTT,INTSK)
  1.  .Q:'ER
  1.  .D ENF^INHE(TRT,.INDA,DUZ,.INA,.ERROR)
  1.  Q
  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. QS(GLB,SUB) ; return subscript
  1.  ; input:  GLB = global ref from $Q
  1.  ;         SUB = subscript to return
  1.  N I,N,P,PO,S,X,%
  1.  I SUB<1 S GLB=$TR($P(GLB,"("),"[]","||") D  Q $G(X(SUB))
  1.  . I GLB["|" S X(-1)=$P(GLB,"|",2),X(-1)=$E(X(-1),2,$L(X(-1))-1),X(0)=$P(GLB,"|",1)_$P(GLB,"|",3)
  1.  . E  S X(0)=GLB
  1.  S GLB=$P(GLB,"(",2),GLB=$E(GLB,1,$L(GLB)-1)
  1.  S S=1,P=1,PO=0 F  S X(S)=$P(GLB,",",P,P+PO) Q:'$L(X(S))  S %=$L(X(S),"""")#2 S:% S=S+1,P=P+1+PO,PO=0 S:'% PO=PO+1 Q:S>SUB
  1.  S GLB=$G(X(SUB)),N=$E(GLB)
  1.  I 'N,N'=0 S GLB=$E(GLB,2,$L(GLB)-1),%=0 F  S %=$F(GLB,"""""",%-1) Q:'%  S GLB=$E(GLB,1,%-3)_""""_$E(GLB,%,999)
  1.  Q GLB