INHOS(UIF,INDEV) ;FRW,JSH ;08:59 AM 17 Oct 1997; Program to handle output to a Transaction Type ; 07 Oct 91
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;INPUT:
; UIF - entry in interface file
; INDEV - Device name
;LOCAL:
; INTT - transaction type entry
; If INTT is not present it indicates that the
; module(s) is being called by ^INHOM or ^INHOT
;
;NOTE: Many modules in this program are called by other programs
;
S X="ERR^INHOS",@^%ZOSF("TRAP")
K (INBPN,INHSRVR,INPNAME,XUAUDIT,UIF,INDEV,XUTIMP,XUTIMT,XUTIMH) 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("Device: "_$P(^%ZIS(1,INDEV,0),U)_" not available.") Q
EN1 I '$D(^INTHU(+$G(UIF),0)) D ERROR("UIF file entry missing: "_+$G(UIF)) Q
N DEST S DEST=+$P(^INTHU(UIF,0),U,2)
I '$D(^INRHD(DEST,0)) D ERROR("Missing DESTINATION number or entry: "_+$G(DEST)) Q
U:$L(INDEV) IO
S INTT=+$P(^INRHD(DEST,0),U,2) I 'INTT D ERROR("Missing transaction type or entry for destination '"_$P(^INRHD(DEST,0),U)_"'") Q
;If transaction type is inactive, log error and update status
I '$P($G(^INRHT(INTT,0)),U,5) D ELOG,ULOG^INHU(UIF,"E","Transaction type '"_$P($G(^INRHT(INTT,0)),U)_"' is not active") Q
S SCR=$P(^INRHT(INTT,0),U,3) I 'SCR D ERROR("Missing script for transaction type: '"_$P(^INRHT(INTT,0),U)_"'") Q
N INOA,INODA,INA
;Start transaction audit
D:$D(XUAUDIT) TTSTRT^XUSAUD(UIF,"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"SCRIPT")
K INHERR,INEDIT S:$P(^INTHU(UIF,0),U,15) INEDIT=$P(^(0),U,15) S C=",",Z="N INDEV,INTT S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_UIF_",.INOA,.INODA)" X Z K INEDIT
;Stop transaction audit
D:$D(XUAUDIT) TTSTP^XUSAUD(0)
;Variable INOA, if set within the inbound script, will be passed as
;the INA array to the ACK call.
;Variable INODA, if set within the inbound script, will be passed as
;the INDA array to the ACK call.
D DONE D:$L(INDEV) ^%ZISC
Q
DONE ;Entry point from INHOT to handle results of attempt
;Stuff LAST DATE/TIME
K ^UTILITY("INV",$J),^UTILITY("INH",$J),DA,DIE,DIC,DR
Q:'$D(^INTHU(UIF,0))
S DIE="^INTHU(",DA=UIF,DR=".09////"_$$NOW^UTDT D ^DIE
G NONFATAL:ER=1,FATAL:ER=2
;
COMP ;Successful processing
N STATUS
S STATUS="C" I '$D(INTT),$P(^INTHU(UIF,0),U,4) S STATUS="S"
D ELOG,ULOG^INHU(UIF,STATUS,.INHERR)
; if inbound msg, process appl. ack
D:$D(INTT) APPLACK(INTT,1,UIF,.INHERR,.INOA,.INODA)
Q
;
NONFATAL ;Non-fatal error
S ATT=$P(^INTHU(UIF,0),U,12)+1,$P(^(0),U,12)=ATT
D REQ(UIF,ATT,$G(INTT)),ULOG^INHU(UIF,"P",.INHERR),ELOG
K INHERR I MR'>ATT S INHERR="Max # of Retries exceeded." D FATAL Q
I RR="" S INHERR="No Retry Rate found." D FATAL Q
Q
;
FATAL ;Fatal error
D ULOG^INHU(UIF,"E",.INHERR),ELOG
; if inbound msg, process appl. ack
D:$D(INTT) APPLACK(INTT,0,UIF,.INHERR,.INOA,.INODA)
Q
;
ELOG ;See if any error to log
D:$D(INHERR)>9 END^INHE(UIF,.INHERR,$G(DEST)):$D(INTT),ENT^INHE(UIF,$G(DEST),.INHERR):'$D(INTT)
Q
;
ELOGACK ; Log 'Appl. Ack creation' errors
D:$D(INHERR)>9 END^INHE($G(INACKUIF),.INHERR,$G(DEST)):$D(INTT),ENT^INHE($G(INACKUIF),$G(DEST),.INHERR):'$D(INTT)
Q
;
REQ(UIF,ATT,TRT) ;Requeue a transaction
;UIF = entry # in UIF
;ATT = current number of attempts
;TRT (optional) = processing transaction type
S X=$$GRET^INHU(UIF,$G(TRT)),RR=$P(X,U),MR=+$P(X,U,2)
Q:RR=""!(MR'>$G(ATT))
;Requeue the entry
S D=$H,T=$P(D,",",2),D=+D
S %=$E(RR,$L(RR))
I %="M" S T=T+(RR*60) I T>86400 S RR=T\86400,T=T#86400,%="D"
I %="H" S T=T+(RR*3600) I T>86400 S RR=T\86400,T=T#86400,%="D"
I %="D" S D=D+RR
S D=D_","_T D SET^INHD(D,+$P(^INTHU(UIF,0),U,2),UIF)
Q
;
APPLACK(INTT,INSTAT,INUIF,INHERR,INOA,INODA,INQUE,INACKUIF) ; Send application
; acknowledgement to remote system in response to receipt of inbound
; message.
;
; Input:
; INTT - (req) TRANSACTION TYPE IEN for inbound msg
; INSTAT - (opt) flag - 1 = positive ack
; 0 = negative ack
; INUIF - (req) UNIVERSAL INTERFACE IEN for inbound msg
; INHERR - (pbr) array containing error msg used to log an error
; in the ack. Returns with script error msg if
; ack script encounters error.
; INOA - (pbr) array sending application-specific information
; from lookup/store routine to script
; INODA - (pbr) array sending application-specific information
; from lookup/store routine to script
; INQUE - (opt) flag - 0/""/non-existent = que ack to O/P Ctlr
; 1 = do NOT que ack to O/P Ctlr
; INACKUIF - (pbr) UNIVERSAL INTERFACE IEN for ack msg
;
; Output:
; INACKUIF - (pbr) UNIVERSAL INTERFACE IEN for ack msg
; INHERR - (pbr) array containing error msg if ack script
; encountered errors during execution
;
S INSTAT=+$G(INSTAT),INQUE=+$G(INQUE)
;
; save originating destination for routing appl. ack
S INOA("INDEST")=$P($G(^INTHU(INUIF,2)),U,2)
;
; save INODA and selected INOA subscripts in ack UIF (per Selective
; Routing design) for use by downstream processes
;
K ^UTILITY("INODA",$J) M ^UTILITY("INODA",$J)=INODA
D ACK(INTT,INSTAT,INUIF,.INHERR,.INOA,.INODA,INQUE,.INACKUIF)
D ELOGACK ; log Ack creation errors
I $G(INACKUIF) D
. M ^INTHU(INACKUIF,6)=^UTILITY("INODA",$J)
. I $D(INOA("DMISID")) M ^INTHU(INACKUIF,7,"DMISID")=INOA("DMISID")
. I $D(INOA("MSGTYPE")) M ^INTHU(INACKUIF,7,"MSGTYPE")=INOA("MSGTYPE")
K ^UTILITY("INODA",$J)
Q
;
ACK(INTT,INSTAT,INUIF,INHERR,INOA,INODA,INQUE,INACKUIF) ;Send application
; acknowledgement. Error msg included in ack can only be 80 chars;
; use first node of INHERR array.
;
; Called by: Interactive (PWS/CIW) and non-interactive interfaces.
;
S:$D(INHERR) INHERR=$TR($S($D(INHERR)<10:INHERR,1:@$Q(INHERR)),"^",",")
D ACK^INHUSEN3(INTT,INSTAT,INUIF,.INHERR,.INOA,.INODA,INQUE,.INACKUIF)
K INDA,INA
Q
;
ERROR(MESS,ROU) ;Error occurred
;INPUT:
; MESS - free text message
; ROU - calling routine
I $G(ROU)="T"
I $G(ROU)="S"
;Stop transaction audit
D:$D(XUAUDIT) TTSTP^XUSAUD(1)
D END^INHE($G(UIF),MESS,$G(DEST)) Q
;
ERR ;System error
X ^INTHOS(1,3) K DIE,DA,DR,DQ,DE,DB,DIC
D END^INHE($G(UIF),$$ERRMSG^INHU1,$G(DEST)) K ZTERROR
ERR1 S ER=2 D DONE
Q
INHOS(UIF,INDEV) ;FRW,JSH ;08:59 AM 17 Oct 1997; Program to handle output to a Transaction Type ; 07 Oct 91
+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 ; INDEV - Device name
+7 ;LOCAL:
+8 ; INTT - transaction type entry
+9 ; If INTT is not present it indicates that the
+10 ; module(s) is being called by ^INHOM or ^INHOT
+11 ;
+12 ;NOTE: Many modules in this program are called by other programs
+13 ;
+14 SET X="ERR^INHOS"
SET @^%ZOSF("TRAP")
+15 KILL (INBPN,INHSRVR,INPNAME,XUAUDIT,UIF,INDEV,XUTIMP,XUTIMT,XUTIMH)
SET INDEV=$GET(INDEV)
+16 XECUTE $GET(^INTHOS(1,2))
+17 DO SETENV^INHUT7
+18 SET X=$PIECE($GET(^INRHSITE(1,0)),U,6)
IF X
XECUTE ^%ZOSF("PRIORITY")
+19 IF $LENGTH(INDEV)
KILL %ZIS
SET %ZIS="0"
SET IOP=INDEV
DO ^%ZIS
IF POP
DO ERROR("Device: "_$PIECE(^%ZIS(1,INDEV,0),U)_" not available.")
QUIT
EN1 IF '$DATA(^INTHU(+$GET(UIF),0))
DO ERROR("UIF file entry missing: "_+$GET(UIF))
QUIT
+1 NEW DEST
SET DEST=+$PIECE(^INTHU(UIF,0),U,2)
+2 IF '$DATA(^INRHD(DEST,0))
DO ERROR("Missing DESTINATION number or entry: "_+$GET(DEST))
QUIT
+3 IF $LENGTH(INDEV)
USE IO
+4 SET INTT=+$PIECE(^INRHD(DEST,0),U,2)
IF 'INTT
DO ERROR("Missing transaction type or entry for destination '"_$PIECE(^INRHD(DEST,0),U)_"'")
QUIT
+5 ;If transaction type is inactive, log error and update status
+6 IF '$PIECE($GET(^INRHT(INTT,0)),U,5)
DO ELOG
DO ULOG^INHU(UIF,"E","Transaction type '"_$PIECE($GET(^INRHT(INTT,0)),U)_"' is not active")
QUIT
+7 SET SCR=$PIECE(^INRHT(INTT,0),U,3)
IF 'SCR
DO ERROR("Missing script for transaction type: '"_$PIECE(^INRHT(INTT,0),U)_"'")
QUIT
+8 NEW INOA,INODA,INA
+9 ;Start transaction audit
+10 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD(UIF,"",$PIECE($GET(^INTHPC(INBPN,0)),U),$GET(INHSRVR),"SCRIPT")
+11 KILL INHERR,INEDIT
IF $PIECE(^INTHU(UIF,0),U,15)
SET INEDIT=$PIECE(^(0),U,15)
SET C=","
SET Z="N INDEV,INTT S ER=$$^IS"_$EXTRACT(SCR#100000+100000,2,6)_"("_UIF_",.INOA,.INODA)"
XECUTE Z
KILL INEDIT
+12 ;Stop transaction audit
+13 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(0)
+14 ;Variable INOA, if set within the inbound script, will be passed as
+15 ;the INA array to the ACK call.
+16 ;Variable INODA, if set within the inbound script, will be passed as
+17 ;the INDA array to the ACK call.
+18 DO DONE
IF $LENGTH(INDEV)
DO ^%ZISC
+19 QUIT
DONE ;Entry point from INHOT to handle results of attempt
+1 ;Stuff LAST DATE/TIME
+2 KILL ^UTILITY("INV",$JOB),^UTILITY("INH",$JOB),DA,DIE,DIC,DR
+3 IF '$DATA(^INTHU(UIF,0))
QUIT
+4 SET DIE="^INTHU("
SET DA=UIF
SET DR=".09////"_$$NOW^UTDT
DO ^DIE
+5 IF ER=1
GOTO NONFATAL
IF ER=2
GOTO FATAL
+6 ;
COMP ;Successful processing
+1 NEW STATUS
+2 SET STATUS="C"
IF '$DATA(INTT)
IF $PIECE(^INTHU(UIF,0),U,4)
SET STATUS="S"
+3 DO ELOG
DO ULOG^INHU(UIF,STATUS,.INHERR)
+4 ; if inbound msg, process appl. ack
+5 IF $DATA(INTT)
DO APPLACK(INTT,1,UIF,.INHERR,.INOA,.INODA)
+6 QUIT
+7 ;
NONFATAL ;Non-fatal error
+1 SET ATT=$PIECE(^INTHU(UIF,0),U,12)+1
SET $PIECE(^(0),U,12)=ATT
+2 DO REQ(UIF,ATT,$GET(INTT))
DO ULOG^INHU(UIF,"P",.INHERR)
DO ELOG
+3 KILL INHERR
IF MR'>ATT
SET INHERR="Max # of Retries exceeded."
DO FATAL
QUIT
+4 IF RR=""
SET INHERR="No Retry Rate found."
DO FATAL
QUIT
+5 QUIT
+6 ;
FATAL ;Fatal error
+1 DO ULOG^INHU(UIF,"E",.INHERR)
DO ELOG
+2 ; if inbound msg, process appl. ack
+3 IF $DATA(INTT)
DO APPLACK(INTT,0,UIF,.INHERR,.INOA,.INODA)
+4 QUIT
+5 ;
ELOG ;See if any error to log
+1 IF $DATA(INHERR)>9
IF $DATA(INTT)
DO END^INHE(UIF,.INHERR,$GET(DEST))
IF '$DATA(INTT)
DO ENT^INHE(UIF,$GET(DEST),.INHERR)
+2 QUIT
+3 ;
ELOGACK ; Log 'Appl. Ack creation' errors
+1 IF $DATA(INHERR)>9
IF $DATA(INTT)
DO END^INHE($GET(INACKUIF),.INHERR,$GET(DEST))
IF '$DATA(INTT)
DO ENT^INHE($GET(INACKUIF),$GET(DEST),.INHERR)
+2 QUIT
+3 ;
REQ(UIF,ATT,TRT) ;Requeue a transaction
+1 ;UIF = entry # in UIF
+2 ;ATT = current number of attempts
+3 ;TRT (optional) = processing transaction type
+4 SET X=$$GRET^INHU(UIF,$GET(TRT))
SET RR=$PIECE(X,U)
SET MR=+$PIECE(X,U,2)
+5 IF RR=""!(MR'>$GET(ATT))
QUIT
+6 ;Requeue the entry
+7 SET D=$HOROLOG
SET T=$PIECE(D,",",2)
SET D=+D
+8 SET %=$EXTRACT(RR,$LENGTH(RR))
+9 IF %="M"
SET T=T+(RR*60)
IF T>86400
SET RR=T\86400
SET T=T#86400
SET %="D"
+10 IF %="H"
SET T=T+(RR*3600)
IF T>86400
SET RR=T\86400
SET T=T#86400
SET %="D"
+11 IF %="D"
SET D=D+RR
+12 SET D=D_","_T
DO SET^INHD(D,+$PIECE(^INTHU(UIF,0),U,2),UIF)
+13 QUIT
+14 ;
APPLACK(INTT,INSTAT,INUIF,INHERR,INOA,INODA,INQUE,INACKUIF) ; Send application
+1 ; acknowledgement to remote system in response to receipt of inbound
+2 ; message.
+3 ;
+4 ; Input:
+5 ; INTT - (req) TRANSACTION TYPE IEN for inbound msg
+6 ; INSTAT - (opt) flag - 1 = positive ack
+7 ; 0 = negative ack
+8 ; INUIF - (req) UNIVERSAL INTERFACE IEN for inbound msg
+9 ; INHERR - (pbr) array containing error msg used to log an error
+10 ; in the ack. Returns with script error msg if
+11 ; ack script encounters error.
+12 ; INOA - (pbr) array sending application-specific information
+13 ; from lookup/store routine to script
+14 ; INODA - (pbr) array sending application-specific information
+15 ; from lookup/store routine to script
+16 ; INQUE - (opt) flag - 0/""/non-existent = que ack to O/P Ctlr
+17 ; 1 = do NOT que ack to O/P Ctlr
+18 ; INACKUIF - (pbr) UNIVERSAL INTERFACE IEN for ack msg
+19 ;
+20 ; Output:
+21 ; INACKUIF - (pbr) UNIVERSAL INTERFACE IEN for ack msg
+22 ; INHERR - (pbr) array containing error msg if ack script
+23 ; encountered errors during execution
+24 ;
+25 SET INSTAT=+$GET(INSTAT)
SET INQUE=+$GET(INQUE)
+26 ;
+27 ; save originating destination for routing appl. ack
+28 SET INOA("INDEST")=$PIECE($GET(^INTHU(INUIF,2)),U,2)
+29 ;
+30 ; save INODA and selected INOA subscripts in ack UIF (per Selective
+31 ; Routing design) for use by downstream processes
+32 ;
+33 KILL ^UTILITY("INODA",$JOB)
MERGE ^UTILITY("INODA",$JOB)=INODA
+34 DO ACK(INTT,INSTAT,INUIF,.INHERR,.INOA,.INODA,INQUE,.INACKUIF)
+35 ; log Ack creation errors
DO ELOGACK
+36 IF $GET(INACKUIF)
Begin DoDot:1
+37 MERGE ^INTHU(INACKUIF,6)=^UTILITY("INODA",$JOB)
+38 IF $DATA(INOA("DMISID"))
MERGE ^INTHU(INACKUIF,7,"DMISID")=INOA("DMISID")
+39 IF $DATA(INOA("MSGTYPE"))
MERGE ^INTHU(INACKUIF,7,"MSGTYPE")=INOA("MSGTYPE")
End DoDot:1
+40 KILL ^UTILITY("INODA",$JOB)
+41 QUIT
+42 ;
ACK(INTT,INSTAT,INUIF,INHERR,INOA,INODA,INQUE,INACKUIF) ;Send application
+1 ; acknowledgement. Error msg included in ack can only be 80 chars;
+2 ; use first node of INHERR array.
+3 ;
+4 ; Called by: Interactive (PWS/CIW) and non-interactive interfaces.
+5 ;
+6 IF $DATA(INHERR)
SET INHERR=$TRANSLATE($SELECT($DATA(INHERR)<10:INHERR,1:@$QUERY(INHERR)),"^",",")
+7 DO ACK^INHUSEN3(INTT,INSTAT,INUIF,.INHERR,.INOA,.INODA,INQUE,.INACKUIF)
+8 KILL INDA,INA
+9 QUIT
+10 ;
ERROR(MESS,ROU) ;Error occurred
+1 ;INPUT:
+2 ; MESS - free text message
+3 ; ROU - calling routine
+4 IF $GET(ROU)="T"
+5 IF $GET(ROU)="S"
+6 ;Stop transaction audit
+7 IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(1)
+8 DO END^INHE($GET(UIF),MESS,$GET(DEST))
QUIT
+9 ;
ERR ;System error
+1 XECUTE ^INTHOS(1,3)
KILL DIE,DA,DR,DQ,DE,DB,DIC
+2 DO END^INHE($GET(UIF),$$ERRMSG^INHU1,$GET(DEST))
KILL ZTERROR
ERR1 SET ER=2
DO DONE
+1 QUIT
