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

INHMS1.m

Go to the documentation of this file. 
  1. INHMS1 ;DJL; 18 Jun 99 13:51;Interface - Message Search
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1. EXPAND ;Expand-action logic on List Processor field
  1.  ; MODULE NAME: EXPAND (Expand-action logic for ^DWL )
  1.  ; DESCRIPTION: Expand using INH MESSAGE DISPLAY print
  1.  ;              template.
  1.  ; RETURN = none
  1.  ; PARAMETERS = none
  1.  ; CODE BEGINS
  1.  N I,X,DIC,DR,DHD,DW,DWCP,INIO,DIE,DA
  1.  Q:'$D(@DWLRF@($P(@DWLRF,U,4),0))
  1.  D CLEAR^DW
  1.  S %ZIS="N" D ^%ZIS Q:POP  S INIO=IO,IOP=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  S DA(@DWLRF@($P(@DWLRF,U,4),0))=""
  1.  S DR="INH MESSAGE DISPLAY",DIC=4001,DHD="@" D PRTLIST^DWPR
  1.  S:INIO=IO X=$$CR^UTSRD
  1.  Q
  1.  ;
  1. INMSPAT(INIEN,INPAT,INPATNAM) ; Test msg. for a patient match
  1.  ; MODULE NAME: INMSPAT (Interface Message PATIENT Search)
  1.  ; DESCRIPTION: Search ^INTHU( INIEN ) message PID segment for matching
  1.  ;               values to the string: INPAT. Using CHCS patient IEN for
  1.  ;               outbound messages and FMP/SSN for inbound messages
  1.  ; RETURN= PASS/FAIL (1/0) and patient found set in INPATNAM 
  1.  ; PARAMETERS:
  1.  ;   INIEN= The IEN of the message in the ^INTHU message file
  1.  ;   INPAT= The patients internal IEN from the ^DPT file
  1.  ;   INPATNAM= The patient name found in the message ("" if none)
  1.  ; CODE BEGINS
  1.  S INPATNAM=$G(INPATNAM),INPAT=+$G(INPAT)
  1.  Q:'INIEN 0
  1.  N INPATFND,INDPTNAM,INDPTSSN,INPIDFND,INBLDCT,INBLDTXT,INDEL,INSUBDEL,INQUIT
  1.  I $$MSGSTD^INHUTC51(INIEN)="NCPDP" Q $$INNCPAT^INHUTC51(INIEN,$G(INSRCH("INPAT")))
  1.  ;
  1.  S (INPATFND,INPIDFND,INBLDCT)=0,INBLDTXT="" D GETLINE^INHOU(INIEN,.INBLDCT,.INBLDTXT)
  1.  Q:'$D(INBLDTXT) 0
  1.  ; if 'MSH' begins the string then get delimiters for the msg.
  1.  ;    and loop thru msg. until 'PID' segment is found
  1.  I $E(INBLDTXT,1,3)="MSH" S INDEL=$E(INBLDTXT,4),INSUBDEL=$E(INBLDTXT,5),INQUIT=0 F  Q:INQUIT  D
  1.  .  D GETLINE^INHOU(INIEN,.INBLDCT,.INBLDTXT)
  1.  .  I '$D(INBLDTXT) S INQUIT=1 Q
  1.  .  S:$E(INBLDTXT,1,3)="PID" (INQUIT,INPIDFND)=1
  1.  ; if the 'PID' segment is found look into the segment to match
  1.  ;  the patients IEN if 'Outbound' msg. or name & FMPSSN if
  1.  ;  'Inbound' msg.
  1.  D:INPIDFND
  1.  .; set the patient name variable
  1.  .  S INPATNAM=$P(INBLDTXT,INDEL,6)
  1.  .; check the OUTBOUND msg with the patient IEN for uniqueness
  1.  .  I $P(^INTHU(INIEN,0),U,10)="O" S:+$P(INBLDTXT,INDEL,4)=INPAT INPATFND=1
  1.  .  I $P(^INTHU(INIEN,0),U,10)="I" D
  1.  ..; for INBOUND msg check the patients name AND FMP/SSN matches
  1.  ..;     for uniqueness
  1.  ..    S INDPTNAM=$P($G(^DPT(INPAT,0)),U,1),INDPTSSN=$P($G(^DPT(INPAT,0)),U,15)
  1.  ..    I (INPATNAM=$$PN^INHUT(INDPTNAM)),($TR($P(INBLDTXT,INDEL,5),"-","")=INDPTSSN) S INPATFND=1
  1.  .  S INPATNAM=$$HLPN^INHUT1(INPATNAM,INSUBDEL)
  1.  Q INPATFND
  1.  ;
  1. INMSRCH(INMSTEXT,INMIEN,INMLOGIC) ; Test msg. for text-string match(multi)
  1.  ; MODULE NAME: INMSRCH (Interface Message MESSAGE Search)
  1.  ; DESCRIPTION: Search ^INTHU( INMIEN ) message for matching values to
  1.  ;              the search string array: INMSTEXT.
  1.  ; RETURN= PASS/FAIL (1/0)
  1.  ; PARAMETERS:
  1.  ;   INMSTEXT= search string array with base node("INTEXT") set to
  1.  ;             subscript count value and subscript nodes containing
  1.  ;             the strings
  1.  ;   INMIEN= The IEN of the message in the ^INTHU message file
  1.  ;   INMLOGIC= The matching logic switch set to 1 or 0
  1.  ;             1= ANDing functionality RE:all strings must be found
  1.  ;                in the message
  1.  ;             0= ORing functionality RE:only one string need match
  1.  ; CODE BEGINS
  1.  N X,INMFOUND,INMQUIT,INMCT,INMLINE,INMNODE
  1.  S (INMFOUND,INMQUIT,INMCT)=0,INMLINE="",INMNODE=1
  1.  F  Q:INMQUIT!INMFOUND  D
  1.  .  D GETLINE^INHOU(INMIEN,.INMCT,.INMLINE)
  1.  .  I '$D(INMLINE) S INMQUIT=1 Q
  1.  .; loop through the strings for the current message
  1.  .  S INMFOUND=$$INLSRCH(.INMSTEXT,.INMLINE,.INMFOUND,INMLOGIC)
  1.  .; no items were found or AND functionality is used.
  1.  .; test if any of INMFOUND(n) are not TRUE quit with 0 returned
  1.  .  I INMLOGIC S INMFOUND=1,X="" F  S X=$O(INMSTEXT("INTEXT",X)) Q:'X  I '$D(INMFOUND(X)) S INMFOUND=0 Q
  1.  Q INMFOUND
  1.  ;
  1. INLSRCH(SRCHTEXT,MSGTEXT,INFOUND,INLOGIC) ; Test msg. for text-string
  1.  ;                                          match(one line)
  1.  ; MODULE NAME: INLSRCH (Interface Message LINE Search)
  1.  ; DESCRIPTION: To find a search string in a message which may be a
  1.  ;              continuation line or not. The search line MAY be
  1.  ;              split across multiple lines.
  1.  ; RETURN= PASS/FAIL (1/0)
  1.  ; PARAMETERS:
  1.  ;   SRCHTEXT= The array of search string containing less than a 70 char.
  1.  ;             count value and subscript nodes containing the strings
  1.  ;   MSGTEXT= NON-HL7 message text/array typical of those returned by
  1.  ;            GETLINE^INHOU.
  1.  ;   INFOUND= The array used to indicate strings matches found.
  1.  ;   INLOGIC= The flag indicating the type(OR/AND) of logic used with
  1.  ;            matching message data and the search strings.
  1.  ; CODE BEGINS
  1.  N BUF,INQUIT,INNODE
  1.  ; pack the message into 250 char./node message
  1.  D MSGPACK(.MSGTEXT)
  1.  S BUF=MSGTEXT,(INFOUND,INQUIT)=0
  1.  F  Q:INFOUND!INQUIT  D
  1.  .; loop thru the strings(SRCHTEXT("INTEXT")) to match
  1.  .; setting a corresponding node(INFOUND(n))=TRUE if a match is
  1.  .; found. quit on a single 'find' for OR functionality
  1.  .  S INNODE="" F  S INNODE=$O(SRCHTEXT("INTEXT",INNODE)) Q:'INNODE  I BUF[SRCHTEXT("INTEXT",INNODE) S INFOUND(INNODE)=1 I 'INLOGIC S INFOUND=1 Q
  1.  .; if OR functionity and a message was found then quit looping thru
  1.  .; this message
  1.  .  I 'INLOGIC,INFOUND Q
  1.  .;  quit if there are no more lines to test
  1.  .  I '$O(MSGTEXT("")) S INQUIT=1 Q
  1.  .;  move the last 69 char to the front of buffer and repack the array
  1.  .  S MSGTEXT=$E(BUF,181,999) D MSGPACK(.MSGTEXT) S BUF=MSGTEXT
  1.  .  Q
  1.  Q INFOUND
  1.  ;
  1. MSGPACK(INMSGTXT) ; pack a subscripted array into 250 char./node
  1.  ; MODULE NAME: MSGPACK (Interface Message Segment Packer)
  1.  ; DESCRIPTION: Interface message segments can extend beyond
  1.  ;              250 char. by spanning multiple nodes. These nodes
  1.  ;              are not required to be 250 char. long but string
  1.  ;              searchs are more efficient if larger strings are
  1.  ;              tested. This routine packs an extended message
  1.  ;              segment to the smallest num. of 250 char./node
  1.  ;              possible. Deleting empty nodes in the process.
  1.  ; RETURN= none
  1.  ; PARAMETERS:
  1.  ;   INMSGTXT= The array containing the message.
  1.  ; CODE BEGINS
  1.  N INLINE,INBUFLEN,INNEXT,INFOUND,INQUIT
  1.  ; test for non-subscripted first node if found pack first node here
  1.  I '$O(INMSGTXT(0)) Q
  1.  S INBUFLEN=$L(INMSGTXT),INLINE=$O(INMSGTXT(""))
  1.  S INMSGTXT=INMSGTXT_$E(INMSGTXT(INLINE),1,250-INBUFLEN)
  1.  S INMSGTXT(INLINE)=$E(INMSGTXT(INLINE),251-INBUFLEN,999)
  1.  I '$L(INMSGTXT(INLINE)) K INMSGTXT(INLINE) S INLINE=$O(INMSGTXT(INLINE))
  1.  ;  pack the SUBSCRIPTED message if it is a continued message and any
  1.  ;  of the lines are not full 250 char. lines 
  1.  I INLINE,$O(INMSGTXT(INLINE)) S INQUIT=0 F  D  Q:INQUIT!'$O(INMSGTXT(INLINE))
  1.  .  S INBUFLEN=$L(INMSGTXT(INLINE)),INNEXT=$O(INMSGTXT(INLINE))
  1.  .; append the next line to the current line (up to 250 char. len.)
  1.  .  S INMSGTXT(INLINE)=INMSGTXT(INLINE)_$E(INMSGTXT(INNEXT),1,250-INBUFLEN)
  1.  .; remove the chars. from the next line that were appended to the
  1.  .; current line
  1.  .  S INMSGTXT(INNEXT)=$E(INMSGTXT(INNEXT),251-INBUFLEN,999)
  1.  .; if the current line is still not full delete the now empty next
  1.  .;  node and don't update the current line index
  1.  .  K:'$L(INMSGTXT(INNEXT)) INMSGTXT(INNEXT)
  1.  .  I $L(INMSGTXT(INLINE))=250 S INLINE=$O(INMSGTXT(INLINE))
  1.  .  Q
  1.  Q
  1.  ;