- INHB1(INBPN) ; cmi/flag/maw - JSH 11 Feb 93 12:15 Interface - routine to run a Background Process 07 Oct 91 6:44 AM ; [ 08/09/2001 9:38 AM ]
- ;;3.01;BHL IHS Interfaces with GIS;;JULY 1, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- ;INBPN = entry # in Background Process Control file (#4004)
- X $G(^INTHOS(1,2))
- Q:'$G(INBPN) Q:'$D(^INTHPC(INBPN,0)) Q:'$G(^INRHSITE(1,"ACT"))
- K INHER S X="ERROR^INHB1",@^%ZOSF("TRAP")
- L +^INRHB("RUN",INBPN):0 E Q
- S ^INRHB("RUN",INBPN)=$H K ^INTHPC(INBPN,2)
- ;cmi/flagstaff/maw mods here for duz 8/9/2001
- ;S U="^",DUZ=.5,DUZ(0)="@",IO="" ;cmi/maw orig 8/9/2001
- S INHLDUZ=$O(^VA(200,"B","GIS,USER",0))
- S DUZ=$S($G(INHLDUZ):INHLDUZ,1:DUZ)
- S U="^",DUZ(0)="@",IO=""
- ;cmi/flagstaff/maw end of mods
- S DIE="^INTHPC(",DA=INBPN,DR=".04///^S X=$J;.05///NOW" D ^DIE
- S X=$$PRIO X:X ^%ZOSF("PRIORITY")
- S X=$P(^INTHPC(INBPN,0),U,3) I X,$D(^%ZIS(1,X,0)) S %ZIS="0",IOP=$P(^%ZIS(1,X,0),U)_";0;99999" D ^%ZIS I POP S INHER="Could not open device: "_$P(^%ZIS(1,X,0),U) G ERROR
- S ROU=$G(^INTHPC(INBPN,"ROU")) I ROU="" S INHER="No routine specified." G ERROR
- S:ROU'["^" ROU="^"_ROU
- U:IO]"" IO D @ROU
- ;
- QUIT ;Background program termination point
- L -^INRHB("RUN",INBPN) Q
- ;
- ERROR ;Process errors
- S X="HALT^INHB1",@^%ZOSF("TRAP") X ^INTHOS(1,3)
- K ^INRHB("RUN",INBPN)
- S:'$D(^INTHPC(INBPN,2,0)) ^(0)="^4004.01D^^"
- S DIC="^INTHPC("_INBPN_",2,",DIC(0)="L",DA(1)=INBPN,X="""NOW""" D ^DIC Q:Y<0
- S ^INTHPC(INBPN,2,+Y,1)=$S($D(INHER):INHER,1:$$ERRMSG^INHU1)
- D ENR^INHE(INBPN,$S($D(INHER):INHER,1:$$ERRMSG^INHU1))
- Q
- ;
- HALT ;Just halt
- K ^INRHB("RUN",INBPN) H
- ;
- PRIO() ;Function which returns priority for this process
- I $P(^INTHPC(INBPN,0),U,6)]"" Q $P(^(0),U,6)
- Q $P($G(^INRHSITE(1,0)),U,6)
- INHB1(INBPN) ; cmi/flag/maw - JSH 11 Feb 93 12:15 Interface - routine to run a Background Process 07 Oct 91 6:44 AM ; [ 08/09/2001 9:38 AM ]
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JULY 1, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;
- +4 ;INBPN = entry # in Background Process Control file (#4004)
- +5 XECUTE $GET(^INTHOS(1,2))
- +6 IF '$GET(INBPN)
- QUIT
- IF '$DATA(^INTHPC(INBPN,0))
- QUIT
- IF '$GET(^INRHSITE(1,"ACT"))
- QUIT
- +7 KILL INHER
- SET X="ERROR^INHB1"
- SET @^%ZOSF("TRAP")
- +8 LOCK +^INRHB("RUN",INBPN):0
- IF '$TEST
- QUIT
- +9 SET ^INRHB("RUN",INBPN)=$HOROLOG
- KILL ^INTHPC(INBPN,2)
- +10 ;cmi/flagstaff/maw mods here for duz 8/9/2001
- +11 ;S U="^",DUZ=.5,DUZ(0)="@",IO="" ;cmi/maw orig 8/9/2001
- +12 SET INHLDUZ=$ORDER(^VA(200,"B","GIS,USER",0))
- +13 SET DUZ=$SELECT($GET(INHLDUZ):INHLDUZ,1:DUZ)
- +14 SET U="^"
- SET DUZ(0)="@"
- SET IO=""
- +15 ;cmi/flagstaff/maw end of mods
- +16 SET DIE="^INTHPC("
- SET DA=INBPN
- SET DR=".04///^S X=$J;.05///NOW"
- DO ^DIE
- +17 SET X=$$PRIO
- IF X
- XECUTE ^%ZOSF("PRIORITY")
- +18 SET X=$PIECE(^INTHPC(INBPN,0),U,3)
- IF X
- IF $DATA(^%ZIS(1,X,0))
- SET %ZIS="0"
- SET IOP=$PIECE(^%ZIS(1,X,0),U)_";0;99999"
- DO ^%ZIS
- IF POP
- SET INHER="Could not open device: "_$PIECE(^%ZIS(1,X,0),U)
- GOTO ERROR
- +19 SET ROU=$GET(^INTHPC(INBPN,"ROU"))
- IF ROU=""
- SET INHER="No routine specified."
- GOTO ERROR
- +20 IF ROU'["^"
- SET ROU="^"_ROU
- +21 IF IO]""
- USE IO
- DO @ROU
- +22 ;
- QUIT ;Background program termination point
- +1 LOCK -^INRHB("RUN",INBPN)
- QUIT
- +2 ;
- ERROR ;Process errors
- +1 SET X="HALT^INHB1"
- SET @^%ZOSF("TRAP")
- XECUTE ^INTHOS(1,3)
- +2 KILL ^INRHB("RUN",INBPN)
- +3 IF '$DATA(^INTHPC(INBPN,2,0))
- SET ^(0)="^4004.01D^^"
- +4 SET DIC="^INTHPC("_INBPN_",2,"
- SET DIC(0)="L"
- SET DA(1)=INBPN
- SET X="""NOW"""
- DO ^DIC
- IF Y<0
- QUIT
- +5 SET ^INTHPC(INBPN,2,+Y,1)=$SELECT($DATA(INHER):INHER,1:$$ERRMSG^INHU1)
- +6 DO ENR^INHE(INBPN,$SELECT($DATA(INHER):INHER,1:$$ERRMSG^INHU1))
- +7 QUIT
- +8 ;
- HALT ;Just halt
- +1 KILL ^INRHB("RUN",INBPN)
- HANG
- +2 ;
- PRIO() ;Function which returns priority for this process
- +1 IF $PIECE(^INTHPC(INBPN,0),U,6)]""
- QUIT $PIECE(^(0),U,6)
- +2 QUIT $PIECE($GET(^INRHSITE(1,0)),U,6)