SRHLVZIU ;B'HAM ISC/DLR - Surgery Interface Sender of Scheduling Information Unsolicited ; [ 05/28/98 11:29 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 '$D(SRSTATUS) D STATUS^SROERR0
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,UPDATE,PRT,OUT
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"
.S PRT=PRT+1
.S HLNDAP=SRX D INIT^HLTRANS S HLMTN="ZIU",HLSDT=1
.;default separator and encoding characters
.S:HLFS="" HLFS="^" S:HLECH="" HLECH="~|\&" S HLQ=""""""
.S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)
.D:'$D(^TMP("HLS",$J)) SEG
.D CHECK I $G(UPDATE)=0 S OUT=1
.I $G(OUT)'=1 D DISPLAY,SEND
EXIT ;
Q
SEG ;segments
D ZCH^SRHLVUO1(.SRI,.SREVENT,.SRSTATUS)
I $G(SRSTATUS)'="(DELETED)" D
.D PID^SRHLVUO(.SRI)
.D OBX^SRHLVUO(.SRI)
.D DG1^SRHLVUO(.SRI)
.D AL1^SRHLVUO(.SRI)
.D ZIS^SRHLVUO2(.SRI)
.D ZIG^SRHLVUO1(.SRI)
.D ZIL^SRHLVUO1(.SRI)
.D ZIP^SRHLVUO1(.SRI)
Q
SEND ;
I $G(UPDATE)=1 D EN^HLTRANS
I SRSTATUS="(DELETED)" K ^XTMP("SRHL7"_CASE,HLNDAP)
K HLMTN,HLSDT
Q
CHECK ;checks ^XTMP for duplicate modification messages
N X
I $D(^XTMP("SRHL7"_CASE,SRNAP,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,X)) S UPDATE=1 Q
..I ^TMP("HLS",$J,HLSDT,X)'=^XTMP("SRHL7"_CASE,SRNAP,X) S UPDATE=1
.I $O(^XTMP("SRHL7"_CASE,SRNAP,X)) S UPDATE=1
I '$D(^XTMP("SRHL7"_CASE,SRNAP,0))!($G(UPDATE)=1) K ^XTMP("SRHL7"_CASE,SRNAP) S ^XTMP("SRHL7"_CASE,SRNAP,0)=DT D
.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)
Q
DISPLAY ;screen message to user
N X
W !,"Sending a "
I SREVENT="S12" W "New Appointment booking"
I SREVENT="S13" W "Reschedule"
I SREVENT="S14" W "Modification"
I SREVENT="S15" W "Cancellation"
I SREVENT="S17" W "Deletion"
W " for case #",CASE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVZIU 2501 printed Nov 22, 2024@17:49:38 Page 2
SRHLVZIU ;B'HAM ISC/DLR - Surgery Interface Sender of Scheduling Information Unsolicited ; [ 05/28/98 11:29 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 '$DATA(SRSTATUS)
DO STATUS^SROERR0
+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,UPDATE,PRT,OUT
+6 SET (SRI,UPDATE)=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
+7 SET PRT=PRT+1
+8 SET HLNDAP=SRX
DO INIT^HLTRANS
SET HLMTN="ZIU"
SET HLSDT=1
+9 ;default separator and encoding characters
+10 if HLFS=""
SET HLFS="^"
if HLECH=""
SET HLECH="~|\&"
SET HLQ=""""""
+11 SET HLCOMP=$EXTRACT(HLECH,1)
SET HLREP=$EXTRACT(HLECH,2)
SET HLSUB=$EXTRACT(HLECH,4)
+12 if '$DATA(^TMP("HLS",$JOB))
DO SEG
+13 DO CHECK
IF $GET(UPDATE)=0
SET OUT=1
+14 IF $GET(OUT)'=1
DO DISPLAY
DO SEND
End DoDot:1
EXIT ;
+1 QUIT
SEG ;segments
+1 DO ZCH^SRHLVUO1(.SRI,.SREVENT,.SRSTATUS)
+2 IF $GET(SRSTATUS)'="(DELETED)"
Begin DoDot:1
+3 DO PID^SRHLVUO(.SRI)
+4 DO OBX^SRHLVUO(.SRI)
+5 DO DG1^SRHLVUO(.SRI)
+6 DO AL1^SRHLVUO(.SRI)
+7 DO ZIS^SRHLVUO2(.SRI)
+8 DO ZIG^SRHLVUO1(.SRI)
+9 DO ZIL^SRHLVUO1(.SRI)
+10 DO ZIP^SRHLVUO1(.SRI)
End DoDot:1
+11 QUIT
SEND ;
+1 IF $GET(UPDATE)=1
DO EN^HLTRANS
+2 IF SRSTATUS="(DELETED)"
KILL ^XTMP("SRHL7"_CASE,HLNDAP)
+3 KILL HLMTN,HLSDT
+4 QUIT
CHECK ;checks ^XTMP for duplicate modification messages
+1 NEW X
+2 IF $DATA(^XTMP("SRHL7"_CASE,SRNAP,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,X))
SET UPDATE=1
QUIT
+5 IF ^TMP("HLS",$JOB,HLSDT,X)'=^XTMP("SRHL7"_CASE,SRNAP,X)
SET UPDATE=1
End DoDot:2
+6 IF $ORDER(^XTMP("SRHL7"_CASE,SRNAP,X))
SET UPDATE=1
End DoDot:1
+7 IF '$DATA(^XTMP("SRHL7"_CASE,SRNAP,0))!($GET(UPDATE)=1)
KILL ^XTMP("SRHL7"_CASE,SRNAP)
SET ^XTMP("SRHL7"_CASE,SRNAP,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,X)=^TMP("HLS",$JOB,HLSDT,X)
End DoDot:1
+9 QUIT
DISPLAY ;screen message to user
+1 NEW X
+2 WRITE !,"Sending a "
+3 IF SREVENT="S12"
WRITE "New Appointment booking"
+4 IF SREVENT="S13"
WRITE "Reschedule"
+5 IF SREVENT="S14"
WRITE "Modification"
+6 IF SREVENT="S15"
WRITE "Cancellation"
+7 IF SREVENT="S17"
WRITE "Deletion"
+8 WRITE " for case #",CASE
+9 QUIT
