INHERR ;DJL; 30 Jan 96 14:40;Interface - Error Search
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
SEARCH ; Search/List/Output INTHER errors that match a search criteria
; MODULE NAME: SEARCH ( Interface Error Search Routine )
; DESCRIPTION: Prompts the user for search criteria to be used
; to find matches in the Interface Error File
; file (^INTHER). 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("HELP")="N INHELP D BLDHELP^INHERR3(.INHELP),SRCHHELP^INHERR3(.INHELP)"
; Create the list processor TITLE text
S INPARM2("TITLE")="W ?IOM-$L(""Interface Error Search"")/2,""Interface Error Search"""
F S INFNDNAM="INMSGS" S INQUIT=$$BGNSRCH(.INFNDNAM,1,.INDA,.INPARM2,0) Q:$S(INQUIT=0:0,INQUIT=4:0,1:1) D:$O(@INFNDNAM@(0)) POST^INHERR2(INFNDNAM,"INH ERROR DISPLAY",4003) K @INFNDNAM
D:+INDA INKINDA^INHMS(INDA)
Q
;
BGNSRCH(INMSGFND,INKINDA,INDA,INPARM2,SUMMARY) ; 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(PBR) = A NAME of an array in which to build a list(in
; subscript/selection order) of the selected items IEN's
; into ^INTHU
; INKINDA(PBV) = 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(PBR) = Set to the node into ^DIZ(4001.1) where the selected
; search criteria is setup.
; INPARM2(PBR) = 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)"
; "SUMMARY" = 1 : SUMMARY REPORT, 0 : NORMAL REPORT
; 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,XGABPOP,DUOUT,DLAYGO
S INKINDA=$G(INKINDA),INDA=$G(INDA),SUMMARY=$G(SUMMARY)
S INERRTYP("CONTINUE")=0,INERRTYP("EXIT")=1,INERRTYP("SYSTEM")=2,INERRTYP("CREATION")=3,INERRTYP("CRITERIA")=4
;Don't quit here if system is IHS
;I '$$SC^INHUTIL1,'$$IHS^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 Error 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
; **** For the summary report, default text lenght is 30
I SUMMARY S:'$D(^DIZ(4001.1,INDA,20)) $P(^DIZ(4001.1,INDA,20),U,3)=1,$P(^DIZ(4001.1,INDA,20),U,11)=30
; Force ^DWC to ask to file then Preset the fields for another search
S:SUMMARY DWN="INH ERROR SUMMARY"
S:'SUMMARY DWN="INH ERROR SEARCH"
S DWASK=""
;IHS branch to call DWC if not IHS or DDS if it is.
I '$$SC^INHUTIL1 D Q:'$G(DDSSAVE) 1 G IHSJUMP
.N DDSFILE,DDSPAGE
.S (DIE,DDSFILE)=4001.1,DR="["_DWN_"]",DDSPAGE=1,DDSPARM="SC",INFORM=1
.D ^DDS
.S INERRTYP("CONTINUE")=1
S DIE=4001.1 D ^DWC
I '$D(DWFILE) S INUQUIT=1 D:'INKINDA INKINDA^INHMS(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^INHMS(INDA) Q INERRTYP("CRITERIA")
IHSJUMP ;IHS jumps here to bypass windowman calls
D GATHER^INHERR4(.INSRCH,INDA,.IND,.INRVSRCH)
; Check for summary report
N INSUM1
S INND20=$G(^DIZ(4001.1,INDA,20))
S INSUM1=$P(INND20,U,3)
S INTLN=$P(INND20,U,11),INSRCH("TEXTLEN")=$G(INTLN)
I INSUM1 D QUEUE^INHES(.INSRCH) Q INERRTYP("CONTINUE")
; End of modification for summary report
S INMSGSZ=$$SRCHSIZE^INHERR4(.INSRCH,"^INTHER(""B"")") Q:INMSGSZ<0 INERRTYP("CONTINUE") I 'INMSGSZ D MS^DWD("No Errors to Search") S X=$$CR^UTSRD D:'INKINDA INKINDA^INHMS(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")) INPARM2("TITLE")=$G(INPARM2("TITLE"))_" D HOTTITLE^INHOU2"
; setup the title used in the list processor
S:$G(DWL("TITLE"))'["INHTITLE^INHERR3" DWL("TITLE")=$G(INPARM2("TITLE"))_" D INHTITLE^INHERR3(INMSGSZ,.INSRCH)"
S DWL="FEW",DWLRF="INL",DWL("MORE")="LIST^INHERR2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT)",DWLB="0^3^17^78",$P(@DWLRF,U,2)=0
S:$G(INSRCH("INEXPAND")) DWLB="0^5^15^78"
S INSRCHCT=0 D LIST^INHERR2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT) I INQUIT D:'INKINDA INKINDA^INHMS(INDA) K @DWLRF Q INERRTYP("CONTINUE")
S:'$L($G(INPARM2("HELP"))) 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^INHERR1("INH ERROR DISPLAY",4003)
. I DWLR="?" X INPARM2("HELP")
. 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
; Default action (first hotkey item) with selected items and <RETURN> entered
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^INHMS(INDA)
; cleanup the array built as list for ^DWL(could be in global(expand))
K:$D(@DWLRF) @DWLRF Q INERRTYP("CONTINUE")
;
INHERR ;DJL; 30 Jan 96 14:40;Interface - Error Search
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
SEARCH ; Search/List/Output INTHER errors that match a search criteria
+1 ; MODULE NAME: SEARCH ( Interface Error Search Routine )
+2 ; DESCRIPTION: Prompts the user for search criteria to be used
+3 ; to find matches in the Interface Error File
+4 ; file (^INTHER). 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("HELP")="N INHELP D BLDHELP^INHERR3(.INHELP),SRCHHELP^INHERR3(.INHELP)"
+16 ; Create the list processor TITLE text
+17 SET INPARM2("TITLE")="W ?IOM-$L(""Interface Error Search"")/2,""Interface Error Search"""
+18 FOR
SET INFNDNAM="INMSGS"
SET INQUIT=$$BGNSRCH(.INFNDNAM,1,.INDA,.INPARM2,0)
IF $SELECT(INQUIT=0
QUIT
IF $ORDER(@INFNDNAM@(0))
DO POST^INHERR2(INFNDNAM,"INH ERROR DISPLAY",4003)
KILL @INFNDNAM
+19 IF +INDA
DO INKINDA^INHMS(INDA)
+20 QUIT
+21 ;
BGNSRCH(INMSGFND,INKINDA,INDA,INPARM2,SUMMARY) ; 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(PBR) = 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(PBV) = 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(PBR) = Set to the node into ^DIZ(4001.1) where the selected
+22 ; search criteria is setup.
+23 ; INPARM2(PBR) = 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 ; "SUMMARY" = 1 : SUMMARY REPORT, 0 : NORMAL REPORT
+36 ; CODE BEGINS
+37 NEW X,Y,INTEMP,DWLR,DWLRF,INL,INQUIT,INUQUIT,IND,INNODE,INSRCH,INM,INSRCHCT,INRVSRCH
+38 NEW DIC,DWL,DWLB,DIE,DWN,INERRTYP,DWLMK,DWLMK1,DWLMK2,DWLMSG,DWLHOT,DIPA,INMSGSZ,XGABESCF,XGABPOP,DUOUT,DLAYGO
+39 SET INKINDA=$GET(INKINDA)
SET INDA=$GET(INDA)
SET SUMMARY=$GET(SUMMARY)
+40 SET INERRTYP("CONTINUE")=0
SET INERRTYP("EXIT")=1
SET INERRTYP("SYSTEM")=2
SET INERRTYP("CREATION")=3
SET INERRTYP("CRITERIA")=4
+41 ;Don't quit here if system is IHS
+42 ;I '$$SC^INHUTIL1,'$$IHS^INHUTIL1 D ERR^INHMS2("Incorrect system type! This routine option is not available on this system.") Q INERRTYP("SYSTEM")
+43 ; create ^DIZ file if 1) single pass calling
+44 ; 2) multi-pass and INDA is not yet created
+45 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 Error Search Failed")
QUIT INERRTYP("CREATION")
+46 SET DA=INDA
+47 ; set the listing order default=Newest to Oldest
+48 IF '$DATA(^DIZ(4001.1,INDA,11))
SET ^DIZ(4001.1,INDA,11)=0
+49 ; set the expanded display default=NO
+50 IF '$DATA(^DIZ(4001.1,INDA,12))
SET ^DIZ(4001.1,INDA,12)=0
+51 ; **** For the summary report, default text lenght is 30
+52 IF SUMMARY
IF '$DATA(^DIZ(4001.1,INDA,20))
SET $PIECE(^DIZ(4001.1,INDA,20),U,3)=1
SET $PIECE(^DIZ(4001.1,INDA,20),U,11)=30
+53 ; Force ^DWC to ask to file then Preset the fields for another search
+54 IF SUMMARY
SET DWN="INH ERROR SUMMARY"
+55 IF 'SUMMARY
SET DWN="INH ERROR SEARCH"
+56 SET DWASK=""
+57 ;IHS branch to call DWC if not IHS or DDS if it is.
+58 IF '$$SC^INHUTIL1
Begin DoDot:1
+59 NEW DDSFILE,DDSPAGE
+60 SET (DIE,DDSFILE)=4001.1
SET DR="["_DWN_"]"
SET DDSPAGE=1
SET DDSPARM="SC"
SET INFORM=1
+61 DO ^DDS
+62 SET INERRTYP("CONTINUE")=1
End DoDot:1
IF '$GET(DDSSAVE)
QUIT 1
GOTO IHSJUMP
+63 SET DIE=4001.1
DO ^DWC
+64 IF '$DATA(DWFILE)
SET INUQUIT=1
IF 'INKINDA
DO INKINDA^INHMS(INDA)
QUIT INERRTYP("EXIT")
+65 IF '$GET(^DIZ(4001.1,INDA,1))
DO ERR^INHMS2("START DATE search criteria was not entered.","",1)
IF 'INKINDA
DO INKINDA^INHMS(INDA)
QUIT INERRTYP("CRITERIA")
IHSJUMP ;IHS jumps here to bypass windowman calls
+1 DO GATHER^INHERR4(.INSRCH,INDA,.IND,.INRVSRCH)
+2 ; Check for summary report
+3 NEW INSUM1
+4 SET INND20=$GET(^DIZ(4001.1,INDA,20))
+5 SET INSUM1=$PIECE(INND20,U,3)
+6 SET INTLN=$PIECE(INND20,U,11)
SET INSRCH("TEXTLEN")=$GET(INTLN)
+7 IF INSUM1
DO QUEUE^INHES(.INSRCH)
QUIT INERRTYP("CONTINUE")
+8 ; End of modification for summary report
+9 SET INMSGSZ=$$SRCHSIZE^INHERR4(.INSRCH,"^INTHER(""B"")")
IF INMSGSZ<0
QUIT INERRTYP("CONTINUE")
IF 'INMSGSZ
DO MS^DWD("No Errors to Search")
SET X=$$CR^UTSRD
IF 'INKINDA
DO INKINDA^INHMS(INDA)
QUIT INERRTYP("CONTINUE")
+10 ; Setup the Hot-Key paramters to be called if set in INPARM2 structure.
+11 IF $DATA(INPARM2("HOT"))>9
SET INNODE=""
FOR
SET INNODE=$ORDER(INPARM2("HOT",INNODE))
IF 'INNODE
QUIT
SET DWLHOT(INNODE)=INPARM2("HOT",INNODE)
+12 IF $DATA(INPARM2("HOT"))>9
IF INPARM2("TITLE")'[$GET(INPARM2("TITLE"))
SET INPARM2("TITLE")=$GET(INPARM2("TITLE"))_" D HOTTITLE^INHOU2"
+13 ; setup the title used in the list processor
+14 IF $GET(DWL("TITLE"))'["INHTITLE^INHERR3"
SET DWL("TITLE")=$GET(INPARM2("TITLE"))_" D INHTITLE^INHERR3(INMSGSZ,.INSRCH)"
+15 SET DWL="FEW"
SET DWLRF="INL"
SET DWL("MORE")="LIST^INHERR2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT)"
SET DWLB="0^3^17^78"
SET $PIECE(@DWLRF,U,2)=0
+16 IF $GET(INSRCH("INEXPAND"))
SET DWLB="0^5^15^78"
+17 SET INSRCHCT=0
DO LIST^INHERR2(.INQUIT,.IND,.INSRCH,.DWLRF,INRVSRCH,.INL,.INSRCHCT)
IF INQUIT
IF 'INKINDA
DO INKINDA^INHMS(INDA)
KILL @DWLRF
QUIT INERRTYP("CONTINUE")
+18 IF '$LENGTH($GET(INPARM2("HELP")))
SET DWL=DWL_"H"
+19 FOR
DO ^DWL
IF $$QUITDWL^INHMS3($GET(DWLR))
QUIT
IF DWL'["K"
SET DWL=DWL_"K"
Begin DoDot:1
+20 IF DWLR="E"
DO EXPAND^INHERR1("INH ERROR DISPLAY",4003)
+21 IF DWLR="?"
XECUTE INPARM2("HELP")
+22 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
+23 IF DWLR[$PIECE(INPARM2("HOT",INHOTOPT),U,2)
XECUTE INPARM2("HOT",INHOTOPT,"ACTION")
End DoDot:2
End DoDot:1
IF $DATA(@DWLRF)<10
QUIT
+24 IF DWLR["^"
KILL DWLMK,DWLMK1
+25 ; Default action (first hotkey item) with selected items and <RETURN> entered
+26 IF $DATA(INPARM2("HOT"))>9
IF $DATA(DWLMK)
NEW INHOTOPT
SET INHOTOPT=$ORDER(INPARM2("HOT",""))
XECUTE INPARM2("HOT",INHOTOPT,"ACTION")
+27 ; Action-Bar to be called if a name was passed.
+28 IF $LENGTH($GET(INPARM2("BAR")))
DO ABASK^XGABAR(INPARM2("BAR"))
SET INPARM2("BAR","XGABESCF")=XGABESCF
SET INPARM2("BAR","XGABPOP")=XGABPOP
+29 ;
+30 ; build the selection-ordered list in @INMSGFND (^UTILITY if needed)
+31 ; build it from 'DWLMK' because 'DWLMK1' is not reliable after the
+32 ; EXPAND functality has been exercized.
+33 IF $DATA(DWLMK)
Begin DoDot:1
+34 KILL @INMSGFND
+35 IF DWLRF[U
SET INMSGFND="^UTILITY(""INL"","_$JOB_"_"_DUZ_"_"_$PIECE($HOROLOG,",",2)_")"
KILL @INMSGFND
+36 SET INNODE=0
FOR
SET INNODE=$ORDER(DWLMK(INNODE))
IF INNODE=""
QUIT
SET @INMSGFND@(DWLMK(INNODE))=@DWLRF@(INNODE,0)
End DoDot:1
+37 IF 'INKINDA
DO INKINDA^INHMS(INDA)
+38 ; cleanup the array built as list for ^DWL(could be in global(expand))
+39 IF $DATA(@DWLRF)
KILL @DWLRF
QUIT INERRTYP("CONTINUE")
+40 ;
