| 1 | SRHLVZIU ;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.
|
|---|
| 4 | MSG(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 | ;
|
|---|
| 11 | START ;
|
|---|
| 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
|
|---|
| 26 | EXIT ;
|
|---|
| 27 | Q
|
|---|
| 28 | SEG ;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
|
|---|
| 40 | SEND ;
|
|---|
| 41 | I $G(UPDATE)=1 D EN^HLTRANS
|
|---|
| 42 | I SRSTATUS="(DELETED)" K ^XTMP("SRHL7"_CASE,HLNDAP)
|
|---|
| 43 | K HLMTN,HLSDT
|
|---|
| 44 | Q
|
|---|
| 45 | CHECK ;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
|
|---|
| 55 | DISPLAY ;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
|
|---|
