- 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 ;
