INHES2 ;KN; 9 Sep 96 13:51; Calling routine for the INHES Module.
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; MODULE NAME: INTERFACE ERROR SUMMARY (INHES2)
;
;
INSUM(INSRCH,INAR) ;Summary routine
;
; Description:
; The INSUM is used to search global ^INTHER Interface Error File
; from the start date to the end/date. It will group the error
; messages according to the text length, report the count for each
; group. It also collects details for the first and last occurences
; of each group occurs and of error messages such as: Transaction type,
; Message ID, Error loc, Destination and Background process.
;
; Return: None
;
; Parameters:
; INSRCH = Array of criteria
; INAR = Array of IEN
;
; Code begins:
N INKA
S INRVSRCH=$G(INSRCH("INORDER"))
S INKA="INARDET"
; get the count, first and last occurence IEN
D INSUMP(.INSRCH,.INAR,.INKA)
; INKD is the display array
; INKD is the array that contains the error text and all the details
; for the first and last occurences.
S INKD="INARDIS"
; get all the details message and store in display array INKD
D GETERR(.INKA,.INKD)
W:($P(IOST,"-")["C") @IOF D HSET^INHES,HEADER^INHES
; display summary report
S INX="" F S INX=$O(@INKD@(INX)) Q:INX="" D
. D NP Q:$G(DUOUT) W !,$G(@INKD@(INX)),?7,INX
. F INJ=1:1:2 D
.. Q:'$D(@INKD@(INX,INJ))
.. I INRVSRCH=0 D NP Q:$G(DUOUT) W !?5,$S(INJ=1:"Latest",INJ=2:"Earliest")," occurence: ",$G(@INKD@(INX,INJ)),?45,$E($G(@INKD@(INX,INJ,4)),1,30)
.. I INRVSRCH=1 D NP Q:$G(DUOUT) W !?5,$S(INJ=1:"Earliest",INJ=2:"Latest")," occurence: ",$G(@INKD@(INX,INJ)),?45,$E($G(@INKD@(INX,INJ,4)),1,30)
.. D NP Q:$G(DUOUT) W !?5,$E($G(@INKD@(INX,INJ,1)),1,30),?45,$E($G(@INKD@(INX,INJ,2)),1,30)
.. D NP Q:$G(DUOUT) W !?5,$E($G(@INKD@(INX,INJ,3)),1,30),?45,$E($G(@INKD@(INX,INJ,5)),1,30),!
K @INKA,INKA,@INKD,INKD
; Display the total report
D NP Q:$G(DUOUT) W !!,"TOTAL ERROR : ",$G(INSRCH("FOUND"))," TOTAL SEARCH : ",$G(INSRCH("TOTAL"))
; call function to display the "end of report"
W !!,$J("",30)_"*** End of Report ***"
I ($P(IOST,"-")["C")&('$D(IO("Q")))&(IO=IO(0))&(INPAGE>0) Q:$G(DUOUT) W ! D ^UTSRD("Press <RETURN> to continue or ^ to Quit;;;;;;;0;;;;DTIME;;X","","",1) S:(X=1)!(X=2) DUOUT=1
Q:$G(DUOUT)
Q
;
NP ; New page
I $Y>(IOSL-5) D HEADER^INHES
Q
; The function SEARCH is reused code from the INHERR
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 Summary"")/2,""Interface Error Summary"""
F S INFNDNAM="INMSGS" S INQUIT=$$BGNSRCH^INHERR(.INFNDNAM,1,.INDA,.INPARM2,1) 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
;
GETERR(INKA,INKD) ; get error messages
;
; Description: The GETERR is used to given the IEN for the first and
; last occurance in INKA array, get details for the error
; messages such as: Transaction Type, Destination, Message
; ID, Error location, Background process and store in
; display array INKD parameter.
; Return: None
;
; Parameters:
; INKA = array of IEN for the first and last occuence
; INKD = display array
;
; Code begins:
; loop through INKA array to get all info and convert date
S INT="" F S INT=$O(@INKA@(INT)) Q:INT="" D
.F INJ=1:1:2 D
.. Q:'$D(@INKA@(INT,INJ)) S INIEN=$G(@INKA@(INT,INJ)),@INKD@(INT)=$G(@INKA@(INT))
..; acquire the .01 field for errors and messages
.. S INERRTXT=$G(^INTHER(INIEN,0)),INMSGTXT=$S(+$P(INERRTXT,U,4):$G(^INTHU($P(INERRTXT,U,4),0)),1:"")
..; get the date
.. S Y=$P(^INTHER(INIEN,0),"^") D DD^%DT S @INKD@(INT,INJ)=$G(Y)
..; transaction type
.. S INETTYPE=$S(+$P(INERRTXT,U,2):+$P(INERRTXT,U,2),+$P(INMSGTXT,U,11):+$P(INMSGTXT,U,11),1:"None") S:+INETTYPE @INKD@(INT,INJ,1)=$P($G(^INRHT(INETTYPE,0)),U)
..; error location
.. S INELOC=$S(+$P(INERRTXT,U,5):+$P(INERRTXT,U,5),1:"None") S:+INELOC @INKD@(INT,INJ,2)=$P($G(^INTHERL(INELOC,0)),U)
..; destination
.. S INEDEST=$S(+$P(INERRTXT,U,9):+$P(INERRTXT,U,9),+$P(INMSGTXT,U,2):+$P(INMSGTXT,U,2),1:"None") S:+INEDEST @INKD@(INT,INJ,3)=$P($G(^INRHD(INEDEST,0)),U)
.. S @INKD@(INT,INJ,4)=$S($L($P(INMSGTXT,U,5)):$P(INMSGTXT,U,5),1:"None")
..; background process
.. S INBGDPR=$S(+$P(INERRTXT,U,11):+$P(INERRTXT,U,11),1:"None") S:+INBGDPR @INKD@(INT,INJ,5)=$P($G(^INTHPC(INBGDPR,0)),U)
..; Merge to file if array too large
.. I $S<20000 N INTMPY S INTMPY=INKD,INKD="^UTILITY($J,""INAD"")" K @INKD M @INKD=@INTMPY K @INTMPY,INTMPY
Q
;
INSUMP(INSRCH,INAR,INKA) ;Summary routine
;
; Description: The INSUM is used to search global ^INTHER Interface
; Error File. Get the count for each group of the
; error messages according to select text length. It
; also calculate the count, save the IEN for the first
; and the last occurence for each group of the messages.
;
; Return: None
;
; Parameters:
; INSRCH = Array of the criteria
; INAR = Array of IEN
; INKA = Array of count, ien for the first and last occurence
;
; Code begins:
N INT,INTIM,INENODE
S INEXLN=$G(INSRCH("TEXTLEN"))
; INKA is an array that contains the error count for each group
; and also the first and last occurences IEN.
; Maximum text lenght is 120 due to system restriction for MERGE
I $G(INEXLN)>120 S INEXLN=120
;INX is ien from inar array
S INT=0
F S INT=$O(@INAR@(INT)) Q:'INT D
.; Loop through multiple node and concat the error message text
. S INENODE=0,OK=1,INX=$G(@INAR@(INT)),INTXT=""
. F S INENODE=$O(^INTHER(INX,2,INENODE)) Q:'INENODE!'OK D
.. S INLV=$G(^INTHER(INX,2,INENODE,0))
.. S:$L(INTXT)+$L(INLV)>120 OK=0 Q:'OK
.. S INTXT=$G(INTXT)_INLV
. S INTXT=$$UPCASE^%ZTF($E(INTXT,1,$G(INEXLN)))
. I INTXT="" S INTXT="No Error Text"
.; store in display array INKA, if memory is full, merge to ^UTILITY
. I $S<20000 N INTMPY S INTMPY=INKA,INKA="^UTILITY($J,""INAC"")" K @INKA M @INKA=@INTMPY K @INTMPY,INTMPY
. S @INKA@(INTXT)=$G(@INKA@(INTXT))+1
.; save the ien of first and last occurance
. I '$D(@INKA@(INTXT,1)) S @INKA@(INTXT,1)=INX
. E S @INKA@(INTXT,2)=INX
Q
INHES2 ;KN; 9 Sep 96 13:51; Calling routine for the INHES Module.
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; MODULE NAME: INTERFACE ERROR SUMMARY (INHES2)
+5 ;
+6 ;
INSUM(INSRCH,INAR) ;Summary routine
+1 ;
+2 ; Description:
+3 ; The INSUM is used to search global ^INTHER Interface Error File
+4 ; from the start date to the end/date. It will group the error
+5 ; messages according to the text length, report the count for each
+6 ; group. It also collects details for the first and last occurences
+7 ; of each group occurs and of error messages such as: Transaction type,
+8 ; Message ID, Error loc, Destination and Background process.
+9 ;
+10 ; Return: None
+11 ;
+12 ; Parameters:
+13 ; INSRCH = Array of criteria
+14 ; INAR = Array of IEN
+15 ;
+16 ; Code begins:
+17 NEW INKA
+18 SET INRVSRCH=$GET(INSRCH("INORDER"))
+19 SET INKA="INARDET"
+20 ; get the count, first and last occurence IEN
+21 DO INSUMP(.INSRCH,.INAR,.INKA)
+22 ; INKD is the display array
+23 ; INKD is the array that contains the error text and all the details
+24 ; for the first and last occurences.
+25 SET INKD="INARDIS"
+26 ; get all the details message and store in display array INKD
+27 DO GETERR(.INKA,.INKD)
+28 IF ($PIECE(IOST,"-")["C")
WRITE @IOF
DO HSET^INHES
DO HEADER^INHES
+29 ; display summary report
+30 SET INX=""
FOR
SET INX=$ORDER(@INKD@(INX))
IF INX=""
QUIT
Begin DoDot:1
+31 DO NP
IF $GET(DUOUT)
QUIT
WRITE !,$GET(@INKD@(INX)),?7,INX
+32 FOR INJ=1:1:2
Begin DoDot:2
+33 IF '$DATA(@INKD@(INX,INJ))
QUIT
+34 IF INRVSRCH=0
DO NP
IF $GET(DUOUT)
QUIT
WRITE !?5,$SELECT(INJ=1:"Latest",INJ=2:"Earliest")," occurence: ",$GET(@INKD@(INX,INJ)),?45,$EXTRACT($GET(@INKD@(INX,INJ,4)),1,30)
+35 IF INRVSRCH=1
DO NP
IF $GET(DUOUT)
QUIT
WRITE !?5,$SELECT(INJ=1:"Earliest",INJ=2:"Latest")," occurence: ",$GET(@INKD@(INX,INJ)),?45,$EXTRACT($GET(@INKD@(INX,INJ,4)),1,30)
+36 DO NP
IF $GET(DUOUT)
QUIT
WRITE !?5,$EXTRACT($GET(@INKD@(INX,INJ,1)),1,30),?45,$EXTRACT($GET(@INKD@(INX,INJ,2)),1,30)
+37 DO NP
IF $GET(DUOUT)
QUIT
WRITE !?5,$EXTRACT($GET(@INKD@(INX,INJ,3)),1,30),?45,$EXTRACT($GET(@INKD@(INX,INJ,5)),1,30),!
End DoDot:2
End DoDot:1
+38 KILL @INKA,INKA,@INKD,INKD
+39 ; Display the total report
+40 DO NP
IF $GET(DUOUT)
QUIT
WRITE !!,"TOTAL ERROR : ",$GET(INSRCH("FOUND"))," TOTAL SEARCH : ",$GET(INSRCH("TOTAL"))
+41 ; call function to display the "end of report"
+42 WRITE !!,$JUSTIFY("",30)_"*** End of Report ***"
+43 IF ($PIECE(IOST,"-")["C")&('$DATA(IO("Q")))&(IO=IO(0))&(INPAGE>0)
IF $GET(DUOUT)
QUIT
WRITE !
DO ^UTSRD("Press <RETURN> to continue or ^ to Quit;;;;;;;0;;;;DTIME;;X","","",1)
IF (X=1)!(X=2)
SET DUOUT=1
+44 IF $GET(DUOUT)
QUIT
+45 QUIT
+46 ;
NP ; New page
+1 IF $Y>(IOSL-5)
DO HEADER^INHES
+2 QUIT
+3 ; The function SEARCH is reused code from the INHERR
SEARCH ; Search/List/Output INTHER errors that match a search criteria
+1 ; Module Name: SEARCH ( Interface Error Search Routine )
+2 ;
+3 ; Description: Prompts the user for search criteria to be used
+4 ; to find matches in the Interface Error File
+5 ; file (^INTHER). The user is presented with a list
+6 ; of matching items which can be selectively expanded
+7 ; or printed(user chosen device). The user is then
+8 ; brought back to the Search Criteria menu and can
+9 ; continue with another search or exit with the F10 key.
+10 ; Return: none
+11 ; Parameters: none
+12 ;
+13 ; Code begins
+14 NEW INDA,INQUIT,INFNDNAM,INSELECT,INPARM2
+15 SET INFNDNAM="INMSGS"
NEW @INFNDNAM
+16 ; Create the list processor help text
+17 SET INPARM2("HELP")="N INHELP D BLDHELP^INHERR3(.INHELP),SRCHHELP^INHERR3(.INHELP)"
+18 ; Create the list processor TITLE text
+19 SET INPARM2("TITLE")="W ?IOM-$L(""Interface Error Summary"")/2,""Interface Error Summary"""
+20 FOR
SET INFNDNAM="INMSGS"
SET INQUIT=$$BGNSRCH^INHERR(.INFNDNAM,1,.INDA,.INPARM2,1)
IF $SELECT(INQUIT=0
QUIT
IF $ORDER(@INFNDNAM@(0))
DO POST^INHERR2(INFNDNAM,"INH ERROR DISPLAY",4003)
KILL @INFNDNAM
+21 IF +INDA
DO INKINDA^INHMS(INDA)
+22 QUIT
+23 ;
GETERR(INKA,INKD) ; get error messages
+1 ;
+2 ; Description: The GETERR is used to given the IEN for the first and
+3 ; last occurance in INKA array, get details for the error
+4 ; messages such as: Transaction Type, Destination, Message
+5 ; ID, Error location, Background process and store in
+6 ; display array INKD parameter.
+7 ; Return: None
+8 ;
+9 ; Parameters:
+10 ; INKA = array of IEN for the first and last occuence
+11 ; INKD = display array
+12 ;
+13 ; Code begins:
+14 ; loop through INKA array to get all info and convert date
+15 SET INT=""
FOR
SET INT=$ORDER(@INKA@(INT))
IF INT=""
QUIT
Begin DoDot:1
+16 FOR INJ=1:1:2
Begin DoDot:2
+17 IF '$DATA(@INKA@(INT,INJ))
QUIT
SET INIEN=$GET(@INKA@(INT,INJ))
SET @INKD@(INT)=$GET(@INKA@(INT))
+18 ; acquire the .01 field for errors and messages
+19 SET INERRTXT=$GET(^INTHER(INIEN,0))
SET INMSGTXT=$SELECT(+$PIECE(INERRTXT,U,4):$GET(^INTHU($PIECE(INERRTXT,U,4),0)),1:"")
+20 ; get the date
+21 SET Y=$PIECE(^INTHER(INIEN,0),"^")
DO DD^%DT
SET @INKD@(INT,INJ)=$GET(Y)
+22 ; transaction type
+23 SET INETTYPE=$SELECT(+$PIECE(INERRTXT,U,2):+$PIECE(INERRTXT,U,2),+$PIECE(INMSGTXT,U,11):+$PIECE(INMSGTXT,U,11),1:"None")
IF +INETTYPE
SET @INKD@(INT,INJ,1)=$PIECE($GET(^INRHT(INETTYPE,0)),U)
+24 ; error location
+25 SET INELOC=$SELECT(+$PIECE(INERRTXT,U,5):+$PIECE(INERRTXT,U,5),1:"None")
IF +INELOC
SET @INKD@(INT,INJ,2)=$PIECE($GET(^INTHERL(INELOC,0)),U)
+26 ; destination
+27 SET INEDEST=$SELECT(+$PIECE(INERRTXT,U,9):+$PIECE(INERRTXT,U,9),+$PIECE(INMSGTXT,U,2):+$PIECE(INMSGTXT,U,2),1:"None")
IF +INEDEST
SET @INKD@(INT,INJ,3)=$PIECE($GET(^INRHD(INEDEST,0)),U)
+28 SET @INKD@(INT,INJ,4)=$SELECT($LENGTH($PIECE(INMSGTXT,U,5)):$PIECE(INMSGTXT,U,5),1:"None")
+29 ; background process
+30 SET INBGDPR=$SELECT(+$PIECE(INERRTXT,U,11):+$PIECE(INERRTXT,U,11),1:"None")
IF +INBGDPR
SET @INKD@(INT,INJ,5)=$PIECE($GET(^INTHPC(INBGDPR,0)),U)
+31 ; Merge to file if array too large
+32 IF $STORAGE<20000
NEW INTMPY
SET INTMPY=INKD
SET INKD="^UTILITY($J,""INAD"")"
KILL @INKD
MERGE @INKD=@INTMPY
KILL @INTMPY,INTMPY
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
INSUMP(INSRCH,INAR,INKA) ;Summary routine
+1 ;
+2 ; Description: The INSUM is used to search global ^INTHER Interface
+3 ; Error File. Get the count for each group of the
+4 ; error messages according to select text length. It
+5 ; also calculate the count, save the IEN for the first
+6 ; and the last occurence for each group of the messages.
+7 ;
+8 ; Return: None
+9 ;
+10 ; Parameters:
+11 ; INSRCH = Array of the criteria
+12 ; INAR = Array of IEN
+13 ; INKA = Array of count, ien for the first and last occurence
+14 ;
+15 ; Code begins:
+16 NEW INT,INTIM,INENODE
+17 SET INEXLN=$GET(INSRCH("TEXTLEN"))
+18 ; INKA is an array that contains the error count for each group
+19 ; and also the first and last occurences IEN.
+20 ; Maximum text lenght is 120 due to system restriction for MERGE
+21 IF $GET(INEXLN)>120
SET INEXLN=120
+22 ;INX is ien from inar array
+23 SET INT=0
+24 FOR
SET INT=$ORDER(@INAR@(INT))
IF 'INT
QUIT
Begin DoDot:1
+25 ; Loop through multiple node and concat the error message text
+26 SET INENODE=0
SET OK=1
SET INX=$GET(@INAR@(INT))
SET INTXT=""
+27 FOR
SET INENODE=$ORDER(^INTHER(INX,2,INENODE))
IF 'INENODE!'OK
QUIT
Begin DoDot:2
+28 SET INLV=$GET(^INTHER(INX,2,INENODE,0))
+29 IF $LENGTH(INTXT)+$LENGTH(INLV)>120
SET OK=0
IF 'OK
QUIT
+30 SET INTXT=$GET(INTXT)_INLV
End DoDot:2
+31 SET INTXT=$$UPCASE^%ZTF($EXTRACT(INTXT,1,$GET(INEXLN)))
+32 IF INTXT=""
SET INTXT="No Error Text"
+33 ; store in display array INKA, if memory is full, merge to ^UTILITY
+34 IF $STORAGE<20000
NEW INTMPY
SET INTMPY=INKA
SET INKA="^UTILITY($J,""INAC"")"
KILL @INKA
MERGE @INKA=@INTMPY
KILL @INTMPY,INTMPY
+35 SET @INKA@(INTXT)=$GET(@INKA@(INTXT))+1
+36 ; save the ien of first and last occurance
+37 IF '$DATA(@INKA@(INTXT,1))
SET @INKA@(INTXT,1)=INX
+38 IF '$TEST
SET @INKA@(INTXT,2)=INX
End DoDot:1
+39 QUIT
