source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLOORU.m@ 1749

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1SRHLOORU ;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.
4MSG(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
14START ;
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
34EXIT ;
35 Q
36GEN ;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
48SEG ;segments
49 S SRI=1
50 D PID^SRHLUO(.SRI,"HLS")
51 D OBR^SRHLUO4(.SRI,CASE,"HLS")
52 Q
53DISPLAY ;screen message to user
54 W !,"Sending an observation result message for case #",CASE
55 Q
56CHECK ;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
Note: See TracBrowser for help on using the repository browser.