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
Q
;
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))
Q
;
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"
Q
;
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
Q
;
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 ;
