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

INHF.m

Go to the documentation of this file. 
  1. INHF(INTT,INDA,INDIPA,INTIME,INPRIOR,INDIV,INQUE) ; cmi/flag/maw - DGH,JSH 6 Apr 97 13:06 Formatter front-end for application calls ;
  1.  ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;INTT = Textual form of the transaction type (not an entry #) [REQD]
  1.  ;INDA = Entry # in base file (file mentioned in script) [REQD]
  1.  ;         If passed by reference (opt), subscripts may hold entry
  1.  ;         numbers in subfiles in the format:
  1.  ;            INDA(subfile #,DA)=""
  1.  ;INDIPA = An array passed by reference whose subscripts will become
  1.  ;             '@' variables in the script [OPT]
  1.  ;INTIME = When to run [OPT]
  1.  ;             time in $H, FileMan, or %DT format
  1.  ;INPRIOR = Priority [OPT], a number 0 - 10 (Parameter added for ver 4.4)
  1.  ;INDIV = Division. If supplied, it will be stored in UIF field .21
  1.  ;INQUE = 1 to suppress queuing in "AH" cross reference. Use this
  1.  ;   to create entries in task file for Unit Test Utilities 
  1.  ;OUTPUT:  INHF = INTSK if accepted
  1.  ;              = 0 if rejected for any reason (including system inactive)
  1.  ;N X,Y,INTSK,TIME,DIC,DLAYGO,DO,DS,PRIOR,%DT S INHF=0
  1.  S INHF=0
  1.  D EN^XBNEW("MAIN^INHF","IN*")  ;cmi/maw added for RPMS
  1.  Q
  1.  ;
  1. MAIN ;EP - this is the start of the routine
  1.  Q:'$G(^INRHSITE(1,"ACT"))  ;Quit if interface system is inactive
  1.  Q:'$L($G(INTT))!'$D(INDA)!'$G(DUZ)
  1.  S X=INTT,INTT=$O(^INRHT("B",INTT,"")) I 'INTT D ERROR("^INHF call made with unknown transaction type '"_X_"'") Q
  1.  S INTT(0)=^INRHT(INTT,0) Q:'$P(INTT(0),U,5)  ;Quit if this transaction type is inactive
  1.  Q:$P(INTT(0),U,6)  ;Quit if this transaction type is not a parent
  1.  K:$G(INTIME)="" INTIME
  1.  I '$D(INTIME),$P(INTT(0),U,13)]"" S INTIME=$P(INTT(0),U,13)
  1.  I $G(INTIME)="STAT" S INTIME="00000,00000" G PRIOR
  1.  I $D(INTIME) S TIME=INTIME D
  1.  .Q:TIME?1.N1","1.N
  1.  .I TIME?7N.1".".N S INTIME=$$CDATF2H^UTDT(TIME) S:INTIME=+INTIME INTIME=INTIME_",1" Q
  1.  .S X=TIME,%DT="RTS" D ^%DT I Y<0 D  Q
  1.  ..D ERROR("Time specified in ^INHF call is invalid '"_TIME_"'"_".  Processing transaction NOW instead.") S INTIME=$H
  1.  .S INTIME=$$CDATF2H^UTDT(Y)
  1.  S:'$G(INTIME) INTIME=$H S X=$P(INTIME,",",2) I $L(X)<5 S X=$E("00000",1,5-$L(X))_X,$P(INTIME,",",2)=X
  1. PRIOR S PRIOR=$S($L($G(INPRIOR)):+INPRIOR,1:+$P(INTT(0),U,14))
  1.  S DIC="^INLHFTSK(",DLAYGO=4000.1,DIC(0)="LF",X=INTT
  1.  ;Branch if system is IHS
  1.  I $$SC^INHUTIL1 D EN^DICN
  1.  I '$$SC^INHUTIL1 D NEW^DICN
  1.  I Y<0 D ERROR("Unable to add entry into Interface Formatter Task file") Q
  1.  S INTSK=+Y
  1.  L +^INLHFTSK(INTSK)
  1.  M ^INLHFTSK(INTSK,2)=INDIPA
  1.  I $D(INDA)>9 M ^INLHFTSK(INTSK,1)=INDA
  1.  S ^INLHFTSK(INTSK,0)=INTT_U_INDA_U_DUZ_U_INTIME_U_$P($G(DUZ(2)),U,1)_U_PRIOR_U_$S($D(INDIV):INDIV,1:$P($G(DUZ(2)),U))
  1.  S:'$G(INQUE) ^INLHFTSK("AH",PRIOR,INTIME,INTSK)=""
  1.  L -^INLHFTSK(INTSK)
  1.  S INHF=INTSK
  1.  Q
  1. ACK(INTT,INQUE) ;Entry point to send Acknowledge message
  1.  ;Ack Transaction Types do not have the Parent/Child structure
  1.  ;INTT = transaction type entry #
  1.  ;INQUE (OPT) = If set to 1, will pass parameter into script signalling
  1.  ;that ack is not to be queued into output controller, INLHSCH
  1.  N SCR,DEST,Z
  1.  S SCR=$P(^INRHT(INTT,0),U,3),DEST=+$P(^INRHT(INTT,0),U,2)
  1.  Q:'SCR!'DEST  Q:'$D(^INRHS(SCR))!'$D(^INRHD(DEST))
  1.  S Z="S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_INTT_",-1,.INA,"_DEST_","_$G(INQUE)_")"
  1.  X Z
  1.  Q
  1. ERROR(MESS) ;Log an error message
  1.  D ENF^INHE($G(INTT),$G(INDA),$G(DUZ),.INDIPA,MESS)
  1.  Q
  1. ERR ;MUMPS error
  1.  D ERROR($$ERRMSG^INHU1)
  1.  X $G(^INTHOS(1,3))
  1.  K ^INLHFTSK(INTSK),^INLHFTSK("B",INTT,INTSK)
  1.  Q