INHOTM1(INBPN,INHSRVR) ;DGH,FRW ; 4 Mar 94 09:00; Output controller background processor - server [ 06/22/2001 2:31 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
;
Q:'$G(INBPN)!'$G(INHSRVR)
L +^INRHB("RUN","SRVR",INBPN,INHSRVR):5 E Q
X $G(^INTHOS(1,2))
Q:'$$RUN^INHOTM
K INHER S X="ERROR^INHOTM1",@^%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,4) S:'INHANG INHANG=10
S INCUTOFF=$P($G(^INRHSITE(1,0)),U,15) S:'INCUTOFF INCUTOFF=99999
S INHMWAIT=$P($G(^INRHSITE(1,2)),U,2) S:'INHMWAIT INHMWAIT=60
;
S MODE=0,INHWAIT=-INHANG
;
LOOP ;Loop through transactions in the server queue
Q:'$$GETDEV
S INHWAIT=INHWAIT+INHANG
I '$$RUN^INHOTM!(INHWAIT>INHMWAIT) G HALT
S ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$H
;Get next transaction from queue
L +^INLHSCH:3 E H INHANG G LOOP
S DA=$$NEXTDA I 'DA L -^INLHSCH H INHANG G LOOP
;Determine how to process transaction
S TYPE=$$TYPE^INHOTM(DA)_"^INHOTM",INHWAIT=0
K ^INLHSCH(PRIO,H,DA),^INLHSCH("DEST",DEST,PRIO,DA)
L -^INLHSCH
;Verify transaction is ok
I 'TYPE D G LOOP
. I 'DEST S MES="Transaction has no destination." D ENO^INHE("",DA,"",MES),ULOG^INHU(DA,"E",MES) K MES
. I 'TYPE S MES="Destination has no method of processing." D ENO^INHE("",DA,DEST,MES),ULOG^INHU(DA,"E",MES) K MES
. H INHANG
;Process transaction
D @TYPE H INHANG G LOOP
Q
;
NEXTDA() ;Get next transaction off queue
S DAY=+$H,TIME=$P($H,",",2),DA=""
S P="" F S P=$O(^INLHSCH(P)) Q:(P'?1.NP)!(P>INCUTOFF)!DA D
.S H=$O(^INLHSCH(P,"")) Q:H=""
.S ND=+H,NT=$P(H,",",2) Q:ND>DAY!(NT>TIME&(ND=DAY))
.S DA=$O(^INLHSCH(P,H,0)),PRIO=P Q:'DA
Q +DA
;
GETDEV() ;Perform device handling
;OUTPUT:
; function value - boolean flag
; 1 => ok , 0 => problems encountered
; DEV - $I of device (or NULL), device is open for use
;
;***NEEDS TO BE COMPLETED
S DEV=""
Q 1
;
ERROR ;Error module for server
S X="HALT^INHOTM1",@^%ZOSF("TRAP")
X ^INTHOS(1,3)
D ENR^INHE(INBPN,$S($D(INHER):INHER,1:$$ERRMSG^INHU1)) ;***CALL IS WRONG ENO^INHE
;*** SHOULD ALSO NOTE TRANSACTION IF DA EXISTS - MAY NOT BE CORRECT - MAY BE LAST DA PROCESSED
;
HALT ;Halt process
K ^INRHB("RUN","SRVR",INBPN,INHSRVR)
L -^INRHB("RUN","SRVR",INBPN,INHSRVR)
H
;
INHOTM1(INBPN,INHSRVR) ;DGH,FRW ; 4 Mar 94 09:00; Output controller background processor - server [ 06/22/2001 2:31 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 ;
+5 IF '$GET(INBPN)!'$GET(INHSRVR)
QUIT
+6 LOCK +^INRHB("RUN","SRVR",INBPN,INHSRVR):5
IF '$TEST
QUIT
+7 XECUTE $GET(^INTHOS(1,2))
+8 IF '$$RUN^INHOTM
QUIT
+9 KILL INHER
SET X="ERROR^INHOTM1"
SET @^%ZOSF("TRAP")
+10 SET ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$HOROLOG
+11 ;***REPLACE WITH STANDARD CALL
+12 SET U="^"
SET DUZ=.5
SET DUZ(0)="@"
SET IO=""
+13 SET X=$$PRIO^INHB1
IF X
XECUTE ^%ZOSF("PRIORITY")
+14 ;Set up control variables
+15 SET INHANG=$PIECE($GET(^INRHSITE(1,0)),U,4)
IF 'INHANG
SET INHANG=10
+16 SET INCUTOFF=$PIECE($GET(^INRHSITE(1,0)),U,15)
IF 'INCUTOFF
SET INCUTOFF=99999
+17 SET INHMWAIT=$PIECE($GET(^INRHSITE(1,2)),U,2)
IF 'INHMWAIT
SET INHMWAIT=60
+18 ;
+19 SET MODE=0
SET INHWAIT=-INHANG
+20 ;
LOOP ;Loop through transactions in the server queue
+1 IF '$$GETDEV
QUIT
+2 SET INHWAIT=INHWAIT+INHANG
+3 IF '$$RUN^INHOTM!(INHWAIT>INHMWAIT)
GOTO HALT
+4 SET ^INRHB("RUN","SRVR",INBPN,INHSRVR)=$HOROLOG
+5 ;Get next transaction from queue
+6 LOCK +^INLHSCH:3
IF '$TEST
HANG INHANG
GOTO LOOP
+7 SET DA=$$NEXTDA
IF 'DA
LOCK -^INLHSCH
HANG INHANG
GOTO LOOP
+8 ;Determine how to process transaction
+9 SET TYPE=$$TYPE^INHOTM(DA)_"^INHOTM"
SET INHWAIT=0
+10 KILL ^INLHSCH(PRIO,H,DA),^INLHSCH("DEST",DEST,PRIO,DA)
+11 LOCK -^INLHSCH
+12 ;Verify transaction is ok
+13 IF 'TYPE
Begin DoDot:1
+14 IF 'DEST
SET MES="Transaction has no destination."
DO ENO^INHE("",DA,"",MES)
DO ULOG^INHU(DA,"E",MES)
KILL MES
+15 IF 'TYPE
SET MES="Destination has no method of processing."
DO ENO^INHE("",DA,DEST,MES)
DO ULOG^INHU(DA,"E",MES)
KILL MES
+16 HANG INHANG
End DoDot:1
GOTO LOOP
+17 ;Process transaction
+18 DO @TYPE
HANG INHANG
GOTO LOOP
+19 QUIT
+20 ;
NEXTDA() ;Get next transaction off queue
+1 SET DAY=+$HOROLOG
SET TIME=$PIECE($HOROLOG,",",2)
SET DA=""
+2 SET P=""
FOR
SET P=$ORDER(^INLHSCH(P))
IF (P'?1.NP)!(P>INCUTOFF)!DA
QUIT
Begin DoDot:1
+3 SET H=$ORDER(^INLHSCH(P,""))
IF H=""
QUIT
+4 SET ND=+H
SET NT=$PIECE(H,",",2)
IF ND>DAY!(NT>TIME&(ND=DAY))
QUIT
+5 SET DA=$ORDER(^INLHSCH(P,H,0))
SET PRIO=P
IF 'DA
QUIT
End DoDot:1
+6 QUIT +DA
+7 ;
GETDEV() ;Perform device handling
+1 ;OUTPUT:
+2 ; function value - boolean flag
+3 ; 1 => ok , 0 => problems encountered
+4 ; DEV - $I of device (or NULL), device is open for use
+5 ;
+6 ;***NEEDS TO BE COMPLETED
+7 SET DEV=""
+8 QUIT 1
+9 ;
ERROR ;Error module for server
+1 SET X="HALT^INHOTM1"
SET @^%ZOSF("TRAP")
+2 XECUTE ^INTHOS(1,3)
+3 ;***CALL IS WRONG ENO^INHE
DO ENR^INHE(INBPN,$SELECT($DATA(INHER):INHER,1:$$ERRMSG^INHU1))
+4 ;*** SHOULD ALSO NOTE TRANSACTION IF DA EXISTS - MAY NOT BE CORRECT - MAY BE LAST DA PROCESSED
+5 ;
HALT ;Halt process
+1 KILL ^INRHB("RUN","SRVR",INBPN,INHSRVR)
+2 LOCK -^INRHB("RUN","SRVR",INBPN,INHSRVR)
+3 HANG
+4 ;
