INHD ; cmi/flag/maw - FRW,DGH,JSH 29 Aug 97 08:42 Interface Input Driver 07 Oct 91 6:44 AM ; [ 09/09/2004 1:23 PM ]
;;3.01;BHL IHS Interfaces with GIS;**1,12**;JUN 01, 2002
;COPYRIGHT 1991-2000 SAIC
;cmi/maw modified STORE sub to strip off |CR|
;
NEWO(DEST,G,ACK,TT,MID,%OUT,INORDUZ,INORDIV,INUIF6,INUIF7,INMIDGEN) ;Make a new outgoing entry
;INPUT:
;DEST = Entry # of a destination (file #4005)
;G = Global reference of lines of data: $G@(n) n=1,2,3,...
;ACK = Acknowledge required (0 = NO, 1 = YES)
;TT = Originating Transaction Type (file #4000)
;MID = Message ID
;%OUT = Allow output controller to process (0=yes 1=no)
;INORDUZ = originating user, ien to USER file #3
;INORDIV = originating division,
; ien to MEDICAL CENTER DIVISION file 40.8
;INUIF6 = (opt) See INDA.
;INUIF7 = (opt) See INA.
;INMIDGEN = message ID of originating message (from node 0 piece 5)
; INA - (opt) Selected subnodes of INA array are merged into
; the outbound msg after outbound script execution.
; Used by application teams' screening logic
; (@INA@("node")). Data may already reside in
; INUIF7.
; INDA - (opt) INDA array is merged into the outbound msg as it
; exists prior to outbound script execution. Used
; by appl. teams' screening logic (@INDA@("node")).
; Data may already reside in INUIF6.
;
;OUTPUT:
;Function value - entry # in UIF or -1 (if error)
;
S X="ERROR^INHD",@^%ZOSF("TRAP")
I '$G(DEST)!($G(G)="")!($G(ACK)="")!'$G(TT) Q -1
Q:'$D(^INRHD(DEST)) -1
N H,C,I,X,DA,DIC,DR,TIME,SRC,DO,Y,DIC,DD,DIE,DLAYGO,INHNOW
;cmi/anch/maw 9/8/2004 made a change to call FILE^DICN
;S X="NOW",DLAYGO=4001,DIC="^INTHU(",DIC(0)="FL" D ^DICN ;cmi/maw orig
D NOW^%DTC S INHNOW=$G(%)
K DD,DO S X=INHNOW,DLAYGO=4001,DIC="^INTHU(",DIC(0)="L" D FILE^DICN ;cmi/anch/maw new
I Y<0 D FAILO Q -1
S DA=+Y L +^INTHU(DA)
N INMID,INDEST,INSRC,ING,INNEACK,INDIR,INNEOUT,INTT,INORGIEN
S INMIDGEN=$G(INMIDGEN)
S INMID=MID,INDEST=DEST,ING=G,INNEACK=ACK,INDIR="OUT",INNEOUT=$G(%OUT),INSRC="",INTT=TT S INORGIEN=$S('$L(INMIDGEN):"",1:$O(^INTHU("C",INMIDGEN,0)))
S DIE="^INTHU(",DR="[INH MESSAGE NEW]" D ^DIE
I $D(INUIF6) M ^INTHU(DA,6)=INUIF6
I '$D(INUIF6),$D(INDA) M ^INTHU(DA,6)=INDA
I $D(INUIF7) M ^INTHU(DA,7)=INUIF7
I '$D(INUIF7) D
. I $D(INA("DMISID")) M ^INTHU(DA,7,"DMISID")=INA("DMISID")
. I $D(INA("MSGTYPE")) M ^INTHU(DA,7,"MSGTYPE")=INA("MSGTYPE")
D STORE
L -^INTHU(DA)
Q DA
;
STORE ;Store text in message file (INTHU)
;INPUT:
; DA - ien in INTHU
; G - location (array) of message
; DEST, %OUT, TT (opt)
;OUTPUT:
; TT - ien of Transaction Type
; TIME - time to process ($H format)
;
N C,I,J
;cmi/maw added next 3 lines to strip |CR| off of X12 messages
I $G(BHLMIEN),$P($G(^INTHL7M(BHLMIEN,0)),U,12)="X12" D
. S (C,I)=0 F S I=$O(@G@(I)) Q:'I S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I),"|CR|")_$S('$O(@G@(I,0)):"",1:"") I $O(@G@(I,0)) D
.. S J=0 F S J=$O(@G@(I,J)) Q:'J S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I,J),"|CR|")_$S('$O(@G@(I,J)):"",1:"")
I $G(BHLMIEN),$P($G(^INTHL7M(BHLMIEN,0)),U,12)'="X12" D
. S (C,I)=0 F S I=$O(@G@(I)) Q:'I S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I),"|CR|")_$S('$O(@G@(I,0)):"|CR|",1:"") I $O(@G@(I,0)) D
.. S J=0 F S J=$O(@G@(I,J)) Q:'J S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I,J),"|CR|")_$S('$O(@G@(I,J)):"|CR|",1:"")
I '$G(BHLMIEN) D
. S (C,I)=0 F S I=$O(@G@(I)) Q:'I S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I),"|CR|")_$S('$O(@G@(I,0)):"|CR|",1:"") I $O(@G@(I,0)) D
.. S J=0 F S J=$O(@G@(I,J)) Q:'J S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I,J),"|CR|")_$S('$O(@G@(I,J)):"|CR|",1:"")
S ^INTHU(DA,3,0)="^^"_C_"^"_C
D TIME,SET(TIME,DEST,DA,$G(%OUT))
;cmi/maw end of mods
Q
;
NEW(MID,DEST,SRC,G,ACK,DIR,%OUT,INMIDGEN) ;Make a new entry from an outside program
;INPUT:
;MID = Message ID of incoming message [REQD]
; If ="^" then generate one and use it
;DEST = Name of a destination (file #4005) [REQD]
;SRC = Free Text source [REQD]
;G = Global reference of lines of data: $G@(n) n=1,2,3,... [REQD]
;ACK = Acknowledge required (0 = NO, 1 = YES) [REQD]
;DIR = Direction (I:default = Incoming, O = Outgoing) [OPT]
;%OUT = Allow output controller to process (0:default = YES 1 = NO) [OPT]
;INMIDGEN = Message ID of originating message (node 0, piece 5)
;
;OUTPUT:
;Function - entry # in UIF (^INTHU) or -1 (if error)
;
S X="ERROR^INHD",@^%ZOSF("TRAP")
N TT,DIC,TIME,DO,X,Y,DA,DIC,DD,DIE,DR,DLAYGO
I $G(DEST)=""!($G(SRC)="")!($G(G)="")!($G(ACK)="")!($G(MID)="") D FAILR Q -1
S DEST=$O(^INRHD("B",DEST,""))
I MID'="^",'DEST D FAILR Q -1
I $D(^INTHU("C",MID)) D FAILR Q -1
I MID="^" S MID=$$MESSID
S:$G(DIR)="" DIR="I" S DIR=$E(DIR) Q:"IO"'[DIR -1
S X="NOW",DLAYGO=4001,DIC="^INTHU(",DIC(0)="FL" D ^DICN
I Y<0 D FAILR Q -1
S DA=+Y L +^INTHU(DA)
N INMID,INDEST,INSRC,ING,INNEACK,INDIR,INNEOUT,INTT,INORGIEN
S INMIDGEN=$G(INMIDGEN)
S INMID=MID,INDEST=DEST,INSRC=SRC,ING=G,INNEACK=ACK,INDIR=DIR,INNEOUT=$G(%OUT),INTT="" S INORGIEN=$S('$L(INMIDGEN):"",1:$O(^INTHU("C",INMIDGEN,0)))
S DIE="^INTHU(",DR="[INH MESSAGE NEW]" D ^DIE
D STORE
L -^INTHU(DA)
Q DA
;
FAILR ;Creation of UIF entry by a receiver ( NEW ) failed
N ERROR
D ERRMES
D ENR^INHE("",.ERROR)
Q
FAILO ;Creation of UIF entry by NEWO failed
N ERROR,INBZ,INBNZ
D ERRMES
;Call appropriate erorr module
S INBZ=+$G(INBPN),INBNZ=$P($G(^INTHPC(INBZ,0)),U,1)
;I INBZ=1 D ENO^INHE(
;I INBZ=2 D ENF^INHE(
;I INBNZ["RECE" D ENR^INHE("",.ERROR)
;I INBNZ["TRANS" D ENT^INHE(
;D ENR^INHE("",.ERROR) ;cmi/anch/maw 9/8/2004 this is a bug
D ENR^INHE(+$G(INBPN),.ERROR) ;cmi/anch/maw 9/8/2004 this is the fix
;
Q
ERRMES ;Set up "creation failed" error message
S ERROR(1)="UIF entry creation failed:"
S ERROR(2)=" DEST = '"_$G(DEST)_"'",ERROR(3)=" SOURCE = '"_$G(SRC)_"'",ERROR(4)=" MESS ID = '"_$G(MID)_"'",ERROR(5)=" Global Ref = '"_$G(G)_"'"
Q
;
MESSID() ;Function to return a unique Message ID
N X,Y
L +^INTHU("MESSID")
M1 S X=$G(^INTHU("MESSID"))+1,^("MESSID")=X,Y=$P($G(^INRHSITE(1,0)),U,8)_X
G:$D(^INTHU("C",Y)) M1
L -^INTHU("MESSID")
Q Y
;
ERROR ;Handle errors
X ^INTHOS(1,3)
D ENI^INHE($G(TT),$G(DEST),$$ERRMSG^INHU1) ;CHECK CALL
Q -1
;
SET(INH,IND,INU,INO,INPRIO) ;Queue an entry into ^INLHSCH
;INPUT:
;INH = $H format of when [REQ]
;IND = destination entry # [REQ]
;INU = UIF entry # [REQ]
;INO = if defined and non-zero, suppress setting output queue [OPT]
;INPRIO = if defined, sets processing priority [OPT]
;TT - ien of Transaction Type
;
Q:'$G(IND)!'$G(INU)!$G(INO) Q:'$D(^INRHD(IND,0))!'$D(^INTHU(INU,0))
N H,INP,X,Y,DIE,DR,DA,TT0,INDELQ
;Determine destination queue
S INDELQ=$P(^INRHD(IND,0),U,12)
S H=$P(INH,",",2) I $L(H)<5 S H=$E("00000",1,5-$L(H))_H
S INH=$P(INH,",")_","_H
;Housekeeping messages may have no TT
S TT0=$S('$D(TT):"",TT:^INRHT(TT,0),1:"")
S INP=$S($D(INPRIO):+INPRIO,$L(TT0):+$P(TT0,U,16),1:0)
S DR=".16////"_INP_";.19////"_INH,DIE="^INTHU(",DA=INU D ^DIE
;Place in destination queue AND exit
I INDELQ S ^INLHDEST(IND,INP,INH,INU)="" Q
;Defaul to OUTPUT CONTROLLER queue
S ^INLHSCH(INP,INH,INU)=""
Q
;
TIME ;Get time to process. If STAT, set to 00000,00000
;INPUT:
; DEST - ien of destination (req)
; TT - ien of transaction type (optional)
;OUTPUT:
; TT - ien of Transaction Type
; TIME - time to process
N TTP
;if outgoing, TT is defined. If incoming, get from destination
I '$D(TT) S TT=$P(^INRHD(DEST,0),U,2)
I 'TT S TIME=$H Q
S TTP=$P(^INRHT(TT,0),U,15)
I TTP="" S TIME=$H Q
I TTP="STAT" S TIME="00000,00000" Q
;Handle relative times (ex. NOW+30S)
I TTP["NOW",TTP["+" D
. N %,P,T S T=$P(TTP,"+",2)
. ;Only one measure (D,H,M, or S) is supported
. F %="S","M","H","D" I T[% S P(%)=+T Q
. S TTP=$$ADDT^%ZTFDT($$NOW^%ZTFDT,$G(P("D")),$G(P("H")),$G(P("M")),$G(P("S")))
N X,Y,%DT S X=TTP,%DT="TRS" D ^%DT S TIME=$$CDATF2H^UTDT(Y)
S:TIME<0 TIME=$H
Q
INHD ; cmi/flag/maw - FRW,DGH,JSH 29 Aug 97 08:42 Interface Input Driver 07 Oct 91 6:44 AM ; [ 09/09/2004 1:23 PM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;**1,12**;JUN 01, 2002
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;cmi/maw modified STORE sub to strip off |CR|
+4 ;
NEWO(DEST,G,ACK,TT,MID,%OUT,INORDUZ,INORDIV,INUIF6,INUIF7,INMIDGEN) ;Make a new outgoing entry
+1 ;INPUT:
+2 ;DEST = Entry # of a destination (file #4005)
+3 ;G = Global reference of lines of data: $G@(n) n=1,2,3,...
+4 ;ACK = Acknowledge required (0 = NO, 1 = YES)
+5 ;TT = Originating Transaction Type (file #4000)
+6 ;MID = Message ID
+7 ;%OUT = Allow output controller to process (0=yes 1=no)
+8 ;INORDUZ = originating user, ien to USER file #3
+9 ;INORDIV = originating division,
+10 ; ien to MEDICAL CENTER DIVISION file 40.8
+11 ;INUIF6 = (opt) See INDA.
+12 ;INUIF7 = (opt) See INA.
+13 ;INMIDGEN = message ID of originating message (from node 0 piece 5)
+14 ; INA - (opt) Selected subnodes of INA array are merged into
+15 ; the outbound msg after outbound script execution.
+16 ; Used by application teams' screening logic
+17 ; (@INA@("node")). Data may already reside in
+18 ; INUIF7.
+19 ; INDA - (opt) INDA array is merged into the outbound msg as it
+20 ; exists prior to outbound script execution. Used
+21 ; by appl. teams' screening logic (@INDA@("node")).
+22 ; Data may already reside in INUIF6.
+23 ;
+24 ;OUTPUT:
+25 ;Function value - entry # in UIF or -1 (if error)
+26 ;
+27 SET X="ERROR^INHD"
SET @^%ZOSF("TRAP")
+28 IF '$GET(DEST)!($GET(G)="")!($GET(ACK)="")!'$GET(TT)
QUIT -1
+29 IF '$DATA(^INRHD(DEST))
QUIT -1
+30 NEW H,C,I,X,DA,DIC,DR,TIME,SRC,DO,Y,DIC,DD,DIE,DLAYGO,INHNOW
+31 ;cmi/anch/maw 9/8/2004 made a change to call FILE^DICN
+32 ;S X="NOW",DLAYGO=4001,DIC="^INTHU(",DIC(0)="FL" D ^DICN ;cmi/maw orig
+33 DO NOW^%DTC
SET INHNOW=$GET(%)
+34 ;cmi/anch/maw new
KILL DD,DO
SET X=INHNOW
SET DLAYGO=4001
SET DIC="^INTHU("
SET DIC(0)="L"
DO FILE^DICN
+35 IF Y<0
DO FAILO
QUIT -1
+36 SET DA=+Y
LOCK +^INTHU(DA)
+37 NEW INMID,INDEST,INSRC,ING,INNEACK,INDIR,INNEOUT,INTT,INORGIEN
+38 SET INMIDGEN=$GET(INMIDGEN)
+39 SET INMID=MID
SET INDEST=DEST
SET ING=G
SET INNEACK=ACK
SET INDIR="OUT"
SET INNEOUT=$GET(%OUT)
SET INSRC=""
SET INTT=TT
SET INORGIEN=$SELECT('$LENGTH(INMIDGEN):"",1:$ORDER(^INTHU("C",INMIDGEN,0)))
+40 SET DIE="^INTHU("
SET DR="[INH MESSAGE NEW]"
DO ^DIE
+41 IF $DATA(INUIF6)
MERGE ^INTHU(DA,6)=INUIF6
+42 IF '$DATA(INUIF6)
IF $DATA(INDA)
MERGE ^INTHU(DA,6)=INDA
+43 IF $DATA(INUIF7)
MERGE ^INTHU(DA,7)=INUIF7
+44 IF '$DATA(INUIF7)
Begin DoDot:1
+45 IF $DATA(INA("DMISID"))
MERGE ^INTHU(DA,7,"DMISID")=INA("DMISID")
+46 IF $DATA(INA("MSGTYPE"))
MERGE ^INTHU(DA,7,"MSGTYPE")=INA("MSGTYPE")
End DoDot:1
+47 DO STORE
+48 LOCK -^INTHU(DA)
+49 QUIT DA
+50 ;
STORE ;Store text in message file (INTHU)
+1 ;INPUT:
+2 ; DA - ien in INTHU
+3 ; G - location (array) of message
+4 ; DEST, %OUT, TT (opt)
+5 ;OUTPUT:
+6 ; TT - ien of Transaction Type
+7 ; TIME - time to process ($H format)
+8 ;
+9 NEW C,I,J
+10 ;cmi/maw added next 3 lines to strip |CR| off of X12 messages
+11 IF $GET(BHLMIEN)
IF $PIECE($GET(^INTHL7M(BHLMIEN,0)),U,12)="X12"
Begin DoDot:1
+12 SET (C,I)=0
FOR
SET I=$ORDER(@G@(I))
IF 'I
QUIT
SET C=C+1
SET ^INTHU(DA,3,C,0)=$PIECE(@G@(I),"|CR|")_$SELECT('$ORDER(@G@(I,0)):"",1:"")
IF $ORDER(@G@(I,0))
Begin DoDot:2
+13 SET J=0
FOR
SET J=$ORDER(@G@(I,J))
IF 'J
QUIT
SET C=C+1
SET ^INTHU(DA,3,C,0)=$PIECE(@G@(I,J),"|CR|")_$SELECT('$ORDER(@G@(I,J)):"",1:"")
End DoDot:2
End DoDot:1
+14 IF $GET(BHLMIEN)
IF $PIECE($GET(^INTHL7M(BHLMIEN,0)),U,12)'="X12"
Begin DoDot:1
+15 SET (C,I)=0
FOR
SET I=$ORDER(@G@(I))
IF 'I
QUIT
SET C=C+1
SET ^INTHU(DA,3,C,0)=$PIECE(@G@(I),"|CR|")_$SELECT('$ORDER(@G@(I,0)):"|CR|",1:"")
IF $ORDER(@G@(I,0))
Begin DoDot:2
+16 SET J=0
FOR
SET J=$ORDER(@G@(I,J))
IF 'J
QUIT
SET C=C+1
SET ^INTHU(DA,3,C,0)=$PIECE(@G@(I,J),"|CR|")_$SELECT('$ORDER(@G@(I,J)):"|CR|",1:"")
End DoDot:2
End DoDot:1
+17 IF '$GET(BHLMIEN)
Begin DoDot:1
+18 SET (C,I)=0
FOR
SET I=$ORDER(@G@(I))
IF 'I
QUIT
SET C=C+1
SET ^INTHU(DA,3,C,0)=$PIECE(@G@(I),"|CR|")_$SELECT('$ORDER(@G@(I,0)):"|CR|",1:"")
IF $ORDER(@G@(I,0))
Begin DoDot:2
+19 SET J=0
FOR
SET J=$ORDER(@G@(I,J))
IF 'J
QUIT
SET C=C+1
SET ^INTHU(DA,3,C,0)=$PIECE(@G@(I,J),"|CR|")_$SELECT('$ORDER(@G@(I,J)):"|CR|",1:"")
End DoDot:2
End DoDot:1
+20 SET ^INTHU(DA,3,0)="^^"_C_"^"_C
+21 DO TIME
DO SET(TIME,DEST,DA,$GET(%OUT))
+22 ;cmi/maw end of mods
+23 QUIT
+24 ;
NEW(MID,DEST,SRC,G,ACK,DIR,%OUT,INMIDGEN) ;Make a new entry from an outside program
+1 ;INPUT:
+2 ;MID = Message ID of incoming message [REQD]
+3 ; If ="^" then generate one and use it
+4 ;DEST = Name of a destination (file #4005) [REQD]
+5 ;SRC = Free Text source [REQD]
+6 ;G = Global reference of lines of data: $G@(n) n=1,2,3,... [REQD]
+7 ;ACK = Acknowledge required (0 = NO, 1 = YES) [REQD]
+8 ;DIR = Direction (I:default = Incoming, O = Outgoing) [OPT]
+9 ;%OUT = Allow output controller to process (0:default = YES 1 = NO) [OPT]
+10 ;INMIDGEN = Message ID of originating message (node 0, piece 5)
+11 ;
+12 ;OUTPUT:
+13 ;Function - entry # in UIF (^INTHU) or -1 (if error)
+14 ;
+15 SET X="ERROR^INHD"
SET @^%ZOSF("TRAP")
+16 NEW TT,DIC,TIME,DO,X,Y,DA,DIC,DD,DIE,DR,DLAYGO
+17 IF $GET(DEST)=""!($GET(SRC)="")!($GET(G)="")!($GET(ACK)="")!($GET(MID)="")
DO FAILR
QUIT -1
+18 SET DEST=$ORDER(^INRHD("B",DEST,""))
+19 IF MID'="^"
IF 'DEST
DO FAILR
QUIT -1
+20 IF $DATA(^INTHU("C",MID))
DO FAILR
QUIT -1
+21 IF MID="^"
SET MID=$$MESSID
+22 IF $GET(DIR)=""
SET DIR="I"
SET DIR=$EXTRACT(DIR)
IF "IO"'[DIR
QUIT -1
+23 SET X="NOW"
SET DLAYGO=4001
SET DIC="^INTHU("
SET DIC(0)="FL"
DO ^DICN
+24 IF Y<0
DO FAILR
QUIT -1
+25 SET DA=+Y
LOCK +^INTHU(DA)
+26 NEW INMID,INDEST,INSRC,ING,INNEACK,INDIR,INNEOUT,INTT,INORGIEN
+27 SET INMIDGEN=$GET(INMIDGEN)
+28 SET INMID=MID
SET INDEST=DEST
SET INSRC=SRC
SET ING=G
SET INNEACK=ACK
SET INDIR=DIR
SET INNEOUT=$GET(%OUT)
SET INTT=""
SET INORGIEN=$SELECT('$LENGTH(INMIDGEN):"",1:$ORDER(^INTHU("C",INMIDGEN,0)))
+29 SET DIE="^INTHU("
SET DR="[INH MESSAGE NEW]"
DO ^DIE
+30 DO STORE
+31 LOCK -^INTHU(DA)
+32 QUIT DA
+33 ;
FAILR ;Creation of UIF entry by a receiver ( NEW ) failed
+1 NEW ERROR
+2 DO ERRMES
+3 DO ENR^INHE("",.ERROR)
+4 QUIT
FAILO ;Creation of UIF entry by NEWO failed
+1 NEW ERROR,INBZ,INBNZ
+2 DO ERRMES
+3 ;Call appropriate erorr module
+4 SET INBZ=+$GET(INBPN)
SET INBNZ=$PIECE($GET(^INTHPC(INBZ,0)),U,1)
+5 ;I INBZ=1 D ENO^INHE(
+6 ;I INBZ=2 D ENF^INHE(
+7 ;I INBNZ["RECE" D ENR^INHE("",.ERROR)
+8 ;I INBNZ["TRANS" D ENT^INHE(
+9 ;D ENR^INHE("",.ERROR) ;cmi/anch/maw 9/8/2004 this is a bug
+10 ;cmi/anch/maw 9/8/2004 this is the fix
DO ENR^INHE(+$GET(INBPN),.ERROR)
+11 ;
+12 QUIT
ERRMES ;Set up "creation failed" error message
+1 SET ERROR(1)="UIF entry creation failed:"
+2 SET ERROR(2)=" DEST = '"_$GET(DEST)_"'"
SET ERROR(3)=" SOURCE = '"_$GET(SRC)_"'"
SET ERROR(4)=" MESS ID = '"_$GET(MID)_"'"
SET ERROR(5)=" Global Ref = '"_$GET(G)_"'"
+3 QUIT
+4 ;
MESSID() ;Function to return a unique Message ID
+1 NEW X,Y
+2 LOCK +^INTHU("MESSID")
M1 SET X=$GET(^INTHU("MESSID"))+1
SET ^("MESSID")=X
SET Y=$PIECE($GET(^INRHSITE(1,0)),U,8)_X
+1 IF $DATA(^INTHU("C",Y))
GOTO M1
+2 LOCK -^INTHU("MESSID")
+3 QUIT Y
+4 ;
ERROR ;Handle errors
+1 XECUTE ^INTHOS(1,3)
+2 ;CHECK CALL
DO ENI^INHE($GET(TT),$GET(DEST),$$ERRMSG^INHU1)
+3 QUIT -1
+4 ;
SET(INH,IND,INU,INO,INPRIO) ;Queue an entry into ^INLHSCH
+1 ;INPUT:
+2 ;INH = $H format of when [REQ]
+3 ;IND = destination entry # [REQ]
+4 ;INU = UIF entry # [REQ]
+5 ;INO = if defined and non-zero, suppress setting output queue [OPT]
+6 ;INPRIO = if defined, sets processing priority [OPT]
+7 ;TT - ien of Transaction Type
+8 ;
+9 IF '$GET(IND)!'$GET(INU)!$GET(INO)
QUIT
IF '$DATA(^INRHD(IND,0))!'$DATA(^INTHU(INU,0))
QUIT
+10 NEW H,INP,X,Y,DIE,DR,DA,TT0,INDELQ
+11 ;Determine destination queue
+12 SET INDELQ=$PIECE(^INRHD(IND,0),U,12)
+13 SET H=$PIECE(INH,",",2)
IF $LENGTH(H)<5
SET H=$EXTRACT("00000",1,5-$LENGTH(H))_H
+14 SET INH=$PIECE(INH,",")_","_H
+15 ;Housekeeping messages may have no TT
+16 SET TT0=$SELECT('$DATA(TT):"",TT:^INRHT(TT,0),1:"")
+17 SET INP=$SELECT($DATA(INPRIO):+INPRIO,$LENGTH(TT0):+$PIECE(TT0,U,16),1:0)
+18 SET DR=".16////"_INP_";.19////"_INH
SET DIE="^INTHU("
SET DA=INU
DO ^DIE
+19 ;Place in destination queue AND exit
+20 IF INDELQ
SET ^INLHDEST(IND,INP,INH,INU)=""
QUIT
+21 ;Defaul to OUTPUT CONTROLLER queue
+22 SET ^INLHSCH(INP,INH,INU)=""
+23 QUIT
+24 ;
TIME ;Get time to process. If STAT, set to 00000,00000
+1 ;INPUT:
+2 ; DEST - ien of destination (req)
+3 ; TT - ien of transaction type (optional)
+4 ;OUTPUT:
+5 ; TT - ien of Transaction Type
+6 ; TIME - time to process
+7 NEW TTP
+8 ;if outgoing, TT is defined. If incoming, get from destination
+9 IF '$DATA(TT)
SET TT=$PIECE(^INRHD(DEST,0),U,2)
+10 IF 'TT
SET TIME=$HOROLOG
QUIT
+11 SET TTP=$PIECE(^INRHT(TT,0),U,15)
+12 IF TTP=""
SET TIME=$HOROLOG
QUIT
+13 IF TTP="STAT"
SET TIME="00000,00000"
QUIT
+14 ;Handle relative times (ex. NOW+30S)
+15 IF TTP["NOW"
IF TTP["+"
Begin DoDot:1
+16 NEW %,P,T
SET T=$PIECE(TTP,"+",2)
+17 ;Only one measure (D,H,M, or S) is supported
+18 FOR %="S","M","H","D"
IF T[%
SET P(%)=+T
QUIT
+19 SET TTP=$$ADDT^%ZTFDT($$NOW^%ZTFDT,$GET(P("D")),$GET(P("H")),$GET(P("M")),$GET(P("S")))
End DoDot:1
+20 NEW X,Y,%DT
SET X=TTP
SET %DT="TRS"
DO ^%DT
SET TIME=$$CDATF2H^UTDT(Y)
+21 IF TIME<0
SET TIME=$HOROLOG
+22 QUIT
