INHOT.m

INHOT(UIF,MODE,INDEV) ;FRW,JSH; 20 Oct 97 12:34; Program to handle output to a Transceiver program ; 07 Oct 91   6:43 AM

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

 ;INPUT:

 ;  UIF    - entry # in Interface file

 ;  MODE   - mode of operaton (0=multi-thread, 1=single thread)

 ;  INDEV  - (optional) device name

 ;

 S X="ERR^INHOT",@^%ZOSF("TRAP")

 K (INBPN,INHSRVR,INPNAME,XUAUDIT,XUTIMP,XUTIMT,XUTIMH,UIF,MODE,INDEV) S INDEV=$G(INDEV)

 X $G(^INTHOS(1,2))

 D SETENV^INHUT7

 S X=$P($G(^INRHSITE(1,0)),U,6) X:X ^%ZOSF("PRIORITY")

 I $L(INDEV) K %ZIS S %ZIS="0",IOP=INDEV D ^%ZIS I POP D ERROR^INHOS("Device: "_INDEV_" not available","T") G Q

 I '$D(^INTHU(+$G(UIF),0)) D ERROR^INHOS("UIF file entry missing: "_+$G(UIF),"T") G Q

 N DEST S DEST=+$P(^INTHU(UIF,0),U,2)

 I '$D(^INRHD(DEST,0)) D ERROR^INHOS("Missing DESTINATION number or entry: "_+$G(DEST),"T") G Q

 U:IO]"" IO S ^INLHSCH("ACT",DEST,$J)=""

EN1 ;Restart with a new UIF entry

 I '$D(^INTHU(+$G(UIF),0)) D ERROR^INHOS("UIF file entry missing: "_+$G(UIF),"T") G Q

 S ROU=$P(^INRHD(DEST,0),U,3) I ROU="" D ERROR^INHOS("Destination: "_$P(^INRHD(DEST,0),U)_" is missing a routine name.","T") G Q

 S:ROU'["^" ROU="^"_ROU

 ;Start transaction audit

 D:$D(XUAUDIT) TTSTRT^XUSAUD(UIF,"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"OUTPUT")

 K INHERR S Z="N MODE,DEST S ER=$$"_ROU_"("_UIF_",.INHERR)" X Z

 ;Stop transaction audit

 D:$D(XUAUDIT) TTSTP^XUSAUD(0)

RET K INTT D:ER>-1 DONE^INHOS

 ;S UIF=$$CHK G:UIF EN1

 ;

Q ;Quit tag

 D:$L(INDEV) ^%ZISC K ^INLHSCH("ACT",DEST,$J)

 Q

 ;

ERR ;Handle an error

 X ^INTHOS(1,3)

 D ENT^INHE(UIF,$G(DEST),$$ERRMSG^INHU1) K ZTERROR

 S ER=2 G RET

 ;

CHK() ;Look for another entry with this destination

 ;8/31/94--not using this functionality for now, though may

 ;want to revise for some future use -- dgh

 Q:'$D(^INRHB("RUN",1)) ""

 L +^INLHSCH

 N H,DA,PRIO

 S DA=0,PRIO="" F  S PRIO=$O(^INLHSCH("DEST",DEST,PRIO)) Q:PRIO=""  D  Q:DA

 . S DA=0 F  S DA=$O(^INLHSCH("DEST",DEST,PRIO,DA)) Q:'DA  S H=^(DA) I '$D(^INLHSCH(PRIO,H,DA)) Q:$H>+H!(+$H=+H&($P($H,",",2)>$P(H,",",2)))

 K:DA ^INLHSCH("DEST",DEST,PRIO,DA)

 L -^INLHSCH Q DA

 ;

INHOT(UIF,MODE,INDEV) ;FRW,JSH; 20 Oct 97 12:34; Program to handle output to a Transceiver program ; 07 Oct 91   6:43 AM

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

 +4       ;INPUT:

 +5       ;  UIF    - entry # in Interface file

 +6       ;  MODE   - mode of operaton (0=multi-thread, 1=single thread)

 +7       ;  INDEV  - (optional) device name

 +8       ;

 +9        SET X="ERR^INHOT"

           SET @^%ZOSF("TRAP")

 +10       KILL (INBPN,INHSRVR,INPNAME,XUAUDIT,XUTIMP,XUTIMT,XUTIMH,UIF,MODE,INDEV)

           SET INDEV=$GET(INDEV)

 +11       XECUTE $GET(^INTHOS(1,2))

 +12       DO SETENV^INHUT7

 +13       SET X=$PIECE($GET(^INRHSITE(1,0)),U,6)

           IF X

               XECUTE ^%ZOSF("PRIORITY")

 +14       IF $LENGTH(INDEV)

               KILL %ZIS

               SET %ZIS="0"

               SET IOP=INDEV

               DO ^%ZIS

               IF POP

                   DO ERROR^INHOS("Device: "_INDEV_" not available","T")

                   GOTO Q

 +15       IF '$DATA(^INTHU(+$GET(UIF),0))

               DO ERROR^INHOS("UIF file entry missing: "_+$GET(UIF),"T")

               GOTO Q

 +16       NEW DEST

           SET DEST=+$PIECE(^INTHU(UIF,0),U,2)

 +17       IF '$DATA(^INRHD(DEST,0))

               DO ERROR^INHOS("Missing DESTINATION number or entry: "_+$GET(DEST),"T")

               GOTO Q

 +18       IF IO]""

               USE IO

           SET ^INLHSCH("ACT",DEST,$JOB)=""

