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

INHUT5.m

Go to the documentation of this file. 
  1. INHUT5 ;JPD,KAC; 6 Feb 96 13:25;utilities 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  Q
  1.  ;
  1. INITIALS(X) ;Make initials from name
  1.  ; Input: X (req) = name from which to extract initials
  1.  ;                  format : LAST,FIRST MIDDLE
  1.  ; Output: returns initials
  1.  Q $E($P(X,",",2))_$E($P(X," ",2))_$E(X)
  1. NUM(X) ;--Converts a string to a number
  1.  ; Input - X - String
  1.  ; Returns - Numeric value
  1.  N I,Y
  1.  S Y="" F I=1:1:$L(X) S:"-.0123456789"[$E(X,I) Y=Y_$E(X,I)
  1.  Q +Y
  1. RPTFOOT() ;Report Footer
  1.  F  Q:$Y'<($G(IOSL)-5)  W !
  1.  W !,?IOM/2-11,"*** End of Report ***"
  1.  I $E(IOST)="C" W ! I $$CR^UTSRD
  1.  Q ""
  1. DATIM() ;date/time function
  1.  ; Returns: Y - Date/time
  1.  N Y,%,%H,%I,X
  1.  D NOW^%DTC S Y=% D DD^%DT
  1.  Q Y
  1.  ;
  1. MUMPS ; Input transform for Selective Routing M Code free text fields (SRMC).
  1.  ; Customized input transform adds ability to check for application
  1.  ; team code that uses argumentless Locks or Kills.
  1.  ;
  1.  ; Input:
  1.  ; X = value input by user
  1.  ;
  1.  ; Output:
  1.  ; Kill X if value entered doesn't meet restrictions imposed by 
  1.  ; transform.
  1.  ;
  1.  Q:'$D(X)
  1.  ; disallow argumentless Locks
  1.  I (X?1"L"." ")!(X?.E1" "1"L"2" ".E)!(X?.E1" "1"L"." ")!(X?1"LOCK"." ")!(X?.E1" "1"LOCK"2" ".E)!(X?.E1" "1"LOCK"." ") K X Q
  1.  ; disallow argumentless Kills
  1.  I (X?1"K"." ")!(X?.E1" "1"K"2" ".E)!(X?.E1" "1"K"." ")!(X?1"KILL"." ")!(X?.E1" "1"KILL"2" ".E)!(X?.E1" "1"KILL"." ") K X Q
  1.  I $$SC^INHUTIL1 D MUMPS^DIED ; validate M syntax
  1.  ;;Modified for IHS to call DIM directly
  1.  I '$$SC^INHUTIL1 D ^DIM
  1.  Q
  1.  ;
  1. FINDRID(INSRDATA,INDEST) ; $$function - Determine if there is a match of
  1.  ; RouteID in 1st subscript of INSRDATA array
  1.  ; Input:
  1.  ; INSRDATA - array of RouteID nodes to be checked with Destination Route ID table
  1.  ; INDEST   - INTERFACE DESTINATION IEN containing list of RouteIDs to ck
  1.  ;
  1.  ; Output:
  1.  ; 1: Match NOT-FOUND
  1.  ; 0: Match FOUND
  1.  ;
  1.  N %,FNDDEST
  1.  ; Loop through INSRDATA("RouteID") using "B" xref to identify a match in
  1.  ; the destination's Route ID table
  1.  S FNDDEST=1,%="" F  S %=$O(INSRDATA(%)) Q:'$L(%)  I $O(^INRHD(INDEST,9,"B",%,0)) S FNDDEST=0 Q
  1.  Q FNDDEST
  1.  ;
  1. RCVSCRN(INSRCTL,INSRDATA,INA,INDA) ; Default Inbound Receiver screen.
  1.  ; Provides screening logic based on minimum requirements for 
  1.  ; accepting a message at the Receiver process.
  1.  ;
  1.  ; Logic: If Receiving Facility field in MSH of inbound msg matches
  1.  ; a Route ID entry for this inbound destination, accept msg into
  1.  ; database, else, suppress receipt of msg.
  1.  ;
  1.  ; Called by: Application entry point (RCVSCRN^INHUT).
  1.  ;            D RCVSCRN^INHUT5(.INSRCTL,.INSRDATA,.INA,.INDA)
  1.  ;
  1.  ; Input:
  1.  ; INSRCTL  - array - screening logic control information
  1.  ;   "INTT"     - (opt) INTERFACE TRANSACTION IEN for inbound msg
  1.  ;   "INDEST"   - (req) INTERFACE DESTINATION IEN for inbound msg
  1.  ;   "INBPC"    - (opt) BACKGROUND PROCESS CONTROL IEN for inbound msg
  1.  ;   "MSH"      - (req) HL7 Message Header (MSH) string (not parsed)
  1.  ;                      from inbound msg
  1.  ; INA      - (opt) Not used.
  1.  ; INDA     - (opt) Not used.
  1.  ;
  1.  ; Variables:
  1.  ; INDELIM  - HL7 Field Separator for inbound msg
  1.  ; INRCVFAC - HL7 Receiving Facility field from inbound msg
  1.  ;
  1.  ; Output:
  1.  ; INSRDATA - (pbr) array - screening logic return values
  1.  ;                  false = receive msg into database
  1.  ;                  true  = suppress receipt of msg
  1.  ;   "Route ID" - identifies system to which to route msg.  Multiple
  1.  ;                entries are allowed.
  1.  ;
  1.  N INDELIM,INRCVFAC
  1.  K INSRDATA
  1.  I '$L($G(INSRCTL("MSH"))) S INSRDATA=0 Q  ; no MSH - receive msg
  1.  ;
  1.  ; get Receiving Facility field from msg
  1.  S INDELIM=$E(INSRCTL("MSH"),4)
  1.  S INRCVFAC=$P(INSRCTL("MSH"),INDELIM,6)
  1.  ;
  1.  I $L(INRCVFAC) S INSRDATA(INRCVFAC)="" Q  ; return Route ID for lookup
  1.  ;
  1.  ; Receiving Facility = ""
  1.  ; 1) no DEST - receive msg
  1.  ; 2) Route IDs exist - suppress msg
  1.  ;    NO Route IDs - receive msg
  1.  S INSRDATA=$S('$G(INSRCTL("INDEST")):0,1:$D(^INRHD(INSRCTL("INDEST"),9,"B")))
  1.  Q
  1.  ;