INHERR1.m

INHERR1 ;DJL; 28 Feb 95 10:40;Interface - Error Search

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

EXPAND(INTEMPLT,INFILE) ;Expand-action logic on List Processor field

 ; MODULE NAME: EXPAND (Expand-action logic for ^DWL )

 ; DESCRIPTION: Expand using print template name passed and

 ;              on the file passed.

 ; RETURN = none

 ; PARAMETERS

 ;    INTEMPLT = The print template to use

 ;    INFILE   = The file to use

 ; CODE BEGINS

 N I,X,DIC,DR,DHD,DW,DWCP,INIO,DIE,DA

 Q:'$D(@DWLRF@($P(@DWLRF,U,4),0))

 D CLEAR^DW

 S %ZIS="N" D ^%ZIS Q:POP  S INIO=IO,IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 S DA(@DWLRF@($P(@DWLRF,U,4),0))=""

 S DR=INTEMPLT,DIC=INFILE,DHD="@" D PRTLIST^DWPR

 S:INIO=IO X=$$CR^UTSRD

 Q

 ;

INERSRCH(INETEXT,INEIEN,INELOGIC) ; Test error for text-string match(multi)

 ; MODULE NAME: INERSRCH (Interface Error MESSAGE Search)

 ; DESCRIPTION: Search ^INTHER( INEIEN ) error for matching values to

 ;              the search string array: INETEXT.

 ; RETURN= PASS/FAIL (1/0)

 ; PARAMETERS:

 ;   INETEXT= search string array with base node("INTEXT") set to

 ;             subscript count value and subscript nodes containing

 ;             the strings

 ;   INEIEN= The IEN of the error in the ^INTHER error file

 ;   INELOGIC= The matching logic switch set to 1 or 0

 ;             1= ANDing functionality RE:all strings must be found

 ;                in the error

 ;             0= ORing functionality RE:only one string need match

 ; CODE BEGINS

 N X,INEFOUND,INELINE,INENODE

 S (INEFOUND,INENODE)=0 F  S INENODE=$O(^INTHER(INEIEN,2,INENODE)) Q:'INENODE!INEFOUND  D

 .  S INELINE=^INTHER(INEIEN,2,INENODE,0)

 .  I '$D(INELINE) Q

 .; loop through the strings for the current error

 .; For enhances text searching use MSGPACK^INHMS1

 .  S INEFOUND=$$INLSRCH(.INETEXT,.INELINE,.INEFOUND,INELOGIC)

 .; no items were found or AND functionality is used.

 .; test if any of INEFOUND(n) are not TRUE quit with 0 returned

 .  I INELOGIC S INEFOUND=1,X="" F  S X=$O(INETEXT("INTEXT",X)) Q:'X  I '$D(INEFOUND(X)) S INEFOUND=0 Q

 Q INEFOUND

 ;

INLSRCH(SRCHTEXT,MSGTEXT,INFOUND,INLOGIC) ; Test error for text-string

 ;                                          match(one line)

 ; MODULE NAME: INLSRCH (Interface Error LINE Search)

 ; DESCRIPTION: To find a search string in a error which may be a

 ;              continuation line or not. The search line MAY be

 ;              split across multiple lines.

 ; RETURN= PASS/FAIL (1/0)

 ; PARAMETERS:

 ;   SRCHTEXT(PBR)= The array of search string containing less than a 70 char.

 ;             count value and subscript nodes containing the strings

 ;   MSGTEXT(PBR)= error text/array

 ;   INFOUND(PBR)= The array used to indicate strings matches found.

 ;   INLOGIC(PBV)= The flag indicating the type(OR/AND) of logic used with

 ;            matching error data and the search strings.

 ; CODE BEGINS

 N BUF,INQUIT,INNODE

 ; pack the error into 250 char./node error

 ; *** COMMENTED-OUT(following line) FOR ERROR SEARCH ONLY ***

 ;D MSGPACK(.MSGTEXT)

 S BUF=MSGTEXT,(INFOUND,INQUIT)=0

 F  Q:INFOUND!INQUIT  D

 .; loop thru the strings(SRCHTEXT("INTEXT")) to match

 .; setting a corresponding node(INFOUND(n))=TRUE if a match is

 .; found. quit on a single 'find' for OR functionality

 .  S INNODE="" F  S INNODE=$O(SRCHTEXT("INTEXT",INNODE)) Q:'INNODE  I BUF[SRCHTEXT("INTEXT",INNODE) S INFOUND(INNODE)=1 I 'INLOGIC S INFOUND=1 Q

 .; if OR functionity and a error was found then quit looping thru

 .; this error

 .  I 'INLOGIC,INFOUND Q

 .;  quit if there are no more lines to test

 .  I '$O(MSGTEXT("")) S INQUIT=1 Q

 .;  move the last 69 char to the front of buffer and repack the array

 .; *** COMMENTED-OUT(following line) FOR ERROR SEARCH ONLY ***

 .;  S MSGTEXT=$E(BUF,181,999) D MSGPACK(.MSGTEXT) S BUF=MSGTEXT

 .  Q

 Q INFOUND

 ;

INHERR1   ;DJL; 28 Feb 95 10:40;Interface - Error Search

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

