- 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 Jan 18, 2025@03:40:54 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