- 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
- 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
