HLTF0 ;AISC/SAW,JRP - File Data in Message Text File ;05/05/2000 09:01
;;1.6;HEALTH LEVEL SEVEN;**12,19,64,91,109**;Oct 13, 1995
;
STATUS(MTIEN,STATUS,ERR,ERRTEXT,COMDT,NOEVENT) ;Update Status of Entry in Message Text File and log an event for errors
;
;This is a subroutine call with parameter passing. No output
;parameters are returned
;
;$D(HLTCP) will determine if you are updating file 773, instead
; of file 772.
;Required Input Parameters
; MTIEN = IEN of entry in file 772 or 773, to be updated
; STATUS = IEN of new status (pointer to Message Status file)
;Optional Parameters
; ERR = IEN of error message (pointer to Error Message file)
; ERRTEXT = An error message of up to 200 characters
; COMDT = 0/1 ; 1=update DATE/TIME PROCESSED, field 100
; NOEVENT = 1 if an event should NOT be logged. Presumably this signals that the application already logged the event
;
;Check for required parameters
I '$G(MTIEN)!('$G(STATUS)) Q
;File new status info
N HLJ,HLOCK,X
;if TCP update status in file 773, else status in file 772
I $D(HLTCP) S X="HLJ(773,",HLOCK="^HLMA("
E S X="HLJ(772,",HLOCK="^HL(772,"
S X=X_""""_MTIEN_","")",HLOCK=HLOCK_MTIEN_")"
;20=status, 21=date process
S @X@(20)=STATUS,@X@(21)=$S(STATUS=1:"@",1:$$NOW^XLFDT)
;22=error msg
S:$G(ERRTEXT)]"" @X@(22)=$E(ERRTEXT,1,200)
;23=error type
S:$G(ERR) @X@(23)=+ERR
;100=date/time processed
S:$G(COMDT) @X@(100)=$$NOW^XLFDT
;**109** F L +@HLOCK:1 Q:$T H 1
D FILE^HLDIE("","HLJ","","STATUS","HLTF0") ;HL*1.6*109
;**109** L -@HLOCK
;
;if the status is error, and the event is not being surpressed by the
;application, log a new event
I '$G(NOEVENT),$G(STATUS)=4 D
.N CODE,HL7MSGID,ERROR,PARENT,EVENT
.S CODE=$G(ERR)
.S (HL7MSGID,PARENT)=""
.I $G(MTIEN) D
..N NODE
..I $G(HLTCP) D
...S NODE=$G(^HLMA(MTIEN,0))
...S HL7MSGID=$P(NODE,"^",2)
...S PARENT=$P(NODE,"^",6)
..E D
...S NODE=$G(^HL(772,MTIEN,0))
...S HL7MSGID=$P(NODE,"^",6)
...S PARENT=$P(NODE,"^",8)
.;
.S EVENT=$$EVENT^HLEME(CODE,"HEALTH LEVEL SEVEN",HL7MSGID,,,.ERROR)
.;I 'EVENT,'$D(ZTQUEUED) W !,"Failed to create an Event in STATUS^HLTF0: ",$G(ERROR)_" "_$G(ERROR(1))_" "_$G(ERROR(2))
.;
.I EVENT D
..I $L($G(ERRTEXT)),$$ADDNOTE^HLEME(EVENT,"Application Error Text: "_ERRTEXT)
..;If this message was not the initial message in a transaction protocol, then provide some information about the initial message
..I PARENT,PARENT'=$G(MTIEN) D
...N PLINK,PMSGID,PMSGTYPE,PNODE,PEVENT,PNOTES
...I $D(HLTCP) D
....S PNODE=$G(^HLMA(PARENT,0))
....S PLINK=$P(PNODE,"^",7)
....S PMSGID=$P(PNODE,"^",2)
....S PMSGTYPE=$P(PNODE,"^",13)
....S PEVENT=$P(PNODE,"^",14)
...E D
....S PNODE=$G(^HL(772,PARENT,0))
....S PLINK=$P(PNODE,"^",11)
....S PMSGID=$P(PNODE,"^",6)
....S PMSGTYPE=""
....S PEVENT=""
...S PNOTES(1)="Initial Message in this transaction protocol:"
...S PNOTES(2)=" Initial Message ID: "_PMSGID
...S PNOTES(3)=" Logical Link of Initial Message: "
...S:PLINK PNOTES(3)=PNOTES(3)_$P($G(^HLCS(870,PLINK,0)),"^")
...S:PMSGTYPE PNOTES(4)=" Inital Message Type: "_$P($G(^HL(771.2,PMSGTYPE,0)),"^")
...S:PEVENT PNOTES(5)=" Inital Message Event: "_$P($G(^HL(779.001,PEVENT,0)),"^")
...I $$ADDNOTE^HLEME(EVENT,.PNOTES) ;then notes successfully added
Q
;
STATS(MTIEN,HLCHAR,HLEVN) ;Enter Statistics for an Entry in Message
;Text File
;
;This is a subroutine call with parameter passing. No output
;parameters are returned
;
;Required Input Parameters
; MTIEN = The IEN from the Message Text file of the entry to be
; updated
; HLCHAR = The number of characters in the message
; HLEVN = The number of HL7 events in the message
;
;Check for required parameters
I '$G(MTIEN)!('$D(HLCHAR))!('$D(HLEVN)) Q
I '$D(^HL(772,MTIEN,0)) Q
;File statistical info
;**109** F L +^HL(772,MTIEN):1 H:'$T 1 I $T D Q
D
. S ^HL(772,MTIEN,"S")=HLCHAR_"^"_$G(HLEVN)
;**109** . L -^HL(772,MTIEN)
Q
STUFF(HLMT) ;Update Fields on Zero Node of the Message Text File for
;Version 1.5 Interface Only
;
;This is a subroutine call with parameter passing. No output
;parameters are returned
;
;Required Input Parameter
; HLMT = Message type, O for outgoing or I for incoming
;
;Check for required parameter
Q:HLMT']""
;File zero node data
N DA,DIC,DIE,DR
S (DIC,DIE)="^HL(772,",DA=HLDA
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))
F L +^HL(772,DA):1 H:'$T 1 I $T D Q
. D ^DIE
. L -^HL(772,DA)
Q
UPDATE(MTIEN,MTIENP,HLMT,EID,CLIENT,SERVER,PRIORITY,REPLYTO,LOGLINK,HLP) ;
;Update Fields of the Message Text File #772 or Message Administration
; File #773 for Bi-directional TCP
;
;$D(HLTCP) will determine if you are updating file 773, instead
; of file 772.
;
;This is a subroutine call with parameter passing. No output
;parameters are returned
;
;Required Input Parameters
; MTIEN = The IEN from file 772 or 773 of the entry to be
; updated
; MTIENP = The IEN from the Message Text file of the parent entry
; to which this entry (MTIEN) should be linked. TCP will
; ignore this parameter.
; HLMT = The type of message, I for Incoming or O for Outgoing
;NOTE: Either Client or Server must be passed. Both parameters may
; be passed
; CLIENT = The IEN of the client (subscriber) application from
; the Application Parameter file
; SERVER = The IEN of the server (event driver) application from
; the Application Parameter file
;Optional parameters
; EID = The IEN from the Protocol file of the event related to this
; Message Text file entry
;PRIORITY = I for immediate or D for deferred
; REPLYTO = The IEN from the Message Text file of the message being
; acknowledged. (Only used for acknowledgement messages.)
; LOGLINK = The IEN of the logical link from the Logical Link file
; HLP("SECURITY") = A 1 to 40 character string
; HLP("CONTPTR") = Continuation pointer, a 1 to 180 character string
; HLP("MSGTYPE") = M for Single Message or B for Batch of Messages
; HLP("EVENT") = ien of event type
; HLP("MTYPE") = ien of message type
; HLP("HLTCPI") = ien of initial message
; HLP("ACKTIME") = acknowledge timeout override for this message
; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
;
;Check for required parameters
I '$G(MTIEN)!($G(HLMT)']"") Q
;File new status info
N HLJ,HLOCK,X,Y
;if TCP update status in file 773, else status in file 772
S Y=$D(HLTCP)
I Y S X="HLJ(773,",HLOCK="^HLMA("
E S X="HLJ(772,",HLOCK="^HL(772,"
;transmission type
S X=X_""""_MTIEN_","")",HLOCK=HLOCK_MTIEN_")",@X@($S(Y:3,1:4))=HLMT
;sending or server application
S:$G(SERVER) @X@($S(Y:13,1:2))=SERVER
;receiving or client application
S:$G(CLIENT) @X@($S(Y:14,1:3))=CLIENT
;acknowledgement to
S:$G(REPLYTO) @X@($S(Y:12,1:7))=REPLYTO
;parent message
S:$G(MTIENP) @X@(8)=MTIENP
;priority
S:$G(PRIORITY)]"" @X@($S(Y:4,1:9))=PRIORITY
;related event protocol
S:$G(EID) @X@($S(Y:8,1:10))=EID
;logical link
S:$G(LOGLINK) @X@($S(Y:7,1:11))=LOGLINK
;security
S:$G(HLP("SECURITY"))]"" @X@($S(Y:9,1:12))=HLP("SECURITY")
;namespace - HL*1.6*91
I HLOCK["HL(772" S:$G(HLP("NAMESPACE"))?1U1.3UN @X@(16)=HLP("NAMESPACE") ;HL*1.6*91
;message type
S:$G(HLP("MSGTYPE"))]"" @X@($S(Y:5,1:14))=HLP("MSGTYPE")
;continuation pointer
S:$G(HLP("CONTPTR"))]"" @X@($S(Y:11,1:13))=HLP("CONTPTR")
;ack timeout override
S:$G(HLP("ACKTIME")) @X@(26)=HLP("ACKTIME")
;only for file 773
I Y D
. ;initial message
. S:$G(HLP("HLTCPI")) @X@(6)=HLP("HLTCPI")
. ;message type
. S:$G(HLP("MTYPE")) @X@(15)=HLP("MTYPE")
. ;event type
. S:$G(HLP("EVENT")) @X@(16)=HLP("EVENT")
;**109** F L +@HLOCK:1 Q:$T H 1
D FILE^HLDIE("","HLJ","","UPDATE","HLTF0") ; HL*1.6*109
;**109** L -@HLOCK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTF0 8190 printed Oct 16, 2024@18:00:40 Page 2
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
+2 ;
STATUS(MTIEN,STATUS,ERR,ERRTEXT,COMDT,NOEVENT) ;Update Status of Entry in Message Text File and log an event for errors
+1 ;
+2 ;This is a subroutine call with parameter passing. No output
+3 ;parameters are returned
+4 ;
+5 ;$D(HLTCP) will determine if you are updating file 773, instead
+6 ; of file 772.
+7 ;Required Input Parameters
+8 ; MTIEN = IEN of entry in file 772 or 773, to be updated
+9 ; STATUS = IEN of new status (pointer to Message Status file)
+10 ;Optional Parameters
+11 ; ERR = IEN of error message (pointer to Error Message file)
+12 ; ERRTEXT = An error message of up to 200 characters
+13 ; COMDT = 0/1 ; 1=update DATE/TIME PROCESSED, field 100
+14 ; NOEVENT = 1 if an event should NOT be logged. Presumably this signals that the application already logged the event
+15 ;
+16 ;Check for required parameters
+17 IF '$GET(MTIEN)!('$GET(STATUS))
QUIT
+18 ;File new status info
+19 NEW HLJ,HLOCK,X
+20 ;if TCP update status in file 773, else status in file 772
+21 IF $DATA(HLTCP)
SET X="HLJ(773,"
SET HLOCK="^HLMA("
+22 IF '$TEST
SET X="HLJ(772,"
SET HLOCK="^HL(772,"
+23 SET X=X_""""_MTIEN_","")"
SET HLOCK=HLOCK_MTIEN_")"
+24 ;20=status, 21=date process
+25 SET @X@(20)=STATUS
SET @X@(21)=$SELECT(STATUS=1:"@",1:$$NOW^XLFDT)
+26 ;22=error msg
+27 if $GET(ERRTEXT)]""
SET @X@(22)=$EXTRACT(ERRTEXT,1,200)
+28 ;23=error type
+29 if $GET(ERR)
SET @X@(23)=+ERR
+30 ;100=date/time processed
+31 if $GET(COMDT)
SET @X@(100)=$$NOW^XLFDT
+32 ;**109** F L +@HLOCK:1 Q:$T H 1
+33 ;HL*1.6*109
DO FILE^HLDIE("","HLJ","","STATUS","HLTF0")
+34 ;**109** L -@HLOCK
+35 ;
+36 ;if the status is error, and the event is not being surpressed by the
+37 ;application, log a new event
+38 IF '$GET(NOEVENT)
IF $GET(STATUS)=4
Begin DoDot:1
+39 NEW CODE,HL7MSGID,ERROR,PARENT,EVENT
+40 SET CODE=$GET(ERR)
+41 SET (HL7MSGID,PARENT)=""
+42 IF $GET(MTIEN)
Begin DoDot:2
+43 NEW NODE
+44 IF $GET(HLTCP)
Begin DoDot:3
+45 SET NODE=$GET(^HLMA(MTIEN,0))
+46 SET HL7MSGID=$PIECE(NODE,"^",2)
+47 SET PARENT=$PIECE(NODE,"^",6)
End DoDot:3
+48 IF '$TEST
Begin DoDot:3
+49 SET NODE=$GET(^HL(772,MTIEN,0))
+50 SET HL7MSGID=$PIECE(NODE,"^",6)
+51 SET PARENT=$PIECE(NODE,"^",8)
End DoDot:3
End DoDot:2
+52 ;
+53 SET EVENT=$$EVENT^HLEME(CODE,"HEALTH LEVEL SEVEN",HL7MSGID,,,.ERROR)
+54 ;I 'EVENT,'$D(ZTQUEUED) W !,"Failed to create an Event in STATUS^HLTF0: ",$G(ERROR)_" "_$G(ERROR(1))_" "_$G(ERROR(2))
+55 ;
+56 IF EVENT
Begin DoDot:2
+57 IF $LENGTH($GET(ERRTEXT))
IF $$ADDNOTE^HLEME(EVENT,"Application Error Text: "_ERRTEXT)
+58 ;If this message was not the initial message in a transaction protocol, then provide some information about the initial message
+59 IF PARENT
IF PARENT'=$GET(MTIEN)
Begin DoDot:3
+60 NEW PLINK,PMSGID,PMSGTYPE,PNODE,PEVENT,PNOTES
+61 IF $DATA(HLTCP)
Begin DoDot:4
+62 SET PNODE=$GET(^HLMA(PARENT,0))
+63 SET PLINK=$PIECE(PNODE,"^",7)
+64 SET PMSGID=$PIECE(PNODE,"^",2)
+65 SET PMSGTYPE=$PIECE(PNODE,"^",13)
+66 SET PEVENT=$PIECE(PNODE,"^",14)
End DoDot:4
+67 IF '$TEST
Begin DoDot:4
+68 SET PNODE=$GET(^HL(772,PARENT,0))
+69 SET PLINK=$PIECE(PNODE,"^",11)
+70 SET PMSGID=$PIECE(PNODE,"^",6)
+71 SET PMSGTYPE=""
+72 SET PEVENT=""
End DoDot:4
+73 SET PNOTES(1)="Initial Message in this transaction protocol:"
+74 SET PNOTES(2)=" Initial Message ID: "_PMSGID
+75 SET PNOTES(3)=" Logical Link of Initial Message: "
+76 if PLINK
SET PNOTES(3)=PNOTES(3)_$PIECE($GET(^HLCS(870,PLINK,0)),"^")
+77 if PMSGTYPE
SET PNOTES(4)=" Inital Message Type: "_$PIECE($GET(^HL(771.2,PMSGTYPE,0)),"^")
+78 if PEVENT
SET PNOTES(5)=" Inital Message Event: "_$PIECE($GET(^HL(779.001,PEVENT,0)),"^")
+79 ;then notes successfully added
IF $$ADDNOTE^HLEME(EVENT,.PNOTES)
End DoDot:3
End DoDot:2
End DoDot:1
+80 QUIT
+81 ;
STATS(MTIEN,HLCHAR,HLEVN) ;Enter Statistics for an Entry in Message
+1 ;Text File
+2 ;
+3 ;This is a subroutine call with parameter passing. No output
+4 ;parameters are returned
+5 ;
+6 ;Required Input Parameters
+7 ; MTIEN = The IEN from the Message Text file of the entry to be
+8 ; updated
+9 ; HLCHAR = The number of characters in the message
+10 ; HLEVN = The number of HL7 events in the message
+11 ;
+12 ;Check for required parameters
+13 IF '$GET(MTIEN)!('$DATA(HLCHAR))!('$DATA(HLEVN))
QUIT
+14 IF '$DATA(^HL(772,MTIEN,0))
QUIT
+15 ;File statistical info
+16 ;**109** F L +^HL(772,MTIEN):1 H:'$T 1 I $T D Q
+17 Begin DoDot:1
+18 SET ^HL(772,MTIEN,"S")=HLCHAR_"^"_$GET(HLEVN)
End DoDot:1
+19 ;**109** . L -^HL(772,MTIEN)
+20 QUIT
STUFF(HLMT) ;Update Fields on Zero Node of the Message Text File for
+1 ;Version 1.5 Interface Only
+2 ;
+3 ;This is a subroutine call with parameter passing. No output
+4 ;parameters are returned
+5 ;
+6 ;Required Input Parameter
+7 ; HLMT = Message type, O for outgoing or I for incoming
+8 ;
+9 ;Check for required parameter
+10 if HLMT']""
QUIT
+11 ;File zero node data
+12 NEW DA,DIC,DIE,DR
+13 SET (DIC,DIE)="^HL(772,"
SET DA=HLDA
+14 SET DR="4////"_HLMT_$SELECT('$GET(HLDAP):"",1:";2////"_HLDAP)_$SELECT('$GET(HLXMZ):"",1:";5////"_HLXMZ)_$SELECT('$GET(HLDAI):"",1:";7////"_HLDAI)_";Q"_$SELECT('$PIECE($GET(HLNDAP0),U,12):"",1:";3////"_$PIECE($GET(HLNDAP0),U,12))
+15 FOR
LOCK +^HL(772,DA):1
if '$TEST
HANG 1
IF $TEST
Begin DoDot:1
+16 DO ^DIE
+17 LOCK -^HL(772,DA)
End DoDot:1
QUIT
+18 QUIT
UPDATE(MTIEN,MTIENP,HLMT,EID,CLIENT,SERVER,PRIORITY,REPLYTO,LOGLINK,HLP) ;
+1 ;Update Fields of the Message Text File #772 or Message Administration
+2 ; File #773 for Bi-directional TCP
+3 ;
+4 ;$D(HLTCP) will determine if you are updating file 773, instead
+5 ; of file 772.
+6 ;
+7 ;This is a subroutine call with parameter passing. No output
+8 ;parameters are returned
+9 ;
+10 ;Required Input Parameters
+11 ; MTIEN = The IEN from file 772 or 773 of the entry to be
+12 ; updated
+13 ; MTIENP = The IEN from the Message Text file of the parent entry
+14 ; to which this entry (MTIEN) should be linked. TCP will
+15 ; ignore this parameter.
+16 ; HLMT = The type of message, I for Incoming or O for Outgoing
+17 ;NOTE: Either Client or Server must be passed. Both parameters may
+18 ; be passed
+19 ; CLIENT = The IEN of the client (subscriber) application from
+20 ; the Application Parameter file
+21 ; SERVER = The IEN of the server (event driver) application from
+22 ; the Application Parameter file
+23 ;Optional parameters
+24 ; EID = The IEN from the Protocol file of the event related to this
+25 ; Message Text file entry
+26 ;PRIORITY = I for immediate or D for deferred
+27 ; REPLYTO = The IEN from the Message Text file of the message being
+28 ; acknowledged. (Only used for acknowledgement messages.)
+29 ; LOGLINK = The IEN of the logical link from the Logical Link file
+30 ; HLP("SECURITY") = A 1 to 40 character string
+31 ; HLP("CONTPTR") = Continuation pointer, a 1 to 180 character string
+32 ; HLP("MSGTYPE") = M for Single Message or B for Batch of Messages
+33 ; HLP("EVENT") = ien of event type
+34 ; HLP("MTYPE") = ien of message type
+35 ; HLP("HLTCPI") = ien of initial message
+36 ; HLP("ACKTIME") = acknowledge timeout override for this message
+37 ; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
+38 ;
+39 ;Check for required parameters
+40 IF '$GET(MTIEN)!($GET(HLMT)']"")
QUIT
+41 ;File new status info
+42 NEW HLJ,HLOCK,X,Y
+43 ;if TCP update status in file 773, else status in file 772
+44 SET Y=$DATA(HLTCP)
+45 IF Y
SET X="HLJ(773,"
SET HLOCK="^HLMA("
+46 IF '$TEST
SET X="HLJ(772,"
SET HLOCK="^HL(772,"
+47 ;transmission type
+48 SET X=X_""""_MTIEN_","")"
SET HLOCK=HLOCK_MTIEN_")"
SET @X@($SELECT(Y:3,1:4))=HLMT
+49 ;sending or server application
+50 if $GET(SERVER)
SET @X@($SELECT(Y:13,1:2))=SERVER
+51 ;receiving or client application
+52 if $GET(CLIENT)
SET @X@($SELECT(Y:14,1:3))=CLIENT
+53 ;acknowledgement to
+54 if $GET(REPLYTO)
SET @X@($SELECT(Y:12,1:7))=REPLYTO
+55 ;parent message
+56 if $GET(MTIENP)
SET @X@(8)=MTIENP
+57 ;priority
+58 if $GET(PRIORITY)]""
SET @X@($SELECT(Y:4,1:9))=PRIORITY
+59 ;related event protocol
+60 if $GET(EID)
SET @X@($SELECT(Y:8,1:10))=EID
+61 ;logical link
+62 if $GET(LOGLINK)
SET @X@($SELECT(Y:7,1:11))=LOGLINK
+63 ;security
+64 if $GET(HLP("SECURITY"))]""
SET @X@($SELECT(Y:9,1:12))=HLP("SECURITY")
+65 ;namespace - HL*1.6*91
+66 ;HL*1.6*91
IF HLOCK["HL(772"
if $GET(HLP("NAMESPACE"))?1U1.3UN
SET @X@(16)=HLP("NAMESPACE")
+67 ;message type
+68 if $GET(HLP("MSGTYPE"))]""
SET @X@($SELECT(Y:5,1:14))=HLP("MSGTYPE")
+69 ;continuation pointer
+70 if $GET(HLP("CONTPTR"))]""
SET @X@($SELECT(Y:11,1:13))=HLP("CONTPTR")
+71 ;ack timeout override
+72 if $GET(HLP("ACKTIME"))
SET @X@(26)=HLP("ACKTIME")
+73 ;only for file 773
+74 IF Y
Begin DoDot:1
+75 ;initial message
+76 if $GET(HLP("HLTCPI"))
SET @X@(6)=HLP("HLTCPI")
+77 ;message type
+78 if $GET(HLP("MTYPE"))
SET @X@(15)=HLP("MTYPE")
+79 ;event type
+80 if $GET(HLP("EVENT"))
SET @X@(16)=HLP("EVENT")
End DoDot:1
+81 ;**109** F L +@HLOCK:1 Q:$T H 1
+82 ; HL*1.6*109
DO FILE^HLDIE("","HLJ","","UPDATE","HLTF0")
+83 ;**109** L -@HLOCK
+84 QUIT
