source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTP0.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1HLTP0 ;AISC/SAW,JRP - Transaction Processor Module (Cont'd) ;11/19/97 11:13
2 ;;1.6;HEALTH LEVEL SEVEN;**25,37**;Oct 13, 1995
3PROCESS(HLMTIEN,HLLD0,HLLD1,HLRESLT) ;Process an incoming message
4 ;
5 ;INPUT : HLMTIEN - One of two values
6 ; 1) Pointer to entry in MESSAGE TEXT file (#772)
7 ; that requires processing (internal message)
8 ; 2) Pointer to entry in MESSAGE TEXT file (#772)
9 ; that external message will be placed into
10 ; HLLD0 - One of three values
11 ; 1) Pointer to LOGICAL LINK file (#870) that
12 ; contains the message
13 ; 2) 'XM' if the message was received through MailMan
14 ; 3) 'DHCP' if the message is from an internal
15 ; application
16 ; HLLD1 - Pointer to entry in IN QUEUE multiple (#19) of
17 ; the LOGICAL LINK file (#870)
18 ; - Only used for messages received through the
19 ; LOGICAL LINK file (#870)
20 ; HLRESLT - Variable to return error text in (pass by reference)
21 ;OUTPUT : On successful completion, HLRESLT will be set to NULL
22 ; On error, HLRESLT will be set to ErrorCode^ErrorText
23 ;
24 ;Check parameters
25 S HLRESLT="7^"_$G(^HL(771.7,7,0))_" at PROCESS^HLTP0 entry point"
26 Q:('$G(HLMTIEN))
27 S HLLD0=$G(HLLD0)
28 Q:(HLLD0="")
29 Q:((HLLD0'="XM")&(HLLD0'="DHCP")&('$D(^HLCS(870,+HLLD0,0))))
30 S HLLD1=+$G(HLLD1)
31 Q:((+HLLD0)&('$D(^HLCS(870,+HLLD0,1,HLLD1,0))))
32 S HLRESLT=""
33 N HLEXROU,CHARCNT,EVNTCNT,HDRFND,FLDSPRTR,LINE,TEXT,SEGNAME,HDRTYPE
34 N HLENROU,HLNEXT,HLNODE,HLPROU,HLQUIT,HLMTIENS
35 ;
36 ;Prepare to process internal message
37 I (HLLD0="DHCP") D Q:(HLRESLT'="")
38 .;Determine statistics for message
39 .S LINE=0
40 .S TEXT=""
41 .S HDRFND=0
42 .S CHARCNT=0
43 .S EVNTCNT=0
44 .S HLMSA=""
45 .S HLHDR=""
46 .S SEGNAME=""
47 .S HDRTYPE=""
48 .;Order through message text
49 .F S LINE=+$O(^HL(772,HLMTIEN,"IN",LINE)) Q:('LINE) D
50 ..S TEXT=$G(^HL(772,HLMTIEN,"IN",LINE,0))
51 ..;Determine if header found yet (skip lines until it is)
52 ..S:"FHS,BHS,MSH"[$E(TEXT,1,3) HDRFND=1
53 ..Q:('HDRFND)
54 ..;Increment character count
55 ..S CHARCNT=CHARCNT+$L(TEXT)
56 ..;Get segment name
57 ..S SEGNAME=$E(TEXT,1,3)
58 ..;If header segment, process it and set HLHDR equal to it
59 ..I "FHS,BHS,MSH"[SEGNAME D
60 ...I (HLHDR="") S HLHDR=TEXT,FLDSPRTR=$E(TEXT,4),HDRTYPE=SEGNAME
61 ...S $P(TEXT,FLDSPRTR,8)=""
62 ...S:(SEGNAME="MSH") EVNTCNT=EVNTCNT+1
63 ..;If acknowledgement segment, set HLMSA equal to it
64 ..S:((SEGNAME="MSA")&(HLMSA="")&(HDRTYPE="MSH")) HLMSA=TEXT
65 .;Update statistics
66 .D STATS^HLTF0(HLMTIEN,CHARCNT,EVNTCNT)
67 .S:(HLHDR="") HLRESLT="12^"_$G(^HL(771.7,12,0))
68 ;
69 ;Prepare to process external message
70 I (HLLD0'="DHCP") D Q:(HLRESLT'="")
71 .;Store message in Message Text file
72 .D MERGEIN^HLTF2(HLLD0,$S($G(HLLD1):HLLD1,1:""),HLMTIEN,.HLHDR,.HLMSA)
73 . ; for batch message
74 .I $D(HLMSA),$P(HLMSA,$E(HLHDR,4),2)="" S HLMSA=""
75 .S:('$D(HLHDR)) HLRESLT="12^"_$G(^HL(771.7,12,0))
76 ;
77 ;Process message
78 D ^HLTP01
79 ;
80 ;Update status of subscriber message
81 I (HLMTIENS) D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S($D(HLERR):HLERR,HLRESLT:$P(HLRESLT,"^",2),1:""))
82 ;
83 ;Execute exit action of client protocol
84 X:$G(HLEXROU)]"" HLEXROU
85 Q
Note: See TracBrowser for help on using the repository browser.