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

HLTF0.m

Go to the documentation of this file. 
  1. HLTF0 ;AISC/SAW,JRP - File Data in Message Text File ;05/05/2000  09:01
  1.  ;;1.6;HEALTH LEVEL SEVEN;**12,19,64,91,109**;Oct 13, 1995
  1.  ;
  1. STATUS(MTIEN,STATUS,ERR,ERRTEXT,COMDT,NOEVENT) ;Update Status of Entry in Message Text File and log an event for errors
  1.  ;
  1.  ;This is a subroutine call with parameter passing.  No output
  1.  ;parameters are returned
  1.  ;
  1.  ;$D(HLTCP) will determine if you are updating file 773, instead
  1.  ; of file 772.
  1.  ;Required Input Parameters
  1.  ;    MTIEN = IEN of entry in file 772 or 773, to be updated
  1.  ;   STATUS = IEN of new status (pointer to Message Status file)
  1.  ;Optional Parameters
  1.  ;      ERR = IEN of error message (pointer to Error Message file)
  1.  ;  ERRTEXT = An error message of up to 200 characters
  1.  ;    COMDT = 0/1 ; 1=update DATE/TIME PROCESSED, field 100
  1.  ;  NOEVENT = 1 if an event should NOT be logged.  Presumably this signals that the application already logged the event
  1.  ;
  1.  ;Check for required parameters
  1.  I '$G(MTIEN)!('$G(STATUS)) Q
  1.  ;File new status info
  1.  N HLJ,HLOCK,X
  1.  ;if TCP update status in file 773, else status in file 772
  1.  I $D(HLTCP) S X="HLJ(773,",HLOCK="^HLMA("
  1.  E  S X="HLJ(772,",HLOCK="^HL(772,"
  1.  S X=X_""""_MTIEN_","")",HLOCK=HLOCK_MTIEN_")"
  1.  ;20=status, 21=date process
  1.  S @X@(20)=STATUS,@X@(21)=$S(STATUS=1:"@",1:$$NOW^XLFDT)
  1.  ;22=error msg
  1.  S:$G(ERRTEXT)]"" @X@(22)=$E(ERRTEXT,1,200)
  1.  ;23=error type
  1.  S:$G(ERR) @X@(23)=+ERR
  1.  ;100=date/time processed
  1.  S:$G(COMDT) @X@(100)=$$NOW^XLFDT
  1.  ;**109** F  L +@HLOCK:1 Q:$T  H 1
  1.  D FILE^HLDIE("","HLJ","","STATUS","HLTF0") ;HL*1.6*109
  1.  ;**109** L -@HLOCK
  1.  ;
  1.  ;if the status is error, and the event is not being surpressed by the
  1.  ;application, log a new event
  1.  I '$G(NOEVENT),$G(STATUS)=4 D
  1.  .N CODE,HL7MSGID,ERROR,PARENT,EVENT
  1.  .S CODE=$G(ERR)
  1.  .S (HL7MSGID,PARENT)=""
  1.  .I $G(MTIEN) D
  1.  ..N NODE
  1.  ..I $G(HLTCP) D
  1.  ...S NODE=$G(^HLMA(MTIEN,0))
  1.  ...S HL7MSGID=$P(NODE,"^",2)
  1.  ...S PARENT=$P(NODE,"^",6)
  1.  ..E  D
  1.  ...S NODE=$G(^HL(772,MTIEN,0))
  1.  ...S HL7MSGID=$P(NODE,"^",6)
  1.  ...S PARENT=$P(NODE,"^",8)
  1.  .;
  1.  .S EVENT=$$EVENT^HLEME(CODE,"HEALTH LEVEL SEVEN",HL7MSGID,,,.ERROR)
  1.  .;I 'EVENT,'$D(ZTQUEUED) W !,"Failed to create an Event in STATUS^HLTF0: ",$G(ERROR)_" "_$G(ERROR(1))_" "_$G(ERROR(2))
  1.  .;
  1.  .I EVENT D
  1.  ..I $L($G(ERRTEXT)),$$ADDNOTE^HLEME(EVENT,"Application Error Text: "_ERRTEXT)
  1.  ..;If this message was not the initial message in a transaction protocol, then provide some information about the initial message
  1.  ..I PARENT,PARENT'=$G(MTIEN) D
  1.  ...N PLINK,PMSGID,PMSGTYPE,PNODE,PEVENT,PNOTES
  1.  ...I $D(HLTCP) D
  1.  ....S PNODE=$G(^HLMA(PARENT,0))
  1.  ....S PLINK=$P(PNODE,"^",7)
  1.  ....S PMSGID=$P(PNODE,"^",2)
  1.  ....S PMSGTYPE=$P(PNODE,"^",13)
  1.  ....S PEVENT=$P(PNODE,"^",14)
  1.  ...E  D
  1.  ....S PNODE=$G(^HL(772,PARENT,0))
  1.  ....S PLINK=$P(PNODE,"^",11)
  1.  ....S PMSGID=$P(PNODE,"^",6)
  1.  ....S PMSGTYPE=""
  1.  ....S PEVENT=""
  1.  ...S PNOTES(1)="Initial Message in this transaction protocol:"
  1.  ...S PNOTES(2)="  Initial Message ID: "_PMSGID
  1.  ...S PNOTES(3)="  Logical Link of Initial Message: "
  1.  ...S:PLINK PNOTES(3)=PNOTES(3)_$P($G(^HLCS(870,PLINK,0)),"^")
  1.  ...S:PMSGTYPE PNOTES(4)="  Inital Message Type: "_$P($G(^HL(771.2,PMSGTYPE,0)),"^")
  1.  ...S:PEVENT PNOTES(5)="  Inital Message Event: "_$P($G(^HL(779.001,PEVENT,0)),"^")
  1.  ...I $$ADDNOTE^HLEME(EVENT,.PNOTES) ;then notes successfully added
  1.  Q
  1.  ;
  1. STATS(MTIEN,HLCHAR,HLEVN) ;Enter Statistics for an Entry in Message
  1.  ;Text File
  1.  ;
  1.  ;This is a subroutine call with parameter passing.  No output
  1.  ;parameters are returned
  1.  ;
  1.  ;Required Input Parameters
  1.  ;   MTIEN = The IEN from the Message Text file of the entry to be
  1.  ;             updated
  1.  ;  HLCHAR = The number of characters in the message
  1.  ;   HLEVN = The number of HL7 events in the message
  1.  ;
  1.  ;Check for required parameters
  1.  I '$G(MTIEN)!('$D(HLCHAR))!('$D(HLEVN)) Q
  1.  I '$D(^HL(772,MTIEN,0)) Q
  1.  ;File statistical info
  1.  ;**109** F  L +^HL(772,MTIEN):1 H:'$T 1 I $T D  Q
  1.  D
  1.  .  S ^HL(772,MTIEN,"S")=HLCHAR_"^"_$G(HLEVN)
  1.  ;**109** .  L -^HL(772,MTIEN)
  1.  Q
  1. STUFF(HLMT) ;Update Fields on Zero Node of the Message Text File for
  1.  ;Version 1.5 Interface Only
  1.  ;
  1.  ;This is a subroutine call with parameter passing.  No output
  1.  ;parameters are returned
  1.  ;
  1.  ;Required Input Parameter
  1.  ;  HLMT = Message type, O for outgoing or I for incoming
  1.  ;
  1.  ;Check for required parameter
  1.  Q:HLMT']""
  1.  ;File zero node data
  1.  N DA,DIC,DIE,DR
  1.  S (DIC,DIE)="^HL(772,",DA=HLDA
  1.  S DR="4////"_HLMT_$S('$G(HLDAP):"",1:";2////"_HLDAP)_$S('$G(HLXMZ):"",1:";5////"_HLXMZ)_$S('$G(HLDAI):"",1:";7////"_HLDAI)_";Q"_$S('$P($G(HLNDAP0),U,12):"",1:";3////"_$P($G(HLNDAP0),U,12))
  1.  F  L +^HL(772,DA):1 H:'$T 1 I $T D  Q
  1.  .  D ^DIE
  1.  .  L -^HL(772,DA)
  1.  Q
  1. UPDATE(MTIEN,MTIENP,HLMT,EID,CLIENT,SERVER,PRIORITY,REPLYTO,LOGLINK,HLP) ;
  1.  ;Update Fields of the Message Text File #772 or Message Administration
  1.  ; File #773 for Bi-directional TCP
  1.  ;
  1.  ;$D(HLTCP) will determine if you are updating file 773, instead
  1.  ; of file 772.
  1.  ;
  1.  ;This is a subroutine call with parameter passing.  No output
  1.  ;parameters are returned
  1.  ;
  1.  ;Required Input Parameters
  1.  ;   MTIEN = The IEN from file 772 or 773 of the entry to be
  1.  ;             updated
  1.  ;  MTIENP = The IEN from the Message Text file of the parent entry
  1.  ;           to which this entry (MTIEN) should be linked. TCP will
  1.  ;           ignore this parameter.
  1.  ;    HLMT = The type of message, I for Incoming or O for Outgoing
  1.  ;NOTE:  Either Client or Server must be passed.  Both parameters may
  1.  ;         be passed
  1.  ;  CLIENT = The IEN of the client (subscriber) application from
  1.  ;             the Application Parameter file
  1.  ;  SERVER = The IEN of the server (event driver) application from
  1.  ;             the Application Parameter file
  1.  ;Optional parameters
  1.  ;     EID = The IEN from the Protocol file of the event related to this
  1.  ;             Message Text file entry
  1.  ;PRIORITY = I for immediate or D for deferred
  1.  ; REPLYTO = The IEN from the Message Text file of the message being
  1.  ;             acknowledged.  (Only used for acknowledgement messages.)
  1.  ; LOGLINK = The IEN of the logical link from the Logical Link file
  1.  ; HLP("SECURITY")    = A 1 to 40 character string
  1.  ; HLP("CONTPTR")     = Continuation pointer, a 1 to 180 character string
  1.  ; HLP("MSGTYPE")     = M for Single Message or B for Batch of Messages
  1.  ; HLP("EVENT")       = ien of event type
  1.  ; HLP("MTYPE")       = ien of message type
  1.  ; HLP("HLTCPI")      = ien of initial message
  1.  ; HLP("ACKTIME")     = acknowledge timeout override for this message
  1.  ; HLP("NAMESPACE")   = Passed in by application namespace - HL*1.6*91
  1.  ;
  1.  ;Check for required parameters
  1.  I '$G(MTIEN)!($G(HLMT)']"") Q
  1.  ;File new status info
  1.  N HLJ,HLOCK,X,Y
  1.  ;if TCP update status in file 773, else status in file 772
  1.  S Y=$D(HLTCP)
  1.  I Y S X="HLJ(773,",HLOCK="^HLMA("
  1.  E  S X="HLJ(772,",HLOCK="^HL(772,"
  1.  ;transmission type
  1.  S X=X_""""_MTIEN_","")",HLOCK=HLOCK_MTIEN_")",@X@($S(Y:3,1:4))=HLMT
  1.  ;sending or server application
  1.  S:$G(SERVER) @X@($S(Y:13,1:2))=SERVER
  1.  ;receiving or client application
  1.  S:$G(CLIENT) @X@($S(Y:14,1:3))=CLIENT
  1.  ;acknowledgement to
  1.  S:$G(REPLYTO) @X@($S(Y:12,1:7))=REPLYTO
  1.  ;parent message
  1.  S:$G(MTIENP) @X@(8)=MTIENP
  1.  ;priority
  1.  S:$G(PRIORITY)]"" @X@($S(Y:4,1:9))=PRIORITY
  1.  ;related event protocol
  1.  S:$G(EID) @X@($S(Y:8,1:10))=EID
  1.  ;logical link
  1.  S:$G(LOGLINK) @X@($S(Y:7,1:11))=LOGLINK
  1.  ;security
  1.  S:$G(HLP("SECURITY"))]"" @X@($S(Y:9,1:12))=HLP("SECURITY")
  1.  ;namespace - HL*1.6*91
  1.  I HLOCK["HL(772" S:$G(HLP("NAMESPACE"))?1U1.3UN @X@(16)=HLP("NAMESPACE") ;HL*1.6*91
  1.  ;message type
  1.  S:$G(HLP("MSGTYPE"))]"" @X@($S(Y:5,1:14))=HLP("MSGTYPE")
  1.  ;continuation pointer
  1.  S:$G(HLP("CONTPTR"))]"" @X@($S(Y:11,1:13))=HLP("CONTPTR")
  1.  ;ack timeout override
  1.  S:$G(HLP("ACKTIME")) @X@(26)=HLP("ACKTIME")
  1.  ;only for file 773
  1.  I Y D
  1.  . ;initial message
  1.  . S:$G(HLP("HLTCPI")) @X@(6)=HLP("HLTCPI")
  1.  . ;message type
  1.  . S:$G(HLP("MTYPE")) @X@(15)=HLP("MTYPE")
  1.  . ;event type
  1.  . S:$G(HLP("EVENT")) @X@(16)=HLP("EVENT")
  1.  ;**109** F  L +@HLOCK:1 Q:$T  H 1
  1.  D FILE^HLDIE("","HLJ","","UPDATE","HLTF0") ; HL*1.6*109
  1.  ;**109** L -@HLOCK
  1.  Q