INHVEXP ;BAR ; 24 Nov 95 15:02; PRINT EXCEPTIONS BETWEEN INH MAP AND LOCAL DATA
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
EN ;Main entry point
;NEW statements
N %ZIS,A,INEXIT,INHDR,INPAGE,X,ZTDESC,ZTIO,ZTRTN,ZTSAVE,INSYS,INOSYS,K,INFUNC,INFUNCN,INRECID,INDA,INDIC,INGL,INDE,X,N,F
S U="^" K ^UTILITY($J)
ENUSE ;User input
;Setup FileMan
D ENV^UTIL
;System Check and verify by user
; INSYS = current system
; INOSYS = other system
S INSYS=$$SYS^INHUTIL1()
I '$L(INSYS) W *7,!!,"Sorry, I don't know what kind of system we're on.",! G QUIT
W !!," I think this is a ",$$SYSNAME^INHUTIL1(INSYS)," system"
;Standard reader
S Y=$$YN^UTSRD("Do you want to continue? ;1","") G:'+Y QUIT
S INOSYS=$S(INSYS="SC":"VA",1:"SC")
;
;Device handling & Tasking logic
K IOP S %ZIS("A")="QUEUE ON DEVICE: ",%ZIS("B")="",%ZIS="NQ",%ZIS("RM")="S^132" D ^%ZIS G:POP QUIT
S IOM=132,IOP=ION_";"_IOST_";"_IOM_";"_IOSL
I IO=IO(0) S %ZIS="" D ^%ZIS I POP W *7,!,"Sorry, unable to find device..." G QUIT
I IO'=IO(0) S ZTDESC="Map File Exception Report",ZTIO=IOP,ZTRTN="ENQUE^INHVEXP" D G QUIT
.F X="IN*","IO*" S ZTSAVE(X)=""
.D ^%ZTLOAD
;
ENQUE ;Taskman entry point
;
;*********************************************************
;Main loop thru 4090.1 x-ref
N ND S ND="^INVD(4090.1,INSYS)"
F S ND=$Q(ND) Q:$QS(ND,2)'=INSYS D
.S INFUNC=$QS(ND,3),INRECID=$QS(ND,4),INDA=$QS(ND,5),BRCT=0
.D FUNC
.Q:INRECID=""
.S INEX=0 D RECID
.Q:INDA=""
.D DA
.K:INEX'>1 ^UTILITY($J,"EX",INFUNC,INRECID)
.D:$L(INGL) LF
;initialize print variables
S INPAGE=0,INEXIT=0,IOM=132
D HSET,HEADER
;
;Loop thru ^UTILITY file and print
S ND="^UTILITY($J,""MF"")",L=1
F S ND=$Q(@ND) Q:$QS(ND,2)'="MS" D
.S N=5,X=^(INFUNC),INFUNC=$QS(ND,3),INRECID=$QS(ND,4),INDA=$QS(ND,5),A=$QS(ND,6)
.D WRITE
.S N=10,X=$G(^(INRECID)) D:$L(X) WRITE
.I INDA'="" S N=1,X=INDA_" "_INRECID_" "_$P($G(^INVD(4090.1,INDA,0)),"^",1) D WRITE
.S L=0,N=$S($X<30:30,1:$X+2)
.I A'="" S X=^UTILITY($J,"MF",INFUNC,INRECID,INDA,A) D:$L(X) WRITE
.;Write out NON EXCLUDE conflicts
.D:$D(^UTILITY($J,"EX",INFUNC)) WRITEE
.;Call to output data pointer exceptions
.D:$D(^UTILITY($J,"LF",INFUNC)) WRITEL
I ($P(IOST,"-")["C")&('$D(IO("Q")))&(IO=IO(0)) R !,"Press <RETURN> to continue ",A:DTIME
E W !!,"*** End Of Report ***",!,IOF
G QUIT
;
;*********************************************************
FUNC ;Verify map function exists and log error if not
S INFUNCN=$P($G(^INVD(4090.2,INFUNC,0)),"^",1),INDIC=$G(^INVD(4090.2,INFUNC,INSYS)),INGL=""
I '$L(INFUNCN) S ^UTILITY($J,"MF",INFUNC)="Map function "_INFUNC_" not defined and contains the following entries:" Q
S ^UTILITY($J,"MF",INFUNC)="Map function "_INFUNC_" - "_INFUNCN_$S(+INDIC:" (file)",1:" (non-file)")
Q:'+INDIC
S INGL=$G(^DIC(INDIC,0,"GL"))
I '$L(INGL) S ^UTILITY($J,"MF",INFUNC,0)="File #"_INDIC_" does not have a ""GL"" reference in ^DIC"
Q
;
RECID ;Processing at INRECID loop
;Quit if not a file reference
S INDE="" Q:'+INDIC
;returns data element of function type - INDE
;set quotes around INRECID in case it's not a number
S T=$C(34)_INRECID_$C(34) S INDE=$G(@(INGL_T_",0)"))
Q
;
DA ;DA MODULE - STARTS HERE
;Init INDAVD - DA VALIDATION FLAG
;Verify ien exists in 4090.1 and log error if not
I '($D(^INVD(4090.1,INDA,0))#2) S ^UTILITY($J,"MF",INFUNC,INRECID,INDA,0)="Record does not exist in file 4090.1" Q
;
;Record valid records if INFUNC is invalid
I '$L(INFUNCN) S ^UTILITY($J,"MF",INFUNC,INRECID,INDA,0)="Exists under undefined map function "_INFUNC
;
;Verify map function number matches x-ref map function
S X=$P(^INVD(4090.1,INDA,0),"^",2) I X'=INFUNC D
.S N=$P($G(^INVD(4090.2,X,0)),"^",1)
.S ^UTILITY($J,"MF",INFUNC,INRECID,INDA,1)="Map function no. "_X_"-"_N_" does not match x-ref map no. "_INFUNC_"-"_INFUNCN
;
;Validate INRECID
I +INDIC,'$L(INDE) S INDE=$G(@(INGL_(+INRECID)_",0)")) I $L(INDE) S ^UTILITY($J,"MF",INFUNC,INRECID,INDA,2)=INSYS_" Record ID """_INRECID_""" is not fully numeric but info was found under """_(+INRECID)_""""
;
;Verify record id number matches record id (INRECID)
S X=$G(^INVD(4090.1,INDA,$S(INSYS="SC":1,1:10))) I X'=INRECID S ^UTILITY($J,"MF",INFUNC,INRECID,INDA,3)="Data element record id "_X_" does not match with x-ref id "_INRECID
;
;Verify data name matches data element name
I +INDIC S X=$G(^INVD(4090.1,INDA,$S(INSYS="SC":2,1:11))),Y=$P(INDE,"^",1) I X'=Y,$D(^DD(INDIC,.01,0))#2 S C=$P(^DD(INDIC,.01,0),U,2) D Y^DIQ
I +INDIC,X'=Y S ^UTILITY($J,"MF",INFUNC,INRECID,INDA,4)="Data element name "_X_" does not match with file entry "_Y
;
;Setup exclude array - INEX is non-exclude counter
S ^UTILITY($J,"EX",INFUNC,INRECID,INDA)=+$G(^INVD(4090.1,INDA,$S(INSYS="SC":3,1:12)))
I '+^(INDA) S INEX=INEX+1,^UTILITY($J,"LFX",INFUNC,INRECID)=""
Q
;
;*********************************************************
LF ;Check each data element points to a valid NOT EXCLUDE reference
S X=0 F S X=$O(@(INGL_X_")")) Q:'+X I '$D(^UTILITY($J,"LFX",INFUNC,X)) S ^UTILITY($J,"LF",INFUNC,X)="Data element "_X_" - "_$P($G(@(INGL_X_",0)")),"^",1)_" does not have data pointing to it"
Q
;*********************************************************
;
N A
I ($P(IOST,"-")["C")&('$D(IO("Q")))&(IO=IO(0))&(INPAGE>0) R !,"Press <RETURN> to continue ",A:DTIME I A[U S INEXIT=1 Q
S INPAGE=INPAGE+1 W @IOF
S A=0 F S A=$O(INHDR(A)) Q:'A U IO W !,@INHDR(A)
Q
;
WRITE ;output a line
I ($Y>(IOSL-3))&(INPAGE>0)&(L) D HEADER
Q:INEXIT
I L W !,?N,X Q
K F D FORMAT^UTIL(X,(132-N),"F") W ?N,F(1) F F=2:1 Q:'$D(F(F)) W !?N,F(F)
S L=1 Q
;
WRITEE ;output exclude problems
S N=5,L=1,X="These multiple NOT EXCLUDE's exist:" D WRITE
;
S N=3,INRECID="" F S INRECID=$O(^UTILITY($J,"EX",INFUNC,INRECID)) Q:INRECID="" D
.S INDA="" F S INDA=$O(^UTILITY($J,"EX",INFUNC,INRECID,INDA)) Q:INDA="" I '^(INDA) S X="Local file "_INDA_" of "_INSYS_" record id "_INRECID_" is not excluded" D WRITE
Q
;
WRITEL ;Output data exceptions
S N=5,L=1,X="These records do not have data pointing to them:" D WRITE
S N=3,INRECID="" F S INRECID=$O(^UTILITY($J,"LF",INFUNC,INRECID)) Q:INRECID="" S X=^(INRECID) D WRITE
Q
;
HSET ;set up header
S Y=DT D DD^%DT
S INHDR(1)="""Interface Exception Report for "_$$SYSNAME^INHUTIL1(INSYS)_" System"",?(IOM-22),"""_Y_" PAGE: "",INPAGE"
S INHDR(2)=""" File # / Record ID / Name Exception Description"""
S INHDR(4)="",$P(INHDR(4),"-",IOM-1)="",INHDR(4)=""""_INHDR(4)_""",!"
Q
;
QUIT ;exit module
D ^%ZISC
S IOP="",%ZIS="" D ^%ZIS U IO K IO("Q"),IOP,POP
K ^UTILITY($J) ;CLEAN UP UTIL GLOB
Q
;
INHVEXP ;BAR ; 24 Nov 95 15:02; PRINT EXCEPTIONS BETWEEN INH MAP AND LOCAL DATA
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
EN ;Main entry point
+1 ;NEW statements
+2 NEW %ZIS,A,INEXIT,INHDR,INPAGE,X,ZTDESC,ZTIO,ZTRTN,ZTSAVE,INSYS,INOSYS,K,INFUNC,INFUNCN,INRECID,INDA,INDIC,INGL,INDE,X,N,F
+3 SET U="^"
KILL ^UTILITY($JOB)
ENUSE ;User input
+1 ;Setup FileMan
+2 DO ENV^UTIL
+3 ;System Check and verify by user
+4 ; INSYS = current system
+5 ; INOSYS = other system
+6 SET INSYS=$$SYS^INHUTIL1()
+7 IF '$LENGTH(INSYS)
WRITE *7,!!,"Sorry, I don't know what kind of system we're on.",!
GOTO QUIT
+8 WRITE !!," I think this is a ",$$SYSNAME^INHUTIL1(INSYS)," system"
+9 ;Standard reader
+10 SET Y=$$YN^UTSRD("Do you want to continue? ;1","")
IF '+Y
GOTO QUIT
+11 SET INOSYS=$SELECT(INSYS="SC":"VA",1:"SC")
+12 ;
+13 ;Device handling & Tasking logic
+14 KILL IOP
SET %ZIS("A")="QUEUE ON DEVICE: "
SET %ZIS("B")=""
SET %ZIS="NQ"
SET %ZIS("RM")="S^132"
DO ^%ZIS
IF POP
GOTO QUIT
+15 SET IOM=132
SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
+16 IF IO=IO(0)
SET %ZIS=""
DO ^%ZIS
IF POP
WRITE *7,!,"Sorry, unable to find device..."
GOTO QUIT
+17 IF IO'=IO(0)
SET ZTDESC="Map File Exception Report"
SET ZTIO=IOP
SET ZTRTN="ENQUE^INHVEXP"
Begin DoDot:1
+18 FOR X="IN*","IO*"
SET ZTSAVE(X)=""
+19 DO ^%ZTLOAD
End DoDot:1
GOTO QUIT
+20 ;
ENQUE ;Taskman entry point
+1 ;
+2 ;*********************************************************
+3 ;Main loop thru 4090.1 x-ref
+4 NEW ND
SET ND="^INVD(4090.1,INSYS)"
+5 FOR
SET ND=$QUERY(ND)
IF $QSUBSCRIPT(ND,2)'=INSYS
QUIT
Begin DoDot:1
+6 SET INFUNC=$QSUBSCRIPT(ND,3)
SET INRECID=$QSUBSCRIPT(ND,4)
SET INDA=$QSUBSCRIPT(ND,5)
SET BRCT=0
+7 DO FUNC
+8 IF INRECID=""
QUIT
+9 SET INEX=0
DO RECID
+10 IF INDA=""
QUIT
+11 DO DA
+12 IF INEX'>1
KILL ^UTILITY($JOB,"EX",INFUNC,INRECID)
+13 IF $LENGTH(INGL)
DO LF
End DoDot:1
+14 ;initialize print variables
+15 SET INPAGE=0
SET INEXIT=0
SET IOM=132
+16 DO HSET
DO HEADER
+17 ;
+18 ;Loop thru ^UTILITY file and print
+19 SET ND="^UTILITY($J,""MF"")"
SET L=1
+20 FOR
SET ND=$QUERY(@ND)
IF $QSUBSCRIPT(ND,2)'="MS"
QUIT
Begin DoDot:1
+21 SET N=5
SET X=^(INFUNC)
SET INFUNC=$QSUBSCRIPT(ND,3)
SET INRECID=$QSUBSCRIPT(ND,4)
SET INDA=$QSUBSCRIPT(ND,5)
SET A=$QSUBSCRIPT(ND,6)
+22 DO WRITE
+23 SET N=10
SET X=$GET(^(INRECID))
IF $LENGTH(X)
DO WRITE
+24 IF INDA'=""
SET N=1
SET X=INDA_" "_INRECID_" "_$PIECE($GET(^INVD(4090.1,INDA,0)),"^",1)
DO WRITE
+25 SET L=0
SET N=$SELECT($X<30:30,1:$X+2)
+26 IF A'=""
SET X=^UTILITY($JOB,"MF",INFUNC,INRECID,INDA,A)
IF $LENGTH(X)
DO WRITE
+27 ;Write out NON EXCLUDE conflicts
+28 IF $DATA(^UTILITY($JOB,"EX",INFUNC))
DO WRITEE
+29 ;Call to output data pointer exceptions
+30 IF $DATA(^UTILITY($JOB,"LF",INFUNC))
DO WRITEL
End DoDot:1
+31 IF ($PIECE(IOST,"-")["C")&('$DATA(IO("Q")))&(IO=IO(0))
READ !,"Press <RETURN> to continue ",A:DTIME
+32 IF '$TEST
WRITE !!,"*** End Of Report ***",!,IOF
+33 GOTO QUIT
+34 ;
+35 ;*********************************************************
FUNC ;Verify map function exists and log error if not
+1 SET INFUNCN=$PIECE($GET(^INVD(4090.2,INFUNC,0)),"^",1)
SET INDIC=$GET(^INVD(4090.2,INFUNC,INSYS))
SET INGL=""
+2 IF '$LENGTH(INFUNCN)
SET ^UTILITY($JOB,"MF",INFUNC)="Map function "_INFUNC_" not defined and contains the following entries:"
QUIT
+3 SET ^UTILITY($JOB,"MF",INFUNC)="Map function "_INFUNC_" - "_INFUNCN_$SELECT(+INDIC:" (file)",1:" (non-file)")
+4 IF '+INDIC
QUIT
+5 SET INGL=$GET(^DIC(INDIC,0,"GL"))
+6 IF '$LENGTH(INGL)
SET ^UTILITY($JOB,"MF",INFUNC,0)="File #"_INDIC_" does not have a ""GL"" reference in ^DIC"
+7 QUIT
+8 ;
RECID ;Processing at INRECID loop
+1 ;Quit if not a file reference
+2 SET INDE=""
IF '+INDIC
QUIT
+3 ;returns data element of function type - INDE
+4 ;set quotes around INRECID in case it's not a number
+5 SET T=$CHAR(34)_INRECID_$CHAR(34)
SET INDE=$GET(@(INGL_T_",0)"))
+6 QUIT
+7 ;
DA ;DA MODULE - STARTS HERE
+1 ;Init INDAVD - DA VALIDATION FLAG
+2 ;Verify ien exists in 4090.1 and log error if not
+3 IF '($DATA(^INVD(4090.1,INDA,0))#2)
SET ^UTILITY($JOB,"MF",INFUNC,INRECID,INDA,0)="Record does not exist in file 4090.1"
QUIT
+4 ;
+5 ;Record valid records if INFUNC is invalid
+6 IF '$LENGTH(INFUNCN)
SET ^UTILITY($JOB,"MF",INFUNC,INRECID,INDA,0)="Exists under undefined map function "_INFUNC
+7 ;
+8 ;Verify map function number matches x-ref map function
+9 SET X=$PIECE(^INVD(4090.1,INDA,0),"^",2)
IF X'=INFUNC
Begin DoDot:1
+10 SET N=$PIECE($GET(^INVD(4090.2,X,0)),"^",1)
+11 SET ^UTILITY($JOB,"MF",INFUNC,INRECID,INDA,1)="Map function no. "_X_"-"_N_" does not match x-ref map no. "_INFUNC_"-"_INFUNCN
End DoDot:1
+12 ;
+13 ;Validate INRECID
+14 IF +INDIC
IF '$LENGTH(INDE)
SET INDE=$GET(@(INGL_(+INRECID)_",0)"))
IF $LENGTH(INDE)
SET ^UTILITY($JOB,"MF",INFUNC,INRECID,INDA,2)=INSYS_" Record ID """_INRECID_""" is not fully numeric but info was found under """_(+INRECID)_""""
+15 ;
+16 ;Verify record id number matches record id (INRECID)
+17 SET X=$GET(^INVD(4090.1,INDA,$SELECT(INSYS="SC":1,1:10)))
IF X'=INRECID
SET ^UTILITY($JOB,"MF",INFUNC,INRECID,INDA,3)="Data element record id "_X_" does not match with x-ref id "_INRECID
+18 ;
+19 ;Verify data name matches data element name
+20 IF +INDIC
SET X=$GET(^INVD(4090.1,INDA,$SELECT(INSYS="SC":2,1:11)))
SET Y=$PIECE(INDE,"^",1)
IF X'=Y
IF $DATA(^DD(INDIC,.01,0))#2
SET C=$PIECE(^DD(INDIC,.01,0),U,2)
DO Y^DIQ
+21 IF +INDIC
IF X'=Y
SET ^UTILITY($JOB,"MF",INFUNC,INRECID,INDA,4)="Data element name "_X_" does not match with file entry "_Y
+22 ;
+23 ;Setup exclude array - INEX is non-exclude counter
+24 SET ^UTILITY($JOB,"EX",INFUNC,INRECID,INDA)=+$GET(^INVD(4090.1,INDA,$SELECT(INSYS="SC":3,1:12)))
+25 IF '+^(INDA)
SET INEX=INEX+1
SET ^UTILITY($JOB,"LFX",INFUNC,INRECID)=""
+26 QUIT
+27 ;
+28 ;*********************************************************
LF ;Check each data element points to a valid NOT EXCLUDE reference
+1 SET X=0
FOR
SET X=$ORDER(@(INGL_X_")"))
IF '+X
QUIT
IF '$DATA(^UTILITY($JOB,"LFX",INFUNC,X))
SET ^UTILITY($JOB,"LF",INFUNC,X)="Data element "_X_" - "_$PIECE($GET(@(INGL_X_",0)")),"^",1)_" does not have data pointing to it"
+2 QUIT
+3 ;*********************************************************
+4 ;
+1 NEW A
+2 IF ($PIECE(IOST,"-")["C")&('$DATA(IO("Q")))&(IO=IO(0))&(INPAGE>0)
READ !,"Press <RETURN> to continue ",A:DTIME
IF A[U
SET INEXIT=1
QUIT
+3 SET INPAGE=INPAGE+1
WRITE @IOF
+4 SET A=0
FOR
SET A=$ORDER(INHDR(A))
IF 'A
QUIT
USE IO
WRITE !,@INHDR(A)
+5 QUIT
+6 ;
WRITE ;output a line
+1 IF ($Y>(IOSL-3))&(INPAGE>0)&(L)
DO HEADER
+2 IF INEXIT
QUIT
+3 IF L
WRITE !,?N,X
QUIT
+4 KILL F
DO FORMAT^UTIL(X,(132-N),"F")
WRITE ?N,F(1)
FOR F=2:1
IF '$DATA(F(F))
QUIT
WRITE !?N,F(F)
+5 SET L=1
QUIT
+6 ;
WRITEE ;output exclude problems
+1 SET N=5
SET L=1
SET X="These multiple NOT EXCLUDE's exist:"
DO WRITE
+2 ;
+3 SET N=3
SET INRECID=""
FOR
SET INRECID=$ORDER(^UTILITY($JOB,"EX",INFUNC,INRECID))
IF INRECID=""
QUIT
Begin DoDot:1
+4 SET INDA=""
FOR
SET INDA=$ORDER(^UTILITY($JOB,"EX",INFUNC,INRECID,INDA))
IF INDA=""
QUIT
IF '^(INDA)
SET X="Local file "_INDA_" of "_INSYS_" record id "_INRECID_" is not excluded"
DO WRITE
End DoDot:1
+5 QUIT
+6 ;
WRITEL ;Output data exceptions
+1 SET N=5
SET L=1
SET X="These records do not have data pointing to them:"
DO WRITE
+2 SET N=3
SET INRECID=""
FOR
SET INRECID=$ORDER(^UTILITY($JOB,"LF",INFUNC,INRECID))
IF INRECID=""
QUIT
SET X=^(INRECID)
DO WRITE
+3 QUIT
+4 ;
HSET ;set up header
+1 SET Y=DT
DO DD^%DT
+2 SET INHDR(1)="""Interface Exception Report for "_$$SYSNAME^INHUTIL1(INSYS)_" System"",?(IOM-22),"""_Y_" PAGE: "",INPAGE"
+3 SET INHDR(2)=""" File # / Record ID / Name Exception Description"""
+4 SET INHDR(4)=""
SET $PIECE(INHDR(4),"-",IOM-1)=""
SET INHDR(4)=""""_INHDR(4)_""",!"
+5 QUIT
+6 ;
QUIT ;exit module
+1 DO ^%ZISC
+2 SET IOP=""
SET %ZIS=""
DO ^%ZIS
USE IO
KILL IO("Q"),IOP,POP
+3 ;CLEAN UP UTIL GLOB
KILL ^UTILITY($JOB)
+4 QUIT
+5 ;
