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

INHU.m

Go to the documentation of this file. 
  1. INHU ;DGH,JSH; 19 Apr 99 11:53;Generic Interface utility routines 
  1.  ;;3.01;BHL IHS Interfaces with GIS;**16**;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TOOLS_460; GEN 3; 17-JUL-1997
  1.  ;COPYRIGHT 1988, 1989, 1990 SAIC
  1.  ;
  1. GRET(UIF,TT) ;Returns  retry interval^max # of retries
  1.  ;for entry # UIF running transaction type TT
  1.  N DEST,X,RR,MR S (RR,MR)=""
  1.  G:'$G(TT) G1
  1.  S RR=$P($G(^INRHT(+$G(TT),0)),U,10),MR=$P($G(^(0)),U,11)
  1.  I RR]"",MR]"" Q RR_"^"_MR
  1. G1 S DEST=+$P($G(^INTHU(+$G(UIF),0)),U,2)
  1.  G:'DEST G2
  1.  S:RR="" RR=$P($G(^INRHD(DEST,0)),U,5)
  1.  S:MR="" MR=$P($G(^INRHD(DEST,0)),U,6)
  1.  I RR]"",MR]"" Q RR_"^"_MR
  1. G2 S:RR="" RR=$P(^INRHSITE(1,0),U,3)
  1.  S:MR="" MR=+$P(^INRHSITE(1,0),U,2)
  1.  Q RR_"^"_MR
  1.  ;
  1. ULOG(UIF,ACT,INMSG,REPUIF,INNOACT) ;Make an activity log entry in UIF
  1.  ;UIF (required) = entry # in UIF
  1.  ;ACT (required) = log action
  1.  ;INMSG (opt) = array containing lines of message (passed by reference)
  1.  ;       if $D(INMSG)<9 then INMSG contains a 1 line message
  1.  ;REPUIF (opt) = Pointer to another UIF, used to track replicated
  1.  ;               messages from UIF to multiple other UIFs.
  1.  ;INNOACT (opt)= Boolean: 0 update message action,
  1.  ;                        1 don't update message, only activity log.
  1.  ;             (Used for selective routing suppression logging.)
  1.  ;
  1.  Q:'$D(^INTHU(UIF,0))  ;Quit if entry non-existent
  1.  N DIC,DO,DINUM,DA,Y,DIE,DR,DUZ S DUZ=.5,DUZ(0)="@"
  1.  S DA(1)=UIF,DIC="^INTHU("_DA(1)_",1,",DIC(0)="FL",X="""NOW"""
  1.  S:'$D(^INTHU(UIF,1,0)) ^(0)="^4001.01DA^^"
  1.  D ^DIC Q:Y<0  S (INZ,DA)=+Y
  1.  I $G(ACT)]"" S DIE="^INTHU("_DA(1)_",1,",DR=".02///"_$E(ACT) S:$D(REPUIF) DR=DR_";.03////"_REPUIF D ^DIE D:$P(^INTHU(UIF,0),U,3)'=$E(ACT)
  1.  . Q:$G(INNOACT)  S DIE="^INTHU(",DA=UIF,DR=".03////"_$E(ACT) D ^DIE
  1.  Q:'$D(INMSG)
  1.  S:$D(INMSG)=1 INMSG(1)=INMSG
  1.  S (I,%)=0 F  S I=$O(INMSG(I)) Q:'I  S %=%+1,^INTHU(UIF,1,INZ,1,%,0)=INMSG(I)
  1.  S ^INTHU(UIF,1,INZ,1,0)=U_U_%_U_%
  1.  Q
  1.  ;
  1. ACKLOG(%M,%AM,%S,%L) ;Log an acknowledgement to a message
  1.  ;%M  (reqd) = UIF entry # of current message
  1.  ;%AM (reqd) = ID of message to acknowledge
  1.  ;%S  (reqd) = ack status (0 = NAK, 1=ACK)
  1.  ;%L  (opt)  = message to store if NAK
  1.  ;
  1.  Q:'$D(^INTHU(+$G(%M)))
  1.  N AMID,MESS,STAT
  1.  S AMID=$O(^INTHU("C",%AM,0)) Q:'AMID
  1.  S $P(^INTHU(%M,0),U,7)=AMID
  1.  S $P(^INTHU(AMID,0),U,6)=%M,STAT=$S('%S:"K",1:"C")
  1.  S DIE="^INTHU(",DA=AMID,DR=".03///"_STAT D ^DIE
  1.  I %S S MESS(1)="Positive Acknowledge received"
  1.  I '%S S MESS(1)="Negative Acknowledge received" S:$G(%L)]"" MESS(2)=%L
  1.  S MESS(1)=MESS(1)_" in transaction with ID="_$P(^INTHU(%M,0),U,5)_" for transaction with ID="_%AM
  1.  D:'%S ENK^INHE(AMID,.MESS)
  1.  D ULOG^INHU(AMID,STAT,.MESS)
  1.  Q
  1.  ;
  1. PIECE(%L,%D,%N) ;Function to get a piece of a line that may be over 250 characters long
  1.  ;%L = variable (passed by reference with overflow nodes)
  1.  ;%D = delimiter
  1.  ;%N = piece number
  1.  Q:$D(%L)<9 $P(%L,%D,%N)
  1.  N I,L1,X,L0 S L0=$L(%L,%D)
  1.  Q:L0>%N $P(%L,%D,%N)
  1.  Q:L0=%N $P(%L,%D,%N)_$P($G(%L(1)),%D)
  1.  F I=1:1 Q:'$D(%L(I))  S L1=$L(%L(I),%D)-1 D  Q:$D(X)
  1.  . I L1+L0'<%N S X=$P(%L(I),%D,%N-L0+1) S:L0+L1=%N X=X_$P($G(%L(I+1)),%D) Q
  1.  . S L0=L0+L1
  1.  Q $G(X)
  1.  ;
  1. EXTRACT(%L,%1,%2) ;Function to extract from a line that may be over 250 characters
  1.  ;%L = variable (passed by reference with overflow nodes)
  1.  ;%1 = starting position
  1.  ;%2 = ending position
  1.  S:'$D(%2) %2=%1
  1.  Q:$D(%L)<9!($L(%L)'<%2) $E(%L,%1,%2)
  1.  N L0,L1,I,X S X=""
  1.  S L0=$L(%L) I L0'<%1 S X=$E(%L,%1,L0)
  1.  F I=1:1 Q:'$D(%L(I))  S L1=$L(%L(I)) D  Q:L0+L1'<%2  S L0=L0+L1
  1.  . I X="",L0+L1'<%1 S X=$E(%L(I),%1-L0,%2-L0)
  1.  . I %1'>L0 S X=X_$E(%L(I),1,%2-L0)
  1.  Q X
  1.  ;
  1. SETPIECE(%L,%D,%N,%X,%C) ;Set a piece in a line which may be more than 250 characters
  1.  ;%L = variable (pass by reference with overflow nodes)
  1.  ;%D = delimiter
  1.  ;%N = piece #
  1.  ;%X = data to place
  1.  ;%C = current number of pieces (pass by reference)
  1.  N Z,Y,I
  1.  S $P(Z,%D,%N-%C+''%C)="",Z=Z_%X
  1. S1 I $D(%L)<9 D  S %C=%N Q
  1.  . S %L=$G(%L) I $L(%L)+$L(Z)<251 S %L=%L_Z Q
  1.  . S Y=250-$L(%L),%L=%L_$E(Z,1,Y),%L(1)=$E(Z,Y+1,999)
  1.  F I=0:1 Q:'$D(%L(I+1))
  1.  I $L(%L(I))+$L(Z)<251 S %L(I)=%L(I)_Z,%C=%N Q
  1.  S Y=250-$L(%L(I)),%L(I)=%L(I)_$E(Z,1,Y),%L(I+1)=$E(Z,Y+1,999),%C=%N
  1.  Q
  1.  ;
  1. CONCAT(%L,%X,%D) ;Concatenate a string onto another with length greater than 250
  1.  ;%L = variable to add to (pass by value with overflow nodes)
  1.  ;%X = data to concatenate
  1.  ;%D = 1 if delimter is used  ;added by dgh for test
  1.  N L0,Z,%C,%N
  1.  ;;S Z=%X,%N=0 G S1 ;;commented out by dgh, following inserted
  1.  ;S Z=DELIM_%X,%N=0 G S1
  1.  S Z=$S($G(%D):DELIM_%X,1:%X),%N=0 G S1
  1.  ;
  1. REPLCE(%L,%X,%P) ;Replace a portion of a string
  1.  ;For fixed length, non-delimited strings, this function replaces
  1.  ;a portion of the data (e.g. a fixed length field in the string)
  1.  ;with a new value. Both old and new lengths must be the same.
  1.  ;%L = Current string
  1.  ;%X = data to insert
  1.  ;%P = starting position to insert
  1.  N LEN
  1.  S LEN=$L(%X)
  1.  Q
  1. ECHK(UIF) ;Resolve errors for UIF entry 
  1.  ;UIF = entry # in file 4001
  1.  Q:X'="C"
  1.  N INI
  1.  S INI=0 F  S INI=$O(^INTHER("U",UIF,INI)) Q:'INI  I $D(^INTHER(INI,0)) K ^INTHER("AE",0,INI) S $P(^INTHER(INI,0),"^",10)=1,^INTHER("AE",1,INI)=""
  1.  Q
  1.  ;
  1. MAIL ;Input Xform on MAIL RECIPIENT field in file #4005
  1.  N XMY,XMDUZ,DIC,DA,Y,INX,XMLOC
  1.  K:$E(X,1,2)="G."!($E(X,1,2)="g.")&(X'["@") X
  1.  S XMDUZ=0 D WHO^XMA21 K:'$D(XMY) X S:$D(X) X=$O(XMY(""))