INHUTC4 ;KN,bar; 15 Sep 97 14:41; Interface Message/Error Search
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;;COPYRIGHT 1997 SAIC
;
;
; MODULE NAME: Interface Message/Error Search (INHUTC4)
;
; PURPOSE:
; The purpose of the Interface Message/Error Search module is to
; provide User/Programmer a generic search functionality into files
; ^INTHU and ^INTHER.
;
; DESCRIPTION:
; This module contains three sub-modules: INHUTC4, INHUTC5 and INHUTC6.
;
DISPLAY(INOPT,INMSGFND) ; Interactive output using DWL
;
; Description: The function Interactive search DISPLAY is performed
; the search interactively in the increment of matching
; records. Also, the DISPLAY uses List Processor DWL
; to present user with a list of matching records for
; selection and expanding or printing.
; Furthermore, this function has capability to allow for
; programmer to override the List Processor by assigning
; value to the option array INOPT. The search criteria
; is defined in INSRCH array and found records will be
; returned in INMSGFND array.
;
; Return:
; 0 = No error found (the program completed properly)
; 1 = No message to search (no message found)
; 2 = User stop the search (user abort DWL)
;
; Parameters:
; INOPT = Array of option values passed by reference.
; INMSGFND = A NAME of an array in which to build a list(in
; subscript/selection order) of the selected items IEN's
; into ^INTHU or ^INTHER.
;
; Code begins:
N X,Y,INL,INQUIT,IND,INMSGSZ,INNODE,INSRCHCT,INTYPE,INST,INRET,INSRCH
N DWL,DWLB,DWLMK,DWLMK1,DWLHOT,DWLR,DWLRF,XGABESCF,XBABPOP
;
; ---------- Retrieve Search criteria --------
I '$D(INSRCH) S INX=$$GATHER^INHUTC6($G(INOPT("CRITERIA")),.INSRCH) Q:'INX 1
S INTYPE=INSRCH("TYPE"),INST=$$UPCASE^%ZTF($E(INTYPE))_$$DNCASE^%ZTF($E(INTYPE,2,$L(INTYPE))),INMSGSZ=0,INRET=0
;
I '$$SC^INHUTIL1 D G IHSJUMP
.S DWLRF="INL"
.D EN^INHUTC52(.INSRCH)
.;VA List processor expands/displays within itself, so set quit
.S:'$D(INOPT("LIST","HOT")) INRET=2
; ---------- Init ListMan Title --------------
; Set up the default DWL title - ;bar; set app and func?
S:'$D(INOPT("LIST","TITLE")) X="Interface "_INST_" Search",X=$J("",IOM-$L(X)/2)_X,X=X_$J("",IOM-$L(X)),INOPT("LIST","TITLE")="W """_X_""""
;
; ---------- Transaction Specific ------------
I INTYPE="TRANSACTION" D
. ; determine scope of search and warn user if needed
. S INMSGSZ=$$SRCHSIZE^INHMS4(.INSRCH) Q:INMSGSZ<0
. ; Create the list processor help text
. S:'$D(INOPT("LIST","HELP")) INOPT("LIST","HELP")="N INHELP D BLDHELP^INHMS3(.INHELP),SRCHHELP^INHMS3(.INHELP)"
. S DWL("TITLE")=INOPT("LIST","TITLE")_" D INHTITLE^INHMS3(INMSGSZ,.INSRCH)"
;
; ---------- Error Specific ------------------
I INTYPE="ERROR" D
. ; determine scope of search and warn user if needed
. S INMSGSZ=$$SRCHSIZE^INHERR4(.INSRCH,"^INTHER(""B"")")
. S:'$D(INOPT("LIST","HELP")) INOPT("LIST","HELP")="N INHELP D BLDHELP^INHERR3(.INHELP),SRCHHELP^INHERR3(.INHELP)"
. S DWL("TITLE")=INOPT("LIST","TITLE")_" D INHTITLE^INHERR3(INMSGSZ,.INSRCH)"
;
; ---------- Search Size ----------------------
; check for user abort or no records to search
Q:INMSGSZ<0 2
;IHS branch
I 'INMSGSZ,$$SC^INHUTIL1 D MS^DWD("No "_INST_"s to Search") S X=$$CR^UTSRD Q 1
S INOPT("SRCHSIZE")=INMSGSZ
;
; ---------- Init ListMan Hot Keys ------------
I $D(INOPT("LIST","HOT"))>9 D
. S INNODE="" F S INNODE=$O(INOPT("LIST","HOT",INNODE)) Q:'INNODE S DWLHOT(INNODE)=INOPT("LIST","HOT",INNODE)
. S DWL("TITLE")=DWL("TITLE")_" D HOTTITLE^INHOU2"
;
; ---------- DWL set up, save the display list in array DWLRF
S DWL="GFEWZ",DWLRF="INL",DWLB="0^2^17^78"
S:'$L($G(INOPT("LIST","HELP"))) DWL=DWL_"H"
; If expand in error search, then the display window is smaller for more titles
I INTYPE="TRANSACTION",$G(INSRCH("INEXPAND")) S DWLB="0^3^16^78"
I INTYPE="ERROR",$G(INSRCH("INEXPAND")) S DWLB="0^5^15^78"
;
; --------- set up "more" functionality --------
S DWL("MORE")=$S($D(INOPT("LIST","MORE")):INOPT("LIST","MORE"),1:"FIND^INHUTC5(.INQUIT,.INOPT,.DWLRF,.INSRCH)")
S INOPT("DISPFORMAT")=$G(INOPT("DISPFORMAT"),"D BLDSTR^INHUTC4(INM,INSRCH(""INFNDCT""),.INIEN,.INSRCH)")
S INOPT("MAXFND")=$G(INOPT("MAXFND"),20),(INOPT("INSRCHCT"),INOPT("INFNDCT"))=0
S INSRCHCT=0 D @DWL("MORE")
I INQUIT=4 S INRET=2 G CLEAN
I INQUIT=3,$G(INOPT("INFNDCT"))=0 S INRET=1 G CLEAN
;
; ---------- Set up default print template -----
S:'$D(INOPT("PRINT")) INOPT("PRINT")="INH "_$S(INTYPE="TRANSACTION":"MESSAGE",1:INTYPE)_" DISPLAY"
;
; ---------- Call ListMan
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(INOPT("PRINT"),INSRCH("FILENUM"))
. ; Let user get help, and hot key if any
. I DWLR="?" X INOPT("LIST","HELP")
. I DWLR["H",$D(INOPT("LIST","HOT"))>9,($D(DWLMK)) N INHOTOPT S INHOTOPT="" F S INHOTOPT=$O(INOPT("LIST","HOT",INHOTOPT)) Q:'INHOTOPT D
.. I DWLR[$P(INOPT("LIST","HOT",INHOTOPT),U,2) X INOPT("LIST","HOT",INHOTOPT,"ACTION")
; If user abort DWL, then set the return value, quit and clear screen
I DWLR["^" S INRET=2 G CLEAN
IHSJUMP ;IHS logic jumps here to bypass CHCS Listman calls
I $D(INOPT("LIST","HOT"))>9,$D(DWLMK) N INHOTOPT S INHOTOPT=$O(INOPT("LIST","HOT","")) X INOPT("LIST","HOT",INHOTOPT,"ACTION")
; Action-Bar to be called if a name was passed and system is not IHS.
I $L($G(INOPT("LIST","BAR"))),$$SC^INHUTIL1 D ABASK^XGABAR(INOPT("LIST","BAR")) S INOPT("LIST","BAR","XGABESCF")=XGABESCF,INOPT("LIST","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 functionality has been exercized.
I $D(DWLMK) D
. S:DWLRF[U INMSGFND="^UTILITY(""INS"","_$J_")" K @INMSGFND
. S INNODE=0 F S INNODE=$O(DWLMK(INNODE)) Q:INNODE="" S @INMSGFND@(DWLMK(INNODE))=@DWLRF@(INNODE,0)
CLEAN ; cleanup vars and the selection array
K:$D(@DWLRF) @DWLRF
M INOPT("INSRCH")=INSRCH
D CLEAR^DW
Q INRET
;
BLDSTR(INDA,INSEQ,DWLRF,INSRCH) ; Build text to display in ListMan screen
;
; input: INDA = ien of record found
; INSEQ = list sequence number
; DWLRF = name of list storage array
; INSRCH = search criteria array
; return:
; Build entries of text into DWLRF array
;
N INETBL,INMTBL
I INSRCH("TYPE")="TRANSACTION" D
. S @DWLRF@(INSEQ)=$$INMSGSTR^INHMS2(INDA,"","")
. I $G(INSRCH("INEXPAND")) S %=$$INMSGSTR^INHMS2(INDA,"",$G(INSRCH("INEXPAND"))) I $L(%) S @DWLRF@(INSEQ+.1)=%
I INSRCH("TYPE")="ERROR" D
. M INETBL=INSRCH("INETBL"),INMTBL=INSRCH("INMTBL")
. S @DWLRF@(INSEQ)=$$INMSGSTR^INHERR3(INDA,"",$G(INSRCH("INEXPAND")))
. ; show the expanded listing date only if EXPAND and a MESSAGE exists
. D:$G(INSRCH("INEXPAND"))
.. S %=$$INMSGSTR^INHERR3(INDA,"",$G(INSRCH("INEXPAND")),2) S:$L(%) @DWLRF@((INSEQ+.1))=%
.. S %=$$INMSGSTR^INHERR3(INDA,"",$G(INSRCH("INEXPAND")),3) S:$L(%) @DWLRF@((INSEQ+.2))=%
. S %=$$INMSGSTR^INHERR3(INDA,"",$G(INSRCH("INEXPAND")),1) S:$L(%) @DWLRF@((INSEQ+.3))=%
; make first line selectable, INDA is used to pass the ien to the selected array later
S @DWLRF@(INSEQ,0)=INDA
Q
;
INHUTC4 ;KN,bar; 15 Sep 97 14:41; Interface Message/Error Search
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;;COPYRIGHT 1997 SAIC
+4 ;
+5 ;
+6 ; MODULE NAME: Interface Message/Error Search (INHUTC4)
+7 ;
+8 ; PURPOSE:
+9 ; The purpose of the Interface Message/Error Search module is to
+10 ; provide User/Programmer a generic search functionality into files
+11 ; ^INTHU and ^INTHER.
+12 ;
+13 ; DESCRIPTION:
+14 ; This module contains three sub-modules: INHUTC4, INHUTC5 and INHUTC6.
+15 ;
DISPLAY(INOPT,INMSGFND) ; Interactive output using DWL
+1 ;
+2 ; Description: The function Interactive search DISPLAY is performed
+3 ; the search interactively in the increment of matching
+4 ; records. Also, the DISPLAY uses List Processor DWL
+5 ; to present user with a list of matching records for
+6 ; selection and expanding or printing.
+7 ; Furthermore, this function has capability to allow for
+8 ; programmer to override the List Processor by assigning
+9 ; value to the option array INOPT. The search criteria
+10 ; is defined in INSRCH array and found records will be
+11 ; returned in INMSGFND array.
+12 ;
+13 ; Return:
+14 ; 0 = No error found (the program completed properly)
+15 ; 1 = No message to search (no message found)
+16 ; 2 = User stop the search (user abort DWL)
+17 ;
+18 ; Parameters:
+19 ; INOPT = Array of option values passed by reference.
+20 ; INMSGFND = A NAME of an array in which to build a list(in
+21 ; subscript/selection order) of the selected items IEN's
+22 ; into ^INTHU or ^INTHER.
+23 ;
+24 ; Code begins:
+25 NEW X,Y,INL,INQUIT,IND,INMSGSZ,INNODE,INSRCHCT,INTYPE,INST,INRET,INSRCH
+26 NEW DWL,DWLB,DWLMK,DWLMK1,DWLHOT,DWLR,DWLRF,XGABESCF,XBABPOP
+27 ;
+28 ; ---------- Retrieve Search criteria --------
+29 IF '$DATA(INSRCH)
SET INX=$$GATHER^INHUTC6($GET(INOPT("CRITERIA")),.INSRCH)
IF 'INX
QUIT 1
+30 SET INTYPE=INSRCH("TYPE")
SET INST=$$UPCASE^%ZTF($EXTRACT(INTYPE))_$$DNCASE^%ZTF($EXTRACT(INTYPE,2,$LENGTH(INTYPE)))
SET INMSGSZ=0
SET INRET=0
+31 ;
+32 IF '$$SC^INHUTIL1
Begin DoDot:1
+33 SET DWLRF="INL"
+34 DO EN^INHUTC52(.INSRCH)
+35 ;VA List processor expands/displays within itself, so set quit
+36 IF '$DATA(INOPT("LIST","HOT"))
SET INRET=2
End DoDot:1
GOTO IHSJUMP
+37 ; ---------- Init ListMan Title --------------
+38 ; Set up the default DWL title - ;bar; set app and func?
+39 IF '$DATA(INOPT("LIST","TITLE"))
SET X="Interface "_INST_" Search"
SET X=$JUSTIFY("",IOM-$LENGTH(X)/2)_X
SET X=X_$JUSTIFY("",IOM-$LENGTH(X))
SET INOPT("LIST","TITLE")="W """_X_""""
+40 ;
+41 ; ---------- Transaction Specific ------------
+42 IF INTYPE="TRANSACTION"
Begin DoDot:1
+43 ; determine scope of search and warn user if needed
+44 SET INMSGSZ=$$SRCHSIZE^INHMS4(.INSRCH)
IF INMSGSZ<0
QUIT
+45 ; Create the list processor help text
+46 IF '$DATA(INOPT("LIST","HELP"))
SET INOPT("LIST","HELP")="N INHELP D BLDHELP^INHMS3(.INHELP),SRCHHELP^INHMS3(.INHELP)"
+47 SET DWL("TITLE")=INOPT("LIST","TITLE")_" D INHTITLE^INHMS3(INMSGSZ,.INSRCH)"
End DoDot:1
+48 ;
+49 ; ---------- Error Specific ------------------
+50 IF INTYPE="ERROR"
Begin DoDot:1
+51 ; determine scope of search and warn user if needed
+52 SET INMSGSZ=$$SRCHSIZE^INHERR4(.INSRCH,"^INTHER(""B"")")
+53 IF '$DATA(INOPT("LIST","HELP"))
SET INOPT("LIST","HELP")="N INHELP D BLDHELP^INHERR3(.INHELP),SRCHHELP^INHERR3(.INHELP)"
+54 SET DWL("TITLE")=INOPT("LIST","TITLE")_" D INHTITLE^INHERR3(INMSGSZ,.INSRCH)"
End DoDot:1
+55 ;
+56 ; ---------- Search Size ----------------------
+57 ; check for user abort or no records to search
+58 IF INMSGSZ<0
QUIT 2
+59 ;IHS branch
+60 IF 'INMSGSZ
IF $$SC^INHUTIL1
DO MS^DWD("No "_INST_"s to Search")
SET X=$$CR^UTSRD
QUIT 1
+61 SET INOPT("SRCHSIZE")=INMSGSZ
+62 ;
+63 ; ---------- Init ListMan Hot Keys ------------
+64 IF $DATA(INOPT("LIST","HOT"))>9
Begin DoDot:1
+65 SET INNODE=""
FOR
SET INNODE=$ORDER(INOPT("LIST","HOT",INNODE))
IF 'INNODE
QUIT
SET DWLHOT(INNODE)=INOPT("LIST","HOT",INNODE)
+66 SET DWL("TITLE")=DWL("TITLE")_" D HOTTITLE^INHOU2"
End DoDot:1
+67 ;
+68 ; ---------- DWL set up, save the display list in array DWLRF
+69 SET DWL="GFEWZ"
SET DWLRF="INL"
SET DWLB="0^2^17^78"
+70 IF '$LENGTH($GET(INOPT("LIST","HELP")))
SET DWL=DWL_"H"
+71 ; If expand in error search, then the display window is smaller for more titles
+72 IF INTYPE="TRANSACTION"
IF $GET(INSRCH("INEXPAND"))
SET DWLB="0^3^16^78"
+73 IF INTYPE="ERROR"
IF $GET(INSRCH("INEXPAND"))
SET DWLB="0^5^15^78"
+74 ;
+75 ; --------- set up "more" functionality --------
+76 SET DWL("MORE")=$SELECT($DATA(INOPT("LIST","MORE")):INOPT("LIST","MORE"),1:"FIND^INHUTC5(.INQUIT,.INOPT,.DWLRF,.INSRCH)")
+77 SET INOPT("DISPFORMAT")=$GET(INOPT("DISPFORMAT"),"D BLDSTR^INHUTC4(INM,INSRCH(""INFNDCT""),.INIEN,.INSRCH)")
+78 SET INOPT("MAXFND")=$GET(INOPT("MAXFND"),20)
SET (INOPT("INSRCHCT"),INOPT("INFNDCT"))=0
+79 SET INSRCHCT=0
DO @DWL("MORE")
+80 IF INQUIT=4
SET INRET=2
GOTO CLEAN
+81 IF INQUIT=3
IF $GET(INOPT("INFNDCT"))=0
SET INRET=1
GOTO CLEAN
+82 ;
+83 ; ---------- Set up default print template -----
+84 IF '$DATA(INOPT("PRINT"))
SET INOPT("PRINT")="INH "_$SELECT(INTYPE="TRANSACTION":"MESSAGE",1:INTYPE)_" DISPLAY"
+85 ;
+86 ; ---------- Call ListMan
+87 FOR
DO ^DWL
IF $$QUITDWL^INHMS3($GET(DWLR))
QUIT
IF DWL'["K"
SET DWL=DWL_"K"
Begin DoDot:1
+88 IF DWLR="E"
DO EXPAND^INHERR1(INOPT("PRINT"),INSRCH("FILENUM"))
+89 ; Let user get help, and hot key if any
+90 IF DWLR="?"
XECUTE INOPT("LIST","HELP")
+91 IF DWLR["H"
IF $DATA(INOPT("LIST","HOT"))>9
IF ($DATA(DWLMK))
NEW INHOTOPT
SET INHOTOPT=""
FOR
SET INHOTOPT=$ORDER(INOPT("LIST","HOT",INHOTOPT))
IF 'INHOTOPT
QUIT
Begin DoDot:2
+92 IF DWLR[$PIECE(INOPT("LIST","HOT",INHOTOPT),U,2)
XECUTE INOPT("LIST","HOT",INHOTOPT,"ACTION")
End DoDot:2
End DoDot:1
IF $DATA(@DWLRF)<10
QUIT
+93 ; If user abort DWL, then set the return value, quit and clear screen
+94 IF DWLR["^"
SET INRET=2
GOTO CLEAN
IHSJUMP ;IHS logic jumps here to bypass CHCS Listman calls
+1 IF $DATA(INOPT("LIST","HOT"))>9
IF $DATA(DWLMK)
NEW INHOTOPT
SET INHOTOPT=$ORDER(INOPT("LIST","HOT",""))
XECUTE INOPT("LIST","HOT",INHOTOPT,"ACTION")
+2 ; Action-Bar to be called if a name was passed and system is not IHS.
+3 IF $LENGTH($GET(INOPT("LIST","BAR")))
IF $$SC^INHUTIL1
DO ABASK^XGABAR(INOPT("LIST","BAR"))
SET INOPT("LIST","BAR","XGABESCF")=XGABESCF
SET INOPT("LIST","BAR","XGABPOP")=XGABPOP
+4 ; build the selection-ordered list in @INMSGFND (^UTILITY if needed)
+5 ; build it from 'DWLMK' because 'DWLMK1' is not reliable after the
+6 ; EXPAND functionality has been exercized.
+7 IF $DATA(DWLMK)
Begin DoDot:1
+8 IF DWLRF[U
SET INMSGFND="^UTILITY(""INS"","_$JOB_")"
KILL @INMSGFND
+9 SET INNODE=0
FOR
SET INNODE=$ORDER(DWLMK(INNODE))
IF INNODE=""
QUIT
SET @INMSGFND@(DWLMK(INNODE))=@DWLRF@(INNODE,0)
End DoDot:1
CLEAN ; cleanup vars and the selection array
+1 IF $DATA(@DWLRF)
KILL @DWLRF
+2 MERGE INOPT("INSRCH")=INSRCH
+3 DO CLEAR^DW
+4 QUIT INRET
+5 ;
BLDSTR(INDA,INSEQ,DWLRF,INSRCH) ; Build text to display in ListMan screen
+1 ;
+2 ; input: INDA = ien of record found
+3 ; INSEQ = list sequence number
+4 ; DWLRF = name of list storage array
+5 ; INSRCH = search criteria array
+6 ; return:
+7 ; Build entries of text into DWLRF array
+8 ;
+9 NEW INETBL,INMTBL
+10 IF INSRCH("TYPE")="TRANSACTION"
Begin DoDot:1
+11 SET @DWLRF@(INSEQ)=$$INMSGSTR^INHMS2(INDA,"","")
+12 IF $GET(INSRCH("INEXPAND"))
SET %=$$INMSGSTR^INHMS2(INDA,"",$GET(INSRCH("INEXPAND")))
IF $LENGTH(%)
SET @DWLRF@(INSEQ+.1)=%
End DoDot:1
+13 IF INSRCH("TYPE")="ERROR"
Begin DoDot:1
+14 MERGE INETBL=INSRCH("INETBL"),INMTBL=INSRCH("INMTBL")
+15 SET @DWLRF@(INSEQ)=$$INMSGSTR^INHERR3(INDA,"",$GET(INSRCH("INEXPAND")))
+16 ; show the expanded listing date only if EXPAND and a MESSAGE exists
+17 IF $GET(INSRCH("INEXPAND"))
Begin DoDot:2
+18 SET %=$$INMSGSTR^INHERR3(INDA,"",$GET(INSRCH("INEXPAND")),2)
IF $LENGTH(%)
SET @DWLRF@((INSEQ+.1))=%
+19 SET %=$$INMSGSTR^INHERR3(INDA,"",$GET(INSRCH("INEXPAND")),3)
IF $LENGTH(%)
SET @DWLRF@((INSEQ+.2))=%
End DoDot:2
+20 SET %=$$INMSGSTR^INHERR3(INDA,"",$GET(INSRCH("INEXPAND")),1)
IF $LENGTH(%)
SET @DWLRF@((INSEQ+.3))=%
End DoDot:1
+21 ; make first line selectable, INDA is used to pass the ien to the selected array later
+22 SET @DWLRF@(INSEQ,0)=INDA
+23 QUIT
+24 ;
