INHB1.m

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)