Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCLNT1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCLNT1.m
r613 r623 1 HLOCLNT1 ;IRMFO-ALB/CJM - Writing messages, reading acks;03/24/2004 14:43 ;07/10/20072 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134,137**;Oct 13, 1995;Build 21 3 4 5 6 WRITEMSG(HLCSTATE,HLMSTATE) 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 READACK(HLCSTATE,HDR,MSA) 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 BADMSGS(WORK) 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 ...S ^HLB("ERRORS",RAPP,TIME,MSG)=""149 150 151 152 153 154 1 HLOCLNT1 ;IRMFO-ALB/CJM - Writing messages, reading acks;03/24/2004 14:43 ;03/19/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134**;Oct 13, 1995;Build 30 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; 6 WRITEMSG(HLCSTATE,HLMSTATE) ; 7 ;Description: This function uses the services offered by the transport layer to send a message over an open communication channel. 8 ; 9 ;Input: 10 ; HLCSTATE (pass by reference, required) Defines the LLP & its state 11 ; HLMSTATE (pass by reference, required) The message 12 ;Output: 13 ; Function returns 1 on success, 0 on failure 14 ; 15 N SEG,QUIT,HDR 16 S QUIT=0 17 Q:'$G(HLMSTATE("IEN")) 0 18 S HDR(1)=HLMSTATE("HDR",1),HDR(2)=HLMSTATE("HDR",2) 19 Q:'$$WRITEHDR^HLOT(.HLCSTATE,.HDR) 0 20 I HLMSTATE("BATCH") D 21 .N LAST S LAST=0 22 .S HLMSTATE("BATCH","CURRENT MESSAGE")=0 23 .F Q:'$$NEXTMSG^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT 24 ..S LAST=HLMSTATE("BATCH","CURRENT MESSAGE") 25 ..I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q 26 ..F Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT 27 ...I '$$WRITESEG^HLOT(.HLCSTATE,.SEG) S QUIT=1 Q 28 .K SEG S SEG(1)="BTS"_HLMSTATE("HDR","FIELD SEPARATOR")_LAST 29 .S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1 30 E D 31 .F Q:'$$HLNEXT^HLOMSG(.HLMSTATE,.SEG) D Q:QUIT 32 ..S:'$$WRITESEG^HLOT(.HLCSTATE,.SEG) QUIT=1 33 S:'$$ENDMSG^HLOT(.HLCSTATE) QUIT=1 34 Q 'QUIT 35 ; 36 READACK(HLCSTATE,HDR,MSA) ; 37 ;Description: This function uses the services offered by the transport layer to read an accept ack. 38 ; 39 ;Input: 40 ; HLCSTATE (pass by reference, required) Defines the communication channel and its state. 41 ;Output: 42 ; Function returns 1 on success, 0 on failure 43 ; HDR (pass by reference) the message header: 44 ; HDR(1) is components 1-6 45 ; HDR(2) is components 7-end 46 ; MSA (pass by reference) the MSA segment as an unsubscripted variable 47 ; 48 N SEG 49 K HDR,MSA,MAX,I 50 S MAX=HLCSTATE("SYSTEM","MAXSTRING")-40 ;MAX is the maximum that can be safely stored on a node, leaving room for the other fields stored with MSA seg 51 Q:'$$READHDR^HLOT(.HLCSTATE,.HDR) 0 52 F Q:'$$READSEG^HLOT(.HLCSTATE,.SEG) D 53 .I $E($E(SEG(1),1,3)_$E($G(SEG(2)),1,3),1,3)="MSA" D 54 ..S MSA="" 55 ..F I=1:1 Q:'$D(SEG(I)) S MSA=MSA_$S((MAX-$L(MSA))<1:"",1:$E(SEG(I),1,MAX)) 56 I $D(MSA),HLCSTATE("MESSAGE ENDED") D Q 1 57 .D SPLITHDR^HLOSRVR1(.HDR) 58 .S HLCSTATE("COUNTS","ACKS")=$G(HLCSTATE("COUNTS","ACKS"))+1 59 Q 0 60 ; 61 CONNECT(LINK,PORT,TIMEOUT,HLCSTATE) ; 62 ;sets up HLCSTATE() and opens a client connection 63 ;Input: 64 ; LINK - name of the link to connect to 65 ; PORT (optional) port # to connect to, defaults to that specified by the link 66 ; TIMEOUT (optional) specifies the open timeout in seconds, defaults to 30 67 ;Output: 68 ; HLCSTATE - array to hold the connection state 69 ; 70 I $G(HLCSTATE("CONNECTED")) D Q:HLCSTATE("CONNECTED") 71 .I $G(HLCSTATE("LINK","NAME"))]"",($G(HLCSTATE("LINK","NAME"))'=LINK) D CLOSE^HLOT(.HLCSTATE) Q 72 .I $G(HLCSTATE("LINK","NAME"))]"",$G(PORT),($G(HLCSTATE("LINK","PORT"))'=PORT) D CLOSE^HLOT(.HLCSTATE) Q 73 .I (HLCSTATE("SYSTEM","OS")="CACHE") D Q 74 ..U HLCSTATE("DEVICE") S HLCSTATE("CONNECTED")=($ZA\8192#2) 75 ..I 'HLCSTATE("CONNECTED") D CLOSE^HLOT(.HLCSTATE) 76 .;D CLOSE^HLOT(.HLCSTATE) 77 K HLCSTATE 78 N ARY,NODE 79 I '$$GETLINK^HLOTLNK(LINK,.ARY) S HLCSTATE("LINK","NAME")=LINK,HLCSTATE("LINK","PORT")=$G(PORT) D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0 80 M HLCSTATE("LINK")=ARY 81 I HLCSTATE("LINK","SHUTDOWN") S HLCSTATE("CONNECTED")=0 D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0 82 ;overlay the port if supplied from the queue 83 S:$G(PORT) HLCSTATE("LINK","PORT")=PORT 84 S HLCSTATE("READ TIMEOUT")=20 85 S HLCSTATE("OPEN TIMEOUT")=$S($G(TIMEOUT):TIMEOUT,1:30) 86 S HLCSTATE("COUNTS")=0 87 S HLCSTATE("READ")="" ;where the reads are stored 88 ; 89 ;HLCSTATE("BUFFER",<seg>,<line>) serves as a write buffer so that a lot can be written all at once 90 S HLCSTATE("BUFFER","BYTE COUNT")=0 ;count of BYTES in buffer 91 S HLCSTATE("BUFFER","SEGMENT COUNT")=0 ;count of segments in buffer 92 ; 93 S HLCSTATE("MESSAGE ENDED")=0 ;end of message flag 94 S NODE=^%ZOSF("OS") 95 S HLCSTATE("SERVER")=0 96 S HLCSTATE("SYSTEM","OS")=$S(NODE["DSM":"DSM",NODE["OpenM":"CACHE",NODE["G.TM":"G.TM",1:"") 97 I HLCSTATE("SYSTEM","OS")="" D LINKDOWN^HLOCLNT(.HLCSTATE) Q 0 98 D 99 .N SYS 100 .D SYSPARMS^HLOSITE(.SYS) 101 .S HLCSTATE("SYSTEM","BUFFER")=SYS("HL7 BUFFER") 102 .S HLCSTATE("SYSTEM","MAXSTRING")=SYS("MAXSTRING") 103 .S HLCSTATE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE") 104 .S HLCSTATE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE") 105 I HLCSTATE("LINK","LLP")="TCP" D 106 .S HLCSTATE("OPEN")="OPEN^HLOTCP" 107 E ;no other LLP implemented 108 D OPEN^HLOT(.HLCSTATE) 109 ; 110 ;mark the failure time for the link so other processes know not to try for a while 111 I 'HLCSTATE("CONNECTED") D LINKDOWN^HLOCLNT(.HLCSTATE) 112 Q HLCSTATE("CONNECTED") 113 ; 114 BADMSGS(WORK) ; 115 ;finds messages that won't transmit after 8 hours of trying and takes them off the outgoing queue 116 N LINK 117 S LINK="" 118 F S LINK=$O(^HLTMP("FAILING LINKS",LINK)) Q:LINK="" D 119 .N TIME,QUE,COUNT 120 .S TIME=$G(^HLTMP("FAILING LINKS",LINK)) Q:TIME="" 121 .Q:$$HDIFF^XLFDT($H,TIME,2)<28800 ;8 hours 122 .Q:'$$IFOPEN^HLOUSR1(LINK) 123 .L +^HLB("QUEUE","OUT",LINK):0 124 .S QUE="" 125 .F S QUE=$O(^HLB("QUEUE","OUT",LINK,QUE)) Q:QUE="" D 126 ..N MSG S MSG=0 127 ..S MSG=$O(^HLB("QUEUE","OUT",LINK,QUE,MSG)) 128 ..Q:'MSG 129 ..S COUNT=$G(^HLB(MSG,"TRIES")) 130 ..I COUNT>20 D 131 ...N NODE0,NODE1,NODE2,TIME,RAPP,SAPP,FS,CS,ACTION,MTYPE,EVENT 132 ...S NODE0=$G(^HLB(MSG,0)) 133 ...Q:'$P(NODE0,"^",2) 134 ...S TIME=$$NOW^XLFDT 135 ...S NODE1=$G(^HLB(MSG,1)) 136 ...S NODE2=$G(^HLB(MSG,2)) 137 ...S FS=$E(NODE1,4) 138 ...Q:FS="" 139 ...S CS=$E(NODE1,5) 140 ...Q:CS="" 141 ...S SAPP=$P(NODE1,FS,3) 142 ...S:SAPP="" SAPP="UNKNOWN" 143 ...S RAPP=$P(NODE1,FS,5) 144 ...S MTYPE=$P($P(NODE2,FS,4),CS) 145 ...S EVENT=$P($P(NODE2,FS,4),CS,2) 146 ...S $P(^HLB(MSG,0),"^",21)=COUNT_" FAILED TRANSMISSIONS" 147 ...S $P(^HLB(MSG,0),"^",20)="TF" 148 ...S ^HLB("ERRORS","TF",SAPP,TIME,MSG)="" 149 ...D COUNT^HLOESTAT("OUT",RAPP,SAPP,MTYPE,EVENT) 150 ...S ACTION=$P(NODE0,"^",14,15) 151 ...I ACTION'="^",ACTION]"" D INQUE^HLOQUE(LINK,QUE,MSG,ACTION,1) 152 ...D DEQUE^HLOQUE(LINK,QUE,"OUT",MSG) 153 .L -^HLB("QUEUE","OUT",LINK) 154 Q
Note:
See TracChangeset
for help on using the changeset viewer.
