- 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 ;