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