Routine: INHERR2

INHERR2 ;DJL; 27 Oct 95 11:44;Interface - Error Search

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

 ;COPYRIGHT 1991-2000 SAIC

LIST(INQUIT,IND,INSRCH,DWLRF,INRVSRCH,INL,INSRCHCT) ; Build the error array

 ; MODULE NAME: LIST ( Build the list of matching errors )

 ; DESCRIPTION:

 ; loop through the errors from date-start to date-end and

 ; give the user a progress indicator

 ; PARAMETERS:

 ;    INQUIT(PBV) = 0 = The program completed properly

 ;             1 = No matching errors were found

 ;    IND(PBV) = The starting time/date of the search set from information

 ;          in INSRCH and determined by INRVSRCH flag

 ;    INSRCH(PBR) = Array for holding search criteria information

 ;    DWLRF(PBV) = Settings for the Display Processor

 ;    INRVSRCH(PBV) = Flag set user indicating direction of the search

 ;          -1 = (default)a reverse listing order. Newest to Oldest

 ;           0 = a forward search listing order. Oldest to Newest

 ;    INL(PBR) = Array used to load with error items matching the criteria

 ;    INSRCHCT(PBV) = The combined count of error items searched

 ; CODE BEGINS

 N INM,INFNDCT,INBLKCT,INNOMORE,INDSPSZ,DWLR,INETBL,INMTBL

 S INDSPSZ=1000 ; max. num. of msg. for disp. progress

 S INFNDCT=$P(@DWLRF,U,2),INBLKCT=INFNDCT+19 ; INBLKCT=num. of msg./win.

 ; build the set-of-code tables for MSGTEST usage

 D CODETBL^INHERR3("INETBL",4003,.1),CODETBL^INHERR3("INMTBL",4001,.03)

 S:'IND IND=$O(^INTHER("B",IND),INRVSRCH)

 F  Q:$S('IND:1,(INRVSRCH>-1)&(IND>INSRCH("INEND")):1,(INRVSRCH=-1)&(IND<INSRCH("INSTART")):1,1:0)!(INFNDCT>(INBLKCT))  D  S IND=$O(^INTHER("B",IND),INRVSRCH)

 .  S INM="" F  S INM=$O(^INTHER("B",IND,INM),INRVSRCH) Q:'INM  D

 ..    D MSGTEST(INM,.DWLRF,.INSRCH,.INSRCHCT,.INFNDCT) I '(INSRCHCT#20) D MS^DWD("SEARCHING...  ERRORS SEARCHED: "_INSRCHCT_"   ERRORS FOUND: "_INFNDCT)

 I '$O(@DWLRF@(0)) D MS^DWD("No Errors Found.") S INQUIT=$$CR^UTSRD,INQUIT=1 Q

 ; check for completion of search to terminate 'more' functionality

 S INNOMORE=0 S:$S('IND:1,(INRVSRCH>-1)&(IND>INSRCH("INEND")):1,(INRVSRCH=-1)&(IND<INSRCH("INSTART")):1,1:0) INNOMORE=1,$P(@DWLRF,U,2)=0

 S:'INNOMORE $P(@DWLRF,U,2)=INFNDCT

 S INQUIT=0

MSGTEST(INEIEN,INLIST,INSRCH,INSRCHCT,INFNDCT) ; Add matching error to array

 ; MODULE NAME: MSGTEST ( Interface Error Match Criteria Test )

 ; DESCRIPTION: Tests the error for matches to values passed in third

 ;              parameter array nodes and addes the IEN to the second

 ;              parameter array. Updates counters accordingly.

 ; RETURN = none

 ; PARAMETERS:

 ;    INEIEN(PBV)= IEN into ^INTHER

 ;    INLIST(PBR) = The NAME of the array to add items found

 ;    INSRCH(PBR) = The array of items to find

 ;    INSRCHCT(PBR) = The count of errors searched

 ;    INFNDCT(PBR) = The count of errors found

 ; CODE BEGINS

 N INTEMPX,INTEMPY,INMAXSZ,INMIEN

 S INMAXSZ=100,INTEMPX=$G(^INTHER(INEIEN,0)),INSRCHCT=INSRCHCT+1

 S INMIEN=$P(INTEMPX,U,4),INTEMPY=$G(^INTHU(+INMIEN,0))

 ; Checking the Interface Error file

 I INSRCH("INDEST")]"" I $P(INTEMPX,U,9)'=INSRCH("INDEST")&($P(INTEMPY,U,2)'=INSRCH("INDEST")) Q

 I INSRCH("INORIG")]"" I $P(INTEMPX,U,2)'=INSRCH("INORIG")&($P(INTEMPY,U,11)'=INSRCH("INORIG")) Q

 I $D(INSRCH("INERLOC")),INSRCH("INERLOC")]"",$P(INTEMPX,U,5)'=INSRCH("INERLOC") Q

 I $D(INSRCH("INERSTAT")),INSRCH("INERSTAT")]"",$P(INTEMPX,U,10)'=INSRCH("INERSTAT") Q

 I $D(INSRCH("INTEXT"))>9 Q:'$$INERSRCH^INHERR1(.INSRCH,INEIEN,INSRCH("INTYPE"))

 ; Checking the Interface Message file

 I $G(INSRCH("INMSGSTART")) Q:($P(INTEMPY,U)<INSRCH("INMSGSTART"))

 I $G(INSRCH("INMSGSTART")) Q:($P(INTEMPY,U)>INSRCH("INMSGEND"))

 I INSRCH("INID")]"" Q:$P(INTEMPY,U,5)'=INSRCH("INID")

 I INSRCH("INDIR")]"" Q:$P(INTEMPY,U,10)'=INSRCH("INDIR")

 I INSRCH("INSTAT")]"" Q:$P(INTEMPY,U,3)'=INSRCH("INSTAT")

 I INSRCH("INSOURCE")]"" Q:$E($P(INTEMPY,U,8),1,$L(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")

 I INSRCH("INPAT")]"" Q:'INMIEN  Q:'$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))

 ; move the found-items array to ^UTILITY if it's getting too large

 ; kill the new ^UTILITY space incase it already exists prior to merg

 I INFNDCT>INMAXSZ,(INLIST'[U) N INTEMPY S INTEMPY=INLIST,INLIST="^UTILITY(""INL"","_$J_"_"_DUZ_"_"_$P($H,",",2)_")" K @INLIST M @INLIST=@INTEMPY K @INTEMPY,INTEMPY

 S @INLIST@(INSRCHCT)=$$INMSGSTR^INHERR3(INEIEN,"",$G(INSRCH("INEXPAND"))),@INLIST@(INSRCHCT,0)=INEIEN,INFNDCT=INFNDCT+1

 I '$G(INSRCH("INEXPAND")) S @INLIST@((INSRCHCT+.1))=$$INMSGSTR^INHERR3(INEIEN,"",$G(INSRCH("INEXPAND")),1) K:'$L(@INLIST@((INSRCHCT+.1))) @INLIST@((INSRCHCT+.1))

 ; show the expanded listing date only if EXPAND and a MESSAGE exists

 D:$G(INSRCH("INEXPAND"))

 . S @INLIST@((INSRCHCT+.1))=$$INMSGSTR^INHERR3(INEIEN,"",$G(INSRCH("INEXPAND")),2) K:'$L(@INLIST@((INSRCHCT+.1))) @INLIST@((INSRCHCT+.1))

 D:+INMIEN&($G(INSRCH("INEXPAND")))

 . S @INLIST@((INSRCHCT+.2))=$$INMSGSTR^INHERR3(INEIEN,"",$G(INSRCH("INEXPAND")),3) K:'$L(@INLIST@((INSRCHCT+.2))) @INLIST@((INSRCHCT+.2))

 I $G(INSRCH("INEXPAND")) S @INLIST@((INSRCHCT+.3))=$$INMSGSTR^INHERR3(INEIEN,"",$G(INSRCH("INEXPAND")),1) K:'$L(@INLIST@((INSRCHCT+.3))) @INLIST@((INSRCHCT+.3))

DWLTITLE(INEXPAND) ; Write the title

 W !,"  Date/Time           Error Status     Error Location"

 W:INEXPAND !,"    Transaction Type                          Destination"

 W:INEXPAND !,"    Message Date/Time     Message ID            Message Status"

 W !,"         Error Text"

POST(INNAME,INTEMPLT,INFILE) ; Disply/Print

 ; MODULE NAME: POST ( Post-action logic on List Processor field )

 ; DESCRIPTION: Display/print using template passed on file passed

 ; RETURN = none

 ; PARAMETERS:

 ;    INNAME(PBV) = A NAME of an Array of IEN's into the file of items

 ;            selected for displaying/printing

 ;    INTEMPLT(PBV) = Print template to use

 ;    INFILE(PBV) = The file to use

 ; CODE BEGINS

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

 I $O(@INNAME@(0)) D

 . D CLEAR^DW

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

 . S I=0 F  S I=$O(@INNAME@(I)) Q:'I  S DA(@INNAME@(I))=""

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

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

INHERR2   ;DJL; 27 Oct 95 11:44;Interface - Error Search

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

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

LIST(INQUIT,IND,INSRCH,DWLRF,INRVSRCH,INL,INSRCHCT) ; Build the error array

 +1       ; MODULE NAME: LIST ( Build the list of matching errors )

 +2       ; DESCRIPTION:

 +3       ; loop through the errors from date-start to date-end and

 +4       ; give the user a progress indicator

 +5       ; PARAMETERS:

 +6       ;    INQUIT(PBV) = 0 = The program completed properly

 +7       ;             1 = No matching errors were found

 +8       ;    IND(PBV) = The starting time/date of the search set from information

 +9       ;          in INSRCH and determined by INRVSRCH flag

 +10      ;    INSRCH(PBR) = Array for holding search criteria information

 +11      ;    DWLRF(PBV) = Settings for the Display Processor

 +12      ;    INRVSRCH(PBV) = Flag set user indicating direction of the search

 +13      ;          -1 = (default)a reverse listing order. Newest to Oldest

 +14      ;           0 = a forward search listing order. Oldest to Newest

 +15      ;    INL(PBR) = Array used to load with error items matching the criteria

 +16      ;    INSRCHCT(PBV) = The combined count of error items searched

 +17      ; CODE BEGINS

 +18       NEW INM,INFNDCT,INBLKCT,INNOMORE,INDSPSZ,DWLR,INETBL,INMTBL

 +19      ; max. num. of msg. for disp. progress

           SET INDSPSZ=1000

 +20      ; INBLKCT=num. of msg./win.

           SET INFNDCT=$PIECE(@DWLRF,U,2)

           SET INBLKCT=INFNDCT+19

 +21      ; build the set-of-code tables for MSGTEST usage

 +22       DO CODETBL^INHERR3("INETBL",4003,.1)

           DO CODETBL^INHERR3("INMTBL",4001,.03)

 +23       IF 'IND

               SET IND=$ORDER(^INTHER("B",IND),INRVSRCH)

 +24       FOR

               IF $SELECT('IND

                   QUIT

               Begin DoDot:1

 +25               SET INM=""

FOR

                       SET INM=$ORDER(^INTHER("B",IND,INM),INRVSRCH)

                       IF 'INM

                           QUIT

                       Begin DoDot:2

 +26                       DO MSGTEST(INM,.DWLRF,.INSRCH,.INSRCHCT,.INFNDCT)

                           IF '(INSRCHCT#20)

                               DO MS^DWD("SEARCHING...  ERRORS SEARCHED: "_INSRCHCT_"   ERRORS FOUND: "_INFNDCT)

                       End DoDot:2

               End DoDot:1

               SET IND=$ORDER(^INTHER("B",IND),INRVSRCH)

 +27       IF '$ORDER(@DWLRF@(0))

               DO MS^DWD("No Errors Found.")

               SET INQUIT=$$CR^UTSRD

               SET INQUIT=1

               QUIT

 +28      ; check for completion of search to terminate 'more' functionality

 +29       SET INNOMORE=0

           IF $SELECT('IND

               SET INNOMORE=1

               SET $PIECE(@DWLRF,U,2)=0

 +30       IF 'INNOMORE

               SET $PIECE(@DWLRF,U,2)=INFNDCT

 +31       SET INQUIT=0

 +32       QUIT

 +33      ;

MSGTEST(INEIEN,INLIST,INSRCH,INSRCHCT,INFNDCT) ; Add matching error to array

 +1       ; MODULE NAME: MSGTEST ( Interface Error Match Criteria Test )

 +2       ; DESCRIPTION: Tests the error for matches to values passed in third

 +3       ;              parameter array nodes and addes the IEN to the second

 +4       ;              parameter array. Updates counters accordingly.

 +5       ; RETURN = none

 +6       ; PARAMETERS:

 +7       ;    INEIEN(PBV)= IEN into ^INTHER

 +8       ;    INLIST(PBR) = The NAME of the array to add items found

 +9       ;    INSRCH(PBR) = The array of items to find

 +10      ;    INSRCHCT(PBR) = The count of errors searched

 +11      ;    INFNDCT(PBR) = The count of errors found

 +12      ; CODE BEGINS

 +13       NEW INTEMPX,INTEMPY,INMAXSZ,INMIEN

 +14       SET INMAXSZ=100

           SET INTEMPX=$GET(^INTHER(INEIEN,0))

           SET INSRCHCT=INSRCHCT+1

 +15       SET INMIEN=$PIECE(INTEMPX,U,4)

           SET INTEMPY=$GET(^INTHU(+INMIEN,0))

 +16      ; Checking the Interface Error file

 +17       IF INSRCH("INDEST")]""

               IF $PIECE(INTEMPX,U,9)'=INSRCH("INDEST")&($PIECE(INTEMPY,U,2)'=INSRCH("INDEST"))

                   QUIT

 +18       IF INSRCH("INORIG")]""

               IF $PIECE(INTEMPX,U,2)'=INSRCH("INORIG")&($PIECE(INTEMPY,U,11)'=INSRCH("INORIG"))

                   QUIT

 +19       IF $DATA(INSRCH("INERLOC"))

               IF INSRCH("INERLOC")]""

                   IF $PIECE(INTEMPX,U,5)'=INSRCH("INERLOC")

                       QUIT

 +20       IF $DATA(INSRCH("INERSTAT"))

               IF INSRCH("INERSTAT")]""

                   IF $PIECE(INTEMPX,U,10)'=INSRCH("INERSTAT")

                       QUIT

 +21       IF $DATA(INSRCH("INTEXT"))>9

               IF '$$INERSRCH^INHERR1(.INSRCH,INEIEN,INSRCH("INTYPE"))

                   QUIT

 +22      ; Checking the Interface Message file

 +23       IF $GET(INSRCH("INMSGSTART"))

               IF ($PIECE(INTEMPY,U)<INSRCH("INMSGSTART"))

                   QUIT

 +24       IF $GET(INSRCH("INMSGSTART"))

               IF ($PIECE(INTEMPY,U)>INSRCH("INMSGEND"))

                   QUIT

 +25       IF INSRCH("INID")]""

               IF $PIECE(INTEMPY,U,5)'=INSRCH("INID")

                   QUIT

 +26       IF INSRCH("INDIR")]""

               IF $PIECE(INTEMPY,U,10)'=INSRCH("INDIR")

                   QUIT

 +27       IF INSRCH("INSTAT")]""

               IF $PIECE(INTEMPY,U,3)'=INSRCH("INSTAT")

                   QUIT

 +28       IF INSRCH("INSOURCE")]""

               IF $EXTRACT($PIECE(INTEMPY,U,8),1,$LENGTH(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")

                   QUIT

 +29       IF INSRCH("INPAT")]""

               IF 'INMIEN

                   QUIT

               IF '$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))

                   QUIT

 +30      ; move the found-items array to ^UTILITY if it's getting too large

 +31      ; kill the new ^UTILITY space incase it already exists prior to merg

 +32       IF INFNDCT>INMAXSZ

               IF (INLIST'[U)

                   NEW INTEMPY

                   SET INTEMPY=INLIST

                   SET INLIST="^UTILITY(""INL"","_$JOB_"_"_DUZ_"_"_$PIECE($HOROLOG,",",2)_")"

                   KILL @INLIST

                   MERGE @INLIST=@INTEMPY

                   KILL @INTEMPY,INTEMPY

 +33       SET @INLIST@(INSRCHCT)=$$INMSGSTR^INHERR3(INEIEN,"",$GET(INSRCH("INEXPAND")))

           SET @INLIST@(INSRCHCT,0)=INEIEN

           SET INFNDCT=INFNDCT+1

 +34       IF '$GET(INSRCH("INEXPAND"))

               SET @INLIST@((INSRCHCT+.1))=$$INMSGSTR^INHERR3(INEIEN,"",$GET(INSRCH("INEXPAND")),1)

               IF '$LENGTH(@INLIST@((INSRCHCT+.1)))

                   KILL @INLIST@((INSRCHCT+.1))

 +35      ; show the expanded listing date only if EXPAND and a MESSAGE exists

 +36       IF $GET(INSRCH("INEXPAND"))

               Begin DoDot:1

 +37               SET @INLIST@((INSRCHCT+.1))=$$INMSGSTR^INHERR3(INEIEN,"",$GET(INSRCH("INEXPAND")),2)

                   IF '$LENGTH(@INLIST@((INSRCHCT+.1)))

                       KILL @INLIST@((INSRCHCT+.1))

               End DoDot:1

 +38       IF +INMIEN&($GET(INSRCH("INEXPAND")))

               Begin DoDot:1

 +39               SET @INLIST@((INSRCHCT+.2))=$$INMSGSTR^INHERR3(INEIEN,"",$GET(INSRCH("INEXPAND")),3)

                   IF '$LENGTH(@INLIST@((INSRCHCT+.2)))

                       KILL @INLIST@((INSRCHCT+.2))

               End DoDot:1

 +40       IF $GET(INSRCH("INEXPAND"))

               SET @INLIST@((INSRCHCT+.3))=$$INMSGSTR^INHERR3(INEIEN,"",$GET(INSRCH("INEXPAND")),1)

               IF '$LENGTH(@INLIST@((INSRCHCT+.3)))

                   KILL @INLIST@((INSRCHCT+.3))

 +41       QUIT

 +42      ;

DWLTITLE(INEXPAND) ; Write the title

 +1        WRITE !,"  Date/Time           Error Status     Error Location"

 +2        IF INEXPAND

               WRITE !,"    Transaction Type                          Destination"

 +3        IF INEXPAND

               WRITE !,"    Message Date/Time     Message ID            Message Status"

 +4        WRITE !,"         Error Text"

 +5        QUIT

 +6       ;

POST(INNAME,INTEMPLT,INFILE) ; Disply/Print

 +1       ; MODULE NAME: POST ( Post-action logic on List Processor field )

 +2       ; DESCRIPTION: Display/print using template passed on file passed

 +3       ; RETURN = none

 +4       ; PARAMETERS:

 +5       ;    INNAME(PBV) = A NAME of an Array of IEN's into the file of items

 +6       ;            selected for displaying/printing

 +7       ;    INTEMPLT(PBV) = Print template to use

 +8       ;    INFILE(PBV) = The file to use

 +9       ;

 +10      ; CODE BEGINS

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

 +12       IF $ORDER(@INNAME@(0))

               Begin DoDot:1

 +13               DO CLEAR^DW

 +14               SET %ZIS="N"

                   DO ^%ZIS

                   IF POP

                       QUIT

                   SET INIO=IO

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

 +15               SET I=0

FOR

                       SET I=$ORDER(@INNAME@(I))

                       IF 'I

                           QUIT

                       SET DA(@INNAME@(I))=""

 +16               SET DR=INTEMPLT

                   SET DIC=INFILE

                   SET DHD="@"

                   DO PRTLIST^DWPR

 +17               IF INIO=IO

                       SET X=$$CR^UTSRD

               End DoDot:1

 +18       QUIT

 +19      ;

INHERR2.m