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

SDHL7UL.m

Go to the documentation of this file. 
  1. SDHL7UL ;MS/TG - TMP HL7 Routine;JULY 23, 2018
  1.  ;;5.3;Scheduling;**704**;May 29, 2018;Build 64
  1.  ;
  1.  Q  ;Direct entry not supported
  1.  ;
  1. LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing
  1.  ;
  1.  ;This subroutine assumes that all VistA HL7 environment variables are
  1.  ;properly initialized and will produce a fatal error if they aren't.
  1.  ;
  1.  N CNT,SEG
  1.  K @MSGROOT
  1.  F SEG=1:1 X HLNEXT Q:HLQUIT'>0  D
  1.  . S CNT=0
  1.  . S @MSGROOT@(SEG,CNT)=HLNODE
  1.  . F  S CNT=$O(HLNODE(CNT)) Q:'CNT  S @MSGROOT@(SEG,CNT)=HLNODE(CNT)
  1.  Q
  1.  ;
  1. LOADXMT(XMT) ;Set HL dependent XMT values
  1.  ;
  1.  ; The HL array and variables are expected to be defined.  If not,
  1.  ; message processing will fail.  These references should not be
  1.  ; wrapped in $G, as null values will simply postpone the failure to
  1.  ; a point that will be harder to diagnose.  Except HL("APAT") which
  1.  ; is not defined on synchronous calls.
  1.  ;
  1.  N SUBPROT,RESPIEN,RESP0
  1.  S XMT("MID")=HL("MID")                   ;Message ID
  1.  S XMT("MODE")="A"                        ;Response mode
  1.  I $G(HL("APAT"))="" S XMT("MODE")="S"    ;Synchronous mode
  1.  S XMT("HLMTIENS")=HLMTIENS               ;Message IEN
  1.  S XMT("MESSAGE TYPE")=HL("MTN")          ;Message type
  1.  S XMT("EVENT TYPE")=HL("ETN")            ;Event type
  1.  S XMT("DELIM")=HL("FS")_HL("ECH")        ;HL Delimiters
  1.  S XMT("MAX SIZE")=0                      ;Default size unlimited
  1.  ;
  1.  ; Map response protocol and builder
  1.  S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^")
  1.  Q
  1.  ;
  1. DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol
  1.  ;
  1.  ;  Integration Agreements:
  1.  ;         2161 : INIT^HLFNC2
  1.  ;
  1.  N HL
  1.  Q:PROTOCOL="" ""
  1.  D INIT^HLFNC2(PROTOCOL,.HL)
  1.  Q $G(HL("FS"))_$G(HL("ECH"))
  1.  ;
  1. PARSEMSG(MSGROOT,HL) ; Message Parser
  1.  ; Does not handle segments that span nodes
  1.  ; Does not handle extremely long segments (uses a local)
  1.  ; Does not handle long fields (segment parser doesn't)
  1.  ;
  1.  N SEG,CNT,DATA,MSG
  1.  F CNT=1:1 Q:'$D(@MSGROOT@(CNT))  M SEG=@MSGROOT@(CNT) D
  1.  . D PARSESEG(SEG(0),.DATA,.HL)
  1.  . K @MSGROOT@(CNT)
  1.  . I DATA(0)'="" M @MSGROOT@(CNT)=DATA
  1.  . Q:'$D(SEG(1))
  1.  . ;Add handler for segments that span nodes here.
  1.  . Q
  1.  Q
  1.  ;
  1. PARSESEG(SEG,DATA,HL) ;Generic segment parser
  1.  ;This procedure parses a single HL7 segment and builds an array
  1.  ;subscripted by the field number containing the data for that field.
  1.  ; Does not handle segments that span nodes
  1.  ;
  1.  ;  Input:
  1.  ;     SEG - HL7 segment to parse
  1.  ;      HL - HL7 environment array
  1.  ;
  1.  ;  Output:
  1.  ;    Function value - field data array [SUB1:field, SUB2:repetition,
  1.  ;                                SUB3:component, SUB4:sub-component] 
  1.  ;
  1.  N CMP     ;component subscript
  1.  N CMPVAL  ;component value
  1.  N FLD     ;field subscript
  1.  N FLDVAL  ;field value
  1.  N REP     ;repetition subscript
  1.  N REPVAL  ;repetition value
  1.  N SUB     ;sub-component subscript
  1.  N SUBVAL  ;sub-component value
  1.  N FS      ;field separator
  1.  N CS      ;component separator
  1.  N RS      ;repetition separator
  1.  N SS      ;sub-component separator
  1.  ;
  1.  K DATA
  1.  S FS=HL("FS")
  1.  S CS=$E(HL("ECH"))
  1.  S RS=$E(HL("ECH"),2)
  1.  S SS=$E(HL("ECH"),4)
  1.  ;
  1.  S DATA(0)=$P(SEG,FS)
  1.  S SEG=$P(SEG,FS,2,9999)
  1.  F FLD=1:1:$L(SEG,FS) D
  1.  . S FLDVAL=$P(SEG,FS,FLD)
  1.  . F REP=1:1:$L(FLDVAL,RS) D
  1.  . . S REPVAL=$P(FLDVAL,RS,REP)
  1.  . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D
  1.  . . . S CMPVAL=$P(REPVAL,CS,CMP)
  1.  . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D
  1.  . . . . S SUBVAL=$P(CMPVAL,SS,SUB)
  1.  . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL
  1.  . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL
  1.  . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL
  1.  . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL
  1.  Q
  1.  ;
  1. BLDSEG(DATA,HL) ;generic segment builder
  1.  ;
  1.  ;  Input:
  1.  ;    DATA - field data array [SUB1:field, SUB2:repetition,
  1.  ;                             SUB3:component, SUB4:sub-component]
  1.  ;     HL - HL7 environment array
  1.  ;
  1.  ;  Output:
  1.  ;   Function Value - Formatted HL7 segment on success, "" on failure
  1.  ;
  1.  N CMP     ;component subscript
  1.  N CMPVAL  ;component value
  1.  N FLD     ;field subscript
  1.  N FLDVAL  ;field value
  1.  N REP     ;repetition subscript
  1.  N REPVAL  ;repetition value
  1.  N SUB     ;sub-component subscript
  1.  N SUBVAL  ;sub-component value
  1.  N FS      ;field separator
  1.  N CS      ;component separator
  1.  N RS      ;repetition separator
  1.  N ES      ;escape character
  1.  N SS      ;sub-component separator
  1.  N SEG,SEP
  1.  ;
  1.  S FS=HL("FS")
  1.  S CS=$E(HL("ECH"))
  1.  S RS=$E(HL("ECH"),2)
  1.  S ES=$E(HL("ECH"),3)
  1.  S SS=$E(HL("ECH"),4)
  1.  ;
  1.  S SEG=$G(DATA(0))
  1.  F FLD=1:1:$O(DATA(""),-1) D
  1.  . S FLDVAL=$G(DATA(FLD)),SEP=FS
  1.  . S SEG=SEG_SEP_FLDVAL
  1.  . F REP=1:1:$O(DATA(FLD,""),-1)  D
  1.  . . S REPVAL=$G(DATA(FLD,REP))
  1.  . . S SEP=$S(REP=1:"",1:RS)
  1.  . . S SEG=SEG_SEP_REPVAL
  1.  . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D
  1.  . . . S CMPVAL=$G(DATA(FLD,REP,CMP))
  1.  . . . S SEP=$S(CMP=1:"",1:CS)
  1.  . . . S SEG=SEG_SEP_CMPVAL
  1.  . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D
  1.  . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB))
  1.  . . . . S SEP=$S(SUB=1:"",1:SS)
  1.  . . . . S SEG=SEG_SEP_SUBVAL
  1.  Q SEG
  1.  ;
  1. RESET ; Initialize or clear session pointer into log
  1.  K ^TMP("SDHL7LOG",$J)
  1.  Q
  1. LOGPRG(RESULT,DTM) ;Purge SDHL7 application log
  1.  ;
  1.  ;  Input:
  1.  ;    DTM - Purge Date/Time - optional
  1.  ;          Fileman date/time
  1.  ;          Default to older than a week
  1.  ;
  1.  ;  Output:
  1.  ;    RESULT - success flag ^ purge date/time
  1.  ;
  1.  N %DT,X,Y
  1.  S X=$G(DTM),%DT="TX" D ^%DT S DTM=Y
  1.  I DTM<0 S DTM=$$HTFM^XLFDT($H-7,1)
  1.  S RESULT=DTM
  1.  S DTM=-DTM
  1.  F  S DTM=$O(^XTMP("SDHL7LOG",2,DTM)) Q:DTM=""  K ^XTMP("SDHL7LOG",2,DTM)
  1.  S RESULT="1^"_RESULT
  1.  Q
  1.  ; 
  1. AUTOPRG ;
  1.  Q:'$G(^XTMP("SDHL7LOG",1,"AUTOPURGE"))
  1.  N DT,DAYS,RESULT
  1.  ; Purge only once per day
  1.  S DT=$$DT^XLFDT
  1.  Q:$G(^XTMP("SDHL7LOG",1,"AUTOPURGE","PURGE DATE"))=DT
  1.  ;
  1.  S DAYS=$G(^XTMP("SDHL7LOG",1,"AUTOPURGE","DAYS"))
  1.  I DAYS<1 S DAYS=7
  1.  ;
  1.  D LOGPRG(.RESULT,$$HTFM^XLFDT($H-DAYS,1))
  1.  S ^XTMP("SDHL7LOG",1,"AUTOPURGE","PURGE DATE")=DT
  1.  Q
  1.  ; 
  1. LOG(NAME,DATA,TYPE,LEVEL) ;Log to SDHL7 application log
  1.  ;
  1.  ;  Input:
  1.  ;    NAME - Name to identify log entry
  1.  ;    DATA - Value,Tree, or Name of structure to put in log
  1.  ;    TYPE - Type of log entry
  1.  ;              S:Set Single Value
  1.  ;              M:Merge Tree 
  1.  ;              I:Indirect Merge @
  1.  ;   LEVEL - Level of log entry - ERROR,TRACE,NAMED,DEBUG
  1.  ;
  1.  ;  Output:
  1.  ;    Adds entry to log
  1.  ;
  1.  ; ^XTMP("SDHL7LOG",0) - Head of log file
  1.  ; ^XTMP("SDHL7LOG",1) - if set indicates that logging is on
  1.  ; ^XTMP("SDHL7LOG",1,"LEVEL") - logging level
  1.  ; ^XTMP("SDHL7LOG",1,"LEVEL",LEVEL) = rank
  1.  ; ^XTMP("SDHL7LOG",1,"NAMES",) - names to log caret delimited string
  1.  ; ^XTMP("SDHL7LOG",1,"NAMES",NAME) - name to log
  1.  ; ^XTMP("SDHL7LOG",2) - contains the log
  1.  ; ^XTMP("SDHL7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry
  1.  ;
  1.  ; ^TMP("SDHL7LOG",$J) - Session current log entry (DTM)
  1.  ;
  1.  ;Quit if logging is not turned on
  1.  Q:'$G(^XTMP("SDHL7LOG",1))
  1.  N DTM,CNT,LOGLEVEL
  1.  ;
  1.  Q:'$D(DATA)
  1.  Q:$G(TYPE)=""
  1.  Q:$G(NAME)=""
  1.  S NAME=$TR(NAME,"^","-")
  1.  ;
  1.  ;If LEVEL is null or unknown default to DEBUG
  1.  I $G(LEVEL)="" S LEVEL="DEBUG"
  1.  I '$D(^XTMP("SDHL7LOG",1,"LEVEL",LEVEL)) S LEVEL="DEBUG"
  1.  ;
  1.  ;Log entries at or lower than the current logging level set
  1.  ;Levels are ranked as follows:
  1.  ;  ^XTMP("SDHL7LOG",1,"LEVEL","ERROR")=1
  1.  ;  ^XTMP("SDHL7LOG",1,"LEVEL","TRACE")=2
  1.  ;  ^XTMP("SDHL7LOG",1,"LEVEL","NAMED")=3
  1.  ;  ^XTMP("SDHL7LOG",1,"LEVEL","DEBUG")=4
  1.  ;Named is like a filtered version of debug.
  1.  ;Additional levels may be added, and ranks changed without affecting
  1.  ;the LOG api.  Inserting a level between Named and Debug will require
  1.  ;a change to the conditional below.
  1.  S LOGLEVEL=$G(^XTMP("SDHL7LOG",1,"LEVEL"))
  1.  I LOGLEVEL="" S LOGLEVEL="TRACE"
  1.  I $G(^XTMP("SDHL7LOG",1,"LEVEL",LEVEL))>$G(^XTMP("SDHL7LOG",1,"LEVEL",LOGLEVEL)) Q:LOGLEVEL'="NAMED"  Q:'$D(^XTMP("SDHL7LOG",1,"NAMES",NAME))
  1.  ;
  1.  ; Check ^TMP("SDHL7LOG",$J) If no current log node start a new node
  1.  I '$G(^TMP("SDHL7LOG",$J)) D
  1.  . S DTM=-$$NOW^XLFDT()
  1.  . K ^XTMP("SDHL7LOG",2,DTM,$J)
  1.  . S ^TMP("SDHL7LOG",$J)=DTM
  1.  . S CNT=1
  1.  . S ^XTMP("SDHL7LOG",2,DTM,$J)=CNT
  1.  . D AUTOPRG
  1.  . Q
  1.  E  D
  1.  . S DTM=^TMP("SDHL7LOG",$J)
  1.  . S CNT=$G(^XTMP("SDHL7LOG",2,DTM,$J))+1
  1.  . S ^XTMP("SDHL7LOG",2,DTM,$J)=CNT
  1.  . Q
  1.  ;
  1.  I TYPE="S" S ^XTMP("SDHL7LOG",2,DTM,$J,CNT,NAME)=DATA Q
  1.  I TYPE="M" M ^XTMP("SDHL7LOG",2,DTM,$J,CNT,NAME)=DATA Q
  1.  I TYPE="I" M ^XTMP("SDHL7LOG",2,DTM,$J,CNT,NAME)=@DATA Q
  1.  ;
  1.  Q
  1. ESCAPE(VAL,HL) ;Escape any special characters
  1.  ; *** Does not handle long strings of special characters ***
  1.  ;
  1.  ;  Input:
  1.  ;    VAL - value to escape
  1.  ;     HL - HL7 environment array
  1.  ;
  1.  ;  Output:
  1.  ;    VAL - passed by reference
  1.  ;
  1.  N FS      ;field separator
  1.  N CS      ;component separator
  1.  N RS      ;repetition separator
  1.  N ES      ;escape character
  1.  N SS      ;sub-component separator
  1.  N L,STR,I
  1.  ;
  1.  S FS=HL("FS")
  1.  S CS=$E(HL("ECH"))
  1.  S RS=$E(HL("ECH"),2)
  1.  S ES=$E(HL("ECH"),3)
  1.  S SS=$E(HL("ECH"),4)
  1.  ;
  1.  I VAL[ES D
  1.  . S L=$L(VAL,ES),STR=""
  1.  . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I)
  1.  . S VAL=STR
  1.  I VAL[FS D
  1.  . S L=$L(VAL,FS),STR=""
  1.  . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I)
  1.  . S VAL=STR
  1.  I VAL[RS D
  1.  . S L=$L(VAL,RS),STR=""
  1.  . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I)
  1.  . S VAL=STR
  1.  I VAL[CS D
  1.  . S L=$L(VAL,CS),STR=""
  1.  . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I)
  1.  . S VAL=STR
  1.  I VAL[SS D
  1.  . S L=$L(VAL,SS),STR=""
  1.  . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I)
  1.  . S VAL=STR
  1.  Q VAL
  1.  ;