- SRHLVOOR ;B'HAM ISC/DLR - Surgery Interface Outgoing ORU message ; [ 06/02/98 9:04 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 ORU 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, if SRSTATUS is equal to (NOT COMPLETE), (COMPLETE), or
- ;(ABORTED): S12 New Appointment; S13 Reschedule; S14 Modification;
- ;S15 Cancellation; and S17 Deletion. The events codes are set to
- ;SREVENT within the surgery routine options.
- ;
- INIT S HLDAP=$O(^HL(771,"B","SR SURGERY",0)) Q:$G(HLDAP)=""
- Q:$P($G(^HL(771,HLDAP,0)),U,2)'="a"
- ;check for the existence of file 133.2
- Q:'$D(^SRO(133.2,0))
- 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
- I '$D(SRSTATUS) D STATUS^SROERR0
- I SRSTATUS="(REQUESTED)"!(SRSTATUS="(SCHEDULED)")!(SRSTATUS="(DELETED)")!(SRSTATUS="(CANCELLED)") Q
- START ;
- N SRNAP
- K ^TMP("HLS",$J)
- N HLCOMP,HLSUB,HLREP,SRI,SRX,UPDATE,PRT,OUT
- 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"
- .S PRT=PRT+1
- .S HLNDAP=SRX D INIT^HLTRANS S HLMTN="ORU",HLSDT=1
- .S:HLFS="" HLFS="^" S:HLECH="" HLECH="~|\&" S HLQ=""""""
- .S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)
- .;check outgoing message for duplication, if OBR segment exists
- .D:'$D(^TMP("HLS",$J)) SEG
- .I $G(OUT)'=1 D CHECK I $G(UPDATE)=0 S OUT=1
- .I $G(OUT)'=1 D DISPLAY,SEND
- EXIT ;
- D KILL^HLTRANS
- Q
- SEG ;segments
- D PID^SRHLVUO(.SRI)
- ;check for OBR, if none exist quit
- S OBRCHK=SRI
- D OBR^SRHLVUO4(.SRI,CASE)
- I OBRCHK=SRI S OUT=1
- Q
- SEND ;
- I $G(UPDATE)=1 D EN^HLTRANS
- K HLMTN,HLSDT
- Q
- DISPLAY ;screen message to user
- W !,"Sending an observation result message for case #",CASE
- Q
- CHECK ;checks ^XTMP for duplicate modification messages
- N X
- I $D(^XTMP("SRHL7"_CASE,SRNAP_"ORU",0)) D
- .S (UPDATE,X)=0 F S X=$O(^TMP("HLS",$J,HLSDT,X)) Q:'X!($G(UPDATE)=1) D
- ..I '$D(^XTMP("SRHL7"_CASE,SRNAP_"ORU",X)) S UPDATE=1 Q
- ..I ^TMP("HLS",$J,HLSDT,X)'=^XTMP("SRHL7"_CASE,SRNAP_"ORU",X) S UPDATE=1
- .I $O(^XTMP("SRHL7"_CASE,SRNAP_"ORU",X)) S UPDATE=1
- 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
- .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)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVOOR 2607 printed Jan 18, 2025@03:40:41 Page 2
- SRHLVOOR ;B'HAM ISC/DLR - Surgery Interface Outgoing ORU message ; [ 06/02/98 9:04 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 ORU 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, if SRSTATUS is equal to (NOT COMPLETE), (COMPLETE), or
- +4 ;(ABORTED): S12 New Appointment; S13 Reschedule; S14 Modification;
- +5 ;S15 Cancellation; and S17 Deletion. The events codes are set to
- +6 ;SREVENT within the surgery routine options.
- +7 ;
- INIT SET HLDAP=$ORDER(^HL(771,"B","SR SURGERY",0))
- if $GET(HLDAP)=""
- QUIT
- +1 if $PIECE($GET(^HL(771,HLDAP,0)),U,2)'="a"
- QUIT
- +2 ;check for the existence of file 133.2
- +3 if '$DATA(^SRO(133.2,0))
- QUIT
- +4 IF $PIECE(^SRO(133.2,$ORDER(^SRO(133.2,"AC","OPERATION",0)),0),U,4)'["S"
- IF $PIECE(^SRO(133.2,$ORDER(^SRO(133.2,"AC","PROCEDURE",0)),0),U,4)'["S"
- QUIT
- +5 IF '$DATA(SRSTATUS)
- DO STATUS^SROERR0
- +6 IF SRSTATUS="(REQUESTED)"!(SRSTATUS="(SCHEDULED)")!(SRSTATUS="(DELETED)")!(SRSTATUS="(CANCELLED)")
- QUIT
- START ;
- +1 NEW SRNAP
- +2 KILL ^TMP("HLS",$JOB)
- +3 NEW HLCOMP,HLSUB,HLREP,SRI,SRX,UPDATE,PRT,OUT
- +4 SET (UPDATE,SRI)=1
- SET PRT=0
- SET SRX=$ORDER(^HL(770,"B","SR AAIS",0))
- if 'SRX
- QUIT
- SET SRNAP=$ORDER(^HL(771,"B","SR AAIS",0))
- IF SRNAP
- if $PIECE($GET(^HL(771,SRNAP,0)),"^",2)="a"
- Begin DoDot:1
- +5 SET PRT=PRT+1
- +6 SET HLNDAP=SRX
- DO INIT^HLTRANS
- SET HLMTN="ORU"
- SET HLSDT=1
- +7 if HLFS=""
- SET HLFS="^"
- if HLECH=""
- SET HLECH="~|\&"
- SET HLQ=""""""
- +8 SET HLCOMP=$EXTRACT(HLECH,1)
- SET HLREP=$EXTRACT(HLECH,2)
- SET HLSUB=$EXTRACT(HLECH,4)
- +9 ;check outgoing message for duplication, if OBR segment exists
- +10 if '$DATA(^TMP("HLS",$JOB))
- DO SEG
- +11 IF $GET(OUT)'=1
- DO CHECK
- IF $GET(UPDATE)=0
- SET OUT=1
- +12 IF $GET(OUT)'=1
- DO DISPLAY
- DO SEND
- End DoDot:1
- EXIT ;
- +1 DO KILL^HLTRANS
- +2 QUIT
- SEG ;segments
- +1 DO PID^SRHLVUO(.SRI)
- +2 ;check for OBR, if none exist quit
- +3 SET OBRCHK=SRI
- +4 DO OBR^SRHLVUO4(.SRI,CASE)
- +5 IF OBRCHK=SRI
- SET OUT=1
- +6 QUIT
- SEND ;
- +1 IF $GET(UPDATE)=1
- DO EN^HLTRANS
- +2 KILL HLMTN,HLSDT
- +3 QUIT
- DISPLAY ;screen message to user
- +1 WRITE !,"Sending an observation result message for case #",CASE
- +2 QUIT
- CHECK ;checks ^XTMP for duplicate modification messages
- +1 NEW X
- +2 IF $DATA(^XTMP("SRHL7"_CASE,SRNAP_"ORU",0))
- Begin DoDot:1
- +3 SET (UPDATE,X)=0
- FOR
- SET X=$ORDER(^TMP("HLS",$JOB,HLSDT,X))
- if 'X!($GET(UPDATE)=1)
- QUIT
- Begin DoDot:2
- +4 IF '$DATA(^XTMP("SRHL7"_CASE,SRNAP_"ORU",X))
- SET UPDATE=1
- QUIT
- +5 IF ^TMP("HLS",$JOB,HLSDT,X)'=^XTMP("SRHL7"_CASE,SRNAP_"ORU",X)
- SET UPDATE=1
- End DoDot:2
- +6 IF $ORDER(^XTMP("SRHL7"_CASE,SRNAP_"ORU",X))
- SET UPDATE=1
- End DoDot:1
- +7 IF '$DATA(^XTMP("SRHL7"_CASE,SRNAP_"ORU",0))!($GET(UPDATE)=1)
- KILL ^XTMP("SRHL7"_CASE,SRNAP_"ORU")
- SET ^XTMP("SRHL7"_CASE,SRNAP_"ORU",0)=DT
- Begin DoDot:1
- +8 SET X=0
- FOR
- SET X=$ORDER(^TMP("HLS",$JOB,HLSDT,X))
- if 'X
- QUIT
- SET ^XTMP("SRHL7"_CASE,SRNAP_"ORU",X)=^TMP("HLS",$JOB,HLSDT,X)
- End DoDot:1
- +9 QUIT