HLOUSR3 ;ALB/CJM/RBN -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am ;03/26/2012
;;1.6;HEALTH LEVEL SEVEN;**126,134,138,139,147,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
EN ; Main entry point.
N HLPARMS
D FULL^VALM1
I '$$ASK(.HLPARMS) S VALMBCK="R" Q
D WAIT^DICD
D EN^VALM("HLO MESSAGE SEARCH")
Q
SEARCH ; Find a message.
N I,APP,START,END,DIR,MSG,EVENT,TIME
D EXIT
S I=""
F S I=$O(HLPARMS(I)) Q:I="" S @I=HLPARMS(I)
K HLPARMS
S (VALMCNT,I)=0
S TIME=START
F S TIME=$O(^HLB("SEARCH",DIR,TIME)) Q:'TIME Q:TIME>END Q:VALMCNT>MAX D
.N SAPP S SAPP=""
.S:APP'="" SAPP=$O(^HLB("SEARCH",DIR,TIME,APP),-1)
.F S SAPP=$O(^HLB("SEARCH",DIR,TIME,SAPP)) Q:SAPP="" Q:$E(SAPP,1,$L(APP))]APP Q:VALMCNT>MAX D:$E(SAPP,1,$L(APP))=APP
..N SMSG S SMSG=""
..S:MSG'="" SMSG=$O(^HLB("SEARCH",DIR,TIME,SAPP,MSG),-1)
..F S SMSG=$O(^HLB("SEARCH",DIR,TIME,SAPP,SMSG)) Q:SMSG="" Q:$E(SMSG,1,$L(MSG))]MSG Q:VALMCNT>MAX D:$E(SMSG,1,$L(MSG))=MSG
...N SEVENT S SEVENT=""
...S:EVENT'="" SEVENT=$O(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,EVENT),-1)
...F S SEVENT=$O(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,SEVENT)) Q:SEVENT="" Q:$E(SEVENT,1,$L(EVENT))]EVENT Q:VALMCNT>MAX D:$E(SEVENT,1,$L(EVENT))=EVENT
....N IEN
....S IEN=""
....F S IEN=$O(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,SEVENT,IEN)) Q:IEN="" Q:VALMCNT>MAX D ADDTO(DIR,TIME,SAPP,SMSG,SEVENT,IEN)
;
;
END ; Return to List Manager.
S VALMBCK="R"
;
Q
ADDTO(DIR,TIME,APP,MSG,EVENT,IEN) ; Add message to queue.
N HDR,FS,LOC,MSGID
S MSGID=$S($P(IEN,"^",2):$P($G(^HLB(+IEN,3,$P(IEN,"^",2),0)),"^",2),1:$P($G(^HLB(IEN,0)),"^",1))
S HDR=$G(^HLB(+IEN,1))
S FS=$E(HDR,4)
I FS'="" D
.I DIR="IN" S LOC=$P(HDR,FS,4)
.I DIR'="IN" S LOC=$P(HDR,FS,6)
E S LOC=""
S @VALMAR@($$I,0)=$$LJ(MSGID,25)_$$LJ(APP,30)_" "_MSG_"~"_EVENT
D CNTRL^VALM10(VALMCNT,1,25,IOINHI,IOINORM)
S @VALMAR@($$I,0)=" "_$$LJ($$FMTE^XLFDT(TIME,2),20)_$$LJ(LOC,60)
S @VALMAR@($$I,0)=""
Q
LJ(STRING,LEN) ;
Q $$LJ^XLFSTR(STRING,LEN)
;
I() ;
S VALMCNT=VALMCNT+1
Q VALMCNT
;
ASK(PARMS) ; Ask for parameter values.
N SUB
F SUB="START","END","EVENT","APP","MSG","DIR" S PARMS(SUB)=""
S PARMS("START")=$$ASKBEGIN^HLOUSR2()
Q:'PARMS("START") 0
S PARMS("END")=$$ASKEND^HLOUSR2(PARMS("START"))
Q:'PARMS("END") 0
S PARMS("APP")=$$ASKAPP()
Q:PARMS("APP")=-1 0
S PARMS("MSG")=$$ASKMSG()
Q:PARMS("MSG")=-1 0
S PARMS("EVENT")=$$ASKEVENT()
Q:PARMS("EVENT")=-1 0
S PARMS("DIR")=$$ASKDIR()
Q:PARMS("DIR")=-1 0
;** P139 START CJM
S PARMS("DIR")=$S(PARMS("DIR")="I":"IN",PARMS("DIR")="i":"IN",1:"OUT")
;** P139 END CJM
S PARMS("MAX")=$$ASKMAX()
Q:'(PARMS("MAX")>-1) 0
Q 1
;
ASKMAX() ; Ask for the maximum number of messages.
N DIR
S DIR(0)="N^1:30000:0"
S DIR("A")="Maximum List Size"
S DIR("B")=1000
S DIR("?",1)="In case a large number of messages meet your search criteria, what are the"
S DIR("?")="maximum number of messages to display? (30,000 maximum)"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q 3*(X-1)
ASKAPP() ; Ask for application name.
N DIR
S DIR(0)="FO^0:60"
S DIR("A")="Application"
S DIR("?",1)="Enter the name of the application, or '^' to exit."
S DIR("?")="You can enter just the first part of the name."
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q X
ASKMSG() ;
N DIR
S DIR(0)="FO^0:3"
S DIR("A")="HL7 Message Type"
S DIR("?",1)="Enter the 3 character message type (e.g. MFN, ADT), or '^' to exit."
S DIR("?")="You can enter just the first character or two."
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q X
ASKEVENT() ; Ask for event.
N DIR
S DIR(0)="FO^0:3"
S DIR("A")="HL7 Event"
S DIR("?",1)="Enter the 3 character event type, or '^' to exit."
S DIR("?")="You can enter just the first character or two."
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q X
ASKDIR() ; Ask message direction
N DIR
S DIR(0)="S^I:INCOMING;O:OUTGOING"
S DIR("A")="Incoming or Outgoing"
S DIR("?",1)="Are you searching for an incoming message or an outgoing message?"
S DIR("?")="You can enter '^' to exit"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q X
HDR ; Set the List Manager header
S VALMHDR(1)="MsgID Application MsgType"
Q
HLP ;
Q
EXIT ; Clean up and exit back to List Manager
D CLEAN^VALM10
D CLEAR^VALM1
S VALMBCK="R"
Q
;
SETPURGE ; Set a message up for purging.
N MSG,DIR
S VALMBCK="R"
Q:'$G(MSGIEN)
Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
I MSG("STATUS")="",'MSG("STATUS","PURGE") W !,"Can not set purge yet!" D PAUSE^VALM1 Q
S DIR(0)="D^"_DT_":"_$$FMADD^XLFDT(DT,+45)_":E"
S DIR("A")="When should the message be purged?"
D ^DIR
D:Y SETPURGE^HLOUSR7(+MSGIEN,Y),DISPLAY^HLOUSR1
Q
SCREEN() ; Screen for message purge status.
N TRUE
S TRUE=1
I $P($G(X),"^",3)="SET PURGE" D Q TRUE
.N MSG
.I '$G(MSGIEN) S TRUE=0 Q
.I '$$GETMSG^HLOMSG(+MSGIEN,.MSG) S TRUE=0 Q
.I MSG("STATUS")="",'MSG("STATUS","PURGE") S TRUE=0
S:'TRUE VALMBCK="R"
Q TRUE
;;**Start Patch HL*1.6.138 **
;;The following three subroutines have been added for HL*1.6*138 - RBN
;;
RESEND ; If outbound message has been sent, resends it.
N CONF
D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
I CONF(0)'=1 D Q
. W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1 Q
;Q:$$VERIFY^HLOQUE1()=-1
N MSG,DIR,ERROR,FLG,OLDIEN,SYS
S OLDIEN=MSGIEN
I $G(OPT1DIS) D K OPT1DIS Q
. W !,"Sorry that option is not available for this message." D PAUSE^VALM1 Q
S VALMBCK="R"
Q:'$G(MSGIEN)
Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
I MSG("DIRECTION")'="OUT" W !,"Message is not an outbound message" D PAUSE^VALM1 Q
I MSG("STATUS")="",'MSG("DT/TM") W !,"Message has not been sent!" D PAUSE^VALM1 Q
Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to resend MsgID: "_MSG("ID"),"NO")
S MSGIEN=$$RESEND^HLOAPI3(+MSGIEN,.ERROR)
I $G(ERROR) W ERROR D PAUSE^VALM1 Q
W !,"The message has been copied to MsgID ",MSGIEN," which will be displayed next"
I $$ASKYESNO^HLOUSR2("Do you want the original message purged?","NO") D
. D SYSPARMS^HLOSITE(.SYS)
. S HLOPURDT=$$FMADD^XLFDT($$NOW^XLFDT,SYS("ERROR PURGE"))
. S FLG=$$SETPURGE^HLOUSR7(OLDIEN,HLOPURDT)
S FLG=$$GETMSG^HLOMSG(+MSGIEN,.MSG)
D DISPLAY^HLOUSR1
Q
;
REPROC ; If inbound message has been processed, reprocesses it.
N CONF
D FULL^VALM1
D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
I CONF(0)'=1 D Q
. W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1 Q
;Q:$$VERIFY^HLOQUE1()=-1
N MSG,DIR,ERROR,SYSPARM
I $G(OPT2DIS) D K OPT2DIS Q
. W !,"Sorry that option is not available for this message." D PAUSE^VALM1 Q
S VALMBCK="R"
Q:'$G(MSGIEN)
Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
I MSG("DIRECTION")'="IN" W !,"Message is not an inbound message" D PAUSE^VALM1 Q
I MSG("STATUS")="",'MSG("STATUS","APP HANDOFF") W !,"Message has not been processed" D PAUSE^VALM1 Q
Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to reprocess MsgID: "_MSG("ID"),"NO")
I '$$PROCNOW^HLOAPI3(+MSGIEN,"",.ERROR) W ERROR D PAUSE^VALM1 Q
W !,"Done! The message has been reprocessed by the application."
S DIR(0)="D^"_DT_":"_$$FMADD^XLFDT(DT,+45)_":E"
I '$$ASKYESNO^HLOUSR2("Do you want to purge the message?","NO") D
. D SYSPARMS^HLOSITE(.SYSPARM)
. S HLOPURDT=$$FMADD^XLFDT($$NOW^XLFDT,SYSPARM("ERROR PURGE"))
. S FLG=$$SETPURGE^HLOUSR7(MSGIEN,HLOPURDT)
Q
;
MSGPREP ; Enable or disable menu options
N MSG,FDA,ERR
D GETMSG^HLOMSG(MSGIEN,.MSG)
I 'MSG("DT/TM") D ; Message has not been sent/processed
. S (OPT1DIS,OPT2DIS)=1
I MSG("DIRECTION")="OUT" D ; Msg outbound and sent ; disable MP
. S OPT2DIS=1
I MSG("DIRECTION")="IN" D ; Msg inbound and sent ; disable MR
. S OPT1DIS=1
S VALMBCK="R"
Q
;;**End Patch HL*1.6*138 **
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOUSR3 7865 printed Dec 13, 2024@01:59:20 Page 2
HLOUSR3 ;ALB/CJM/RBN -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am ;03/26/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,134,138,139,147,158**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
EN ; Main entry point.
+1 NEW HLPARMS
+2 DO FULL^VALM1
+3 IF '$$ASK(.HLPARMS)
SET VALMBCK="R"
QUIT
+4 DO WAIT^DICD
+5 DO EN^VALM("HLO MESSAGE SEARCH")
+6 QUIT
SEARCH ; Find a message.
+1 NEW I,APP,START,END,DIR,MSG,EVENT,TIME
+2 DO EXIT
+3 SET I=""
+4 FOR
SET I=$ORDER(HLPARMS(I))
if I=""
QUIT
SET @I=HLPARMS(I)
+5 KILL HLPARMS
+6 SET (VALMCNT,I)=0
+7 SET TIME=START
+8 FOR
SET TIME=$ORDER(^HLB("SEARCH",DIR,TIME))
if 'TIME
QUIT
if TIME>END
QUIT
if VALMCNT>MAX
QUIT
Begin DoDot:1
+9 NEW SAPP
SET SAPP=""
+10 if APP'=""
SET SAPP=$ORDER(^HLB("SEARCH",DIR,TIME,APP),-1)
+11 FOR
SET SAPP=$ORDER(^HLB("SEARCH",DIR,TIME,SAPP))
if SAPP=""
QUIT
if $EXTRACT(SAPP,1,$LENGTH(APP))]APP
QUIT
if VALMCNT>MAX
QUIT
if $EXTRACT(SAPP,1,$LENGTH(APP))=APP
Begin DoDot:2
+12 NEW SMSG
SET SMSG=""
+13 if MSG'=""
SET SMSG=$ORDER(^HLB("SEARCH",DIR,TIME,SAPP,MSG),-1)
+14 FOR
SET SMSG=$ORDER(^HLB("SEARCH",DIR,TIME,SAPP,SMSG))
if SMSG=""
QUIT
if $EXTRACT(SMSG,1,$LENGTH(MSG))]MSG
QUIT
if VALMCNT>MAX
QUIT
if $EXTRACT(SMSG,1,$LENGTH(MSG))=MSG
Begin DoDot:3
+15 NEW SEVENT
SET SEVENT=""
+16 if EVENT'=""
SET SEVENT=$ORDER(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,EVENT),-1)
+17 FOR
SET SEVENT=$ORDER(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,SEVENT))
if SEVENT=""
QUIT
if $EXTRACT(SEVENT,1,$LENGTH(EVENT))]EVENT
QUIT
if VALMCNT>MAX
QUIT
if $EXTRACT(SEVENT,1,$LENGTH(EVENT))=EVENT
Begin DoDot:4
+18 NEW IEN
+19 SET IEN=""
+20 FOR
SET IEN=$ORDER(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,SEVENT,IEN))
if IEN=""
QUIT
if VALMCNT>MAX
QUIT
DO ADDTO(DIR,TIME,SAPP,SMSG,SEVENT,IEN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 ;
END ; Return to List Manager.
+1 SET VALMBCK="R"
+2 ;
+3 QUIT
ADDTO(DIR,TIME,APP,MSG,EVENT,IEN) ; Add message to queue.
+1 NEW HDR,FS,LOC,MSGID
+2 SET MSGID=$SELECT($PIECE(IEN,"^",2):$PIECE($GET(^HLB(+IEN,3,$PIECE(IEN,"^",2),0)),"^",2),1:$PIECE($GET(^HLB(IEN,0)),"^",1))
+3 SET HDR=$GET(^HLB(+IEN,1))
+4 SET FS=$EXTRACT(HDR,4)
+5 IF FS'=""
Begin DoDot:1
+6 IF DIR="IN"
SET LOC=$PIECE(HDR,FS,4)
+7 IF DIR'="IN"
SET LOC=$PIECE(HDR,FS,6)
End DoDot:1
+8 IF '$TEST
SET LOC=""
+9 SET @VALMAR@($$I,0)=$$LJ(MSGID,25)_$$LJ(APP,30)_" "_MSG_"~"_EVENT
+10 DO CNTRL^VALM10(VALMCNT,1,25,IOINHI,IOINORM)
+11 SET @VALMAR@($$I,0)=" "_$$LJ($$FMTE^XLFDT(TIME,2),20)_$$LJ(LOC,60)
+12 SET @VALMAR@($$I,0)=""
+13 QUIT
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR(STRING,LEN)
+2 ;
I() ;
+1 SET VALMCNT=VALMCNT+1
+2 QUIT VALMCNT
+3 ;
ASK(PARMS) ; Ask for parameter values.
+1 NEW SUB
+2 FOR SUB="START","END","EVENT","APP","MSG","DIR"
SET PARMS(SUB)=""
+3 SET PARMS("START")=$$ASKBEGIN^HLOUSR2()
+4 if 'PARMS("START")
QUIT 0
+5 SET PARMS("END")=$$ASKEND^HLOUSR2(PARMS("START"))
+6 if 'PARMS("END")
QUIT 0
+7 SET PARMS("APP")=$$ASKAPP()
+8 if PARMS("APP")=-1
QUIT 0
+9 SET PARMS("MSG")=$$ASKMSG()
+10 if PARMS("MSG")=-1
QUIT 0
+11 SET PARMS("EVENT")=$$ASKEVENT()
+12 if PARMS("EVENT")=-1
QUIT 0
+13 SET PARMS("DIR")=$$ASKDIR()
+14 if PARMS("DIR")=-1
QUIT 0
+15 ;** P139 START CJM
+16 SET PARMS("DIR")=$SELECT(PARMS("DIR")="I":"IN",PARMS("DIR")="i":"IN",1:"OUT")
+17 ;** P139 END CJM
+18 SET PARMS("MAX")=$$ASKMAX()
+19 if '(PARMS("MAX")>-1)
QUIT 0
+20 QUIT 1
+21 ;
ASKMAX() ; Ask for the maximum number of messages.
+1 NEW DIR
+2 SET DIR(0)="N^1:30000:0"
+3 SET DIR("A")="Maximum List Size"
+4 SET DIR("B")=1000
+5 SET DIR("?",1)="In case a large number of messages meet your search criteria, what are the"
+6 SET DIR("?")="maximum number of messages to display? (30,000 maximum)"
+7 DO ^DIR
+8 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+9 QUIT 3*(X-1)
ASKAPP() ; Ask for application name.
+1 NEW DIR
+2 SET DIR(0)="FO^0:60"
+3 SET DIR("A")="Application"
+4 SET DIR("?",1)="Enter the name of the application, or '^' to exit."
+5 SET DIR("?")="You can enter just the first part of the name."
+6 DO ^DIR
+7 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+8 QUIT X
ASKMSG() ;
+1 NEW DIR
+2 SET DIR(0)="FO^0:3"
+3 SET DIR("A")="HL7 Message Type"
+4 SET DIR("?",1)="Enter the 3 character message type (e.g. MFN, ADT), or '^' to exit."
+5 SET DIR("?")="You can enter just the first character or two."
+6 DO ^DIR
+7 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+8 QUIT X
ASKEVENT() ; Ask for event.
+1 NEW DIR
+2 SET DIR(0)="FO^0:3"
+3 SET DIR("A")="HL7 Event"
+4 SET DIR("?",1)="Enter the 3 character event type, or '^' to exit."
+5 SET DIR("?")="You can enter just the first character or two."
+6 DO ^DIR
+7 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+8 QUIT X
ASKDIR() ; Ask message direction
+1 NEW DIR
+2 SET DIR(0)="S^I:INCOMING;O:OUTGOING"
+3 SET DIR("A")="Incoming or Outgoing"
+4 SET DIR("?",1)="Are you searching for an incoming message or an outgoing message?"
+5 SET DIR("?")="You can enter '^' to exit"
+6 DO ^DIR
+7 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+8 QUIT X
HDR ; Set the List Manager header
+1 SET VALMHDR(1)="MsgID Application MsgType"
+2 QUIT
HLP ;
+1 QUIT
EXIT ; Clean up and exit back to List Manager
+1 DO CLEAN^VALM10
+2 DO CLEAR^VALM1
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
SETPURGE ; Set a message up for purging.
+1 NEW MSG,DIR
+2 SET VALMBCK="R"
+3 if '$GET(MSGIEN)
QUIT
+4 if '$$GETMSG^HLOMSG(+MSGIEN,.MSG)
QUIT
+5 IF MSG("STATUS")=""
IF 'MSG("STATUS","PURGE")
WRITE !,"Can not set purge yet!"
DO PAUSE^VALM1
QUIT
+6 SET DIR(0)="D^"_DT_":"_$$FMADD^XLFDT(DT,+45)_":E"
+7 SET DIR("A")="When should the message be purged?"
+8 DO ^DIR
+9 if Y
DO SETPURGE^HLOUSR7(+MSGIEN,Y)
DO DISPLAY^HLOUSR1
+10 QUIT
SCREEN() ; Screen for message purge status.
+1 NEW TRUE
+2 SET TRUE=1
+3 IF $PIECE($GET(X),"^",3)="SET PURGE"
Begin DoDot:1
+4 NEW MSG
+5 IF '$GET(MSGIEN)
SET TRUE=0
QUIT
+6 IF '$$GETMSG^HLOMSG(+MSGIEN,.MSG)
SET TRUE=0
QUIT
+7 IF MSG("STATUS")=""
IF 'MSG("STATUS","PURGE")
SET TRUE=0
End DoDot:1
QUIT TRUE
+8 if 'TRUE
SET VALMBCK="R"
+9 QUIT TRUE
+10 ;;**Start Patch HL*1.6.138 **
+11 ;;The following three subroutines have been added for HL*1.6*138 - RBN
+12 ;;
RESEND ; If outbound message has been sent, resends it.
+1 NEW CONF
+2 DO OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
+3 IF CONF(0)'=1
Begin DoDot:1
+4 WRITE !,"**** You are not authorized to use this option ****"
DO PAUSE^VALM1
QUIT
End DoDot:1
QUIT
+5 ;Q:$$VERIFY^HLOQUE1()=-1
+6 NEW MSG,DIR,ERROR,FLG,OLDIEN,SYS
+7 SET OLDIEN=MSGIEN
+8 IF $GET(OPT1DIS)
Begin DoDot:1
+9 WRITE !,"Sorry that option is not available for this message."
DO PAUSE^VALM1
QUIT
End DoDot:1
KILL OPT1DIS
QUIT
+10 SET VALMBCK="R"
+11 if '$GET(MSGIEN)
QUIT
+12 if '$$GETMSG^HLOMSG(+MSGIEN,.MSG)
QUIT
+13 IF MSG("DIRECTION")'="OUT"
WRITE !,"Message is not an outbound message"
DO PAUSE^VALM1
QUIT
+14 IF MSG("STATUS")=""
IF 'MSG("DT/TM")
WRITE !,"Message has not been sent!"
DO PAUSE^VALM1
QUIT
+15 if '$$ASKYESNO^HLOUSR2("Are you SURE you want to resend MsgID
QUIT
+16 SET MSGIEN=$$RESEND^HLOAPI3(+MSGIEN,.ERROR)
+17 IF $GET(ERROR)
WRITE ERROR
DO PAUSE^VALM1
QUIT
+18 WRITE !,"The message has been copied to MsgID ",MSGIEN," which will be displayed next"
+19 IF $$ASKYESNO^HLOUSR2("Do you want the original message purged?","NO")
Begin DoDot:1
+20 DO SYSPARMS^HLOSITE(.SYS)
+21 SET HLOPURDT=$$FMADD^XLFDT($$NOW^XLFDT,SYS("ERROR PURGE"))
+22 SET FLG=$$SETPURGE^HLOUSR7(OLDIEN,HLOPURDT)
End DoDot:1
+23 SET FLG=$$GETMSG^HLOMSG(+MSGIEN,.MSG)
+24 DO DISPLAY^HLOUSR1
+25 QUIT
+26 ;
REPROC ; If inbound message has been processed, reprocesses it.
+1 NEW CONF
+2 DO FULL^VALM1
+3 DO OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
+4 IF CONF(0)'=1
Begin DoDot:1
+5 WRITE !,"**** You are not authorized to use this option ****"
DO PAUSE^VALM1
QUIT
End DoDot:1
QUIT
+6 ;Q:$$VERIFY^HLOQUE1()=-1
+7 NEW MSG,DIR,ERROR,SYSPARM
+8 IF $GET(OPT2DIS)
Begin DoDot:1
+9 WRITE !,"Sorry that option is not available for this message."
DO PAUSE^VALM1
QUIT
End DoDot:1
KILL OPT2DIS
QUIT
+10 SET VALMBCK="R"
+11 if '$GET(MSGIEN)
QUIT
+12 if '$$GETMSG^HLOMSG(+MSGIEN,.MSG)
QUIT
+13 IF MSG("DIRECTION")'="IN"
WRITE !,"Message is not an inbound message"
DO PAUSE^VALM1
QUIT
+14 IF MSG("STATUS")=""
IF 'MSG("STATUS","APP HANDOFF")
WRITE !,"Message has not been processed"
DO PAUSE^VALM1
QUIT
+15 if '$$ASKYESNO^HLOUSR2("Are you SURE you want to reprocess MsgID
QUIT
+16 IF '$$PROCNOW^HLOAPI3(+MSGIEN,"",.ERROR)
WRITE ERROR
DO PAUSE^VALM1
QUIT
+17 WRITE !,"Done! The message has been reprocessed by the application."
+18 SET DIR(0)="D^"_DT_":"_$$FMADD^XLFDT(DT,+45)_":E"
+19 IF '$$ASKYESNO^HLOUSR2("Do you want to purge the message?","NO")
Begin DoDot:1
+20 DO SYSPARMS^HLOSITE(.SYSPARM)
+21 SET HLOPURDT=$$FMADD^XLFDT($$NOW^XLFDT,SYSPARM("ERROR PURGE"))
+22 SET FLG=$$SETPURGE^HLOUSR7(MSGIEN,HLOPURDT)
End DoDot:1
+23 QUIT
+24 ;
MSGPREP ; Enable or disable menu options
+1 NEW MSG,FDA,ERR
+2 DO GETMSG^HLOMSG(MSGIEN,.MSG)
+3 ; Message has not been sent/processed
IF 'MSG("DT/TM")
Begin DoDot:1
+4 SET (OPT1DIS,OPT2DIS)=1
End DoDot:1
+5 ; Msg outbound and sent ; disable MP
IF MSG("DIRECTION")="OUT"
Begin DoDot:1
+6 SET OPT2DIS=1
End DoDot:1
+7 ; Msg inbound and sent ; disable MR
IF MSG("DIRECTION")="IN"
Begin DoDot:1
+8 SET OPT1DIS=1
End DoDot:1
+9 SET VALMBCK="R"
+10 QUIT
+11 ;;**End Patch HL*1.6*138 **
+12 ;
