- 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
- ;
- ; =================================================================
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAHLEX1 7573 printed Jan 18, 2025@03:36:18 Page 2
- 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 ; =================================================================