- HLOUSR3 ;ALB/CJM -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am
- ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
- ;
- ;
- 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>600 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>600 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>600 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>600 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>600 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")
- Q 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
- HLOUSR3 ;ALB/CJM -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am
- +1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
- +2 ;
- +3 ;
- EN ;
- +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 ;
- +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>600
- 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>600
- 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>600
- 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>600
- 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>600
- QUIT
- DO ADDTO(DIR,TIME,SAPP,SMSG,SEVENT,IEN)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 ;
- +22 ;
- END SET VALMBCK="R"
- +1 ;
- +2 QUIT
- ADDTO(DIR,TIME,APP,MSG,EVENT,IEN) ;
- +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) ;
- +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 SET PARMS("DIR")=$SELECT(PARMS("DIR")="I":"IN",1:"OUT")
- +16 QUIT 1
- +17 ;
- ASKAPP() ;
- +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() ;
- +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() ;
- +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 ;
- +1 SET VALMHDR(1)="MsgID Application MsgType"
- +2 QUIT
- HLP ;
- +1 QUIT
- EXIT ;
- +1 DO CLEAN^VALM10
- +2 DO CLEAR^VALM1
- +3 SET VALMBCK="R"
- +4 QUIT
