Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHOS

INHOS.m

Go to the documentation of this file. 
  1. 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
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;INPUT:
  1.  ;  UIF    - entry in interface file
  1.  ;  INDEV  - Device name
  1.  ;LOCAL:
  1.  ;  INTT   - transaction type entry
  1.  ;     If INTT is not present it indicates that the
  1.  ;     module(s) is being called by ^INHOM or ^INHOT
  1.  ;
  1.  ;NOTE:  Many modules in this program are called by other programs
  1.  ;
  1.  S X="ERR^INHOS",@^%ZOSF("TRAP")
  1.  K (INBPN,INHSRVR,INPNAME,XUAUDIT,UIF,INDEV,XUTIMP,XUTIMT,XUTIMH) S INDEV=$G(INDEV)
  1.  X $G(^INTHOS(1,2))
  1.  D SETENV^INHUT7
  1.  S X=$P($G(^INRHSITE(1,0)),U,6) X:X ^%ZOSF("PRIORITY")
  1.  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
  1. EN1 I '$D(^INTHU(+$G(UIF),0)) D ERROR("UIF file entry missing: "_+$G(UIF)) Q
  1.  N DEST S DEST=+$P(^INTHU(UIF,0),U,2)
  1.  I '$D(^INRHD(DEST,0)) D ERROR("Missing DESTINATION number or entry: "_+$G(DEST)) Q
  1.  U:$L(INDEV) IO
  1.  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
  1.  ;If transaction type is inactive, log error and update status
  1.  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
  1.  S SCR=$P(^INRHT(INTT,0),U,3) I 'SCR D ERROR("Missing script for transaction type: '"_$P(^INRHT(INTT,0),U)_"'") Q
  1.  N INOA,INODA,INA
  1.  ;Start transaction audit
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD(UIF,"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"SCRIPT")
  1.  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
  1.  ;Stop transaction audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(0)
  1.  ;Variable INOA, if set within the inbound script, will be passed as
  1.  ;the INA array to the ACK call.
  1.  ;Variable INODA, if set within the inbound script, will be passed as
  1.  ;the INDA array to the ACK call.
  1.  D DONE D:$L(INDEV) ^%ZISC
  1.  Q
  1. DONE ;Entry point from INHOT to handle results of attempt
  1.  ;Stuff LAST DATE/TIME
  1.  K ^UTILITY("INV",$J),^UTILITY("INH",$J),DA,DIE,DIC,DR
  1.  Q:'$D(^INTHU(UIF,0))
  1.  S DIE="^INTHU(",DA=UIF,DR=".09////"_$$NOW^UTDT D ^DIE
  1.  G NONFATAL:ER=1,FATAL:ER=2
  1.  ;
  1. COMP ;Successful processing
  1.  N STATUS
  1.  S STATUS="C" I '$D(INTT),$P(^INTHU(UIF,0),U,4) S STATUS="S"
  1.  D ELOG,ULOG^INHU(UIF,STATUS,.INHERR)
  1.  ; if inbound msg, process appl. ack
  1.  D:$D(INTT) APPLACK(INTT,1,UIF,.INHERR,.INOA,.INODA)
  1.  Q
  1.  ;
  1. NONFATAL ;Non-fatal error
  1.  S ATT=$P(^INTHU(UIF,0),U,12)+1,$P(^(0),U,12)=ATT
  1.  D REQ(UIF,ATT,$G(INTT)),ULOG^INHU(UIF,"P",.INHERR),ELOG
  1.  K INHERR I MR'>ATT S INHERR="Max # of Retries exceeded." D FATAL Q
  1.  I RR="" S INHERR="No Retry Rate found." D FATAL Q
  1.  Q
  1.  ;
  1. FATAL ;Fatal error
  1.  D ULOG^INHU(UIF,"E",.INHERR),ELOG
  1.  ; if inbound msg, process appl. ack
  1.  D:$D(INTT) APPLACK(INTT,0,UIF,.INHERR,.INOA,.INODA)
  1.  Q
  1.  ;
  1. ELOG ;See if any error to log
  1.  D:$D(INHERR)>9 END^INHE(UIF,.INHERR,$G(DEST)):$D(INTT),ENT^INHE(UIF,$G(DEST),.INHERR):'$D(INTT)
  1.  Q
  1.  ;
  1. ELOGACK ; Log 'Appl. Ack creation' errors
  1.  D:$D(INHERR)>9 END^INHE($G(INACKUIF),.INHERR,$G(DEST)):$D(INTT),ENT^INHE($G(INACKUIF),$G(DEST),.INHERR):'$D(INTT)
  1.  Q
  1.  ;
  1. REQ(UIF,ATT,TRT) ;Requeue a transaction
  1.  ;UIF = entry # in UIF
  1.  ;ATT = current number of attempts
  1.  ;TRT (optional) = processing transaction type
  1.  S X=$$GRET^INHU(UIF,$G(TRT)),RR=$P(X,U),MR=+$P(X,U,2)
  1.  Q:RR=""!(MR'>$G(ATT))
  1.  ;Requeue the entry
  1.  S D=$H,T=$P(D,",",2),D=+D
  1.  S %=$E(RR,$L(RR))
  1.  I %="M" S T=T+(RR*60) I T>86400 S RR=T\86400,T=T#86400,%="D"
  1.  I %="H" S T=T+(RR*3600) I T>86400 S RR=T\86400,T=T#86400,%="D"
  1.  I %="D" S D=D+RR
  1.  S D=D_","_T D SET^INHD(D,+$P(^INTHU(UIF,0),U,2),UIF)
  1.  Q
  1.  ;
  1. APPLACK(INTT,INSTAT,INUIF,INHERR,INOA,INODA,INQUE,INACKUIF) ; Send application
  1.  ; acknowledgement to remote system in response to receipt of inbound
  1.  ; message.
  1.  ;
  1.  ; Input:
  1.  ;   INTT     - (req) TRANSACTION TYPE IEN for inbound msg
  1.  ;   INSTAT   - (opt) flag - 1 = positive ack
  1.  ;                           0 = negative ack
  1.  ;   INUIF    - (req) UNIVERSAL INTERFACE IEN for inbound msg
  1.  ;   INHERR   - (pbr) array containing error msg used to log an error
  1.  ;                    in the ack.  Returns with script error msg if
  1.  ;                    ack script encounters error.
  1.  ;   INOA     - (pbr) array sending application-specific information
  1.  ;                    from lookup/store routine to script
  1.  ;   INODA    - (pbr) array sending application-specific information
  1.  ;                    from lookup/store routine to script
  1.  ;   INQUE    - (opt) flag - 0/""/non-existent = que ack to O/P Ctlr
  1.  ;                           1 = do NOT que ack to O/P Ctlr
  1.  ;   INACKUIF - (pbr) UNIVERSAL INTERFACE IEN for ack msg
  1.  ;
  1.  ; Output:
  1.  ;   INACKUIF - (pbr) UNIVERSAL INTERFACE IEN for ack msg
  1.  ;   INHERR   - (pbr) array containing error msg if ack script
  1.  ;                    encountered errors during execution
  1.  ;
  1.  S INSTAT=+$G(INSTAT),INQUE=+$G(INQUE)
  1.  ;
  1.  ; save originating destination for routing appl. ack
  1.  S INOA("INDEST")=$P($G(^INTHU(INUIF,2)),U,2)
  1.  ;
  1.  ; save INODA and selected INOA subscripts in ack UIF (per Selective
  1.  ; Routing design) for use by downstream processes
  1.  ;
  1.  K ^UTILITY("INODA",$J) M ^UTILITY("INODA",$J)=INODA
  1.  D ACK(INTT,INSTAT,INUIF,.INHERR,.INOA,.INODA,INQUE,.INACKUIF)
  1.  D ELOGACK  ; log Ack creation errors
  1.  I $G(INACKUIF) D
  1.  . M ^INTHU(INACKUIF,6)=^UTILITY("INODA",$J)
  1.  . I $D(INOA("DMISID")) M ^INTHU(INACKUIF,7,"DMISID")=INOA("DMISID")
  1.  . I $D(INOA("MSGTYPE")) M ^INTHU(INACKUIF,7,"MSGTYPE")=INOA("MSGTYPE")
  1.  K ^UTILITY("INODA",$J)
  1.  Q
  1.  ;
  1. ACK(INTT,INSTAT,INUIF,INHERR,INOA,INODA,INQUE,INACKUIF) ;Send application
  1.  ; acknowledgement.  Error msg included in ack can only be 80 chars;
  1.  ; use first node of INHERR array.
  1.  ;
  1.  ; Called by: Interactive (PWS/CIW) and non-interactive interfaces.
  1.  ;
  1.  S:$D(INHERR) INHERR=$TR($S($D(INHERR)<10:INHERR,1:@$Q(INHERR)),"^",",")
  1.  D ACK^INHUSEN3(INTT,INSTAT,INUIF,.INHERR,.INOA,.INODA,INQUE,.INACKUIF)
  1.  K INDA,INA
  1.  Q
  1.  ;
  1. ERROR(MESS,ROU) ;Error occurred
  1.  ;INPUT:
  1.  ;   MESS  - free text message
  1.  ;   ROU   - calling routine
  1.  I $G(ROU)="T"
  1.  I $G(ROU)="S"
  1.  ;Stop transaction audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(1)
  1.  D END^INHE($G(UIF),MESS,$G(DEST)) Q
  1.  ;
  1. ERR ;System error
  1.  X ^INTHOS(1,3) K DIE,DA,DR,DQ,DE,DB,DIC
  1.  D END^INHE($G(UIF),$$ERRMSG^INHU1,$G(DEST)) K ZTERROR
  1. ERR1 S ER=2 D DONE
  1.  Q