RAHLEX1 ;HIRMFO/REL,CRT - RAD/NUC MED HL7 Voice Reporting Exception Protocols ; 02/02/99
;;5.0;Radiology/Nuclear Medicine;**12**;Mar 16, 1998
; Last Edited by CRT
;
Q
EN ; Print Exception List Protocol - Called from ListMan ONLY
;
D CLEAR^VALM1
;
DEVICE ; Select device to print report
;
S %ZIS="Q",%ZIS("B")="",%ZIS("A")="Select Device: "
D ^%ZIS K %ZIS I POP K DTOUT,DUOUT,POP G END
;
I '$D(IO("Q")) G PRINT
;
S ZTRTN="PRINT^RAHLEX1"
S ZTDESC="Rad/Nuc Med HL7 Voice Reprting Errors List."
;
S ZTSAVE("RAHL7SDT")=""
S ZTSAVE("RAHL7EDT")=""
S ZTSAVE("^TMP($J,""RAHLAPP"",")=""
S ZTSAVE("^TMP($J,""RAHLUSR"",")=""
;S ZTSAVE("^TMP($J,""RAHLSRT"",")="" ; Causes Subscript error !?!?!?!
;
D ^%ZTLOAD
I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: "_$G(ZTSK)
I +$G(ZTSK("D"))=0 W !?5,"Request Cancelled"
H 1.5
D ^%ZISC,HOME^%ZIS K %X,%Y,%XX,%YY,IO("Q")
G END
;
PRINT ; Start printing the report to the requested device - using ^TMP
; RAPN = Page Number
; WAIT = "^" if user has requested to quit prematurely
;
I $D(ZTQUEUED) D
.S ZTREQ="@"
.S RAHLSRT="^TMP($J,""RAHLSRT"")"
.S RAHLUSR="^TMP($J,""RAHLUSR"")"
.S RAHLAPP="^TMP($J,""RAHLAPP"")"
S WAIT="",RAPN=0,RAPL=0
I '$D(@RAHLSRT) D SETTMP^RAHLEX
;
U IO
;
S RASEND="" F S RASEND=$O(@RAHLSRT@(RASEND)) Q:(RASEND="")!(WAIT="^") D
.S RAPN=RAPN+1 D:RAPN'=1 WAIT^RAHLEX1 Q:WAIT="^" D HEADER^RAHLEX1
.S RADATE="" F S RADATE=$O(@RAHLSRT@(RASEND,RADATE)) Q:(RADATE="")!(WAIT="^") D
..S RADPT="" F S RADPT=$O(@RAHLSRT@(RASEND,RADATE,RADPT)) Q:(RADPT="")!(WAIT="^") D
...S RACN="" F S RACN=$O(@RAHLSRT@(RASEND,RADATE,RADPT,RACN)) Q:(RACN="")!(WAIT="^") D
....S RAUSER="" F S RAUSER=$O(@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER)) Q:(RAUSER="")!(WAIT="^") D
.....I $Y+5>IOSL S RAPN=RAPN+1 D WAIT^RAHLEX1 Q:WAIT="^" D HEADER^RAHLEX1
.....S RAEXCP=@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER,"ERR")
.....I $D(ZTQUEUED) D STOPCHK^RAUTL9 I $G(ZTSTOP)=1 S WAIT="^" Q
.....D FORMAT^RAHLEX1
;
I $Y+3>IOSL S RAPN=RAPN+1 D WAIT^RAHLEX1 G END:WAIT="^" D HEADER^RAHLEX1
D EN^DDIOL("** End of Report **","","!?19")
D EN^DDIOL("","","!")
D WAIT^RAHLEX1
;
END ;
I $D(ZTQUEUED) D
.K @RAHLSRT,RAHLSRT,@RAHLUSR,RAHLUSR,@RAHLAPP,RAHLAPP
K X,Y,NOW,%,RASEND,RAUSER,RADATE,RADPT,RACN,RAEXCP,RAPN,RAPL
K DTOUT,DUOUT,ZTRTN,ZTDESC,ZTSAVE,ZTSK,WAIT,ZTSTOP
D CLOSE^RAUTL
D HOME^%ZIS
S VALMBCK="R"
Q
;
;
WAIT ; Prompt user to hit RETURN for next page
;
I $E(IOST,1,2)'="C-" S WAIT="" Q ; Don't prompt if report queued
;
S DIR(0)="E"
S (DIR("?"),DIR("??"))=""
D ^DIR K DIR
I Y=""!(Y=0) S WAIT="^"
Q
;
;
K RAHDR
I '($D(ZTQUEUED)&(RAPN=1)) W @IOF
S RAHDR(1)=$$REPEAT^XLFSTR("=",80)
S RAHDR(1,"F")=""
D NOW^%DTC,YX^%DTC S NOW="Printed: "_$P(Y,"@")_" "_$E($P(Y,"@",2),1,5)
S TITLE="HL7 Voice Reporting Errors "
S PAGE="Page: "_RAPN
S RAHDR(2)=TITLE
S RAHDR(2,"F")="!?1" ; Left Justified
S RAHDR(3)=PAGE
S RAHDR(3,"F")="?"_(78-$L(PAGE)) ; Right Justified
S TITLE="("_RASEND_" - RADIOLOGY/NUCLEAR MEDICINE)"
S RAHDR(4)=TITLE
S RAHDR(4,"F")="!?1" ; Left Justified
S RAHDR(5)=NOW
S RAHDR(5,"F")="?"_(78-$L(NOW)) ; Right Justified
S RAHDR(6)=$$REPEAT^XLFSTR("=",78)
S RAHDR(6,"F")="!?1"
S RAHDR(7)=""
D EN^DDIOL(.RAHDR)
K RAHDR,PAGE,TITLE,NOW
Q
;
FORMAT ; Format of Report
;
K RADSP
D DISDATE^RAHLEX(" at ")
S RADSP(1)="Exception Date: "_XRADATE
S RADSP(1,"F")="!?1"
S RADSP(2)="User: "_$E(RAUSER,1,24)
S RADSP(2,"F")="?50"
S RADSP(3)="Patient Name: "_RADPT
S RADSP(3,"F")="!?1"
S RADSP(4)="Case: "_RACN
S RADSP(4,"F")="?50"
S RADSP(5)="Reason Rejected: "_RAEXCP
S RADSP(5,"F")="!?1"
S RADSP(6)=""
D EN^DDIOL(.RADSP)
K RADSP,XRADATE
Q
;
; =================================================================
;
NXTAPP(DIR) ; Next or Previous Exception Protocol
; VALMLST = Last ListMan Line Displayed
; VALMBG = First ListMan Line Displayed
;
S DIR=$G(DIR)
S VALMBCK=""
I DIR=1 D G NEND ; Next Exception forward
.S RALINE=VALMLST
.I '$D(@RAHLSEL@(RALINE)) D
..S RALINE=$O(@RAHLSEL@(RALINE))
..S:RALINE="" RALINE=VALMLST
.S RALINE=RALINE-14
.S:RALINE<1 RALINE=1
.I VALMBG'=RALINE S VALMBG=RALINE,VALMBCK="R"
; Previous Exception
S RALINE=$O(@RAHLSEL@(VALMBG),-1)
S:('RALINE) RALINE=1
I RALINE'=VALMBG S VALMBG=RALINE,VALMBCK="R"
;
NEND K RALINE,DIR
Q
;
; =================================================================
;
RESEND ; Re-Submit an HL7 Message Protocol
;
K VALMSG
D EN^DDIOL(" ","","!!!")
I HL7EX<1 D Q
.S VALMSG="Function not available - no messages to re-submit"
.S VALMBCK=""
.W $C(7)
RESEND1 K DIR
S DIR(0)="NAO^1:"_HL7EX_":0"
S DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
S DIR("?")="Select one of the exceptions to Re-submit"
S DIR("??")="^D RESH^RAHLEX1"
D ^DIR K DIR I $D(DTOUT)!(Y="")!(Y="^") S VALMBCK="R" Q
;
S RAXIEN="" F RAI=1:1:Y S RAXIEN=$O(@RAHLSEL@(RAXIEN))
S RALINE=RAXIEN
I @RAHLEX@(RALINE+1,0)'["Error:" D G RESEND1
.W $C(7)
.D EN^DDIOL("Message already re-submitted or deleted. Not available for selection","","!?5")
;
S RAXIEN=@RAHLSEL@(RAXIEN)
S HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
D EN^DDIOL("Re-sending Message #"_HLIEN_"...","","!?5")
H 1.5
;
S RESEND=$$REPROC^HLUTIL(HLIEN,"RAHLTCPB")
I RESEND'=0 D ; Fail !!
.W $C(7)
.S VALMSG="Error - Original message may have been purged"
I RESEND=0 D ; Success !!
.S HLMTIENS=HLIEN
.S PURGE=$$SETPURG^HLUTIL(0)
.I PURGE'=0 W $C(7) S VALMSG="Cannot change purge flag for message"
.S %H=$H D YX^%DTC
.S @RAHLEX@(RALINE+1,0)=IOINHI_" Message Re-submitted on "_Y_IOINORM
.S DIK="^RA(79.3,",DA=RAXIEN D ^DIK ; Remove old report entry
;
REND K RAI,RAXIEN,RALINE,RESEND,HLMTIENS,HLIEN,PURGE,DA,DIK,Y,%H
; Also HLUTIL calls
K HL,HLA,HLARYTYP,HLECH,HLEID,HLFORMAT,HLFS,HLHDR,HLQ,HLRESLTA
K VA,VADM,HLEIDS
S VALMBCK="R"
Q
;
RESH ; Extended help
D EN^DDIOL("Select one of the HL7 exceptions to Re-submit","","!")
D EN^DDIOL("(If re-submitted successfully the exception will be deleted from file)","","!")
Q
;
; =================================================================
;
DELETE ; Function to delete Exception Node
;
K VALMSG
D EN^DDIOL(" ","","!!!")
I HL7EX<1 D Q
.S VALMSG="Function not available - No messages to delete"
.S VALMBCK=""
.W $C(7)
DELETE1 K DIR
S DIR(0)="NAO^1:"_HL7EX_":0"
S DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
S DIR("?")="Select one of the exceptions to Delete"
S DIR("??")="^D DELH^RAHLEX1"
D ^DIR K DIR I $D(DTOUT)!(Y="")!(Y="^") S VALMBCK="R" Q
;
S RAXIEN="" F RAI=1:1:Y S RAXIEN=$O(@RAHLSEL@(RAXIEN))
S RALINE=RAXIEN
I @RAHLEX@(RALINE+1,0)'["Error:" D G DELETE1
.W $C(7)
.D EN^DDIOL("Exception already re-submitted or deleted. Not available for selection","","!?5")
;
S RAXIEN=@RAHLSEL@(RAXIEN)
S HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
D EN^DDIOL("Deleting Exception...","","!?5")
H 1.5
;
S DIK="^RA(79.3,",DA=RAXIEN D ^DIK
;
S %H=$H D YX^%DTC
S @RAHLEX@(RALINE+1,0)=IOINHI_" Reported Exception Deleted on "_Y_IOINORM
;
DEND K RAI,RAXIEN,DA,DIK,HLIEN,RALINE,%H,Y
S VALMBCK="R"
Q
;
DELH D EN^DDIOL("Select one of the HL7 exceptions to Delete","","!")
D EN^DDIOL("(Note: Re-submitting a message is a more effective way to delete an exception)","","!")
Q
;
; =================================================================
RAHLEX1 ;HIRMFO/REL,CRT - RAD/NUC MED HL7 Voice Reporting Exception Protocols ; 02/02/99
+1 ;;5.0;Radiology/Nuclear Medicine;**12**;Mar 16, 1998
+2 ; Last Edited by CRT
+3 ;
+4 QUIT
EN ; Print Exception List Protocol - Called from ListMan ONLY
+1 ;
+2 DO CLEAR^VALM1
+3 ;
DEVICE ; Select device to print report
+1 ;
+2 SET %ZIS="Q"
SET %ZIS("B")=""
SET %ZIS("A")="Select Device: "
+3 DO ^%ZIS
KILL %ZIS
IF POP
KILL DTOUT,DUOUT,POP
GOTO END
+4 ;
+5 IF '$DATA(IO("Q"))
GOTO PRINT
+6 ;
+7 SET ZTRTN="PRINT^RAHLEX1"
+8 SET ZTDESC="Rad/Nuc Med HL7 Voice Reprting Errors List."
+9 ;
+10 SET ZTSAVE("RAHL7SDT")=""
+11 SET ZTSAVE("RAHL7EDT")=""
+12 SET ZTSAVE("^TMP($J,""RAHLAPP"",")=""
+13 SET ZTSAVE("^TMP($J,""RAHLUSR"",")=""
+14 ;S ZTSAVE("^TMP($J,""RAHLSRT"",")="" ; Causes Subscript error !?!?!?!
+15 ;
+16 DO ^%ZTLOAD
+17 IF +$GET(ZTSK("D"))>0
WRITE !?5,"Request Queued, Task #: "_$GET(ZTSK)
+18 IF +$GET(ZTSK("D"))=0
WRITE !?5,"Request Cancelled"
+19 HANG 1.5
+20 DO ^%ZISC
DO HOME^%ZIS
KILL %X,%Y,%XX,%YY,IO("Q")
+21 GOTO END
+22 ;
PRINT ; Start printing the report to the requested device - using ^TMP
+1 ; RAPN = Page Number
+2 ; WAIT = "^" if user has requested to quit prematurely
+3 ;
+4 IF $DATA(ZTQUEUED)
Begin DoDot:1
+5 SET ZTREQ="@"
+6 SET RAHLSRT="^TMP($J,""RAHLSRT"")"
+7 SET RAHLUSR="^TMP($J,""RAHLUSR"")"
+8 SET RAHLAPP="^TMP($J,""RAHLAPP"")"
End DoDot:1
+9 SET WAIT=""
SET RAPN=0
SET RAPL=0
+10 IF '$DATA(@RAHLSRT)
DO SETTMP^RAHLEX
+11 ;
+12 USE IO
+13 ;
+14 SET RASEND=""
FOR
SET RASEND=$ORDER(@RAHLSRT@(RASEND))
IF (RASEND="")!(WAIT="^")
QUIT
Begin DoDot:1
+15 SET RAPN=RAPN+1
IF RAPN'=1
DO WAIT^RAHLEX1
IF WAIT="^"
QUIT
DO HEADER^RAHLEX1
+16 SET RADATE=""
FOR
SET RADATE=$ORDER(@RAHLSRT@(RASEND,RADATE))
IF (RADATE="")!(WAIT="^")
QUIT
Begin DoDot:2
+17 SET RADPT=""
FOR
SET RADPT=$ORDER(@RAHLSRT@(RASEND,RADATE,RADPT))
IF (RADPT="")!(WAIT="^")
QUIT
Begin DoDot:3
+18 SET RACN=""
FOR
SET RACN=$ORDER(@RAHLSRT@(RASEND,RADATE,RADPT,RACN))
IF (RACN="")!(WAIT="^")
QUIT
Begin DoDot:4
+19 SET RAUSER=""
FOR
SET RAUSER=$ORDER(@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER))
IF (RAUSER="")!(WAIT="^")
QUIT
Begin DoDot:5
+20 IF $Y+5>IOSL
SET RAPN=RAPN+1
DO WAIT^RAHLEX1
IF WAIT="^"
QUIT
DO HEADER^RAHLEX1
+21 SET RAEXCP=@RAHLSRT@(RASEND,RADATE,RADPT,RACN,RAUSER,"ERR")
+22 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
IF $GET(ZTSTOP)=1
SET WAIT="^"
QUIT
+23 DO FORMAT^RAHLEX1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 IF $Y+3>IOSL
SET RAPN=RAPN+1
DO WAIT^RAHLEX1
IF WAIT="^"
GOTO END
DO HEADER^RAHLEX1
+26 DO EN^DDIOL("** End of Report **","","!?19")
+27 DO EN^DDIOL("","","!")
+28 DO WAIT^RAHLEX1
+29 ;
END ;
+1 IF $DATA(ZTQUEUED)
Begin DoDot:1
+2 KILL @RAHLSRT,RAHLSRT,@RAHLUSR,RAHLUSR,@RAHLAPP,RAHLAPP
End DoDot:1
+3 KILL X,Y,NOW,%,RASEND,RAUSER,RADATE,RADPT,RACN,RAEXCP,RAPN,RAPL
+4 KILL DTOUT,DUOUT,ZTRTN,ZTDESC,ZTSAVE,ZTSK,WAIT,ZTSTOP
+5 DO CLOSE^RAUTL
+6 DO HOME^%ZIS
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
+10 ;
WAIT ; Prompt user to hit RETURN for next page
+1 ;
+2 ; Don't prompt if report queued
IF $EXTRACT(IOST,1,2)'="C-"
SET WAIT=""
QUIT
+3 ;
+4 SET DIR(0)="E"
+5 SET (DIR("?"),DIR("??"))=""
+6 DO ^DIR
KILL DIR
+7 IF Y=""!(Y=0)
SET WAIT="^"
+8 QUIT
+9 ;
+1 ;
+2 KILL RAHDR
+3 IF '($DATA(ZTQUEUED)&(RAPN=1))
WRITE @IOF
+4 SET RAHDR(1)=$$REPEAT^XLFSTR("=",80)
+5 SET RAHDR(1,"F")=""
+6 DO NOW^%DTC
DO YX^%DTC
SET NOW="Printed: "_$PIECE(Y,"@")_" "_$EXTRACT($PIECE(Y,"@",2),1,5)
+7 SET TITLE="HL7 Voice Reporting Errors "
+8 SET PAGE="Page: "_RAPN
+9 SET RAHDR(2)=TITLE
+10 ; Left Justified
SET RAHDR(2,"F")="!?1"
+11 SET RAHDR(3)=PAGE
+12 ; Right Justified
SET RAHDR(3,"F")="?"_(78-$LENGTH(PAGE))
+13 SET TITLE="("_RASEND_" - RADIOLOGY/NUCLEAR MEDICINE)"
+14 SET RAHDR(4)=TITLE
+15 ; Left Justified
SET RAHDR(4,"F")="!?1"
+16 SET RAHDR(5)=NOW
+17 ; Right Justified
SET RAHDR(5,"F")="?"_(78-$LENGTH(NOW))
+18 SET RAHDR(6)=$$REPEAT^XLFSTR("=",78)
+19 SET RAHDR(6,"F")="!?1"
+20 SET RAHDR(7)=""
+21 DO EN^DDIOL(.RAHDR)
+22 KILL RAHDR,PAGE,TITLE,NOW
+23 QUIT
+24 ;
FORMAT ; Format of Report
+1 ;
+2 KILL RADSP
+3 DO DISDATE^RAHLEX(" at ")
+4 SET RADSP(1)="Exception Date: "_XRADATE
+5 SET RADSP(1,"F")="!?1"
+6 SET RADSP(2)="User: "_$EXTRACT(RAUSER,1,24)
+7 SET RADSP(2,"F")="?50"
+8 SET RADSP(3)="Patient Name: "_RADPT
+9 SET RADSP(3,"F")="!?1"
+10 SET RADSP(4)="Case: "_RACN
+11 SET RADSP(4,"F")="?50"
+12 SET RADSP(5)="Reason Rejected: "_RAEXCP
+13 SET RADSP(5,"F")="!?1"
+14 SET RADSP(6)=""
+15 DO EN^DDIOL(.RADSP)
+16 KILL RADSP,XRADATE
+17 QUIT
+18 ;
+19 ; =================================================================
+20 ;
NXTAPP(DIR) ; Next or Previous Exception Protocol
+1 ; VALMLST = Last ListMan Line Displayed
+2 ; VALMBG = First ListMan Line Displayed
+3 ;
+4 SET DIR=$GET(DIR)
+5 SET VALMBCK=""
+6 ; Next Exception forward
IF DIR=1
Begin DoDot:1
+7 SET RALINE=VALMLST
+8 IF '$DATA(@RAHLSEL@(RALINE))
Begin DoDot:2
+9 SET RALINE=$ORDER(@RAHLSEL@(RALINE))
+10 IF RALINE=""
SET RALINE=VALMLST
End DoDot:2
+11 SET RALINE=RALINE-14
+12 IF RALINE<1
SET RALINE=1
+13 IF VALMBG'=RALINE
SET VALMBG=RALINE
SET VALMBCK="R"
End DoDot:1
GOTO NEND
+14 ; Previous Exception
+15 SET RALINE=$ORDER(@RAHLSEL@(VALMBG),-1)
+16 IF ('RALINE)
SET RALINE=1
+17 IF RALINE'=VALMBG
SET VALMBG=RALINE
SET VALMBCK="R"
+18 ;
NEND KILL RALINE,DIR
+1 QUIT
+2 ;
+3 ; =================================================================
+4 ;
RESEND ; Re-Submit an HL7 Message Protocol
+1 ;
+2 KILL VALMSG
+3 DO EN^DDIOL(" ","","!!!")
+4 IF HL7EX<1
Begin DoDot:1
+5 SET VALMSG="Function not available - no messages to re-submit"
+6 SET VALMBCK=""
+7 WRITE $CHAR(7)
End DoDot:1
QUIT
RESEND1 KILL DIR
+1 SET DIR(0)="NAO^1:"_HL7EX_":0"
+2 SET DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
+3 SET DIR("?")="Select one of the exceptions to Re-submit"
+4 SET DIR("??")="^D RESH^RAHLEX1"
+5 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(Y="")!(Y="^")
SET VALMBCK="R"
QUIT
+6 ;
+7 SET RAXIEN=""
FOR RAI=1:1:Y
SET RAXIEN=$ORDER(@RAHLSEL@(RAXIEN))
+8 SET RALINE=RAXIEN
+9 IF @RAHLEX@(RALINE+1,0)'["Error:"
Begin DoDot:1
+10 WRITE $CHAR(7)
+11 DO EN^DDIOL("Message already re-submitted or deleted. Not available for selection","","!?5")
End DoDot:1
GOTO RESEND1
+12 ;
+13 SET RAXIEN=@RAHLSEL@(RAXIEN)
+14 SET HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
+15 DO EN^DDIOL("Re-sending Message #"_HLIEN_"...","","!?5")
+16 HANG 1.5
+17 ;
+18 SET RESEND=$$REPROC^HLUTIL(HLIEN,"RAHLTCPB")
+19 ; Fail !!
IF RESEND'=0
Begin DoDot:1
+20 WRITE $CHAR(7)
+21 SET VALMSG="Error - Original message may have been purged"
End DoDot:1
+22 ; Success !!
IF RESEND=0
Begin DoDot:1
+23 SET HLMTIENS=HLIEN
+24 SET PURGE=$$SETPURG^HLUTIL(0)
+25 IF PURGE'=0
WRITE $CHAR(7)
SET VALMSG="Cannot change purge flag for message"
+26 SET %H=$HOROLOG
DO YX^%DTC
+27 SET @RAHLEX@(RALINE+1,0)=IOINHI_" Message Re-submitted on "_Y_IOINORM
+28 ; Remove old report entry
SET DIK="^RA(79.3,"
SET DA=RAXIEN
DO ^DIK
End DoDot:1
+29 ;
REND KILL RAI,RAXIEN,RALINE,RESEND,HLMTIENS,HLIEN,PURGE,DA,DIK,Y,%H
+1 ; Also HLUTIL calls
+2 KILL HL,HLA,HLARYTYP,HLECH,HLEID,HLFORMAT,HLFS,HLHDR,HLQ,HLRESLTA
+3 KILL VA,VADM,HLEIDS
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
RESH ; Extended help
+1 DO EN^DDIOL("Select one of the HL7 exceptions to Re-submit","","!")
+2 DO EN^DDIOL("(If re-submitted successfully the exception will be deleted from file)","","!")
+3 QUIT
+4 ;
+5 ; =================================================================
+6 ;
DELETE ; Function to delete Exception Node
+1 ;
+2 KILL VALMSG
+3 DO EN^DDIOL(" ","","!!!")
+4 IF HL7EX<1
Begin DoDot:1
+5 SET VALMSG="Function not available - No messages to delete"
+6 SET VALMBCK=""
+7 WRITE $CHAR(7)
End DoDot:1
QUIT
DELETE1 KILL DIR
+1 SET DIR(0)="NAO^1:"_HL7EX_":0"
+2 SET DIR("A")="Select HL7 Exception (1-"_HL7EX_") :"
+3 SET DIR("?")="Select one of the exceptions to Delete"
+4 SET DIR("??")="^D DELH^RAHLEX1"
+5 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!(Y="")!(Y="^")
SET VALMBCK="R"
QUIT
+6 ;
+7 SET RAXIEN=""
FOR RAI=1:1:Y
SET RAXIEN=$ORDER(@RAHLSEL@(RAXIEN))
+8 SET RALINE=RAXIEN
+9 IF @RAHLEX@(RALINE+1,0)'["Error:"
Begin DoDot:1
+10 WRITE $CHAR(7)
+11 DO EN^DDIOL("Exception already re-submitted or deleted. Not available for selection","","!?5")
End DoDot:1
GOTO DELETE1
+12 ;
+13 SET RAXIEN=@RAHLSEL@(RAXIEN)
+14 SET HLIEN=$$GET1^DIQ(79.3,RAXIEN,.05,"I")
+15 DO EN^DDIOL("Deleting Exception...","","!?5")
+16 HANG 1.5
+17 ;
+18 SET DIK="^RA(79.3,"
SET DA=RAXIEN
DO ^DIK
+19 ;
+20 SET %H=$HOROLOG
DO YX^%DTC
+21 SET @RAHLEX@(RALINE+1,0)=IOINHI_" Reported Exception Deleted on "_Y_IOINORM
+22 ;
DEND KILL RAI,RAXIEN,DA,DIK,HLIEN,RALINE,%H,Y
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
DELH DO EN^DDIOL("Select one of the HL7 exceptions to Delete","","!")
+1 DO EN^DDIOL("(Note: Re-submitting a message is a more effective way to delete an exception)","","!")
+2 QUIT
+3 ;
+4 ; =================================================================
