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

HLUTIL.m

Go to the documentation of this file.
  1. HLUTIL ;SFISC/RJH- Utilities for HL7 TCP ;06/03/2008 11:20
  1. ;;1.6;HEALTH LEVEL SEVEN;**36,19,57,64,66,109,142**;Oct 13, 1995;Build 17
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;For TCP only
  1. MSGSTAT(X) ;message status
  1. ;input value: X = message id
  1. ;return value: status^status updated^error msg.^error type pointer^
  1. ;queue position or # of retries^# open failed^ack timeout
  1. ; status:
  1. ; 0 = message doesn't exist
  1. ; 1 = waiting in queue
  1. ; 1.5 = opening connection
  1. ; 1.7 = awaiting response, # of retries
  1. ; 2 = awaiting application ack
  1. ; 3 = successfully completed
  1. ; 4 = error
  1. ; 8 = being generated
  1. ; 9 = awaiting processing
  1. Q:$G(X)']"" 0
  1. N C,I,L,Y,Z
  1. S Y=$O(^HLMA("C",X,0)) Q:'Y 0
  1. ;lock node to flush disk buffers
  1. L +^HLMA(Y,"P"):3 S Z=$G(^HLMA(Y,"P"))
  1. S:'Z Z=0
  1. ;if pending, get queue position
  1. I +Z=1 D
  1. . ;get Logical Link, if msg. not in x-ref, then it is being sent
  1. . S L=+$P(^HLMA(Y,0),U,7) Q:'$D(^HLMA("AC","O",L,Y))
  1. . ;find position in queue, if greater than 2 - use 2
  1. . S I=Y F C=1:1:2 S I=$O(^HLMA("AC","O",L,I),-1) Q:'I
  1. . S $P(Z,U,5)=C
  1. L -^HLMA(Y,"P")
  1. Q Z
  1. ;
  1. MSGACT(X,HLIENACT) ;outgoing message action
  1. ;input value: X = message id
  1. ; HLIENACT = 1-cancel; 2-requeue
  1. ;return value: 1 = action sucessful
  1. ; 0 = action failed
  1. Q:$G(X)']"" 0
  1. N HLIEN,HLIEN0,HLSTAT,HLTCP,Y,LINK
  1. S HLIEN=+$O(^HLMA("C",X,0)) Q:'HLIEN 0
  1. S HLIEN0=$G(^HLMA(HLIEN,0)) Q:'HLIEN0 0
  1. ;must be outgoing
  1. Q:$P(HLIEN0,U,3)'="O" 0
  1. F Y=1:1:3 L +^HLMA(HLIEN,"P"):1 Q:$T H 1
  1. E Q 0
  1. ;
  1. ;**109**
  1. S LINK=$P($G(^HLMA(HLIEN,0)),"^",7)
  1. ;
  1. S HLSTAT=1
  1. ;cancel
  1. I HLIENACT=1 D
  1. . ;HLTCP is set so that file 773 is updated
  1. . S HLTCP=""
  1. . D STATUS^HLTF0(HLIEN,3,,"Cancelled by application",1)
  1. .;
  1. .;**109**
  1. . D DEQUE^HLCSREP(LINK,"O",HLIEN)
  1. .;
  1. ;requeue
  1. I HLIENACT=2 D
  1. . N DA,DIK,HLJ
  1. . ;check for type=outgoing and logical link, need for "AC" x-ref
  1. . I $P(HLIEN0,U,3)'="O"!('$P(HLIEN0,U,7)) S HLSTAT=0 Q
  1. . ;set status=pend transmission
  1. . S Y=$NA(HLJ(773,HLIEN_",")),@Y@(20)=1
  1. . ;delete status update, error msg, error type, date processed
  1. . S (@Y@(21),@Y@(22),@Y@(23),@Y@(100))="@"
  1. . D FILE^HLDIE("","HLJ","","MSGACT","HLUTIL") ; HL*1.6*109
  1. . ;**109**
  1. . ;need to set "AC" x-ref
  1. .; S DA=HLIEN,DIK="^HLMA(",DIK(1)="7^AC"
  1. .; D EN1^DIK
  1. .;
  1. .;**109**
  1. . D ENQUE^HLCSREP(LINK,"O",HLIEN)
  1. ;
  1. L -^HLMA(HLIEN,"P")
  1. Q HLSTAT
  1. ;
  1. CHKLL(X) ;check setup of Logical Link
  1. ;input value: X = institution number or name
  1. ;return value: 1 = setup OK
  1. ; 0 = LL setup incorrect
  1. N HLF,HLRESLT
  1. S HLF=$S(X:"I",1:"")
  1. D LINK^HLUTIL3(X,.HLRESLT,HLF)
  1. S X=+$O(HLRESLT(0)) Q:'X 0
  1. Q $$LLOK^HLCSLM(X)
  1. ;
  1. DONTPURG() ; set the DONT PURGE field to 1 in order to prevent the message
  1. ; from purging.
  1. ; return value : 1 for successfully set the field
  1. ; -1 for failure
  1. Q $$SETPURG(1)
  1. ;
  1. TOPURG() ; clear the DONT PURGE field to allow the message to be purged.
  1. ; return value : 0 for successfully clear the field
  1. ; -1 for failure
  1. Q $$SETPURG(0)
  1. ;
  1. SETPURG(STATUS) ; to set or to clear the DONT PURGE field
  1. ; HLMTIENS = ien in file 773 for this message
  1. ; input: 1 to set the DONT PURGE field
  1. ; 0 to clear the DONT PURGE field.
  1. ; return value: 1 means successfully set the DONT PURGE field
  1. ; 0 means successfully clear the DONT PURGE field
  1. ; -1 means fail to set or to clear the field
  1. I (STATUS'=1),(STATUS'=0) Q -1
  1. I '$D(^HLMA(+$G(HLMTIENS),0)) Q -1
  1. ;
  1. L +^HLMA(HLMTIENS):30
  1. E Q -1
  1. S $P(^HLMA(HLMTIENS,2),U)=STATUS
  1. L -^HLMA(HLMTIENS)
  1. Q STATUS
  1. ;
  1. REPROC(IEN,RTN) ; reprocessing message
  1. ; IEN- the message IEN in file 773
  1. ; RTN- the routine, to be Xecuted for processing the message
  1. ; return value: 0 for success, -1 for failure
  1. N HLMTIEN,HLMTIENS,HLNEXT,HLNODE,HLQUIT,HLERR,HLRESLT,HLTCP
  1. N HL,HDR,FS,ECH,HLMSA,X,X1,X2
  1. S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
  1. I '$D(^HLMA(+$G(IEN),0)) Q -1
  1. ;
  1. ; patch HL*1.6*142
  1. ; I $G(RTN)'["" Q -1
  1. I $G(RTN)']"" Q -1
  1. ;
  1. S (HLMTIENS,HLTCP)=+IEN,HLMTIEN=+^HLMA(HLMTIENS,0),HLMSA=$$MSA^HLTP3(HLMTIEN)
  1. M HDR=^HLMA(HLMTIENS,"MSH")
  1. D CHK^HLTPCK2(.HDR,.HL,.HLMSA)
  1. Q:HL'="" -1
  1. ;
  1. I RTN["D " X RTN
  1. I RTN'["D " D
  1. . I RTN["^" X "D "_RTN
  1. . I RTN'["^" X "D ^"_RTN
  1. S HLRESLT=0 S:($D(HLERR)) HLRESLT="9^"_$G(^HL(771.7,9,0))
  1. ; update the status
  1. D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S($D(HLERR):HLERR,HLRESLT:$P(HLRESLT,"^",2),1:""),1)
  1. Q 0