INHMS ;JSH,DJL; 17 Jan 96 10:03;Interface - Message Search
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
SEARCH ; Search/List/Output INTHU messages that match a search criteria
; MODULE NAME: SEARCH ( Interface Message Search Routine )
; DESCRIPTION: Prompts the user for search criteria to be used
; to find matches in the Interface Message Queue
; file (^INTHU). The user is presented with a list
; of matching items which can be selectively expanded
; or printed(user chosen device). The user is then
; brought back to the Search Criteria menu and can
; continue with another search or exit with the F10 key.
; RETURN = none
; PARAMETERS = none
; CODE BEGINS
N INDA,INQUIT,INFNDNAM,INSELECT,INPARM2
S INFNDNAM="INMSGS" N @INFNDNAM
; Create the list processor help text
S INPARM2("INHELP")="N INHELP D BLDHELP^INHMS3(.INHELP),SRCHHELP^INHMS3(.INHELP)"
; Create the list processor TITLE text
S INPARM2("TITLE")="W ?IOM-$L(""Interface Message Search"")/2,""Interface Message Search"""
F S INFNDNAM="INMSGS" S INQUIT=$$BGNSRCH(.INFNDNAM,1,.INDA,.INPARM2) Q:$S(INQUIT=0:0,INQUIT=4:0,1:1) D:$O(@INFNDNAM@(0)) POST^INHMS2(INFNDNAM) K @INFNDNAM
D:+INDA INKINDA(INDA)
Q
;
BGNSRCH(INMSGFND,INKINDA,INDA,INPARM2) ; Begin a search
; MODULE NAME: BGNSRCH ( Programmers entry point )
; DESCRIPTION: Same fuctionality as SEARCH^INHMS but only executes
; a single pass. This would be useful for a programmers
; interface because an array is loaded with the selected
; items and could be used for other processing needs. An
; Action-Bar can be added to the process by setting the
; fourth parameter to the name of the Action-Bar.
; RETURN = 0 = "CONTINUE" The program completed properly
; 1 = "EXIT" The user exited ^DWC
; 2 = "SYSTEM" The incorrect system
; 3 = "CREATION" The entry to store the search criteria could
; not be created
; 4 = "CRITERIA" The required search criteria was not entered
; PARAMETERS:
; INMSGFND = A NAME of an array in which to build a list(in
; subscript/selection order) of the selected items IEN's
; into ^INTHU
; INKINDA = Flag used to initiate the call to INKINDA(INDA) to do
; cleanup of the ^DIZ global if set to 0 after the search
; or let the calling routine call INKINDA(INDA).
; INDA = Set to the node into ^DIZ(4001.1) where the selected
; search criteria is setup.
; INPARM2 = Structure nodes as follows:
; "HELP" = Executable M code used for the List Processor HELP
; "TITLE" = Executable M code use for the List Processor Title
; "BAR" = A NAME of an Action-Bar to be called immediately after
; all the items in the list have been selected. The
; structure passed is to be updated with the XGABESCF and
; XGABPOP nodes upon exiting. The calling routine must
; evaluate the appropriate structure nodes to determine
; the action to be taken
; "BAR","XGABESCF" & "BAR","XGABPOP" set after bar is run
; "HOT",x ="string indicating the function of the key^ret. value"
; "HOT",x,"ACTION" ="Executable M code used on key selection)"
; CODE BEGINS
N X,Y,INTEMP,DWLR,DWLRF,INL,INQUIT,INUQUIT,IND,INNODE,INSRCH,INM,INSRCHCT,INRVSRCH
N DIC,DWL,DWLB,DIE,DWN,INERRTYP,DWLMK,DWLMK1,DWLMK2,DWLMSG,DWLHOT,DIPA,INMSGSZ,XGABESCF,XBABPOP
S INKINDA=$G(INKINDA),INDA=$G(INDA)
S INERRTYP("CONTINUE")=0,INERRTYP("EXIT")=1,INERRTYP("SYSTEM")=2,INERRTYP("CREATION")=3,INERRTYP("CRITERIA")=4
I '$$SC^INHUTIL1 D ERR^INHMS2("Incorrect system type! This routine option is not available on this system.") Q INERRTYP("SYSTEM")
; create ^DIZ file if 1) single pass calling
; 2) multi-pass and INDA is not yet created
I 'INDA S X=$J_"_"_DUZ_"_"_$P($H,",",2),DIC=4001.1,DIC(0)="L",DLAYGO=4001.1 D ^DIC S INDA=+Y I +Y<0 D ERR^INHMS2("Unable to create file "_X_" Interface Message Search Failed") Q INERRTYP("CREATION")
S DA=INDA
; set the listing order default=Newest to Oldest
S:'$D(^DIZ(4001.1,INDA,11)) ^DIZ(4001.1,INDA,11)=0
; set the expanded display default=NO
S:'$D(^DIZ(4001.1,INDA,12)) ^DIZ(4001.1,INDA,12)=0
; Force ^DWC to ask to file then Preset the fields for another search
S DWASK=""
S DIE=4001.1,DWN="INH MESSAGE SEARCH" D ^DWC
I '$D(DWFILE) S INUQUIT=1 D:'INKINDA INKINDA(INDA) Q INERRTYP("EXIT")
I '$G(^DIZ(4001.1,INDA,1)) D ERR^INHMS2("START DATE search criteria was not entered.","",1) D:'INKINDA INKINDA(INDA) Q INERRTYP("CRITERIA")
D GATHER^INHMS4(.INSRCH,INDA,.IND,.INRVSRCH)
S INMSGSZ=$$SRCHSIZE^INHMS4(.INSRCH) Q:INMSGSZ<0 INERRTYP("CONTINUE") I 'INMSGSZ D MS^DWD("No Messages to Search") S X=$$CR^UTSRD D:'INKINDA INKINDA(INDA) Q INERRTYP("CONTINUE")
; Setup the Hot-Key paramters to be called if set in INPARM2 structure.
I $D(INPARM2("HOT"))>9 S INNODE="" F S INNODE=$O(INPARM2("HOT",INNODE)) Q:'INNODE S DWLHOT(INNODE)=INPARM2("HOT",INNODE)
I $D(INPARM2("HOT"))>9 S INPARM2("TITLE")=$G(INPARM2("TITLE"))_" D HOTTITLE^INHOU2"
; setup the title used in the list processor
S:$G(DWL("TITLE"))'["INHTITLE^INHMS3" DWL("TITLE")=$G(INPARM2("TITLE"))_" D INHTITLE^INHMS3(INMSGSZ,.INSRCH)"
S DWL="GFEW",DWLRF="INL",DWL("MORE")="LIST^INHMS2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT)",DWLB="0^2^17^78",$P(@DWLRF,U,2)=0
S INSRCHCT=0 D LIST^INHMS2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT) I INQUIT D:'INKINDA INKINDA(INDA) K @DWLRF Q INERRTYP("CONTINUE")
S:'$L($G(INPARM2("INHELP"))) DWL=DWL_"H"
F D ^DWL Q:$$QUITDWL^INHMS3($G(DWLR)) S:DWL'["K" DWL=DWL_"K" D Q:$D(@DWLRF)<10
. I DWLR="E" D EXPAND^INHMS1
. I DWLR="?" X INPARM2("INHELP")
. I DWLR["H",$D(INPARM2("HOT"))>9,($D(DWLMK)) N INHOTOPT S INHOTOPT="" F S INHOTOPT=$O(INPARM2("HOT",INHOTOPT)) Q:'INHOTOPT D
.. I DWLR[$P(INPARM2("HOT",INHOTOPT),U,2) X INPARM2("HOT",INHOTOPT,"ACTION")
I DWLR["^" K DWLMK,DWLMK1
I $D(INPARM2("HOT"))>9,$D(DWLMK) N INHOTOPT S INHOTOPT=$O(INPARM2("HOT","")) X INPARM2("HOT",INHOTOPT,"ACTION")
; Action-Bar to be called if a name was passed.
I $L($G(INPARM2("BAR"))) D ABASK^XGABAR(INPARM2("BAR")) S INPARM2("BAR","XGABESCF")=XGABESCF,INPARM2("BAR","XGABPOP")=XGABPOP
;
; build the selection-ordered list in @INMSGFND (^UTILITY if needed)
; build it from 'DWLMK' because 'DWLMK1' is not reliable after the
; EXPAND functality has been exercized.
I $D(DWLMK) D
. K @INMSGFND
. I DWLRF[U S INMSGFND="^UTILITY(""INL"","_$J_"_"_DUZ_"_"_$P($H,",",2)_")" K @INMSGFND
. S INNODE=0 F S INNODE=$O(DWLMK(INNODE)) Q:INNODE="" S @INMSGFND@(DWLMK(INNODE))=@DWLRF@(INNODE,0)
D:'INKINDA INKINDA(INDA)
; cleanup the array built as list for ^DWL(could be in global(expand))
K:$D(@DWLRF) @DWLRF Q INERRTYP("CONTINUE")
;
INKINDA(INDA) ; Clean-up search criteria storage data
; MODULE NAME: INKINDA ( Search Criteria Clean-up Routine )
; DESCRIPTION: Cleans up the Search Criteria Data in the ^DIZ global
; by using the ^DIK routine.
; RETURN = none
; PARAMETERS:
; INDA = Unique IEN into ^DIZ used to store Search Criteria Data
; CODE BEGINS
S INDA=$G(INDA)
I $D(^DIZ(4001.1,+INDA)) N X,DA,DIK S DA=INDA,DIK="^DIZ(4001.1," D ^DIK
Q
;
INHMS ;JSH,DJL; 17 Jan 96 10:03;Interface - Message Search
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
SEARCH ; Search/List/Output INTHU messages that match a search criteria
+1 ; MODULE NAME: SEARCH ( Interface Message Search Routine )
+2 ; DESCRIPTION: Prompts the user for search criteria to be used
+3 ; to find matches in the Interface Message Queue
+4 ; file (^INTHU). The user is presented with a list
+5 ; of matching items which can be selectively expanded
+6 ; or printed(user chosen device). The user is then
+7 ; brought back to the Search Criteria menu and can
+8 ; continue with another search or exit with the F10 key.
+9 ; RETURN = none
+10 ; PARAMETERS = none
+11 ; CODE BEGINS
+12 NEW INDA,INQUIT,INFNDNAM,INSELECT,INPARM2
+13 SET INFNDNAM="INMSGS"
NEW @INFNDNAM
+14 ; Create the list processor help text
+15 SET INPARM2("INHELP")="N INHELP D BLDHELP^INHMS3(.INHELP),SRCHHELP^INHMS3(.INHELP)"
+16 ; Create the list processor TITLE text
+17 SET INPARM2("TITLE")="W ?IOM-$L(""Interface Message Search"")/2,""Interface Message Search"""
+18 FOR
SET INFNDNAM="INMSGS"
SET INQUIT=$$BGNSRCH(.INFNDNAM,1,.INDA,.INPARM2)
IF $SELECT(INQUIT=0
QUIT
IF $ORDER(@INFNDNAM@(0))
DO POST^INHMS2(INFNDNAM)
KILL @INFNDNAM
+19 IF +INDA
DO INKINDA(INDA)
+20 QUIT
+21 ;
BGNSRCH(INMSGFND,INKINDA,INDA,INPARM2) ; Begin a search
+1 ; MODULE NAME: BGNSRCH ( Programmers entry point )
+2 ; DESCRIPTION: Same fuctionality as SEARCH^INHMS but only executes
+3 ; a single pass. This would be useful for a programmers
+4 ; interface because an array is loaded with the selected
+5 ; items and could be used for other processing needs. An
+6 ; Action-Bar can be added to the process by setting the
+7 ; fourth parameter to the name of the Action-Bar.
+8 ; RETURN = 0 = "CONTINUE" The program completed properly
+9 ; 1 = "EXIT" The user exited ^DWC
+10 ; 2 = "SYSTEM" The incorrect system
+11 ; 3 = "CREATION" The entry to store the search criteria could
+12 ; not be created
+13 ; 4 = "CRITERIA" The required search criteria was not entered
+14 ; PARAMETERS:
+15 ; INMSGFND = A NAME of an array in which to build a list(in
+16 ; subscript/selection order) of the selected items IEN's
+17 ; into ^INTHU
+18 ; INKINDA = Flag used to initiate the call to INKINDA(INDA) to do
+19 ; cleanup of the ^DIZ global if set to 0 after the search
+20 ; or let the calling routine call INKINDA(INDA).
+21 ; INDA = Set to the node into ^DIZ(4001.1) where the selected
+22 ; search criteria is setup.
+23 ; INPARM2 = Structure nodes as follows:
+24 ; "HELP" = Executable M code used for the List Processor HELP
+25 ; "TITLE" = Executable M code use for the List Processor Title
+26 ; "BAR" = A NAME of an Action-Bar to be called immediately after
+27 ; all the items in the list have been selected. The
+28 ; structure passed is to be updated with the XGABESCF and
+29 ; XGABPOP nodes upon exiting. The calling routine must
+30 ; evaluate the appropriate structure nodes to determine
+31 ; the action to be taken
+32 ; "BAR","XGABESCF" & "BAR","XGABPOP" set after bar is run
+33 ; "HOT",x ="string indicating the function of the key^ret. value"
+34 ; "HOT",x,"ACTION" ="Executable M code used on key selection)"
+35 ; CODE BEGINS
+36 NEW X,Y,INTEMP,DWLR,DWLRF,INL,INQUIT,INUQUIT,IND,INNODE,INSRCH,INM,INSRCHCT,INRVSRCH
+37 NEW DIC,DWL,DWLB,DIE,DWN,INERRTYP,DWLMK,DWLMK1,DWLMK2,DWLMSG,DWLHOT,DIPA,INMSGSZ,XGABESCF,XBABPOP
+38 SET INKINDA=$GET(INKINDA)
SET INDA=$GET(INDA)
+39 SET INERRTYP("CONTINUE")=0
SET INERRTYP("EXIT")=1
SET INERRTYP("SYSTEM")=2
SET INERRTYP("CREATION")=3
SET INERRTYP("CRITERIA")=4
+40 IF '$$SC^INHUTIL1
DO ERR^INHMS2("Incorrect system type! This routine option is not available on this system.")
QUIT INERRTYP("SYSTEM")
+41 ; create ^DIZ file if 1) single pass calling
+42 ; 2) multi-pass and INDA is not yet created
+43 IF 'INDA
SET X=$JOB_"_"_DUZ_"_"_$PIECE($HOROLOG,",",2)
SET DIC=4001.1
SET DIC(0)="L"
SET DLAYGO=4001.1
DO ^DIC
SET INDA=+Y
IF +Y<0
DO ERR^INHMS2("Unable to create file "_X_" Interface Message Search Failed")
QUIT INERRTYP("CREATION")
+44 SET DA=INDA
+45 ; set the listing order default=Newest to Oldest
+46 IF '$DATA(^DIZ(4001.1,INDA,11))
SET ^DIZ(4001.1,INDA,11)=0
+47 ; set the expanded display default=NO
+48 IF '$DATA(^DIZ(4001.1,INDA,12))
SET ^DIZ(4001.1,INDA,12)=0
+49 ; Force ^DWC to ask to file then Preset the fields for another search
+50 SET DWASK=""
+51 SET DIE=4001.1
SET DWN="INH MESSAGE SEARCH"
DO ^DWC
+52 IF '$DATA(DWFILE)
SET INUQUIT=1
IF 'INKINDA
DO INKINDA(INDA)
QUIT INERRTYP("EXIT")
+53 IF '$GET(^DIZ(4001.1,INDA,1))
DO ERR^INHMS2("START DATE search criteria was not entered.","",1)
IF 'INKINDA
DO INKINDA(INDA)
QUIT INERRTYP("CRITERIA")
+54 DO GATHER^INHMS4(.INSRCH,INDA,.IND,.INRVSRCH)
+55 SET INMSGSZ=$$SRCHSIZE^INHMS4(.INSRCH)
IF INMSGSZ<0
QUIT INERRTYP("CONTINUE")
IF 'INMSGSZ
DO MS^DWD("No Messages to Search")
SET X=$$CR^UTSRD
IF 'INKINDA
DO INKINDA(INDA)
QUIT INERRTYP("CONTINUE")
+56 ; Setup the Hot-Key paramters to be called if set in INPARM2 structure.
+57 IF $DATA(INPARM2("HOT"))>9
SET INNODE=""
FOR
SET INNODE=$ORDER(INPARM2("HOT",INNODE))
IF 'INNODE
QUIT
SET DWLHOT(INNODE)=INPARM2("HOT",INNODE)
+58 IF $DATA(INPARM2("HOT"))>9
SET INPARM2("TITLE")=$GET(INPARM2("TITLE"))_" D HOTTITLE^INHOU2"
+59 ; setup the title used in the list processor
+60 IF $GET(DWL("TITLE"))'["INHTITLE^INHMS3"
SET DWL("TITLE")=$GET(INPARM2("TITLE"))_" D INHTITLE^INHMS3(INMSGSZ,.INSRCH)"
+61 SET DWL="GFEW"
SET DWLRF="INL"
SET DWL("MORE")="LIST^INHMS2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT)"
SET DWLB="0^2^17^78"
SET $PIECE(@DWLRF,U,2)=0
+62 SET INSRCHCT=0
DO LIST^INHMS2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT)
IF INQUIT
IF 'INKINDA
DO INKINDA(INDA)
KILL @DWLRF
QUIT INERRTYP("CONTINUE")
+63 IF '$LENGTH($GET(INPARM2("INHELP")))
SET DWL=DWL_"H"
+64 FOR
DO ^DWL
IF $$QUITDWL^INHMS3($GET(DWLR))
QUIT
IF DWL'["K"
SET DWL=DWL_"K"
Begin DoDot:1
+65 IF DWLR="E"
DO EXPAND^INHMS1
+66 IF DWLR="?"
XECUTE INPARM2("INHELP")
+67 IF DWLR["H"
IF $DATA(INPARM2("HOT"))>9
IF ($DATA(DWLMK))
NEW INHOTOPT
SET INHOTOPT=""
FOR
SET INHOTOPT=$ORDER(INPARM2("HOT",INHOTOPT))
IF 'INHOTOPT
QUIT
Begin DoDot:2
+68 IF DWLR[$PIECE(INPARM2("HOT",INHOTOPT),U,2)
XECUTE INPARM2("HOT",INHOTOPT,"ACTION")
End DoDot:2
End DoDot:1
IF $DATA(@DWLRF)<10
QUIT
+69 IF DWLR["^"
KILL DWLMK,DWLMK1
+70 IF $DATA(INPARM2("HOT"))>9
IF $DATA(DWLMK)
NEW INHOTOPT
SET INHOTOPT=$ORDER(INPARM2("HOT",""))
XECUTE INPARM2("HOT",INHOTOPT,"ACTION")
+71 ; Action-Bar to be called if a name was passed.
+72 IF $LENGTH($GET(INPARM2("BAR")))
DO ABASK^XGABAR(INPARM2("BAR"))
SET INPARM2("BAR","XGABESCF")=XGABESCF
SET INPARM2("BAR","XGABPOP")=XGABPOP
+73 ;
+74 ; build the selection-ordered list in @INMSGFND (^UTILITY if needed)
+75 ; build it from 'DWLMK' because 'DWLMK1' is not reliable after the
+76 ; EXPAND functality has been exercized.
+77 IF $DATA(DWLMK)
Begin DoDot:1
+78 KILL @INMSGFND
+79 IF DWLRF[U
SET INMSGFND="^UTILITY(""INL"","_$JOB_"_"_DUZ_"_"_$PIECE($HOROLOG,",",2)_")"
KILL @INMSGFND
+80 SET INNODE=0
FOR
SET INNODE=$ORDER(DWLMK(INNODE))
IF INNODE=""
QUIT
SET @INMSGFND@(DWLMK(INNODE))=@DWLRF@(INNODE,0)
End DoDot:1
+81 IF 'INKINDA
DO INKINDA(INDA)
+82 ; cleanup the array built as list for ^DWL(could be in global(expand))
+83 IF $DATA(@DWLRF)
KILL @DWLRF
QUIT INERRTYP("CONTINUE")
+84 ;
INKINDA(INDA) ; Clean-up search criteria storage data
+1 ; MODULE NAME: INKINDA ( Search Criteria Clean-up Routine )
+2 ; DESCRIPTION: Cleans up the Search Criteria Data in the ^DIZ global
+3 ; by using the ^DIK routine.
+4 ; RETURN = none
+5 ; PARAMETERS:
+6 ; INDA = Unique IEN into ^DIZ used to store Search Criteria Data
+7 ; CODE BEGINS
+8 SET INDA=$GET(INDA)
+9 IF $DATA(^DIZ(4001.1,+INDA))
NEW X,DA,DIK
SET DA=INDA
SET DIK="^DIZ(4001.1,"
DO ^DIK
+10 QUIT
+11 ;