EN1       ;Restart with a new UIF entry

 +1        IF '$DATA(^INTHU(+$GET(UIF),0))

               DO ERROR^INHOS("UIF file entry missing: "_+$GET(UIF),"T")

               GOTO Q

 +2        SET ROU=$PIECE(^INRHD(DEST,0),U,3)

           IF ROU=""

               DO ERROR^INHOS("Destination: "_$PIECE(^INRHD(DEST,0),U)_" is missing a routine name.","T")

               GOTO Q

 +3        IF ROU'["^"

               SET ROU="^"_ROU

 +4       ;Start transaction audit

 +5        IF $DATA(XUAUDIT)

               DO TTSTRT^XUSAUD(UIF,"",$PIECE($GET(^INTHPC(INBPN,0)),U),$GET(INHSRVR),"OUTPUT")

 +6        KILL INHERR

           SET Z="N MODE,DEST S ER=$$"_ROU_"("_UIF_",.INHERR)"

           XECUTE Z

 +7       ;Stop transaction audit

 +8        IF $DATA(XUAUDIT)

               DO TTSTP^XUSAUD(0)

RET        KILL INTT

           IF ER>-1

               DO DONE^INHOS

 +1       ;S UIF=$$CHK G:UIF EN1

 +2       ;

Q         ;Quit tag

 +1        IF $LENGTH(INDEV)

               DO ^%ZISC

           KILL ^INLHSCH("ACT",DEST,$JOB)

 +2        QUIT 

 +3       ;

ERR       ;Handle an error

 +1        XECUTE ^INTHOS(1,3)

 +2        DO ENT^INHE(UIF,$GET(DEST),$$ERRMSG^INHU1)

           KILL ZTERROR

 +3        SET ER=2

           GOTO RET

 +4       ;

CHK()     ;Look for another entry with this destination

 +1       ;8/31/94--not using this functionality for now, though may

 +2       ;want to revise for some future use -- dgh

 +3        IF '$DATA(^INRHB("RUN",1))

               QUIT ""

 +4        LOCK +^INLHSCH

 +5        NEW H,DA,PRIO

 +6        SET DA=0

           SET PRIO=""

           FOR 

               SET PRIO=$ORDER(^INLHSCH("DEST",DEST,PRIO))

               IF PRIO=""

                   QUIT 

               Begin DoDot:1

 +7                SET DA=0

                   FOR 

                       SET DA=$ORDER(^INLHSCH("DEST",DEST,PRIO,DA))

                       IF 'DA

                           QUIT 

                       SET H=^(DA)

                       IF '$DATA(^INLHSCH(PRIO,H,DA))

                           IF $HOROLOG>+H!(+$HOROLOG=+H&($PIECE($HOROLOG,",",2)>$PIECE(H,",",2)))

                               QUIT 

               End DoDot:1

               IF DA

                   QUIT 

 +8        IF DA

               KILL ^INLHSCH("DEST",DEST,PRIO,DA)

 +9        LOCK -^INLHSCH

           QUIT DA

 +10      ;