Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLOUSR3

HLOUSR3.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;
  1. EN ; Main entry point.
  1.  N HLPARMS
  1.  D FULL^VALM1
  1.  I '$$ASK(.HLPARMS) S VALMBCK="R" Q
  1.  D WAIT^DICD
  1.  D EN^VALM("HLO MESSAGE SEARCH")
  1.  Q
  1.  N I,APP,START,END,DIR,MSG,EVENT,TIME
  1.  D EXIT
  1.  S I=""
  1.  F  S I=$O(HLPARMS(I)) Q:I=""  S @I=HLPARMS(I)
  1.  K HLPARMS
  1.  S (VALMCNT,I)=0
  1.  S TIME=START
  1.  F  S TIME=$O(^HLB("SEARCH",DIR,TIME)) Q:'TIME  Q:TIME>END  Q:VALMCNT>MAX  D
  1.  .N SAPP S SAPP=""
  1.  .S:APP'="" SAPP=$O(^HLB("SEARCH",DIR,TIME,APP),-1)
  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
  1.  ..N SMSG S SMSG=""
  1.  ..S:MSG'="" SMSG=$O(^HLB("SEARCH",DIR,TIME,SAPP,MSG),-1)
  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
  1.  ...N SEVENT S SEVENT=""
  1.  ...S:EVENT'="" SEVENT=$O(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,EVENT),-1)
  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
  1.  ....N IEN
  1.  ....S IEN=""
  1.  ....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)
  1.  ;
  1.  ;
  1. END ; Return to List Manager.
  1.  S VALMBCK="R"
  1.  ;
  1.  Q
  1. ADDTO(DIR,TIME,APP,MSG,EVENT,IEN) ; Add message to queue.
  1.  N HDR,FS,LOC,MSGID
  1.  S MSGID=$S($P(IEN,"^",2):$P($G(^HLB(+IEN,3,$P(IEN,"^",2),0)),"^",2),1:$P($G(^HLB(IEN,0)),"^",1))
  1.  S HDR=$G(^HLB(+IEN,1))
  1.  S FS=$E(HDR,4)
  1.  I FS'="" D
  1.  .I DIR="IN" S LOC=$P(HDR,FS,4)
  1.  .I DIR'="IN" S LOC=$P(HDR,FS,6)
  1.  E  S LOC=""
  1.  S @VALMAR@($$I,0)=$$LJ(MSGID,25)_$$LJ(APP,30)_" "_MSG_"~"_EVENT
  1.  D CNTRL^VALM10(VALMCNT,1,25,IOINHI,IOINORM)
  1.  S @VALMAR@($$I,0)="     "_$$LJ($$FMTE^XLFDT(TIME,2),20)_$$LJ(LOC,60)
  1.  S @VALMAR@($$I,0)=""
  1.  Q
  1. LJ(STRING,LEN) ;
  1.  Q $$LJ^XLFSTR(STRING,LEN)
  1.  ;
  1. I() ;
  1.  S VALMCNT=VALMCNT+1
  1.  Q VALMCNT
  1.  ;
  1. ASK(PARMS) ; Ask for parameter values.
  1.  N SUB
  1.  F SUB="START","END","EVENT","APP","MSG","DIR" S PARMS(SUB)=""
  1.  S PARMS("START")=$$ASKBEGIN^HLOUSR2()
  1.  Q:'PARMS("START") 0
  1.  S PARMS("END")=$$ASKEND^HLOUSR2(PARMS("START"))
  1.  Q:'PARMS("END") 0
  1.  S PARMS("APP")=$$ASKAPP()
  1.  Q:PARMS("APP")=-1 0
  1.  S PARMS("MSG")=$$ASKMSG()
  1.  Q:PARMS("MSG")=-1 0
  1.  S PARMS("EVENT")=$$ASKEVENT()
  1.  Q:PARMS("EVENT")=-1 0
  1.  S PARMS("DIR")=$$ASKDIR()
  1.  Q:PARMS("DIR")=-1 0
  1.  ;** P139 START CJM
  1.  S PARMS("DIR")=$S(PARMS("DIR")="I":"IN",PARMS("DIR")="i":"IN",1:"OUT")
  1.  ;** P139 END CJM
  1.  S PARMS("MAX")=$$ASKMAX()
  1.  Q:'(PARMS("MAX")>-1) 0
  1.  Q 1
  1.  ;
  1. ASKMAX() ; Ask for the maximum number of messages.
  1.  N DIR
  1.  S DIR(0)="N^1:30000:0"
  1.  S DIR("A")="Maximum List Size"
  1.  S DIR("B")=1000
  1.  S DIR("?",1)="In case a large number of messages meet your search criteria, what are the"
  1.  S DIR("?")="maximum number of messages to display? (30,000 maximum)"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT) -1
  1.  Q 3*(X-1)
  1. ASKAPP() ; Ask for application name.
  1.  N DIR
  1.  S DIR(0)="FO^0:60"
  1.  S DIR("A")="Application"
  1.  S DIR("?",1)="Enter the name of the application, or '^' to exit."
  1.  S DIR("?")="You can enter just the first part of the name."
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT) -1
  1.  Q X
  1. ASKMSG() ;
  1.  N DIR
  1.  S DIR(0)="FO^0:3"
  1.  S DIR("A")="HL7 Message Type"
  1.  S DIR("?",1)="Enter the 3 character message type (e.g. MFN, ADT), or '^' to exit."
  1.  S DIR("?")="You can enter just the first character or two."
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT) -1
  1.  Q X
  1. ASKEVENT() ; Ask for event.
  1.  N DIR
  1.  S DIR(0)="FO^0:3"
  1.  S DIR("A")="HL7 Event"
  1.  S DIR("?",1)="Enter the 3 character event type, or '^' to exit."
  1.  S DIR("?")="You can enter just the first character or two."
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT) -1
  1.  Q X
  1. ASKDIR() ; Ask message direction
  1.  N DIR
  1.  S DIR(0)="S^I:INCOMING;O:OUTGOING"
  1.  S DIR("A")="Incoming or Outgoing"
  1.  S DIR("?",1)="Are you searching for an incoming message or an outgoing message?"
  1.  S DIR("?")="You can enter '^' to exit"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT) -1
  1.  Q X
  1. HDR ; Set the List Manager header
  1.  S VALMHDR(1)="MsgID                    Application                    MsgType"
  1.  Q
  1. HLP ;
  1.  Q
  1. EXIT ; Clean up and exit back to List Manager
  1.  D CLEAN^VALM10
  1.  D CLEAR^VALM1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. SETPURGE ; Set a message up for purging.
  1.  N MSG,DIR
  1.  S VALMBCK="R"
  1.  Q:'$G(MSGIEN)
  1.  Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
  1.  I MSG("STATUS")="",'MSG("STATUS","PURGE") W !,"Can not set purge yet!" D PAUSE^VALM1 Q
  1.  S DIR(0)="D^"_DT_":"_$$FMADD^XLFDT(DT,+45)_":E"
  1.  S DIR("A")="When should the message be purged?"
  1.  D ^DIR
  1.  D:Y SETPURGE^HLOUSR7(+MSGIEN,Y),DISPLAY^HLOUSR1
  1.  Q
  1. SCREEN() ;  Screen for message purge status.
  1.  N TRUE
  1.  S TRUE=1
  1.  I $P($G(X),"^",3)="SET PURGE" D  Q TRUE
  1.  .N MSG
  1.  .I '$G(MSGIEN) S TRUE=0 Q
  1.  .I '$$GETMSG^HLOMSG(+MSGIEN,.MSG) S TRUE=0 Q
  1.  .I MSG("STATUS")="",'MSG("STATUS","PURGE") S TRUE=0
  1.  S:'TRUE VALMBCK="R"
  1.  Q TRUE
  1.  ;;**Start Patch HL*1.6.138 **
  1.  ;;The following three subroutines have been added for HL*1.6*138 - RBN
  1.  ;;
  1. RESEND ; If outbound message has been sent, resends it.
  1.  N CONF
  1.  D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
  1.  I CONF(0)'=1 D  Q
  1.  . W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1 Q
  1.  ;Q:$$VERIFY^HLOQUE1()=-1
  1.  N MSG,DIR,ERROR,FLG,OLDIEN,SYS
  1.  S OLDIEN=MSGIEN
  1.  I $G(OPT1DIS) D  K OPT1DIS Q
  1.  . W !,"Sorry that option is not available for this message." D PAUSE^VALM1 Q
  1.  S VALMBCK="R"
  1.  Q:'$G(MSGIEN)
  1.  Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
  1.  I MSG("DIRECTION")'="OUT" W !,"Message is not an outbound message" D PAUSE^VALM1 Q
  1.  I MSG("STATUS")="",'MSG("DT/TM") W !,"Message has not been sent!" D PAUSE^VALM1 Q
  1.  Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to resend MsgID: "_MSG("ID"),"NO")
  1.  S MSGIEN=$$RESEND^HLOAPI3(+MSGIEN,.ERROR)
  1.  I $G(ERROR) W ERROR D PAUSE^VALM1 Q
  1.  W !,"The message has been copied to MsgID ",MSGIEN," which will be displayed next"
  1.  I $$ASKYESNO^HLOUSR2("Do you want the original message purged?","NO") D
  1.  . D SYSPARMS^HLOSITE(.SYS)
  1.  . S HLOPURDT=$$FMADD^XLFDT($$NOW^XLFDT,SYS("ERROR PURGE"))
  1.  . S FLG=$$SETPURGE^HLOUSR7(OLDIEN,HLOPURDT)
  1.  S FLG=$$GETMSG^HLOMSG(+MSGIEN,.MSG)
  1.  D DISPLAY^HLOUSR1
  1.  Q
  1.  ;
  1. REPROC ; If inbound message has been processed, reprocesses it.
  1.  N CONF
  1.  D FULL^VALM1
  1.  D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
  1.  I CONF(0)'=1 D  Q
  1.  . W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1 Q
  1.  ;Q:$$VERIFY^HLOQUE1()=-1
  1.  N MSG,DIR,ERROR,SYSPARM
  1.  I $G(OPT2DIS) D  K OPT2DIS Q
  1.  . W !,"Sorry that option is not available for this message." D PAUSE^VALM1 Q
  1.  S VALMBCK="R"
  1.  Q:'$G(MSGIEN)
  1.  Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
  1.  I MSG("DIRECTION")'="IN" W !,"Message is not an inbound message" D PAUSE^VALM1 Q
  1.  I MSG("STATUS")="",'MSG("STATUS","APP HANDOFF") W !,"Message has not been processed" D PAUSE^VALM1 Q
  1.  Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to reprocess MsgID: "_MSG("ID"),"NO")
  1.  I '$$PROCNOW^HLOAPI3(+MSGIEN,"",.ERROR) W ERROR D PAUSE^VALM1 Q
  1.  W !,"Done!  The message has been reprocessed by the application."
  1.  S DIR(0)="D^"_DT_":"_$$FMADD^XLFDT(DT,+45)_":E"
  1.  I '$$ASKYESNO^HLOUSR2("Do you want to purge the message?","NO") D
  1.  . D SYSPARMS^HLOSITE(.SYSPARM)
  1.  . S HLOPURDT=$$FMADD^XLFDT($$NOW^XLFDT,SYSPARM("ERROR PURGE"))
  1.  . S FLG=$$SETPURGE^HLOUSR7(MSGIEN,HLOPURDT)
  1.  Q
  1.  ;
  1. MSGPREP ; Enable or disable menu options
  1.  N MSG,FDA,ERR
  1.  D GETMSG^HLOMSG(MSGIEN,.MSG)
  1.  I 'MSG("DT/TM") D            ; Message has not been sent/processed
  1.  .  S (OPT1DIS,OPT2DIS)=1
  1.  I MSG("DIRECTION")="OUT" D   ; Msg outbound and sent ; disable MP
  1.  .  S OPT2DIS=1
  1.  I MSG("DIRECTION")="IN" D    ; Msg inbound and sent ; disable MR
  1.  .  S OPT1DIS=1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;;**End Patch HL*1.6*138 **
  1.  ;