HLOUSR3 ;ALB/CJM -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am ;03/20/2007 ;;1.6;HEALTH LEVEL SEVEN;**126,134**;Oct 13, 1995;Build 30 ;Per VHA Directive 2004-038, this routine should not be modified. ; ; EN ; N HLPARMS D FULL^VALM1 I '$$ASK(.HLPARMS) S VALMBCK="R" Q D WAIT^DICD D EN^VALM("HLO MESSAGE SEARCH") Q SEARCH ; 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 S VALMBCK="R" ; Q ADDTO(DIR,TIME,APP,MSG,EVENT,IEN) ; 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) ; 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 S PARMS("DIR")=$S(PARMS("DIR")="I":"IN",1:"OUT") S PARMS("MAX")=$$ASKMAX() Q:'(PARMS("MAX")>-1) 0 Q 1 ; ASKMAX() ; 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() ; 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() ; 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() ; 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 ; S VALMHDR(1)="MsgID Application MsgType" Q HLP ; Q EXIT ; D CLEAN^VALM10 D CLEAR^VALM1 S VALMBCK="R" Q ; SETPURGE ; 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^HLOAPI3(+MSGIEN,Y),DISPLAY^HLOUSR1 Q SCREEN() ; 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