source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOUSR3.m@ 1438

Last change on this file since 1438 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1HLOUSR3 ;ALB/CJM -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am ;03/20/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,134**;Oct 13, 1995;Build 30
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6EN ;
7 N HLPARMS
8 D FULL^VALM1
9 I '$$ASK(.HLPARMS) S VALMBCK="R" Q
10 D WAIT^DICD
11 D EN^VALM("HLO MESSAGE SEARCH")
12 Q
13SEARCH ;
14 N I,APP,START,END,DIR,MSG,EVENT,TIME
15 D EXIT
16 S I=""
17 F S I=$O(HLPARMS(I)) Q:I="" S @I=HLPARMS(I)
18 K HLPARMS
19 S (VALMCNT,I)=0
20 S TIME=START
21 F S TIME=$O(^HLB("SEARCH",DIR,TIME)) Q:'TIME Q:TIME>END Q:VALMCNT>MAX D
22 .N SAPP S SAPP=""
23 .S:APP'="" SAPP=$O(^HLB("SEARCH",DIR,TIME,APP),-1)
24 .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
25 ..N SMSG S SMSG=""
26 ..S:MSG'="" SMSG=$O(^HLB("SEARCH",DIR,TIME,SAPP,MSG),-1)
27 ..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
28 ...N SEVENT S SEVENT=""
29 ...S:EVENT'="" SEVENT=$O(^HLB("SEARCH",DIR,TIME,SAPP,SMSG,EVENT),-1)
30 ...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
31 ....N IEN
32 ....S IEN=""
33 ....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)
34 ;
35 ;
36END S VALMBCK="R"
37 ;
38 Q
39ADDTO(DIR,TIME,APP,MSG,EVENT,IEN) ;
40 N HDR,FS,LOC,MSGID
41 S MSGID=$S($P(IEN,"^",2):$P($G(^HLB(+IEN,3,$P(IEN,"^",2),0)),"^",2),1:$P($G(^HLB(IEN,0)),"^",1))
42 S HDR=$G(^HLB(+IEN,1))
43 S FS=$E(HDR,4)
44 I FS'="" D
45 .I DIR="IN" S LOC=$P(HDR,FS,4)
46 .I DIR'="IN" S LOC=$P(HDR,FS,6)
47 E S LOC=""
48 S @VALMAR@($$I,0)=$$LJ(MSGID,25)_$$LJ(APP,30)_" "_MSG_"~"_EVENT
49 D CNTRL^VALM10(VALMCNT,1,25,IOINHI,IOINORM)
50 S @VALMAR@($$I,0)=" "_$$LJ($$FMTE^XLFDT(TIME,2),20)_$$LJ(LOC,60)
51 S @VALMAR@($$I,0)=""
52 Q
53LJ(STRING,LEN) ;
54 Q $$LJ^XLFSTR(STRING,LEN)
55 ;
56I() ;
57 S VALMCNT=VALMCNT+1
58 Q VALMCNT
59 ;
60ASK(PARMS) ;
61 N SUB
62 F SUB="START","END","EVENT","APP","MSG","DIR" S PARMS(SUB)=""
63 S PARMS("START")=$$ASKBEGIN^HLOUSR2()
64 Q:'PARMS("START") 0
65 S PARMS("END")=$$ASKEND^HLOUSR2(PARMS("START"))
66 Q:'PARMS("END") 0
67 S PARMS("APP")=$$ASKAPP()
68 Q:PARMS("APP")=-1 0
69 S PARMS("MSG")=$$ASKMSG()
70 Q:PARMS("MSG")=-1 0
71 S PARMS("EVENT")=$$ASKEVENT()
72 Q:PARMS("EVENT")=-1 0
73 S PARMS("DIR")=$$ASKDIR()
74 Q:PARMS("DIR")=-1 0
75 S PARMS("DIR")=$S(PARMS("DIR")="I":"IN",1:"OUT")
76 S PARMS("MAX")=$$ASKMAX()
77 Q:'(PARMS("MAX")>-1) 0
78 Q 1
79 ;
80ASKMAX() ;
81 N DIR
82 S DIR(0)="N^1:30000:0"
83 S DIR("A")="Maximum List Size"
84 S DIR("B")=1000
85 S DIR("?",1)="In case a large number of messages meet your search criteria, what are the"
86 S DIR("?")="maximum number of messages to display? (30,000 maximum)"
87 D ^DIR
88 Q:$D(DTOUT)!$D(DUOUT) -1
89 Q 3*(X-1)
90ASKAPP() ;
91 N DIR
92 S DIR(0)="FO^0:60"
93 S DIR("A")="Application"
94 S DIR("?",1)="Enter the name of the application, or '^' to exit."
95 S DIR("?")="You can enter just the first part of the name."
96 D ^DIR
97 Q:$D(DTOUT)!$D(DUOUT) -1
98 Q X
99ASKMSG() ;
100 N DIR
101 S DIR(0)="FO^0:3"
102 S DIR("A")="HL7 Message Type"
103 S DIR("?",1)="Enter the 3 character message type (e.g. MFN, ADT), or '^' to exit."
104 S DIR("?")="You can enter just the first character or two."
105 D ^DIR
106 Q:$D(DTOUT)!$D(DUOUT) -1
107 Q X
108ASKEVENT() ;
109 N DIR
110 S DIR(0)="FO^0:3"
111 S DIR("A")="HL7 Event"
112 S DIR("?",1)="Enter the 3 character event type, or '^' to exit."
113 S DIR("?")="You can enter just the first character or two."
114 D ^DIR
115 Q:$D(DTOUT)!$D(DUOUT) -1
116 Q X
117ASKDIR() ;
118 N DIR
119 S DIR(0)="S^I:INCOMING;O:OUTGOING"
120 S DIR("A")="Incoming or Outgoing"
121 S DIR("?",1)="Are you searching for an incoming message or an outgoing message?"
122 S DIR("?")="You can enter '^' to exit"
123 D ^DIR
124 Q:$D(DTOUT)!$D(DUOUT) -1
125 Q X
126HDR ;
127 S VALMHDR(1)="MsgID Application MsgType"
128 Q
129HLP ;
130 Q
131EXIT ;
132 D CLEAN^VALM10
133 D CLEAR^VALM1
134 S VALMBCK="R"
135 Q
136 ;
137SETPURGE ;
138 N MSG,DIR
139 S VALMBCK="R"
140 Q:'$G(MSGIEN)
141 Q:'$$GETMSG^HLOMSG(+MSGIEN,.MSG)
142 I MSG("STATUS")="",'MSG("STATUS","PURGE") W !,"Can not set purge yet!" D PAUSE^VALM1 Q
143 S DIR(0)="D^"_DT_":"_$$FMADD^XLFDT(DT,+45)_":E"
144 S DIR("A")="When should the message be purged?"
145 D ^DIR
146 D:Y SETPURGE^HLOAPI3(+MSGIEN,Y),DISPLAY^HLOUSR1
147 Q
148SCREEN() ;
149 N TRUE
150 S TRUE=1
151 I $P($G(X),"^",3)="SET PURGE" D Q TRUE
152 .N MSG
153 .I '$G(MSGIEN) S TRUE=0 Q
154 .I '$$GETMSG^HLOMSG(+MSGIEN,.MSG) S TRUE=0 Q
155 .I MSG("STATUS")="",'MSG("STATUS","PURGE") S TRUE=0
156 S:'TRUE VALMBCK="R"
157 Q TRUE
Note: See TracBrowser for help on using the repository browser.