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

HLTP0.m

Go to the documentation of this file.
  1. HLTP0 ;AISC/SAW,JRP - Transaction Processor Module (Cont'd) ;11/19/97 11:13
  1. ;;1.6;HEALTH LEVEL SEVEN;**25,37**;Oct 13, 1995
  1. PROCESS(HLMTIEN,HLLD0,HLLD1,HLRESLT) ;Process an incoming message
  1. ;
  1. ;INPUT : HLMTIEN - One of two values
  1. ; 1) Pointer to entry in MESSAGE TEXT file (#772)
  1. ; that requires processing (internal message)
  1. ; 2) Pointer to entry in MESSAGE TEXT file (#772)
  1. ; that external message will be placed into
  1. ; HLLD0 - One of three values
  1. ; 1) Pointer to LOGICAL LINK file (#870) that
  1. ; contains the message
  1. ; 2) 'XM' if the message was received through MailMan
  1. ; 3) 'DHCP' if the message is from an internal
  1. ; application
  1. ; HLLD1 - Pointer to entry in IN QUEUE multiple (#19) of
  1. ; the LOGICAL LINK file (#870)
  1. ; - Only used for messages received through the
  1. ; LOGICAL LINK file (#870)
  1. ; HLRESLT - Variable to return error text in (pass by reference)
  1. ;OUTPUT : On successful completion, HLRESLT will be set to NULL
  1. ; On error, HLRESLT will be set to ErrorCode^ErrorText
  1. ;
  1. ;Check parameters
  1. S HLRESLT="7^"_$G(^HL(771.7,7,0))_" at PROCESS^HLTP0 entry point"
  1. Q:('$G(HLMTIEN))
  1. S HLLD0=$G(HLLD0)
  1. Q:(HLLD0="")
  1. Q:((HLLD0'="XM")&(HLLD0'="DHCP")&('$D(^HLCS(870,+HLLD0,0))))
  1. S HLLD1=+$G(HLLD1)
  1. Q:((+HLLD0)&('$D(^HLCS(870,+HLLD0,1,HLLD1,0))))
  1. S HLRESLT=""
  1. N HLEXROU,CHARCNT,EVNTCNT,HDRFND,FLDSPRTR,LINE,TEXT,SEGNAME,HDRTYPE
  1. N HLENROU,HLNEXT,HLNODE,HLPROU,HLQUIT,HLMTIENS
  1. ;
  1. ;Prepare to process internal message
  1. I (HLLD0="DHCP") D Q:(HLRESLT'="")
  1. .;Determine statistics for message
  1. .S LINE=0
  1. .S TEXT=""
  1. .S HDRFND=0
  1. .S CHARCNT=0
  1. .S EVNTCNT=0
  1. .S HLMSA=""
  1. .S HLHDR=""
  1. .S SEGNAME=""
  1. .S HDRTYPE=""
  1. .;Order through message text
  1. .F S LINE=+$O(^HL(772,HLMTIEN,"IN",LINE)) Q:('LINE) D
  1. ..S TEXT=$G(^HL(772,HLMTIEN,"IN",LINE,0))
  1. ..;Determine if header found yet (skip lines until it is)
  1. ..S:"FHS,BHS,MSH"[$E(TEXT,1,3) HDRFND=1
  1. ..Q:('HDRFND)
  1. ..;Increment character count
  1. ..S CHARCNT=CHARCNT+$L(TEXT)
  1. ..;Get segment name
  1. ..S SEGNAME=$E(TEXT,1,3)
  1. ..;If header segment, process it and set HLHDR equal to it
  1. ..I "FHS,BHS,MSH"[SEGNAME D
  1. ...I (HLHDR="") S HLHDR=TEXT,FLDSPRTR=$E(TEXT,4),HDRTYPE=SEGNAME
  1. ...S $P(TEXT,FLDSPRTR,8)=""
  1. ...S:(SEGNAME="MSH") EVNTCNT=EVNTCNT+1
  1. ..;If acknowledgement segment, set HLMSA equal to it
  1. ..S:((SEGNAME="MSA")&(HLMSA="")&(HDRTYPE="MSH")) HLMSA=TEXT
  1. .;Update statistics
  1. .D STATS^HLTF0(HLMTIEN,CHARCNT,EVNTCNT)
  1. .S:(HLHDR="") HLRESLT="12^"_$G(^HL(771.7,12,0))
  1. ;
  1. ;Prepare to process external message
  1. I (HLLD0'="DHCP") D Q:(HLRESLT'="")
  1. .;Store message in Message Text file
  1. .D MERGEIN^HLTF2(HLLD0,$S($G(HLLD1):HLLD1,1:""),HLMTIEN,.HLHDR,.HLMSA)
  1. . ; for batch message
  1. .I $D(HLMSA),$P(HLMSA,$E(HLHDR,4),2)="" S HLMSA=""
  1. .S:('$D(HLHDR)) HLRESLT="12^"_$G(^HL(771.7,12,0))
  1. ;
  1. ;Process message
  1. D ^HLTP01
  1. ;
  1. ;Update status of subscriber message
  1. I (HLMTIENS) D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S($D(HLERR):HLERR,HLRESLT:$P(HLRESLT,"^",2),1:""))
  1. ;
  1. ;Execute exit action of client protocol
  1. X:$G(HLEXROU)]"" HLEXROU
  1. Q