EXPAND(INTEMPLT,INFILE) ;Expand-action logic on List Processor field

 +1       ; MODULE NAME: EXPAND (Expand-action logic for ^DWL )

 +2       ; DESCRIPTION: Expand using print template name passed and

 +3       ;              on the file passed.

 +4       ; RETURN = none

 +5       ; PARAMETERS

 +6       ;    INTEMPLT = The print template to use

 +7       ;    INFILE   = The file to use

 +8       ; CODE BEGINS

 +9        NEW I,X,DIC,DR,DHD,DW,DWCP,INIO,DIE,DA

 +10       IF '$DATA(@DWLRF@($PIECE(@DWLRF,U,4),0))

               QUIT 

 +11       DO CLEAR^DW

 +12       SET %ZIS="N"

           DO ^%ZIS

           IF POP

               QUIT 

           SET INIO=IO

           SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 +13       SET DA(@DWLRF@($PIECE(@DWLRF,U,4),0))=""

 +14       SET DR=INTEMPLT

           SET DIC=INFILE

           SET DHD="@"

           DO PRTLIST^DWPR

 +15       IF INIO=IO

               SET X=$$CR^UTSRD

 +16       QUIT 

 +17      ;

INERSRCH(INETEXT,INEIEN,INELOGIC) ; Test error for text-string match(multi)

 +1       ; MODULE NAME: INERSRCH (Interface Error MESSAGE Search)

 +2       ; DESCRIPTION: Search ^INTHER( INEIEN ) error for matching values to

 +3       ;              the search string array: INETEXT.

 +4       ; RETURN= PASS/FAIL (1/0)

 +5       ; PARAMETERS:

 +6       ;   INETEXT= search string array with base node("INTEXT") set to

 +7       ;             subscript count value and subscript nodes containing

 +8       ;             the strings

 +9       ;   INEIEN= The IEN of the error in the ^INTHER error file

 +10      ;   INELOGIC= The matching logic switch set to 1 or 0

 +11      ;             1= ANDing functionality RE:all strings must be found

 +12      ;                in the error

 +13      ;             0= ORing functionality RE:only one string need match

 +14      ; CODE BEGINS

 +15       NEW X,INEFOUND,INELINE,INENODE

 +16       SET (INEFOUND,INENODE)=0

           FOR 

               SET INENODE=$ORDER(^INTHER(INEIEN,2,INENODE))

               IF 'INENODE!INEFOUND

                   QUIT 

               Begin DoDot:1

 +17               SET INELINE=^INTHER(INEIEN,2,INENODE,0)

 +18               IF '$DATA(INELINE)

                       QUIT 

 +19      ; loop through the strings for the current error

 +20      ; For enhances text searching use MSGPACK^INHMS1

 +21               SET INEFOUND=$$INLSRCH(.INETEXT,.INELINE,.INEFOUND,INELOGIC)

 +22      ; no items were found or AND functionality is used.

 +23      ; test if any of INEFOUND(n) are not TRUE quit with 0 returned

 +24               IF INELOGIC

                       SET INEFOUND=1

                       SET X=""

                       FOR 

                           SET X=$ORDER(INETEXT("INTEXT",X))

                           IF 'X

                               QUIT 

                           IF '$DATA(INEFOUND(X))

                               SET INEFOUND=0

                               QUIT 

               End DoDot:1

 +25       QUIT INEFOUND

 +26      ;

INLSRCH(SRCHTEXT,MSGTEXT,INFOUND,INLOGIC) ; Test error for text-string

 +1       ;                                          match(one line)

 +2       ; MODULE NAME: INLSRCH (Interface Error LINE Search)

 +3       ; DESCRIPTION: To find a search string in a error which may be a

 +4       ;              continuation line or not. The search line MAY be

 +5       ;              split across multiple lines.

 +6       ; RETURN= PASS/FAIL (1/0)

 +7       ; PARAMETERS:

 +8       ;   SRCHTEXT(PBR)= The array of search string containing less than a 70 char.

 +9       ;             count value and subscript nodes containing the strings

 +10      ;   MSGTEXT(PBR)= error text/array

 +11      ;   INFOUND(PBR)= The array used to indicate strings matches found.

 +12      ;   INLOGIC(PBV)= The flag indicating the type(OR/AND) of logic used with

 +13      ;            matching error data and the search strings.

 +14      ; CODE BEGINS

 +15       NEW BUF,INQUIT,INNODE

 +16      ; pack the error into 250 char./node error

 +17      ; *** COMMENTED-OUT(following line) FOR ERROR SEARCH ONLY ***

 +18      ;D MSGPACK(.MSGTEXT)

 +19       SET BUF=MSGTEXT

           SET (INFOUND,INQUIT)=0

 +20       FOR 

               IF INFOUND!INQUIT

                   QUIT 

               Begin DoDot:1

 +21      ; loop thru the strings(SRCHTEXT("INTEXT")) to match

 +22      ; setting a corresponding node(INFOUND(n))=TRUE if a match is

 +23      ; found. quit on a single 'find' for OR functionality

 +24               SET INNODE=""

                   FOR 

                       SET INNODE=$ORDER(SRCHTEXT("INTEXT",INNODE))

                       IF 'INNODE

                           QUIT 

                       IF BUF[SRCHTEXT("INTEXT",INNODE)

                           SET INFOUND(INNODE)=1

                           IF 'INLOGIC

                               SET INFOUND=1

                               QUIT 

 +25      ; if OR functionity and a error was found then quit looping thru

 +26      ; this error

 +27               IF 'INLOGIC

                       IF INFOUND

                           QUIT 

 +28      ;  quit if there are no more lines to test

 +29               IF '$ORDER(MSGTEXT(""))

                       SET INQUIT=1

                       QUIT 

 +30      ;  move the last 69 char to the front of buffer and repack the array

 +31      ; *** COMMENTED-OUT(following line) FOR ERROR SEARCH ONLY ***

 +32      ;  S MSGTEXT=$E(BUF,181,999) D MSGPACK(.MSGTEXT) S BUF=MSGTEXT

 +33               QUIT 

               End DoDot:1

 +34       QUIT INFOUND

 +35      ;