INHUT6 ; CHEM,KAC ; 6 May 97 17:03; HL7 Utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
SUPPRESS(INPROC,INTT,INDEST,INBPC,INA,INDA,INUIF,INMSH) ; $$function - Identify
; application screening logic based on precedence at a particular
; GIS process screening point and execute (if exists).
;
; Input:
; INPROC - (req) function of calling process
; "XMT" = Transmitter
; "RCV" = Receiver
; INTT - (opt) INTERFACE TRANSACTION TYPE IEN
; INDEST - (opt) INTERFACE DESTINATION IEN (lowest level)
; Lowest level destination has Route IDs.
; INBPC - (opt) BACKGROUND PROCESS CONTROL IEN
; INA - (opt) "INA" or "^INTHU(IEN,7)" (UNIVERSAL INTERFACE file).
; Location of [selected subnodes of] the INA array.
; Selected subnodes of INA array are merged into
; the outbound message by the Format Controller
; after outbound script execution. Used by
; application teams' screening logic (@INA@("node")).
; INDA - (opt) "INDA" or "^INTHU(IEN,6)" (UNIVERSAL INTERFACE file).
; Location of INDA array. INDA array is merged into
; the outbound message by the Format Controller
; prior to outbound script execution. Used by
; application teams' screening logic (@INDA@("node")).
; INUIF - (opt) UNIVERSAL INTERFACE IEN of message to be screened
; INMSH - (opt) HL7 Message Header (MSH) string (not parsed)
; Set for inbound messages at Receiver screening
; point only.
;
; Variables:
; X - scratch
; INPRI - array - top level = precedence of screen to execute
; - descendents = information relevant to screen
; precedence and execution
; Format: INPRI(X)=File#^IEN^Field # of screening logic"
; Example: INPRI=2 ; execute screen w/ precedence=2
; INPRI(1)=Precedence 1 screening info
; INPRI(2)=Precedence 2 screening info
; INPRI(3)=Precedence 3 screening info
; INSRCTL - array - screening logic control information
; "INSRPROC" - identifies GIS process currently executing
; "XMT" = Transmitter
; "RCV" = Receiver
; "INTT" - INTERFACE TRANSACTION IEN
; "INDEST" - INTERFACE DESTINATION IEN (lowest level)
; Lowest level destination has Route IDs.
; "INBPC" - BACKGROUND PROCESS CONTROL IEN
; "MSH" - HL7 Message Header (MSH) string (not parsed)
; from inbound msg
; INSRDATA - array - screening logic return values
; false = send msg
; true = suppress msg
; "Route ID" - identifies destination to which to route msg.
; Multiple entries are allowed.
; INSRMC - selective routing M code to be executed as a screen at
; this screening point
; INSUPRES - flag - function return value
; 0 = send msg
; 1 = suppress msg
;
; Output:
; 0 = deliver msg to destination
; 1 = suppress msg (no delivery to destination)
;
N INPRI,INSRCTL,INSRDATA,INSRMC,INSUPRES,X
;
; Initialization
S INPROC=$G(INPROC),INTT=$G(INTT),INDEST=$G(INDEST),INBPC=$G(INBPC),INUIF=$G(INUIF),INMSH=$G(INMSH)
;
; Customizations for current screening point - File#^IEN^Screen Node
I INPROC="XMT" D ; Transmitter screens
.; Precedence 1 = Transaction Type
. S:INTT INPRI(1)="4000^"_INTT_"^9"
.; Precedence 2 = Background Process
. S:INBPC INPRI(2)="4004^"_INBPC_"^12"
.; Precedence 3 = Primary Destination
. D:INDEST
.. S X=$P($G(^INRHD(INDEST,7)),U,2) ; Primary Dest has SRMC
.. S INPRI(3)="4005^"_$S(X:X,1:INDEST)_"^16"
;
I INPROC="RCV" D ; Receiver screens
.; Precedence 1 = Transaction Type
. S:INTT INPRI(1)="4000^"_INTT_"^8"
.; Precedence 2 = Background Process
. S:INBPC INPRI(2)="4004^"_INBPC_"^11"
.; Precedence 3 =Inbound Destination (off of BPC)
. D:INDEST
.. S X=$P($G(^INRHD(INDEST,7)),U,2) ; Primary Dest has SRMC
.. S INPRI(3)="4005^"_$S(X:X,1:INDEST)_"^15"
. S INSRCTL("MSH")=INMSH
;
; send if calling process NOT identified or no valid file/table passed in
Q:'$D(INPRI) 0
;
; Get screen w/ highest precedence
S INPRI=0 ; remember precedence of screen to be executed
F S INPRI=$O(INPRI(INPRI)) Q:'INPRI D Q:$L(INSRMC)
. S X="S INSRMC=$G("_^DIC(+INPRI(INPRI),0,"GL")_$P(INPRI(INPRI),U,2)_","_$P(INPRI(INPRI),U,3)_"))"
. X X ; set INSRMC = screening logic to be executed (if exists) or ""
;
Q:'$L($G(INSRMC)) 0 ; send if no screening logic in file/table
;
; Initialization prior to calling screen
S INSRCTL("INSRPROC")=INPROC ; function of calling process
S:INTT INSRCTL("INTT")=INTT
S:INDEST INSRCTL("INDEST")=INDEST
S:INBPC INSRCTL("INBPC")=INBPC
X INSRMC ; execute screening logic
;
; Examine screening results (in INSRDATA)
; Check:
; 1) suppress
; 2) broadcast, no list
; 3) broadcast, list exists - ck if Route ID for this destination
; matches INSRDATA("RouteID") returned by screen
S INSUPRES=$S($G(INSRDATA):1,$D(INSRDATA)<10:0,1:$S($G(INDEST):$$FINDRID^INHUT5(.INSRDATA,INDEST),1:0))
; Log suppressions
I INSUPRES S X=INPRI(INPRI) D LOG^INHUT6(+X,$P(X,U,2),$P(X,U,3),INUIF,$S($G(INUIF):1,1:0))
Q INSUPRES
;
LOG(INFN,INIEN,INSRMC,INUIF,INLOG) ; Log error message.
; Add entry in the UIF ACTIVITY LOG MULTIPLE.
; Used for identifying which screening code suppressed this entry.
; If INUIF is absent, or SR debug is on,
; log message will be in the IFE file only.
; INPUTS:
; INFN File number (Should be 4000, 4004, or 4005)
; INIEN IEN w/in file that was suppressed
; INSRMC SRMC Field number
; INUIF (opt) IEN of the Universal Interface File (Optional)
; INLOG (opt) Boolean: 0 Don't update status, 1: Update status
; INENVSDB (opt) Boolean: 0 no SR debug, 1: Site SR debug is turned on
; INSRCTL("INSRPROC") (opt) Environment variable letting me know
; which gis function is calling me
; INSRCTL("INDEST") (opt) For XMT, its part of ENT^INHE call. (Dest)
; INSRCTL("INBPC") (opt) For RCV, this is part of ENR^INHE call
; INSRCTL("INTT") (opt) For REP, this is part of ENO^INHE call
;
; OUTPUTS:
; INENVSDB Boolean: 0 no debug, 1: Site debug is turned on
;
N X,Y,%,MSG
S:'$D(INENVSDB) INENVSDB=$P($G(^INRHSITE(1,0)),"^",16)
S INFN=+$G(INFN),INIEN=+$G(INIEN),INSRMC=+$G(INSRMC),INUIF=+$G(INUIF),INLOG=+$G(INLOG)
;
S MSG=INFN_"^"_INIEN_"^"_INSRMC_"^"_INUIF_"^"_$G(INSRCTL("INDEST"))
D:INENVSDB ; Use pointers only, unless in DEBUG mode.
.S MSG="INVALID FILE NUMBER IN LOG ROUTINE"
.S %=$G(^DIC(INFN,0,"GL")) D:$L(%) ;
..K MSG S MSG(1)="Suppressed at "_$O(^DD(INFN,0,"NM",""))_" file, "
..I $G(INSRCTL("INDEST")) S X="^INRHD("_(INSRCTL("INDEST"))_",0)" S:$D(@X)#2 MSG(5)=" for dest "_$P(@X,"^")
..S X=%_(INIEN)_",0)" S MSG(2)=$P($G(@X),"^")_" record, "
..S MSG(3)=$P($G(^DD(INFN,INSRMC,0)),"^")_" field, "
..S X=%_(INIEN)_","_(INSRMC)_")"
..S MSG(4)=" with code "_$G(@X)
;
I 'INUIF!INENVSDB D
.;File in IEF via INHE
.I $G(INSRCTL("INSRPROC"))="XMT" D ENT^INHE(INUIF,$G(INSRCTL("INDEST")),.MSG) Q
.I $G(INSRCTL("INSRPROC"))="REP" D ENO^INHE($G(INSRCTL("INTT")),INUIF,$G(INSRCTL("INDEST")),.MSG) Q
.D ENR^INHE(+$G(INSRCTL("INBPC")),.MSG)
;
Q:'INUIF
;
;File in UIF (ACTIVITY LOG MULTIPLE) via ULOG^INHU
I 'INENVSDB K MSG D ULOG^INHU(INUIF,"X",.MSG,"",1) ;Update multiple.
D:INENVSDB ULOG^INHU(INUIF,"X",.MSG,"",1) ;Update multiple w/ MSG
D:INLOG ULOG^INHU(INUIF,"C") ; Update status.
Q
;
INHUT6 ; CHEM,KAC ; 6 May 97 17:03; HL7 Utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
SUPPRESS(INPROC,INTT,INDEST,INBPC,INA,INDA,INUIF,INMSH) ; $$function - Identify
+1 ; application screening logic based on precedence at a particular
+2 ; GIS process screening point and execute (if exists).
+3 ;
+4 ; Input:
+5 ; INPROC - (req) function of calling process
+6 ; "XMT" = Transmitter
+7 ; "RCV" = Receiver
+8 ; INTT - (opt) INTERFACE TRANSACTION TYPE IEN
+9 ; INDEST - (opt) INTERFACE DESTINATION IEN (lowest level)
+10 ; Lowest level destination has Route IDs.
+11 ; INBPC - (opt) BACKGROUND PROCESS CONTROL IEN
+12 ; INA - (opt) "INA" or "^INTHU(IEN,7)" (UNIVERSAL INTERFACE file).
+13 ; Location of [selected subnodes of] the INA array.
+14 ; Selected subnodes of INA array are merged into
+15 ; the outbound message by the Format Controller
+16 ; after outbound script execution. Used by
+17 ; application teams' screening logic (@INA@("node")).
+18 ; INDA - (opt) "INDA" or "^INTHU(IEN,6)" (UNIVERSAL INTERFACE file).
+19 ; Location of INDA array. INDA array is merged into
+20 ; the outbound message by the Format Controller
+21 ; prior to outbound script execution. Used by
+22 ; application teams' screening logic (@INDA@("node")).
+23 ; INUIF - (opt) UNIVERSAL INTERFACE IEN of message to be screened
+24 ; INMSH - (opt) HL7 Message Header (MSH) string (not parsed)
+25 ; Set for inbound messages at Receiver screening
+26 ; point only.
+27 ;
+28 ; Variables:
+29 ; X - scratch
+30 ; INPRI - array - top level = precedence of screen to execute
+31 ; - descendents = information relevant to screen
+32 ; precedence and execution
+33 ; Format: INPRI(X)=File#^IEN^Field # of screening logic"
+34 ; Example: INPRI=2 ; execute screen w/ precedence=2
+35 ; INPRI(1)=Precedence 1 screening info
+36 ; INPRI(2)=Precedence 2 screening info
+37 ; INPRI(3)=Precedence 3 screening info
+38 ; INSRCTL - array - screening logic control information
+39 ; "INSRPROC" - identifies GIS process currently executing
+40 ; "XMT" = Transmitter
+41 ; "RCV" = Receiver
+42 ; "INTT" - INTERFACE TRANSACTION IEN
+43 ; "INDEST" - INTERFACE DESTINATION IEN (lowest level)
+44 ; Lowest level destination has Route IDs.
+45 ; "INBPC" - BACKGROUND PROCESS CONTROL IEN
+46 ; "MSH" - HL7 Message Header (MSH) string (not parsed)
+47 ; from inbound msg
+48 ; INSRDATA - array - screening logic return values
+49 ; false = send msg
+50 ; true = suppress msg
+51 ; "Route ID" - identifies destination to which to route msg.
+52 ; Multiple entries are allowed.
+53 ; INSRMC - selective routing M code to be executed as a screen at
+54 ; this screening point
+55 ; INSUPRES - flag - function return value
+56 ; 0 = send msg
+57 ; 1 = suppress msg
+58 ;
+59 ; Output:
+60 ; 0 = deliver msg to destination
+61 ; 1 = suppress msg (no delivery to destination)
+62 ;
+63 NEW INPRI,INSRCTL,INSRDATA,INSRMC,INSUPRES,X
+64 ;
+65 ; Initialization
+66 SET INPROC=$GET(INPROC)
SET INTT=$GET(INTT)
SET INDEST=$GET(INDEST)
SET INBPC=$GET(INBPC)
SET INUIF=$GET(INUIF)
SET INMSH=$GET(INMSH)
+67 ;
+68 ; Customizations for current screening point - File#^IEN^Screen Node
+69 ; Transmitter screens
IF INPROC="XMT"
Begin DoDot:1
+70 ; Precedence 1 = Transaction Type
+71 IF INTT
SET INPRI(1)="4000^"_INTT_"^9"
+72 ; Precedence 2 = Background Process
+73 IF INBPC
SET INPRI(2)="4004^"_INBPC_"^12"
+74 ; Precedence 3 = Primary Destination
+75 IF INDEST
Begin DoDot:2
+76 ; Primary Dest has SRMC
SET X=$PIECE($GET(^INRHD(INDEST,7)),U,2)
+77 SET INPRI(3)="4005^"_$SELECT(X:X,1:INDEST)_"^16"
End DoDot:2
End DoDot:1
+78 ;
+79 ; Receiver screens
IF INPROC="RCV"
Begin DoDot:1
+80 ; Precedence 1 = Transaction Type
+81 IF INTT
SET INPRI(1)="4000^"_INTT_"^8"
+82 ; Precedence 2 = Background Process
+83 IF INBPC
SET INPRI(2)="4004^"_INBPC_"^11"
+84 ; Precedence 3 =Inbound Destination (off of BPC)
+85 IF INDEST
Begin DoDot:2
+86 ; Primary Dest has SRMC
SET X=$PIECE($GET(^INRHD(INDEST,7)),U,2)
+87 SET INPRI(3)="4005^"_$SELECT(X:X,1:INDEST)_"^15"
End DoDot:2
+88 SET INSRCTL("MSH")=INMSH
End DoDot:1
+89 ;
+90 ; send if calling process NOT identified or no valid file/table passed in
+91 IF '$DATA(INPRI)
QUIT 0
+92 ;
+93 ; Get screen w/ highest precedence
+94 ; remember precedence of screen to be executed
SET INPRI=0
+95 FOR
SET INPRI=$ORDER(INPRI(INPRI))
IF 'INPRI
QUIT
Begin DoDot:1
+96 SET X="S INSRMC=$G("_^DIC(+INPRI(INPRI),0,"GL")_$PIECE(INPRI(INPRI),U,2)_","_$PIECE(INPRI(INPRI),U,3)_"))"
+97 ; set INSRMC = screening logic to be executed (if exists) or ""
XECUTE X
End DoDot:1
IF $LENGTH(INSRMC)
QUIT
+98 ;
+99 ; send if no screening logic in file/table
IF '$LENGTH($GET(INSRMC))
QUIT 0
+100 ;
+101 ; Initialization prior to calling screen
+102 ; function of calling process
SET INSRCTL("INSRPROC")=INPROC
+103 IF INTT
SET INSRCTL("INTT")=INTT
+104 IF INDEST
SET INSRCTL("INDEST")=INDEST
+105 IF INBPC
SET INSRCTL("INBPC")=INBPC
+106 ; execute screening logic
XECUTE INSRMC
+107 ;
+108 ; Examine screening results (in INSRDATA)
+109 ; Check:
+110 ; 1) suppress
+111 ; 2) broadcast, no list
+112 ; 3) broadcast, list exists - ck if Route ID for this destination
+113 ; matches INSRDATA("RouteID") returned by screen
+114 SET INSUPRES=$SELECT($GET(INSRDATA):1,$DATA(INSRDATA)<10:0,1:$SELECT($GET(INDEST):$$FINDRID^INHUT5(.INSRDATA,INDEST),1:0))
+115 ; Log suppressions
+116 IF INSUPRES
SET X=INPRI(INPRI)
DO LOG^INHUT6(+X,$PIECE(X,U,2),$PIECE(X,U,3),INUIF,$SELECT($GET(INUIF):1,1:0))
+117 QUIT INSUPRES
+118 ;
LOG(INFN,INIEN,INSRMC,INUIF,INLOG) ; Log error message.
+1 ; Add entry in the UIF ACTIVITY LOG MULTIPLE.
+2 ; Used for identifying which screening code suppressed this entry.
+3 ; If INUIF is absent, or SR debug is on,
+4 ; log message will be in the IFE file only.
+5 ; INPUTS:
+6 ; INFN File number (Should be 4000, 4004, or 4005)
+7 ; INIEN IEN w/in file that was suppressed
+8 ; INSRMC SRMC Field number
+9 ; INUIF (opt) IEN of the Universal Interface File (Optional)
+10 ; INLOG (opt) Boolean: 0 Don't update status, 1: Update status
+11 ; INENVSDB (opt) Boolean: 0 no SR debug, 1: Site SR debug is turned on
+12 ; INSRCTL("INSRPROC") (opt) Environment variable letting me know
+13 ; which gis function is calling me
+14 ; INSRCTL("INDEST") (opt) For XMT, its part of ENT^INHE call. (Dest)
+15 ; INSRCTL("INBPC") (opt) For RCV, this is part of ENR^INHE call
+16 ; INSRCTL("INTT") (opt) For REP, this is part of ENO^INHE call
+17 ;
+18 ; OUTPUTS:
+19 ; INENVSDB Boolean: 0 no debug, 1: Site debug is turned on
+20 ;
+21 NEW X,Y,%,MSG
+22 IF '$DATA(INENVSDB)
SET INENVSDB=$PIECE($GET(^INRHSITE(1,0)),"^",16)
+23 SET INFN=+$GET(INFN)
SET INIEN=+$GET(INIEN)
SET INSRMC=+$GET(INSRMC)
SET INUIF=+$GET(INUIF)
SET INLOG=+$GET(INLOG)
+24 ;
+25 SET MSG=INFN_"^"_INIEN_"^"_INSRMC_"^"_INUIF_"^"_$GET(INSRCTL("INDEST"))
+26 ; Use pointers only, unless in DEBUG mode.
IF INENVSDB
Begin DoDot:1
+27 SET MSG="INVALID FILE NUMBER IN LOG ROUTINE"
+28 ;
SET %=$GET(^DIC(INFN,0,"GL"))
IF $LENGTH(%)
Begin DoDot:2
+29 KILL MSG
SET MSG(1)="Suppressed at "_$ORDER(^DD(INFN,0,"NM",""))_" file, "
+30 IF $GET(INSRCTL("INDEST"))
SET X="^INRHD("_(INSRCTL("INDEST"))_",0)"
IF $DATA(@X)#2
SET MSG(5)=" for dest "_$PIECE(@X,"^")
+31 SET X=%_(INIEN)_",0)"
SET MSG(2)=$PIECE($GET(@X),"^")_" record, "
+32 SET MSG(3)=$PIECE($GET(^DD(INFN,INSRMC,0)),"^")_" field, "
+33 SET X=%_(INIEN)_","_(INSRMC)_")"
+34 SET MSG(4)=" with code "_$GET(@X)
End DoDot:2
End DoDot:1
+35 ;
+36 IF 'INUIF!INENVSDB
Begin DoDot:1
+37 ;File in IEF via INHE
+38 IF $GET(INSRCTL("INSRPROC"))="XMT"
DO ENT^INHE(INUIF,$GET(INSRCTL("INDEST")),.MSG)
QUIT
+39 IF $GET(INSRCTL("INSRPROC"))="REP"
DO ENO^INHE($GET(INSRCTL("INTT")),INUIF,$GET(INSRCTL("INDEST")),.MSG)
QUIT
+40 DO ENR^INHE(+$GET(INSRCTL("INBPC")),.MSG)
End DoDot:1
+41 ;
+42 IF 'INUIF
QUIT
+43 ;
+44 ;File in UIF (ACTIVITY LOG MULTIPLE) via ULOG^INHU
+45 ;Update multiple.
IF 'INENVSDB
KILL MSG
DO ULOG^INHU(INUIF,"X",.MSG,"",1)
+46 ;Update multiple w/ MSG
IF INENVSDB
DO ULOG^INHU(INUIF,"X",.MSG,"",1)
+47 ; Update status.
IF INLOG
DO ULOG^INHU(INUIF,"C")
+48 QUIT
+49 ;
