| [613] | 1 | SRHLOORU ;B'HAM ISC/DLR - Surgery Interface Outgoing ORU message ; [ 05/19/98 9:33 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**41**;24 Jun 93
|
|---|
| 3 | ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | MSG(CASE,SRSTATUS,SREVENT) ;send ORU message
|
|---|
| 5 | ;This message is sent for every event point within the surgery options.
|
|---|
| 6 | ;There will be a ZIU message sent for each of the following surgery
|
|---|
| 7 | ;events, if SRSTATUS is equal to (NOT COMPLETE), (COMPLETE), or
|
|---|
| 8 | ;(ABORTED): S12 New Appointment; S13 Reschedule; S14 Modification;
|
|---|
| 9 | ;S15 Cancellation; and S17 Deletion. The events codes are set to
|
|---|
| 10 | ;SREVENT within the surgery routine options.
|
|---|
| 11 | ;
|
|---|
| 12 | I $$V^SRHLU D MSG^SRHLVOOR(CASE,SRSTATUS,CASE) Q
|
|---|
| 13 | I SRSTATUS="(REQUESTED)"!(SRSTATUS="(SCHEDULED)")!(SRSTATUS="(DELETED)")!(SRSTATUS="(CANCELLED)") Q
|
|---|
| 14 | START ;
|
|---|
| 15 | S HLDAP=$O(^HL(771,"B","SR SURGERY",0)) Q:$G(HLDAP)=""
|
|---|
| 16 | Q:$P($G(^HL(771,HLDAP,0)),U,2)'="a"
|
|---|
| 17 | ;check for the existence of file 133.2
|
|---|
| 18 | Q:'$D(^SRO(133.2,0))
|
|---|
| 19 | I $P(^SRO(133.2,$O(^SRO(133.2,"AC","OPERATION",0)),0),U,4)'["S",$P(^SRO(133.2,$O(^SRO(133.2,"AC","PROCEDURE",0)),0),U,4)'["S" Q
|
|---|
| 20 | K ^TMP("HLS",$J)
|
|---|
| 21 | N HLCOMP,HLSUB,HLREP,SRI,SRX,UPDATE,PRT,OUT
|
|---|
| 22 | ;V. 1.6 interface
|
|---|
| 23 | ;EID - IEN of event protocol
|
|---|
| 24 | ;HL - array of output parameters
|
|---|
| 25 | ;INT - only for VISTA-to-VISTA message exchange
|
|---|
| 26 | ;SRET - Surgery Event Trigger
|
|---|
| 27 | S SRET="SR Unsolicited transmission of VistA Requested Observation"
|
|---|
| 28 | S EID=$O(^ORD(101,"B",SRET,0)),HL="HL",INT=0
|
|---|
| 29 | D INIT^HLFNC2(EID,.HL,INT) S HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4),HLFS=HL("FS"),HLQ=HL("Q"),HLECH=HL("ECH")
|
|---|
| 30 | ;Q:'$O(HL("")) ;read HL for the error message
|
|---|
| 31 | D SEG
|
|---|
| 32 | ;SKIP duplicate messages
|
|---|
| 33 | D CHECK I $D(UPDATE) D GEN,DISPLAY
|
|---|
| 34 | EXIT ;
|
|---|
| 35 | Q
|
|---|
| 36 | GEN ;generate the message
|
|---|
| 37 | ;HLEID - IEN of event protocol
|
|---|
| 38 | ;HLARYTYP - acknowledgement array (see V. 1.6 HL7 doc)
|
|---|
| 39 | ;HLFORMAT - is HLMA is pre-formatted HL7 form
|
|---|
| 40 | ;HLMTIEN - IEN in 772
|
|---|
| 41 | ;HLRESLT - message ID and/or the error message (for output)
|
|---|
| 42 | ;HLP("CONTPTR") - continuation pointer field value (not used)
|
|---|
| 43 | ;HLP("PRIORITY") - priority field value (not used)
|
|---|
| 44 | ;HLP("SECURITY") - security information (not used)
|
|---|
| 45 | S HLEID=EID,HLARYTYP="GM",HLFORMAT=1,HLMTIEN="",HLRESLT=""
|
|---|
| 46 | D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP)
|
|---|
| 47 | Q
|
|---|
| 48 | SEG ;segments
|
|---|
| 49 | S SRI=1
|
|---|
| 50 | D PID^SRHLUO(.SRI,"HLS")
|
|---|
| 51 | D OBR^SRHLUO4(.SRI,CASE,"HLS")
|
|---|
| 52 | Q
|
|---|
| 53 | DISPLAY ;screen message to user
|
|---|
| 54 | W !,"Sending an observation result message for case #",CASE
|
|---|
| 55 | Q
|
|---|
| 56 | CHECK ;checks ^XTMP for duplicate modification messages
|
|---|
| 57 | N X
|
|---|
| 58 | I $D(^XTMP("SRHL7"_CASE,EID_"ORU",0)) D
|
|---|
| 59 | .S X=0 F S X=$O(^TMP("HLS",$J,X)) Q:'X!($D(UPDATE)) D
|
|---|
| 60 | ..I '$D(^XTMP("SRHL7"_CASE,EID_"ORU",X)) S UPDATE=1 Q
|
|---|
| 61 | ..I ^TMP("HLS",$J,X)'=^XTMP("SRHL7"_CASE,EID_"ORU",X) S UPDATE=1
|
|---|
| 62 | .I $O(^XTMP("SRHL7"_CASE,EID_"ORU",X)) S UPDATE=1
|
|---|
| 63 | I '$D(^XTMP("SRHL7"_CASE,EID_"ORU",0))!$D(UPDATE) K ^XTMP("SRHL7"_CASE,EID_"ORU") S UPDATE=1,^XTMP("SRHL7"_CASE,EID_"ORU",0)=DT D
|
|---|
| 64 | .S X=0 F S X=$O(^TMP("HLS",$J,X)) Q:'X S ^XTMP("SRHL7"_CASE,EID_"ORU",X)=^TMP("HLS",$J,X)
|
|---|
| 65 | Q
|
|---|
