SRHLZIU ;B'HAM ISC/DLR - Surgery Interface Sender of Scheduling Information Unsolicited ; [ 05/19/98 9:35 AM ]
;;3.0; Surgery ;**41**;24 Jun 93
; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
MSG(CASE,SRSTATUS,SREVENT) ;Send ZSQ message.
;This message is sent for every event point within the surgery options.
;There will be a ZIU message sent for each of the following surgery
;events: S12 New Appointment; S13 Reschedule; S14 Modification;
;S15 Cancellation; and S17 Deletion. The events codes are set to
;SREVENT within the surgery routine options.
;
START ;
I $$V^SRHLU D MSG^SRHLVZIU(CASE,SRSTATUS,SREVENT) Q
S HLDAP=$O(^HL(771,"B","SR SURGERY",0)) Q:$G(HLDAP)=""
Q:$P($G(^HL(771,HLDAP,0)),U,2)'="a"
K ^TMP("HLS",$J)
N HLSUB,HLREP,SRX,SRDSP,SRET,UPDATE,PRT,OUT
;V. 1.6 interface
;EID - IEN of event protocol
;HL - array of output parameters
;INT - only for VISTA-to-VISTA message exchange
;SRET - Surgery Event Trigger
D EVNTP
S EID=$O(^ORD(101,"B",SRET,0)),HL="HL",INT=0
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")
;Q:'$O(HL("")) ;read HL for the error message
D SEG
D CHECK I $D(UPDATE) D GEN,DISPLAY
EXIT ;
K EID,HL,INT,^TMP("HLS",$J)
Q
GEN ;generate the message
;HLEID - IEN of event protocol
;HLARYTYP - acknowledgement array (see V. 1.6 HL7 doc)
;HLFORMAT - is HLMA is pre-formatted HL7 form
;HLMTIEN - IEN in 772
;HLRESLT - message ID and/or the error message (for output)
;HLP("CONTPTR") - continuation pointer field value (not used)
;HLP("PRIORITY") - priority field value (not used)
;HLP("SECURITY") - security information (not used)
S HLEID=EID,HLARYTYP="GM",HLFORMAT=1,HLMTIEN="",HLRESLT=""
D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP)
Q
SEG ;segments
N SRI
S SRI=1
D ZCH^SRHLUO1(.SRI,.SREVENT,.SRSTATUS,"HLS")
D PID^SRHLUO(.SRI,"HLS")
D AL1^SRHLUO(.SRI,"HLS")
D OBX^SRHLUO(.SRI,"HLS")
D DG1^SRHLUO(.SRI,"HLS")
D ZIS^SRHLUO2(.SRI,"HLS")
D ZIG^SRHLUO1(.SRI,"HLS")
D ZIP^SRHLUO1(.SRI,"HLS")
D ZIL^SRHLUO1(.SRI,"HLS")
Q
CHECK ;checks ^XTMP for duplicate modification messages
N X
I $D(^XTMP("SRHL7"_CASE,EID,0)) D
.S X=0 F S X=$O(^TMP("HLS",$J,X)) Q:'X!($D(UPDATE)) D
..I '$D(^XTMP("SRHL7"_CASE,EID,X)) S UPDATE=1 Q
..I ^TMP("HLS",$J,X)'=^XTMP("SRHL7"_CASE,EID,X) S UPDATE=1
.I $O(^XTMP("SRHL7"_CASE,EID,X)) S UPDATE=1
I '$D(^XTMP("SRHL7"_CASE,EID,0))!$D(UPDATE) K ^XTMP("SRHL7"_CASE,EID) S UPDATE=1,^XTMP("SRHL7"_CASE,EID,0)=DT D
.S X=0 F S X=$O(^TMP("HLS",$J,X)) Q:'X S ^XTMP("SRHL7"_CASE,EID,X)=^TMP("HLS",$J,X)
Q
DISPLAY ;screen message to user
W !,SRDSP
Q
EVNTP ;set Surgery event trigger protocol and display
S SRDSP="Sending a Notification of Appointment "
I SREVENT="S12" S X="Booking"
I SREVENT="S13" S X="Rescheduling"
I SREVENT="S14" S X="Modification"
I SREVENT="S15" S X="Cancellation"
I SREVENT="S17" S X="Deletion"
S SRDSP=SRDSP_X_" for case #"_CASE
S SRET="SR Notification of Appointment "_X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLZIU 3111 printed Dec 13, 2024@02:39:43 Page 2
SRHLZIU ;B'HAM ISC/DLR - Surgery Interface Sender of Scheduling Information Unsolicited ; [ 05/19/98 9:35 AM ]
+1 ;;3.0; Surgery ;**41**;24 Jun 93
+2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
MSG(CASE,SRSTATUS,SREVENT) ;Send ZSQ message.
+1 ;This message is sent for every event point within the surgery options.
+2 ;There will be a ZIU message sent for each of the following surgery
+3 ;events: S12 New Appointment; S13 Reschedule; S14 Modification;
+4 ;S15 Cancellation; and S17 Deletion. The events codes are set to
+5 ;SREVENT within the surgery routine options.
+6 ;
START ;
+1 IF $$V^SRHLU
DO MSG^SRHLVZIU(CASE,SRSTATUS,SREVENT)
QUIT
+2 SET HLDAP=$ORDER(^HL(771,"B","SR SURGERY",0))
if $GET(HLDAP)=""
QUIT
+3 if $PIECE($GET(^HL(771,HLDAP,0)),U,2)'="a"
QUIT
+4 KILL ^TMP("HLS",$JOB)
+5 NEW HLSUB,HLREP,SRX,SRDSP,SRET,UPDATE,PRT,OUT
+6 ;V. 1.6 interface
+7 ;EID - IEN of event protocol
+8 ;HL - array of output parameters
+9 ;INT - only for VISTA-to-VISTA message exchange
+10 ;SRET - Surgery Event Trigger
+11 DO EVNTP
+12 SET EID=$ORDER(^ORD(101,"B",SRET,0))
SET HL="HL"
SET INT=0
+13 DO INIT^HLFNC2(EID,.HL,INT)
SET HLCOMP=$EXTRACT(HL("ECH"),1)
SET HLREP=$EXTRACT(HL("ECH"),2)
SET HLSUB=$EXTRACT(HL("ECH"),4)
SET HLFS=HL("FS")
SET HLQ=HL("Q")
SET HLECH=HL("ECH")
+14 ;Q:'$O(HL("")) ;read HL for the error message
+15 DO SEG
+16 DO CHECK
IF $DATA(UPDATE)
DO GEN
DO DISPLAY
EXIT ;
+1 KILL EID,HL,INT,^TMP("HLS",$JOB)
+2 QUIT
GEN ;generate the message
+1 ;HLEID - IEN of event protocol
+2 ;HLARYTYP - acknowledgement array (see V. 1.6 HL7 doc)
+3 ;HLFORMAT - is HLMA is pre-formatted HL7 form
+4 ;HLMTIEN - IEN in 772
+5 ;HLRESLT - message ID and/or the error message (for output)
+6 ;HLP("CONTPTR") - continuation pointer field value (not used)
+7 ;HLP("PRIORITY") - priority field value (not used)
+8 ;HLP("SECURITY") - security information (not used)
+9 SET HLEID=EID
SET HLARYTYP="GM"
SET HLFORMAT=1
SET HLMTIEN=""
SET HLRESLT=""
+10 DO GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP)
+11 QUIT
SEG ;segments
+1 NEW SRI
+2 SET SRI=1
+3 DO ZCH^SRHLUO1(.SRI,.SREVENT,.SRSTATUS,"HLS")
+4 DO PID^SRHLUO(.SRI,"HLS")
+5 DO AL1^SRHLUO(.SRI,"HLS")
+6 DO OBX^SRHLUO(.SRI,"HLS")
+7 DO DG1^SRHLUO(.SRI,"HLS")
+8 DO ZIS^SRHLUO2(.SRI,"HLS")
+9 DO ZIG^SRHLUO1(.SRI,"HLS")
+10 DO ZIP^SRHLUO1(.SRI,"HLS")
+11 DO ZIL^SRHLUO1(.SRI,"HLS")
+12 QUIT
CHECK ;checks ^XTMP for duplicate modification messages
+1 NEW X
+2 IF $DATA(^XTMP("SRHL7"_CASE,EID,0))
Begin DoDot:1
+3 SET X=0
FOR
SET X=$ORDER(^TMP("HLS",$JOB,X))
if 'X!($DATA(UPDATE))
QUIT
Begin DoDot:2
+4 IF '$DATA(^XTMP("SRHL7"_CASE,EID,X))
SET UPDATE=1
QUIT
+5 IF ^TMP("HLS",$JOB,X)'=^XTMP("SRHL7"_CASE,EID,X)
SET UPDATE=1
End DoDot:2
+6 IF $ORDER(^XTMP("SRHL7"_CASE,EID,X))
SET UPDATE=1
End DoDot:1
+7 IF '$DATA(^XTMP("SRHL7"_CASE,EID,0))!$DATA(UPDATE)
KILL ^XTMP("SRHL7"_CASE,EID)
SET UPDATE=1
SET ^XTMP("SRHL7"_CASE,EID,0)=DT
Begin DoDot:1
+8 SET X=0
FOR
SET X=$ORDER(^TMP("HLS",$JOB,X))
if 'X
QUIT
SET ^XTMP("SRHL7"_CASE,EID,X)=^TMP("HLS",$JOB,X)
End DoDot:1
+9 QUIT
DISPLAY ;screen message to user
+1 WRITE !,SRDSP
+2 QUIT
EVNTP ;set Surgery event trigger protocol and display
+1 SET SRDSP="Sending a Notification of Appointment "
+2 IF SREVENT="S12"
SET X="Booking"
+3 IF SREVENT="S13"
SET X="Rescheduling"
+4 IF SREVENT="S14"
SET X="Modification"
+5 IF SREVENT="S15"
SET X="Cancellation"
+6 IF SREVENT="S17"
SET X="Deletion"
+7 SET SRDSP=SRDSP_X_" for case #"_CASE
+8 SET SRET="SR Notification of Appointment "_X
+9 QUIT
