source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLVZIU.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SRHLVZIU ;B'HAM ISC/DLR - Surgery Interface Sender of Scheduling Information Unsolicited ; [ 05/28/98 11:29 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 ZSQ 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: S12 New Appointment; S13 Reschedule; S14 Modification;
8 ;S15 Cancellation; and S17 Deletion. The events codes are set to
9 ;SREVENT within the surgery routine options.
10 ;
11START ;
12 I '$D(SRSTATUS) D STATUS^SROERR0
13 S HLDAP=$O(^HL(771,"B","SR SURGERY",0)) Q:$G(HLDAP)=""
14 Q:$P($G(^HL(771,HLDAP,0)),U,2)'="a"
15 K ^TMP("HLS",$J)
16 N HLSUB,HLREP,SRX,UPDATE,PRT,OUT
17 S (SRI,UPDATE)=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"
18 .S PRT=PRT+1
19 .S HLNDAP=SRX D INIT^HLTRANS S HLMTN="ZIU",HLSDT=1
20 .;default separator and encoding characters
21 .S:HLFS="" HLFS="^" S:HLECH="" HLECH="~|\&" S HLQ=""""""
22 .S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)
23 .D:'$D(^TMP("HLS",$J)) SEG
24 .D CHECK I $G(UPDATE)=0 S OUT=1
25 .I $G(OUT)'=1 D DISPLAY,SEND
26EXIT ;
27 Q
28SEG ;segments
29 D ZCH^SRHLVUO1(.SRI,.SREVENT,.SRSTATUS)
30 I $G(SRSTATUS)'="(DELETED)" D
31 .D PID^SRHLVUO(.SRI)
32 .D OBX^SRHLVUO(.SRI)
33 .D DG1^SRHLVUO(.SRI)
34 .D AL1^SRHLVUO(.SRI)
35 .D ZIS^SRHLVUO2(.SRI)
36 .D ZIG^SRHLVUO1(.SRI)
37 .D ZIL^SRHLVUO1(.SRI)
38 .D ZIP^SRHLVUO1(.SRI)
39 Q
40SEND ;
41 I $G(UPDATE)=1 D EN^HLTRANS
42 I SRSTATUS="(DELETED)" K ^XTMP("SRHL7"_CASE,HLNDAP)
43 K HLMTN,HLSDT
44 Q
45CHECK ;checks ^XTMP for duplicate modification messages
46 N X
47 I $D(^XTMP("SRHL7"_CASE,SRNAP,0)) D
48 .S (UPDATE,X)=0 F S X=$O(^TMP("HLS",$J,HLSDT,X)) Q:'X!($G(UPDATE)=1) D
49 ..I '$D(^XTMP("SRHL7"_CASE,SRNAP,X)) S UPDATE=1 Q
50 ..I ^TMP("HLS",$J,HLSDT,X)'=^XTMP("SRHL7"_CASE,SRNAP,X) S UPDATE=1
51 .I $O(^XTMP("SRHL7"_CASE,SRNAP,X)) S UPDATE=1
52 I '$D(^XTMP("SRHL7"_CASE,SRNAP,0))!($G(UPDATE)=1) K ^XTMP("SRHL7"_CASE,SRNAP) S ^XTMP("SRHL7"_CASE,SRNAP,0)=DT D
53 .S X=0 F S X=$O(^TMP("HLS",$J,HLSDT,X)) Q:'X S ^XTMP("SRHL7"_CASE,SRNAP,X)=^TMP("HLS",$J,HLSDT,X)
54 Q
55DISPLAY ;screen message to user
56 N X
57 W !,"Sending a "
58 I SREVENT="S12" W "New Appointment booking"
59 I SREVENT="S13" W "Reschedule"
60 I SREVENT="S14" W "Modification"
61 I SREVENT="S15" W "Cancellation"
62 I SREVENT="S17" W "Deletion"
63 W " for case #",CASE
64 Q
Note: See TracBrowser for help on using the repository browser.