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