source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLVOOR.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1SRHLVOOR ;B'HAM ISC/DLR - Surgery Interface Outgoing ORU message ; [ 06/02/98 9:04 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 ;
12INIT S HLDAP=$O(^HL(771,"B","SR SURGERY",0)) Q:$G(HLDAP)=""
13 Q:$P($G(^HL(771,HLDAP,0)),U,2)'="a"
14 ;check for the existence of file 133.2
15 Q:'$D(^SRO(133.2,0))
16 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
17 I '$D(SRSTATUS) D STATUS^SROERR0
18 I SRSTATUS="(REQUESTED)"!(SRSTATUS="(SCHEDULED)")!(SRSTATUS="(DELETED)")!(SRSTATUS="(CANCELLED)") Q
19START ;
20 N SRNAP
21 K ^TMP("HLS",$J)
22 N HLCOMP,HLSUB,HLREP,SRI,SRX,UPDATE,PRT,OUT
23 S (UPDATE,SRI)=1,PRT=0,SRX=$O(^HL(770,"B","SR AAIS",0)) Q:'SRX S SRNAP=$O(^HL(771,"B","SR AAIS",0)) I SRNAP D:$P($G(^HL(771,SRNAP,0)),"^",2)="a"
24 .S PRT=PRT+1
25 .S HLNDAP=SRX D INIT^HLTRANS S HLMTN="ORU",HLSDT=1
26 .S:HLFS="" HLFS="^" S:HLECH="" HLECH="~|\&" S HLQ=""""""
27 .S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)
28 .;check outgoing message for duplication, if OBR segment exists
29 .D:'$D(^TMP("HLS",$J)) SEG
30 .I $G(OUT)'=1 D CHECK I $G(UPDATE)=0 S OUT=1
31 .I $G(OUT)'=1 D DISPLAY,SEND
32EXIT ;
33 D KILL^HLTRANS
34 Q
35SEG ;segments
36 D PID^SRHLVUO(.SRI)
37 ;check for OBR, if none exist quit
38 S OBRCHK=SRI
39 D OBR^SRHLVUO4(.SRI,CASE)
40 I OBRCHK=SRI S OUT=1
41 Q
42SEND ;
43 I $G(UPDATE)=1 D EN^HLTRANS
44 K HLMTN,HLSDT
45 Q
46DISPLAY ;screen message to user
47 W !,"Sending an observation result message for case #",CASE
48 Q
49CHECK ;checks ^XTMP for duplicate modification messages
50 N X
51 I $D(^XTMP("SRHL7"_CASE,SRNAP_"ORU",0)) D
52 .S (UPDATE,X)=0 F S X=$O(^TMP("HLS",$J,HLSDT,X)) Q:'X!($G(UPDATE)=1) D
53 ..I '$D(^XTMP("SRHL7"_CASE,SRNAP_"ORU",X)) S UPDATE=1 Q
54 ..I ^TMP("HLS",$J,HLSDT,X)'=^XTMP("SRHL7"_CASE,SRNAP_"ORU",X) S UPDATE=1
55 .I $O(^XTMP("SRHL7"_CASE,SRNAP_"ORU",X)) S UPDATE=1
56 I '$D(^XTMP("SRHL7"_CASE,SRNAP_"ORU",0))!($G(UPDATE)=1) K ^XTMP("SRHL7"_CASE,SRNAP_"ORU") S ^XTMP("SRHL7"_CASE,SRNAP_"ORU",0)=DT D
57 .S X=0 F S X=$O(^TMP("HLS",$J,HLSDT,X)) Q:'X S ^XTMP("SRHL7"_CASE,SRNAP_"ORU",X)=^TMP("HLS",$J,HLSDT,X)
58 Q
Note: See TracBrowser for help on using the repository browser.