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