INHFTM1(INBPN,INHSRVR) ; DGH,FRW ; 3 Feb 93 14:54; Format Controller background process - server [ 06/22/2001 2:28 PM ]
;;3.01;BHL IHS Interfaces with GIS;;July 1, 2001
;COPYRIGHT 1991-2000 SAIC
EN ;Main entry point
;INPUT:
; INHSRVR - server number
; INBPN - ien for output controller
;LOCAL:
; DA - transaction to process (ien) in ^INLHFTSK
; INHANG - time to hang after processing a task,
; from file #4002 field #.05
; INHER - error message
; INHMWAIT - maximum time a server should wait for
; something to process before shutting down,
; from file #4002 field #2.04
; INHWAIT - time since a trascation was processed
; MODE - always set to zero (0), used in BACK^INHF
;
L +^INRHB("RUN","SRVR",INBPN,INHSRVR):5 E Q
X $G(^INTHOS(1,2))
Q:'$G(INBPN)!'$G(INHSRVR)!'$$RUN^INHFTM
K INHER S X="ERROR^INHFTM1",@^%ZOSF("TRAP")
S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$H
;*** REPLACE WITH STANDARD CALL
S U="^",DUZ=.5,DUZ(0)="@",IO=""
S X=$$PRIO^INHB1 X:X ^%ZOSF("PRIORITY")
;Set up control variables
S INHANG=$P($G(^INRHSITE(1,0)),U,5) S:'INHANG INHANG=10
S INHMWAIT=$P($G(^INRHSITE(1,2)),U,4) S:'INHMWAIT INHMWAIT=60
S MODE=0,INHWAIT=-INHANG
;
LOOP ;Main loop to process transactions
S INHWAIT=INHWAIT+INHANG
I '$$RUN^INHFTM!(INHWAIT>INHMWAIT) G HALT
S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$H
L +^INLHFTSK("AH"):3 E H INHANG G LOOP
S DA=$$NEXTDA I 'DA L -^INLHFTSK("AH") H INHANG G LOOP
K ^INLHFTSK("AH",PRIO,H,DA)
L -^INLHFTSK("AH")
S INHWAIT=0
D JOB H INHANG G LOOP
Q
;
JOB ;Run formatter
;Any variables that are needed by the server program (^INHFTM1) should be NEWed prior to calling ^INHF
N INHANG,INHMWAIT,INHWAIT,MODE,INBPN,INHSRVR
D BACK^INHFTM(DA)
Q
;
NEXTDA() ;Get next transaction off queue
;OUTPUT:
; function value - next transaction to process
;
S DAY=+$H,TIME=$P($H,",",2),DA=""
S P="" F S P=$O(^INLHFTSK("AH",P)) Q:DA!(P="") D
.S H=$O(^INLHFTSK("AH",P,"")) Q:H=""
.S ND=+H,NT=$P(H,",",2) Q:ND>DAY!(NT>TIME&(ND=DAY))
.S DA=$O(^INLHFTSK("AH",P,H,"")),PRIO=P
Q +DA
;
ERROR ;Error module for server
S X="HALT^INHFTM1",@^%ZOSF("TRAP")
X ^INTHOS(1,3)
S INHER(1)=$S($D(INHER)#2:INHER,1:$$ERRMSG^INHU1)
S INHER(2)="in format controller background server for task "_$G(DA)
;***DA may not be the transaction being processed - it may have been the previous transaction processed
S %="" I +$G(DA) S %=$G(^INLHFTSK(DA,0))
D ENF^INHE($P(%,U,1),$P(%,U,2),$P(%,U,3),"",.INHER)
;
HALT ;Halt process
K ^INRHB("RUN","SRVR",INBPN,INHSRVR)
L -^INRHB("RUN","SRVR",INBPN,INHSRVR)
H
;
INHFTM1(INBPN,INHSRVR) ; DGH,FRW ; 3 Feb 93 14:54; Format Controller background process - server [ 06/22/2001 2:28 PM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;;July 1, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
EN ;Main entry point
+1 ;INPUT:
+2 ; INHSRVR - server number
+3 ; INBPN - ien for output controller
+4 ;LOCAL:
+5 ; DA - transaction to process (ien) in ^INLHFTSK
+6 ; INHANG - time to hang after processing a task,
+7 ; from file #4002 field #.05
+8 ; INHER - error message
+9 ; INHMWAIT - maximum time a server should wait for
+10 ; something to process before shutting down,
+11 ; from file #4002 field #2.04
+12 ; INHWAIT - time since a trascation was processed
+13 ; MODE - always set to zero (0), used in BACK^INHF
+14 ;
+15 LOCK +^INRHB("RUN","SRVR",INBPN,INHSRVR):5
IF '$TEST
QUIT
+16 XECUTE $GET(^INTHOS(1,2))
+17 IF '$GET(INBPN)!'$GET(INHSRVR)!'$$RUN^INHFTM
QUIT
+18 KILL INHER
SET X="ERROR^INHFTM1"
SET @^%ZOSF("TRAP")
+19 SET ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$HOROLOG
+20 ;*** REPLACE WITH STANDARD CALL
+21 SET U="^"
SET DUZ=.5
SET DUZ(0)="@"
SET IO=""
+22 SET X=$$PRIO^INHB1
IF X
XECUTE ^%ZOSF("PRIORITY")
+23 ;Set up control variables
+24 SET INHANG=$PIECE($GET(^INRHSITE(1,0)),U,5)
IF 'INHANG
SET INHANG=10
+25 SET INHMWAIT=$PIECE($GET(^INRHSITE(1,2)),U,4)
IF 'INHMWAIT
SET INHMWAIT=60
+26 SET MODE=0
SET INHWAIT=-INHANG
+27 ;
LOOP ;Main loop to process transactions
+1 SET INHWAIT=INHWAIT+INHANG
+2 IF '$$RUN^INHFTM!(INHWAIT>INHMWAIT)
GOTO HALT
+3 SET ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$HOROLOG
+4 LOCK +^INLHFTSK("AH"):3
IF '$TEST
HANG INHANG
GOTO LOOP
+5 SET DA=$$NEXTDA
IF 'DA
LOCK -^INLHFTSK("AH")
HANG INHANG
GOTO LOOP
+6 KILL ^INLHFTSK("AH",PRIO,H,DA)
+7 LOCK -^INLHFTSK("AH")
+8 SET INHWAIT=0
+9 DO JOB
HANG INHANG
GOTO LOOP
+10 QUIT
+11 ;
JOB ;Run formatter
+1 ;Any variables that are needed by the server program (^INHFTM1) should be NEWed prior to calling ^INHF
+2 NEW INHANG,INHMWAIT,INHWAIT,MODE,INBPN,INHSRVR
+3 DO BACK^INHFTM(DA)
+4 QUIT
+5 ;
NEXTDA() ;Get next transaction off queue
+1 ;OUTPUT:
+2 ; function value - next transaction to process
+3 ;
+4 SET DAY=+$HOROLOG
SET TIME=$PIECE($HOROLOG,",",2)
SET DA=""
+5 SET P=""
FOR
SET P=$ORDER(^INLHFTSK("AH",P))
IF DA!(P="")
QUIT
Begin DoDot:1
+6 SET H=$ORDER(^INLHFTSK("AH",P,""))
IF H=""
QUIT
+7 SET ND=+H
SET NT=$PIECE(H,",",2)
IF ND>DAY!(NT>TIME&(ND=DAY))
QUIT
+8 SET DA=$ORDER(^INLHFTSK("AH",P,H,""))
SET PRIO=P
End DoDot:1
+9 QUIT +DA
+10 ;
ERROR ;Error module for server
+1 SET X="HALT^INHFTM1"
SET @^%ZOSF("TRAP")
+2 XECUTE ^INTHOS(1,3)
+3 SET INHER(1)=$SELECT($DATA(INHER)#2:INHER,1:$$ERRMSG^INHU1)
+4 SET INHER(2)="in format controller background server for task "_$GET(DA)
+5 ;***DA may not be the transaction being processed - it may have been the previous transaction processed
+6 SET %=""
IF +$GET(DA)
SET %=$GET(^INLHFTSK(DA,0))
+7 DO ENF^INHE($PIECE(%,U,1),$PIECE(%,U,2),$PIECE(%,U,3),"",.INHER)
+8 ;
HALT ;Halt process
+1 KILL ^INRHB("RUN","SRVR",INBPN,INHSRVR)
+2 LOCK -^INRHB("RUN","SRVR",INBPN,INHSRVR)
+3 HANG
+4 ;