HLOF778A ;ALB/CJM-HL7 - Saving messages to file 778 (continued) ;02/04/2004
;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
;
;
NEW(HLMSTATE) ;
;This function creates a new entry in file 778.
;Input:
; HLMSTATE (required, pass by reference) These subscripts are expected:
;
;Output - the function returns the ien of the newly created record
;
N IEN,NODE,ID,STAT
S STAT="HLMSTATE(""STATUS"")"
S IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP)
Q:'IEN 0
S HLMSTATE("IEN")=IEN
;
D ;build the message header
.N HDR
.;for incoming messages the header segment should already exist
.;for outgoing messages must build the header segment
.I HLMSTATE("DIRECTION")="OUT" D Q
..I HLMSTATE("BATCH"),$G(HLMSTATE("ACK TO"))]"" S HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")=HLMSTATE("ACK TO")
..D BUILDHDR^HLOPBLD1(.HLMSTATE,$S(HLMSTATE("BATCH"):"BHS",1:"MSH"),.HDR)
..S HLMSTATE("HDR",1)=HDR(1),HLMSTATE("HDR",2)=HDR(2)
;
K ^HLB(IEN)
S ID=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
S NODE=ID_"^"_HLMSTATE("BODY")_"^"_$G(HLMSTATE("ACK TO"))_"^"_$S(HLMSTATE("DIRECTION")="IN":"I",1:"O")_"^"
S $P(NODE,"^",5)=$G(@STAT@("LINK NAME"))
S $P(NODE,"^",6)=$G(@STAT@("QUEUE"))
S $P(NODE,"^",8)=$G(@STAT@("PORT"))
S $P(NODE,"^",20)=$G(@STAT)
S $P(NODE,"^",21)=$G(@STAT@("ERROR TEXT"))
S $P(NODE,"^",16)=HLMSTATE("DT/TM")
;
I HLMSTATE("DIRECTION")="OUT" D
.S $P(NODE,"^",10)=$P($G(@STAT@("APP ACK RESPONSE")),"^")
.S $P(NODE,"^",11)=$P($G(@STAT@("APP ACK RESPONSE")),"^",2)
.S $P(NODE,"^",12)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^")
.S $P(NODE,"^",13)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^",2)
.S $P(NODE,"^",14)=$P($G(@STAT@("FAILURE RESPONSE")),"^")
.S $P(NODE,"^",15)=$P($G(@STAT@("FAILURE RESPONSE")),"^",2)
.;
.;for outgoing set these x-refs now, for incoming msgs set them later
.S ^HLB("B",ID,IEN)=""
.S ^HLB("C",HLMSTATE("BODY"),IEN)=""
.I ($G(@STAT)="SE") S ^HLB("ERRORS","SE",$S($L($G(HLMSTATE("HDR","RECEIVING APPLICATION"))):HLMSTATE("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),HLMSTATE("DT/TM CREATED"),IEN)=""
.;
.;save some space for the ack
.S:($G(HLMSTATE("HDR","ACCEPT ACK TYPE"))="AL") ^HLB(IEN,4)="^^^ "
I $G(HLMSTATE("STATUS","PURGE")) S $P(NODE,"^",9)=HLMSTATE("STATUS","PURGE"),^HLB("AD","OUT",HLMSTATE("STATUS","PURGE"),HLMSTATE("IEN"))=""
S ^HLB(IEN,0)=NODE
;
;store the message header
S ^HLB(IEN,1)=HLMSTATE("HDR",1)
S ^HLB(IEN,2)=HLMSTATE("HDR",2)
;
;if the msg is an app ack, update the original msg
I $G(HLMSTATE("ACK TO","IEN"))]"" D
.N ACKTO
.M ACKTO=HLMSTATE("ACK TO")
.S ACKTO("ACK BY")=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
.D ACKTO^HLOF778(.HLMSTATE,.ACKTO)
.S HLMSTATE("ACK TO","DONE")=1 ;because the update was already done, otherwise it might be done again
;
;The "SEARCH" x-ref will be created asynchronously
S ^HLTMP("PENDING SEARCH X-REF",$J,HLMSTATE("DT/TM CREATED"),IEN)=""
;
Q IEN
;
NEWIEN(DIR,TCP) ;
;This function uses a counter to get the next available ien for file 778. There are 4 different counters, each assigned as range of numbers, selected via the input parameters. It does not create a record.
;Inputs:
; DIR = "IN" or "OUT" (required)
; TCP = 1,0 (optional)
;Output - the function returns the next available ien. Several counters are used:
;
; <"OUT","TCP">
; <"OUT","NOT TCP">
; <"IN","TCP">
; <"IN","NOT TCP">
;
N IEN,COUNTER,INC
I DIR="OUT" S INC=$S(+$G(TCP):0,1:100000000000)
I DIR="IN" S INC=$S(+$G(TCP):200000000000,1:300000000000)
S COUNTER=$NA(^HLC("FILE778",DIR,$S(+$G(TCP):"TCP",1:"NOT TCP")))
AGAIN ;
S IEN=$$INC^HLOSITE(COUNTER,1)
I IEN>100000000000 D
.L +@COUNTER:200
.I $T,@COUNTER>100000000000 S @COUNTER=1,IEN=1
.L -@COUNTER
I IEN>100000000000 G AGAIN
Q (IEN+INC)
;
TCP() ;checks the link to see if its TCP, return 1 if yes, 0 if no or not defined
N IEN,TCP
S TCP=1
S IEN=$G(HLMSTATE("STATUS","LINK IEN"))
I IEN,$P($G(^HLCS(869.1,+$P($G(^HLCS(870,IEN,0)),"^",3),0)),"^")'="TCP" S TCP=0
Q TCP
;
GETWORK(WORK) ; Used by the Process Manager.
;Are there any messages that need the "SEARCH" x-ref set?
;Inputs:
; WORK (required, pass-by-reference)
; ("DOLLARJ")
; ("NOW") (required by the process manager, pass-by-reference)
;
L +^HLTMP("PENDING SEARCH X-REF"):0
Q:'$T 0
N OLD,DOLLARJ,SUCCESS,NOW
S SUCCESS=0
S NOW=$$SEC^XLFDT($H)
S (OLD,DOLLARJ)=$G(WORK("DOLLARJ"))
F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS
.N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,""))
.S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1
;
I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS
.N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,""))
.S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1
S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW
Q:WORK("DOLLARJ")]"" 1
L -^HLTMP("PENDING SEARCH X-REF")
Q 0
;
DOWORK(WORK) ;Used by the Process Manager
;Sets the "SEARCH" x-ref, running 100 seconds behind when the message record was created.
;
N MSGIEN,TIME
S TIME=0
F S TIME=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME)) Q:'TIME Q:((WORK("NOW")-$$SEC^XLFDT(TIME))<100) D
.S MSGIEN=0
.F S MSGIEN=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN)) Q:'MSGIEN D
..N MSG
..I $$GETMSG^HLOMSG(MSGIEN,.MSG) D
...Q:'MSG("DT/TM CREATED")
...I MSG("BATCH") D
....N HDR
....F Q:'$$NEXTMSG^HLOMSG(.MSG,.HDR) S MSG("HDR",1)=HDR(1),MSG("HDR",2)=HDR(2) D SET(.MSG)
...E D
....D SET(.MSG)
..K ^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN)
L -^HLTMP("PENDING SEARCH X-REF")
Q
;
SET(MSG) ;
;sets the ^HLB("SEARCH") x-ref
;
N APP,FS,CS,IEN
I MSG("DIRECTION")'="IN",MSG("DIRECTION")'="OUT" Q
S FS=$E(MSG("HDR",1),4)
Q:FS=""
S CS=$E(MSG("HDR",1),5)
S APP=$S(MSG("DIRECTION")="IN":$P($P(MSG("HDR",1),FS,5),CS),1:$P($P(MSG("HDR",1),FS,3),CS))
I APP="" S APP="UNKNOWN"
I MSG("BATCH") D
.N VALUE
.S VALUE=$P(MSG("HDR",2),FS,4)
.S MSG("MESSAGE TYPE")=$P(VALUE,CS)
.S MSG("EVENT")=$P(VALUE,CS,2)
Q:MSG("MESSAGE TYPE")=""
Q:MSG("EVENT")=""
S IEN=MSG("IEN")
I MSG("BATCH") S IEN=IEN_"^"_MSG("BATCH","CURRENT MESSAGE")
S ^HLB("SEARCH",MSG("DIRECTION"),MSG("DT/TM CREATED"),APP,MSG("MESSAGE TYPE"),MSG("EVENT"),IEN)=""
Q
HLOF778A ;ALB/CJM-HL7 - Saving messages to file 778 (continued) ;02/04/2004
+1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
+2 ;
+3 ;
NEW(HLMSTATE) ;
+1 ;This function creates a new entry in file 778.
+2 ;Input:
+3 ; HLMSTATE (required, pass by reference) These subscripts are expected:
+4 ;
+5 ;Output - the function returns the ien of the newly created record
+6 ;
+7 NEW IEN,NODE,ID,STAT
+8 SET STAT="HLMSTATE(""STATUS"")"
+9 SET IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP)
+10 IF 'IEN
QUIT 0
+11 SET HLMSTATE("IEN")=IEN
+12 ;
+13 ;build the message header
Begin DoDot:1
+14 NEW HDR
+15 ;for incoming messages the header segment should already exist
+16 ;for outgoing messages must build the header segment
+17 IF HLMSTATE("DIRECTION")="OUT"
Begin DoDot:2
+18 IF HLMSTATE("BATCH")
IF $GET(HLMSTATE("ACK TO"))]""
SET HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")=HLMSTATE("ACK TO")
+19 DO BUILDHDR^HLOPBLD1(.HLMSTATE,$SELECT(HLMSTATE("BATCH"):"BHS",1:"MSH"),.HDR)
+20 SET HLMSTATE("HDR",1)=HDR(1)
SET HLMSTATE("HDR",2)=HDR(2)
End DoDot:2
QUIT
End DoDot:1
+21 ;
+22 KILL ^HLB(IEN)
+23 SET ID=$SELECT(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
+24 SET NODE=ID_"^"_HLMSTATE("BODY")_"^"_$GET(HLMSTATE("ACK TO"))_"^"_$SELECT(HLMSTATE("DIRECTION")="IN":"I",1:"O")_"^"
+25 SET $PIECE(NODE,"^",5)=$GET(@STAT@("LINK NAME"))
+26 SET $PIECE(NODE,"^",6)=$GET(@STAT@("QUEUE"))
+27 SET $PIECE(NODE,"^",8)=$GET(@STAT@("PORT"))
+28 SET $PIECE(NODE,"^",20)=$GET(@STAT)
+29 SET $PIECE(NODE,"^",21)=$GET(@STAT@("ERROR TEXT"))
+30 SET $PIECE(NODE,"^",16)=HLMSTATE("DT/TM")
+31 ;
+32 IF HLMSTATE("DIRECTION")="OUT"
Begin DoDot:1
+33 SET $PIECE(NODE,"^",10)=$PIECE($GET(@STAT@("APP ACK RESPONSE")),"^")
+34 SET $PIECE(NODE,"^",11)=$PIECE($GET(@STAT@("APP ACK RESPONSE")),"^",2)
+35 SET $PIECE(NODE,"^",12)=$PIECE($GET(@STAT@("ACCEPT ACK RESPONSE")),"^")
+36 SET $PIECE(NODE,"^",13)=$PIECE($GET(@STAT@("ACCEPT ACK RESPONSE")),"^",2)
+37 SET $PIECE(NODE,"^",14)=$PIECE($GET(@STAT@("FAILURE RESPONSE")),"^")
+38 SET $PIECE(NODE,"^",15)=$PIECE($GET(@STAT@("FAILURE RESPONSE")),"^",2)
+39 ;
+40 ;for outgoing set these x-refs now, for incoming msgs set them later
+41 SET ^HLB("B",ID,IEN)=""
+42 SET ^HLB("C",HLMSTATE("BODY"),IEN)=""
+43 IF ($GET(@STAT)="SE")
SET ^HLB("ERRORS","SE",$SELECT($LENGTH($GET(HLMSTATE("HDR","RECEIVING APPLICATION"))):HLMSTATE("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),HLMSTATE("DT/TM CREATED"),IEN)=""
+44 ;
+45 ;save some space for the ack
+46 IF ($GET(HLMSTATE("HDR","ACCEPT ACK TYPE"))="AL")
SET ^HLB(IEN,4)="^^^ "
End DoDot:1
+47 IF $GET(HLMSTATE("STATUS","PURGE"))
SET $PIECE(NODE,"^",9)=HLMSTATE("STATUS","PURGE")
SET ^HLB("AD","OUT",HLMSTATE("STATUS","PURGE"),HLMSTATE("IEN"))=""
+48 SET ^HLB(IEN,0)=NODE
+49 ;
+50 ;store the message header
+51 SET ^HLB(IEN,1)=HLMSTATE("HDR",1)
+52 SET ^HLB(IEN,2)=HLMSTATE("HDR",2)
+53 ;
+54 ;if the msg is an app ack, update the original msg
+55 IF $GET(HLMSTATE("ACK TO","IEN"))]""
Begin DoDot:1
+56 NEW ACKTO
+57 MERGE ACKTO=HLMSTATE("ACK TO")
+58 SET ACKTO("ACK BY")=$SELECT(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
+59 DO ACKTO^HLOF778(.HLMSTATE,.ACKTO)
+60 ;because the update was already done, otherwise it might be done again
SET HLMSTATE("ACK TO","DONE")=1
End DoDot:1
+61 ;
+62 ;The "SEARCH" x-ref will be created asynchronously
+63 SET ^HLTMP("PENDING SEARCH X-REF",$JOB,HLMSTATE("DT/TM CREATED"),IEN)=""
+64 ;
+65 QUIT IEN
+66 ;
NEWIEN(DIR,TCP) ;
+1 ;This function uses a counter to get the next available ien for file 778. There are 4 different counters, each assigned as range of numbers, selected via the input parameters. It does not create a record.
+2 ;Inputs:
+3 ; DIR = "IN" or "OUT" (required)
+4 ; TCP = 1,0 (optional)
+5 ;Output - the function returns the next available ien. Several counters are used:
+6 ;
+7 ; <"OUT","TCP">
+8 ; <"OUT","NOT TCP">
+9 ; <"IN","TCP">
+10 ; <"IN","NOT TCP">
+11 ;
+12 NEW IEN,COUNTER,INC
+13 IF DIR="OUT"
SET INC=$SELECT(+$GET(TCP):0,1:100000000000)
+14 IF DIR="IN"
SET INC=$SELECT(+$GET(TCP):200000000000,1:300000000000)
+15 SET COUNTER=$NAME(^HLC("FILE778",DIR,$SELECT(+$GET(TCP):"TCP",1:"NOT TCP")))
AGAIN ;
+1 SET IEN=$$INC^HLOSITE(COUNTER,1)
+2 IF IEN>100000000000
Begin DoDot:1
+3 LOCK +@COUNTER:200
+4 IF $TEST
IF @COUNTER>100000000000
SET @COUNTER=1
SET IEN=1
+5 LOCK -@COUNTER
End DoDot:1
+6 IF IEN>100000000000
GOTO AGAIN
+7 QUIT (IEN+INC)
+8 ;
TCP() ;checks the link to see if its TCP, return 1 if yes, 0 if no or not defined
+1 NEW IEN,TCP
+2 SET TCP=1
+3 SET IEN=$GET(HLMSTATE("STATUS","LINK IEN"))
+4 IF IEN
IF $PIECE($GET(^HLCS(869.1,+$PIECE($GET(^HLCS(870,IEN,0)),"^",3),0)),"^")'="TCP"
SET TCP=0
+5 QUIT TCP
+6 ;
GETWORK(WORK) ; Used by the Process Manager.
+1 ;Are there any messages that need the "SEARCH" x-ref set?
+2 ;Inputs:
+3 ; WORK (required, pass-by-reference)
+4 ; ("DOLLARJ")
+5 ; ("NOW") (required by the process manager, pass-by-reference)
+6 ;
+7 LOCK +^HLTMP("PENDING SEARCH X-REF"):0
+8 IF '$TEST
QUIT 0
+9 NEW OLD,DOLLARJ,SUCCESS,NOW
+10 SET SUCCESS=0
+11 SET NOW=$$SEC^XLFDT($HOROLOG)
+12 SET (OLD,DOLLARJ)=$GET(WORK("DOLLARJ"))
+13 FOR
SET DOLLARJ=$ORDER(^HLTMP("PENDING SEARCH X-REF",DOLLARJ))
IF DOLLARJ=""
QUIT
Begin DoDot:1
+14 NEW TIME
SET TIME=$ORDER(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,""))
+15 IF (NOW-$$SEC^XLFDT(TIME)>100)
SET SUCCESS=1
End DoDot:1
IF SUCCESS
QUIT
+16 ;
+17 IF OLD'=""
IF 'SUCCESS
FOR
SET DOLLARJ=$ORDER(^HLTMP("PENDING SEARCH X-REF",DOLLARJ))
IF DOLLARJ=""
QUIT
IF DOLLARJ>OLD
QUIT
Begin DoDot:1
+18 NEW TIME
SET TIME=$ORDER(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,""))
+19 IF (NOW-$$SEC^XLFDT(TIME)>100)
SET SUCCESS=1
End DoDot:1
IF SUCCESS
QUIT
+20 SET WORK("DOLLARJ")=DOLLARJ
SET WORK("NOW")=NOW
+21 IF WORK("DOLLARJ")]""
QUIT 1
+22 LOCK -^HLTMP("PENDING SEARCH X-REF")
+23 QUIT 0
+24 ;
DOWORK(WORK) ;Used by the Process Manager
+1 ;Sets the "SEARCH" x-ref, running 100 seconds behind when the message record was created.
+2 ;
+3 NEW MSGIEN,TIME
+4 SET TIME=0
+5 FOR
SET TIME=$ORDER(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME))
IF 'TIME
QUIT
IF ((WORK("NOW")-$$SEC^XLFDT(TIME))<100)
QUIT
Begin DoDot:1
+6 SET MSGIEN=0
+7 FOR
SET MSGIEN=$ORDER(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN))
IF 'MSGIEN
QUIT
Begin DoDot:2
+8 NEW MSG
+9 IF $$GETMSG^HLOMSG(MSGIEN,.MSG)
Begin DoDot:3
+10 IF 'MSG("DT/TM CREATED")
QUIT
+11 IF MSG("BATCH")
Begin DoDot:4
+12 NEW HDR
+13 FOR
IF '$$NEXTMSG^HLOMSG(.MSG,.HDR)
QUIT
SET MSG("HDR",1)=HDR(1)
SET MSG("HDR",2)=HDR(2)
DO SET(.MSG)
End DoDot:4
+14 IF '$TEST
Begin DoDot:4
+15 DO SET(.MSG)
End DoDot:4
End DoDot:3
+16 KILL ^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN)
End DoDot:2
End DoDot:1
+17 LOCK -^HLTMP("PENDING SEARCH X-REF")
+18 QUIT
+19 ;
SET(MSG) ;
+1 ;sets the ^HLB("SEARCH") x-ref
+2 ;
+3 NEW APP,FS,CS,IEN
+4 IF MSG("DIRECTION")'="IN"
IF MSG("DIRECTION")'="OUT"
QUIT
+5 SET FS=$EXTRACT(MSG("HDR",1),4)
+6 IF FS=""
QUIT
+7 SET CS=$EXTRACT(MSG("HDR",1),5)
+8 SET APP=$SELECT(MSG("DIRECTION")="IN":$PIECE($PIECE(MSG("HDR",1),FS,5),CS),1:$PIECE($PIECE(MSG("HDR",1),FS,3),CS))
+9 IF APP=""
SET APP="UNKNOWN"
+10 IF MSG("BATCH")
Begin DoDot:1
+11 NEW VALUE
+12 SET VALUE=$PIECE(MSG("HDR",2),FS,4)
+13 SET MSG("MESSAGE TYPE")=$PIECE(VALUE,CS)
+14 SET MSG("EVENT")=$PIECE(VALUE,CS,2)
End DoDot:1
+15 IF MSG("MESSAGE TYPE")=""
QUIT
+16 IF MSG("EVENT")=""
QUIT
+17 SET IEN=MSG("IEN")
+18 IF MSG("BATCH")
SET IEN=IEN_"^"_MSG("BATCH","CURRENT MESSAGE")
+19 SET ^HLB("SEARCH",MSG("DIRECTION"),MSG("DT/TM CREATED"),APP,MSG("MESSAGE TYPE"),MSG("EVENT"),IEN)=""
+20 QUIT
