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