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

INHVCRA1.m

Go to the documentation of this file. 
  1. INHVCRA1 ;KAC,JKB ; 7 Mar 96 14:11; Application Server (ApS) Cont'd
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q  ;no top entry
  1.  ;
  1. OPEN(INCHNL,INMEM,INADDR,INPORT,INIP) ; open a TCP socket
  1.  ; Input : INCHNL (req) = will return channel of created socket or error
  1.  ;                        msg if open fails, PBR
  1.  ;         INMEM  ( ? ) = ?? - may be unnecessary, PBR
  1.  ;         INADDR (opt) = IP address of remote server to connect to as a
  1.  ;                        client, or null to open as a server; if null,
  1.  ;                        and PBR, will return address of client that
  1.  ;                        connects
  1.  ;         INPORT (req) = IP port to open (client or server)
  1.  ;         INIP   (req) = array of backround proc params, PBR
  1.  ;         also requires INBPN
  1.  ; Output: void
  1.  N INI,INSTOP
  1.  F INI=1:1:INIP("OTRY") D OPEN^%INET(.INCHNL,.INMEM,.INADDR,INPORT,1) Q:INCHNL  D WAIT^INHUVUT(INBPN,INIP("OHNG"),"",.INSTOP) Q:INSTOP
  1.  I 'INCHNL,INSTOP S INCHNL="process signalled to quit"
  1.  Q
  1.  ;
  1. RECEIVE(INV,INCHNL,INIP,INERR,INMEM) ; read socket
  1.  ; Input : INV    (req) = location to store message, PBR
  1.  ;         INCHNL (req) = socket
  1.  ;         INIP   (req) = array of backround proc params, PBR
  1.  ;         INERR  (opt) = error array, PBR
  1.  ;         INMEM  ( ? ) = ?? - may be unnecessary, PBR
  1.  ;         also requires INBPN,U
  1.  ; Output: 0=ok, 1=no response, 2=failure during receive, 3=fatal err
  1.  ; init vars
  1.  N AP,APREC,INDONE,INORESP,INREC,INSMIN,INTTOT,INULRD,REC
  1.  S (APREC,AP,INDONE,INORESP,INTTOT,INULRD)="",INREC="REC"
  1.  S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
  1.  ; socket read loop
  1.  F  D  Q:INDONE!INORESP
  1.  .D RECV^%INET(.APREC,.INCHNL,INIP("RTO"),1)
  1.  .; handle receive errors
  1.  .I $D(APREC(0)) D  Q
  1.  ..; all but timeouts are fatal
  1.  ..I APREC(0)'["TIMEOUT" S INDONE=1 Q
  1.  ..; handle timeouts
  1.  ..K APREC(0)
  1.  ..S INULRD=INULRD+1 ; increment # of retries
  1.  ..;I INULRD>INIP("RTRY") S INORESP=1 Q  ; retries NOT currently active
  1.  ..D WAIT^INHUVUT(INBPN,INIP("RHNG"),"",.INORESP) Q:INORESP
  1.  ..S INTTOT=INTTOT+INIP("RTO")+INIP("RHNG")
  1.  ..I INTTOT'<INIP("TMAX") S INORESP=1 Q
  1.  .; process end of msg
  1.  .I APREC[$C(28) D
  1.  ..; if end of msg not clean, purge buffer (513 byte msg prob)
  1.  ..I $P(APREC,$C(28),2)'=$C(13) N X S X="" D RECV^%INET(.X,.INCHNL,1,1)
  1.  ..; remove end of msg sequence; set flag
  1.  ..S APREC=$P(APREC,$C(28)),INDONE=1
  1.  .; remove start of msg sequence
  1.  .I APREC[$C(11) S APREC=$P(APREC,$C(11),2)
  1.  .; quit if nothing left
  1.  .Q:'$L(APREC)
  1.  .; switch to global storage if short on memory
  1.  .I $S<INSMIN,INREC'["^" K ^UTILITY("INREC",$J) M ^($J)=@INREC S INREC="^UTILITY(""INREC"","_$J_")"
  1.  .S AP=AP+1,@INREC@(AP)=APREC,INULRD=0
  1.  ; if fatal error
  1.  I $D(APREC(0)) S INERR="fatal error: "_APREC(0) Q 3
  1.  ; if no msg received
  1.  I 'AP S INERR="no message received from remote system" Q 1
  1.  ; if remote system timed-out
  1.  I INORESP S INERR="remote system timed-out during transmission" Q 2
  1.  ; msg receipt completed - parse it
  1.  D PARSE^INHUVUT1 K @INREC
  1.  Q 0
  1.  ;
  1. LOGLOCI ; LOG LOCATION input transform (4004,9.02)
  1.  I X=$E("GLOBAL",1,$L(X)) S X="GLOBAL" Q
  1.  I $L(X)>50 K X Q
  1.  I X[".DAT",$L($$OPENSEQ^%ZTFS1(X,"W")) C X Q
  1.  D TXTPTR^INHU1(3.5,.X,.Y) S:$D(X) X=$P(Y,U)
  1.  Q
  1.  ;
  1. LOGLOCO ; LOG LOCATION output transform (4004,9.02)
  1.  I Y?1.N,$D(^%ZIS(1,Y,0)) S Y=$P(^(0),U)
  1.  Q
  1.  ;
  1. LOG(MSG,TYP,ACK) ; log BACKGROUND PROCESS activity and errors
  1.  ; Input : MSG (req) = status/error/debug message; status msg must be a
  1.  ;                     string, error/debug msg can be a string (PBV) or
  1.  ;                     an array of strings (PBR)
  1.  ;         TYP (opt) = msg type: S=status(def), E=error, or integer
  1.  ;                     corresponding to level of a debug msg
  1.  ;         ACK (opt) = boolean flag; set true only when logging a
  1.  ;                     positive ack (sets piece 3 of run node = $H)
  1.  ;         INBPN,U (req)
  1.  ;         INDEBUG,INDEBUGD,INHSRVR (opt)
  1.  ; Output: void
  1.  ;         INDEBUG,INDEBUGD if not set coming in
  1.  ;         if debug on, will write to debug log (file, device or global)
  1.  ; Local : ENUM = INTERFACE ERROR ptr
  1.  ;         T    = timestamp
  1.  ;         SRVR = server number or 0 if not a multiple background proc
  1.  I '$D(INDEBUG) D DEBUG()
  1.  N SRVR S SRVR=+$G(INHSRVR),TYP=$G(TYP)
  1.  ; if debugging, write to log
  1.  I INDEBUG,INDEBUG'<TYP D
  1.  .I $D(MSG)=1,$L(MSG) S MSG(1)=MSG
  1.  .N J,T S J="",T=$$NOW^%ZTFDT
  1.  .I INDEBUGD="GLOBAL" D  Q
  1.  ..N I S I=$O(^UTILITY("INDEBUG",INBPN,SRVR,$J,""),-1)
  1.  ..F I=I+1:1 S J=$O(MSG(J)) Q:J=""  S ^(I)=T_U_MSG(J) ;NAKED on ^UTILITY
  1.  .U INDEBUGD F  S J=$O(MSG(J)) Q:J=""  W !,INBPN_U_SRVR_U_T_U_MSG(J)
  1.  Q:TYP
  1.  ; on error, log in error file and abbrev msg text to point to it
  1.  I TYP="E" N ENUM D LOAD^INHE("","","","R","","","",.MSG,INBPN,.ENUM) S MSG="Error "_$G(ENUM)
  1.  ; update "run" node (format: Status$H^StatusText^LastPositiveAck$H)
  1.  I SRVR S $P(^INRHB("RUN","SRVR",INBPN,SRVR),U,1,2)=$H_U_MSG S:$G(ACK) $P(^(SRVR),U,3)=$H Q
  1.  S $P(^INRHB("RUN",INBPN),U,1,2)=$H_U_MSG S:$G(ACK) $P(^(INBPN),U,3)=$H
  1.  Q
  1.  ;
  1. DEBUG(L) ; set debug params for a BACKGROUND PROCESS
  1.  ; Input : L (opt) = debug level; "" = look it up (def), 0 = turn it
  1.  ;                   off, positive integer = set it
  1.  ;         also expects INBPN
  1.  ; Output: void
  1.  ;         INDEBUG  = Debug Level
  1.  ;         INDEBUGD = Log Location
  1.  ; if debug level input is null, look it up
  1.  S INDEBUG=$S($L($G(L)):L,1:$P($G(^INTHPC(INBPN,9)),U))
  1.  ; if debug off, close log loc if not a global, then kill var and quit
  1.  I 'INDEBUG D  Q
  1.  .I $L($G(INDEBUGD)) D:INDEBUGD'="GLOBAL" ^%ZISC K INDEBUGD
  1.  ; debug is on - get log loc
  1.  S INDEBUGD=$P(^INTHPC(INBPN,9),U,2)
  1.  ; quit if no need to open (is a global or $P)
  1.  I "GLOBAL"[INDEBUGD S:INDEBUGD="" INDEBUGD=$P Q
  1.  ; if a device ptr, resolve it
  1.  I INDEBUGD,$D(^%ZIS(1,INDEBUGD,0)) S INDEBUGD=$P(^(0),U)
  1.  ; open the device - if can't, use $P
  1.  S IOP=INDEBUGD D ^%ZIS I POP S IOP="" D ^%ZIS
  1.  S INDEBUGD=IO
  1.  Q