INHSYS11 ;PO/SAIC; 17 Jun 99 15:45; installation utiltiy, error summary
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;;
;
;COPYRIGHT 1999 SAIC
Q
;
FLSUMERR(INFILE,INFLD,INIEN,INDAT,INROOT) ; record file/fields error summaries
;Input:
; INFILE - file or sub-file number
; INFDL - field number
; INIEN - entry ien
; INDAT - data value of the field that calling program was trying to
; insert
; INROOT - root node of the entry
;
Q:'$G(^UTILITY("INHSYS_FILERR",$J)) ;error summary will not be collected, if this node is not set to true
S ^UTILITY("INHSYS_FILERR",$J,+$G(INFILE),INROOT)=""
I INIEN>0 D ; this is a failed field insert
.S ^UTILITY("INHSYS_FILERR",$J,+$G(INFILE),INROOT,"FLD",+$G(INIEN),+$G(INFLD))=INDAT
E D ; this is a failed DIC lookup
.S:INDAT="" INDAT="unknown .01 field"
.S ^UTILITY("INHSYS_FILERR",$J,+$G(INFILE),INROOT,"FILE",INDAT)=""
Q
;
FLRPTERR() ;report file/fields error summary
;Input:
; None
; Output
; returns 1 if any error was found
;
N C,INCNT,INDAT,INERRMSG,INFILE,INFLD,INIEN,INX,INROOT,Y
Q:'$O(^UTILITY("INHSYS_FILERR",$J,0)) 0
D HEADER("FILE/FIELD RESTORE ERROR SUMMARY")
W !,"File number and name"
W !,?3,"Error Type",?23,".01 value or"
W !,?23,"Zero node --> Zero node value"
W !,?7,"Field#",?17,"Value"
D DASHLINE()
;
S INFILE=0
F S INFILE=$O(^UTILITY("INHSYS_FILERR",$J,INFILE)) Q:'INFILE D
.;S INX=$P($G(^DIC(INFILE,0)),U)
.S INX=$O(^DD(+INFILE,0,"NM",""))
.W !,INFILE,"-",INX,!
.S INROOT=""
.F S INROOT=$O(^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT)) Q:INROOT="" D
..S INDAT=""
..I $O(^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT,"FILE",""))'="" W ?3,"Failed DIC Lookup"
..F S INDAT=$O(^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT,"FILE",INDAT)) Q:INDAT="" D
...W ?23,INDAT,!
..;
..S INIEN=""
..;I $O(^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT,"FLD",""))'="" W ?3,"Failed Update:"
..F S INIEN=$O(^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT,"FLD",INIEN)) Q:INIEN="" D
...; get the external value of the field data
...; note: make sure C=$P(^DD(INFILE,.01,0),U,2) is exactly before the
...; call to Y^DIQ, otherwise you get intermittent results
...S Y=$P($G(@(INROOT_INIEN_",0)")),U),C=$P(^DD(INFILE,.01,0),U,2) D Y^DIQ
...W ?3,"Failed Update",?23,(INROOT_INIEN_",0)"),"-->",Y,!
...S INFLD=0
...F S INFLD=$O(^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT,"FLD",INIEN,INFLD)) Q:INFLD="" D
....W ?7,INFLD,?17,^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT,"FLD",INIEN,INFLD),!
W !!," **** End of File/Field Restore Error Summary ****",!
Q 1
;
SUMERR(INERRMSG) ;record the error messages for error summary
;Input:
; INERRMSG - error message text
;
Q:'$G(^UTILITY("INHSYS_FILERR",$J)) ;error summary will not be collected, if this node is not set to true. please notice the INHSYS_FILERR vs INSHSYS_SUMERR subscript.
N INCNT
S INCNT=$G(^UTILITY("INHSYS_SUMERR",$J))+1
S ^UTILITY("INHSYS_SUMERR",$J)=INCNT
S ^UTILITY("INHSYS_SUMERR",$J,INCNT)=INERRMSG
Q
;
RPTERR() ;report the error summary
;Input:
; None
; Output
; returns 1 if any error was found
N INCNT
Q:'$O(^UTILITY("INHSYS_SUMERR",$J,0)) 0
D HEADER("COMPILATION ERROR SUMMARY")
D DASHLINE()
S INCNT=0
F S INCNT=$O(^UTILITY("INHSYS_SUMERR",$J,INCNT)) Q:'INCNT D
.W !,^UTILITY("INHSYS_SUMERR",$J,INCNT)
W !!," **** End of Compilation Error Summary ****",!
Q 1
;
;Input:
; INTITLE - title of the header
;
N INMTF,INTIME
S INMTF=$$GETMTF(),INTIME=$$CDATASC^%ZTFDT($H,1,1)
W !,INMTF,?(80-$L(INTIME)),INTIME
W !,$G(INTITLE)
Q
DASHLINE() ; display a dashline
W !,"--------------------------------------------------------------------------------"
Q
;
SPRTCNTR() ; display a message to contact support center
W !!
W !,?9,"********************************************************"
W !,?9,"* Errors encountered during this installation. It is *"
W !,?9,"* recommended that you contact the Support Center. *"
W !,?9,"********************************************************"
W !!
Q
;
GETMTF() ;Get the name of the primary MTF (only one per CHCS system)
;Input:
; none
;Output:
; returns name of the primary MTF
N Y,X
S Y=$G(^DD("SITE",1)) Q:'Y ""
S X=$P($G(^DIC(4,Y,0)),U)
Q X
;
ALLSUMER(INKILL) ;report summary errors if any. kill the utility global if it is required
;Input:
; INKILL = if true kill the Utility global that contains these errors
;
;if error summary is requested, display it on the user's current device
N X,Y
I $G(^UTILITY("INHSYS_FILERR",$J)) D
.S X=$$FLRPTERR^INHSYS11()
.S Y=$$RPTERR^INHSYS11()
I $G(X)!$G(Y) D SPRTCNTR()
K:$G(INKILL) ^UTILITY("INHSYS_SUMERR",$J),^UTILITY("INHSYS_FILERR",$J)
Q
INHSYS11 ;PO/SAIC; 17 Jun 99 15:45; installation utiltiy, error summary
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;;
+4 ;
+5 ;COPYRIGHT 1999 SAIC
+6 QUIT
+7 ;
FLSUMERR(INFILE,INFLD,INIEN,INDAT,INROOT) ; record file/fields error summaries
+1 ;Input:
+2 ; INFILE - file or sub-file number
+3 ; INFDL - field number
+4 ; INIEN - entry ien
+5 ; INDAT - data value of the field that calling program was trying to
+6 ; insert
+7 ; INROOT - root node of the entry
+8 ;
+9 ;error summary will not be collected, if this node is not set to true
IF '$GET(^UTILITY("INHSYS_FILERR",$JOB))
QUIT
+10 SET ^UTILITY("INHSYS_FILERR",$JOB,+$GET(INFILE),INROOT)=""
+11 ; this is a failed field insert
IF INIEN>0
Begin DoDot:1
+12 SET ^UTILITY("INHSYS_FILERR",$JOB,+$GET(INFILE),INROOT,"FLD",+$GET(INIEN),+$GET(INFLD))=INDAT
End DoDot:1
+13 ; this is a failed DIC lookup
IF '$TEST
Begin DoDot:1
+14 IF INDAT=""
SET INDAT="unknown .01 field"
+15 SET ^UTILITY("INHSYS_FILERR",$JOB,+$GET(INFILE),INROOT,"FILE",INDAT)=""
End DoDot:1
+16 QUIT
+17 ;
FLRPTERR() ;report file/fields error summary
+1 ;Input:
+2 ; None
+3 ; Output
+4 ; returns 1 if any error was found
+5 ;
+6 NEW C,INCNT,INDAT,INERRMSG,INFILE,INFLD,INIEN,INX,INROOT,Y
+7 IF '$ORDER(^UTILITY("INHSYS_FILERR",$JOB,0))
QUIT 0
+8 DO HEADER("FILE/FIELD RESTORE ERROR SUMMARY")
+9 WRITE !,"File number and name"
+10 WRITE !,?3,"Error Type",?23,".01 value or"
+11 WRITE !,?23,"Zero node --> Zero node value"
+12 WRITE !,?7,"Field#",?17,"Value"
+13 DO DASHLINE()
+14 ;
+15 SET INFILE=0
+16 FOR
SET INFILE=$ORDER(^UTILITY("INHSYS_FILERR",$JOB,INFILE))
IF 'INFILE
QUIT
Begin DoDot:1
+17 ;S INX=$P($G(^DIC(INFILE,0)),U)
+18 SET INX=$ORDER(^DD(+INFILE,0,"NM",""))
+19 WRITE !,INFILE,"-",INX,!
+20 SET INROOT=""
+21 FOR
SET INROOT=$ORDER(^UTILITY("INHSYS_FILERR",$JOB,INFILE,INROOT))
IF INROOT=""
QUIT
Begin DoDot:2
+22 SET INDAT=""
+23 IF $ORDER(^UTILITY("INHSYS_FILERR",$JOB,INFILE,INROOT,"FILE",""))'=""
WRITE ?3,"Failed DIC Lookup"
+24 FOR
SET INDAT=$ORDER(^UTILITY("INHSYS_FILERR",$JOB,INFILE,INROOT,"FILE",INDAT))
IF INDAT=""
QUIT
Begin DoDot:3
+25 WRITE ?23,INDAT,!
End DoDot:3
+26 ;
+27 SET INIEN=""
+28 ;I $O(^UTILITY("INHSYS_FILERR",$J,INFILE,INROOT,"FLD",""))'="" W ?3,"Failed Update:"
+29 FOR
SET INIEN=$ORDER(^UTILITY("INHSYS_FILERR",$JOB,INFILE,INROOT,"FLD",INIEN))
IF INIEN=""
QUIT
Begin DoDot:3
+30 ; get the external value of the field data
+31 ; note: make sure C=$P(^DD(INFILE,.01,0),U,2) is exactly before the
+32 ; call to Y^DIQ, otherwise you get intermittent results
+33 SET Y=$PIECE($GET(@(INROOT_INIEN_",0)")),U)
SET C=$PIECE(^DD(INFILE,.01,0),U,2)
DO Y^DIQ
+34 WRITE ?3,"Failed Update",?23,(INROOT_INIEN_",0)"),"-->",Y,!
+35 SET INFLD=0
+36 FOR
SET INFLD=$ORDER(^UTILITY("INHSYS_FILERR",$JOB,INFILE,INROOT,"FLD",INIEN,INFLD))
IF INFLD=""
QUIT
Begin DoDot:4
+37 WRITE ?7,INFLD,?17,^UTILITY("INHSYS_FILERR",$JOB,INFILE,INROOT,"FLD",INIEN,INFLD),!
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+38 WRITE !!," **** End of File/Field Restore Error Summary ****",!
+39 QUIT 1
+40 ;
SUMERR(INERRMSG) ;record the error messages for error summary
+1 ;Input:
+2 ; INERRMSG - error message text
+3 ;
+4 ;error summary will not be collected, if this node is not set to true. please notice the INHSYS_FILERR vs INSHSYS_SUMERR subscript.
IF '$GET(^UTILITY("INHSYS_FILERR",$JOB))
QUIT
+5 NEW INCNT
+6 SET INCNT=$GET(^UTILITY("INHSYS_SUMERR",$JOB))+1
+7 SET ^UTILITY("INHSYS_SUMERR",$JOB)=INCNT
+8 SET ^UTILITY("INHSYS_SUMERR",$JOB,INCNT)=INERRMSG
+9 QUIT
+10 ;
RPTERR() ;report the error summary
+1 ;Input:
+2 ; None
+3 ; Output
+4 ; returns 1 if any error was found
+5 NEW INCNT
+6 IF '$ORDER(^UTILITY("INHSYS_SUMERR",$JOB,0))
QUIT 0
+7 DO HEADER("COMPILATION ERROR SUMMARY")
+8 DO DASHLINE()
+9 SET INCNT=0
+10 FOR
SET INCNT=$ORDER(^UTILITY("INHSYS_SUMERR",$JOB,INCNT))
IF 'INCNT
QUIT
Begin DoDot:1
+11 WRITE !,^UTILITY("INHSYS_SUMERR",$JOB,INCNT)
End DoDot:1
+12 WRITE !!," **** End of Compilation Error Summary ****",!
+13 QUIT 1
+14 ;
+1 ;Input:
+2 ; INTITLE - title of the header
+3 ;
+4 NEW INMTF,INTIME
+5 SET INMTF=$$GETMTF()
SET INTIME=$$CDATASC^%ZTFDT($HOROLOG,1,1)
+6 WRITE !,INMTF,?(80-$LENGTH(INTIME)),INTIME
+7 WRITE !,$GET(INTITLE)
+8 QUIT
DASHLINE() ; display a dashline
+1 WRITE !,"--------------------------------------------------------------------------------"
+2 QUIT
+3 ;
SPRTCNTR() ; display a message to contact support center
+1 WRITE !!
+2 WRITE !,?9,"********************************************************"
+3 WRITE !,?9,"* Errors encountered during this installation. It is *"
+4 WRITE !,?9,"* recommended that you contact the Support Center. *"
+5 WRITE !,?9,"********************************************************"
+6 WRITE !!
+7 QUIT
+8 ;
GETMTF() ;Get the name of the primary MTF (only one per CHCS system)
+1 ;Input:
+2 ; none
+3 ;Output:
+4 ; returns name of the primary MTF
+5 NEW Y,X
+6 SET Y=$GET(^DD("SITE",1))
IF 'Y
QUIT ""
+7 SET X=$PIECE($GET(^DIC(4,Y,0)),U)
+8 QUIT X
+9 ;
ALLSUMER(INKILL) ;report summary errors if any. kill the utility global if it is required
+1 ;Input:
+2 ; INKILL = if true kill the Utility global that contains these errors
+3 ;
+4 ;if error summary is requested, display it on the user's current device
+5 NEW X,Y
+6 IF $GET(^UTILITY("INHSYS_FILERR",$JOB))
Begin DoDot:1
+7 SET X=$$FLRPTERR^INHSYS11()
+8 SET Y=$$RPTERR^INHSYS11()
End DoDot:1
+9 IF $GET(X)!$GET(Y)
DO SPRTCNTR()
+10 IF $GET(INKILL)
KILL ^UTILITY("INHSYS_SUMERR",$JOB),^UTILITY("INHSYS_FILERR",$JOB)
+11 QUIT
