INHSYS03 ;slt; 2 Oct 95 14:44;System Configuration data utility cont.
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
RSLV(INREPRT) ;resolve pointer fields to .01 values
; Input:
; INREPRT - 0 - No Report
; 1 - Display Report
;local:
; %LINE - a single line from XRF^INHSYSUT line-tag
; %FILE - the source file number
; %FLD - the source field number
; %FLDS - a string of ";" delimited field numbers
; %LEN - the number of fields to process
; %SFL - sub file number
; %SFLD - sub field number
; %Z0 - zero node from ^DD(%FILE,%FLD,
;
N %LINE,%FILE,%FLD,I,J,%FLDS,%LEN,%SFL,%SFLD,%Z0,%FND,%NDPC,%PTO,%FILES,AA
S %FND=""
I INREPRT D HEAD(2)
D XRF^INHSYSUT(.%FILES)
F AA=1:1 S %FILE=$P(%FILES,U,AA) Q:%FILE="" D
.S %FLDS=%FILES(%FILE),%LEN=$L(%FLDS,";")
.;get one DD field at a time
.F J=1:1:%LEN S %FLD=$P(%FLDS,";",J) I %FLD'="" D
..;if multiple
..I %FLD[":" D SUBFLD(%FILE,%FLD) Q
..S %Z0=$G(^DD(%FILE,%FLD,0)) Q:%Z0=""
..F K="2^%PTO","4^%NDPC" S @$P(K,U,2)=$P(%Z0,U,$P(K,U))
..;resolve ptr values
..D FLD(%PTO,%NDPC,.%FND,%FILE,%FLD)
I INREPRT,%FND W !!,"*** Denotes pointed to file not put in package.",!!
Q
EXPAND(INREPRT) ;Expand pointer values
; Input:
; INREPRT - 0 - No Report
; 1 - Display Report
N INFL,INIEN,%ROOT,%FND
I INREPRT D HEAD(2)
F INFL=4012,4005,4011,4000,4004,4010,4090.2,4020,4006 D Q:INPOP
.S INIEN="0"
.F S INIEN=$O(^UTILITY($J,INFL,INIEN)) Q:'INIEN D Q:INPOP
..S %ROOT=^DIC(INFL,0,"GL"),%FND=0
..D EXPND^INHSYS09(INIEN,INFL,%ROOT,%ROOT_INIEN_",",1,INIEN,INREPRT,INIEN,.%FND)
Q:INPOP I INREPRT,%FND W !!,"*** Denotes pointed to file not put in package.",!!
Q
;
SUBFLD(%FILE,%FLD) ;sub field processing for multiples
; %FILE - the source file number
; %FLD - the source field number
N %SFL,%SFLDS,%SFLD,INL,%Z0,%GBL,%PTO,%NDPC,%ND,%PC,INIEN,INDA,%DIEN
N %GBLN,I,%PTNM,%PGBL
S %SFL=$P(%FLD,":",2),INL=$L(%SFL,",")
S %SFLDS=$P(%SFL,",",2,INL),INL=INL-1
S %SFL=$P(%SFL,","),%FLD=$P(%FLD,":")
F I=1:1:INL S %SFLD=$P(%SFLDS,",",I) D
.S %Z0=^DD(%SFL,%SFLD,0)
.F K="2^%PTO","3^%GBL","4^%NDPC" S @$P(K,U,2)=$P(%Z0,U,$P(K,U))
.S %ND=$P(%NDPC,";"),%PC=$P(%NDPC,";",2)
.S INIEN=""
.F S INIEN=$O(^UTILITY($J,%FILE,INIEN)) Q:'INIEN D
..S INDA=0
..F S INDA=$O(^UTILITY($J,%FILE,INIEN,%FLD,INDA)) Q:'INDA D
...S %DIEN=$P(^(INDA,%ND),U,%PC) Q:'%DIEN
...S %GBLN="^"_%GBL_%DIEN_",0)"
...I '$D(@%GBLN),'$D(%PASS) D Q
....W !,%SFL,?10,$P($G(^DIC(%FILE,0)),U),?38,%FLD," Broken Pointer ",%GBLN
....W !,$G(^DIC(%FILE,0,"GL"))_INIEN
...S INP01=$P(@%GBLN,U)
...S $P(^UTILITY($J,%FILE,INIEN,%FLD,INDA,%ND),U,%PC)=INP01
...S %PTO=$$NUM^INHUT5(%PTO)
...I INREPRT D PRINT(%SFL,%FILE,%SFLD,%PTO,INP01,%GBLN,INIEN,.%FND)
Q
FLD(%PTO,%NDPC,%FND,%FILE,%FLD,INOMIT) ;resolve pointer values to .01 text
; from pointed too file
;input:
; %PTO - file pointed to
; %NDPC - the node;piece
; %FND - 1 - Target file not in package
; 0 - Target file in package
; Site specific files may not be exported. If
; this is an entry in one of those files, %FND will
; be equal to one. ex) DEVICE FILE
; %FILE - the source file number
; %FLD - the source field number
; INOMIT - Omit pointer from being transported
; INOMIT(FILE#,FIELD#)
;local:
; %DIEN - the ien to convert to .01
; %IEN - the source/target file entry ien
; %ND - node
; %PC - piece
; %GBL - source global node
; INP01 - .01 internal value from source
; %NP - No pointed file being brought
;
N %DIEN,%IEN,%ND,%PC,%GBL,INP01,%GBLN,%NP,%PGBL,%PTNM
S %ND=$P(%NDPC,";"),%PC=$P(%NDPC,";",2),%PTO=+$E(%PTO,$F(%PTO,"P"),$L(%PTO))
;get global being pointed to
S %GBL=^DIC(%PTO,0,"GL")
S %IEN=""
F S %IEN=$O(^UTILITY($J,%FILE,%IEN)) Q:'%IEN D
.S %DIEN=$P($G(^(%IEN,%ND)),U,%PC) Q:'%DIEN
.I $D(INOMIT(%FILE,%FLD)) S $P(^UTILITY($J,%FILE,%IEN,%ND),U,%PC)="" Q
.S %GBLN=%GBL_%DIEN_",0)"
.I '$D(@%GBLN) D Q
..W !,%FILE,?10,$P($G(^DIC(%FILE,0)),U),?38,%FLD," Broken Pointer ",%GBLN
..W !,$G(^DIC(%FILE,0,"GL"))_%IEN
.;look at global being pointed to, set UTILITY piece to that value
.S INP01=$P(@%GBLN,U),$P(^UTILITY($J,%FILE,%IEN,%ND),U,%PC)=INP01
.I INREPRT D PRINT(%FILE,%FILE,%FLD,%PTO,INP01,%GBLN,%IEN,.%FND)
Q
PRINT(%SFL,%FILE,%FLD,%PTO,INP01,%GBLN,%IEN,%FND) ;
; %SFL - the source sub file number
; %FILE - the source file number
; %FLD - the source field number
; %PTO - file pointed to
; INP01 - .01 internal value from source
; %GBLN - target global node
; %IEN - target file entry ien
; Output: %FND - 1 - Target file not in package
; 0 - Target file in package
; Site specific files may not be exported. If
; this is an entry in one of those files, %FND will
; be equal to one. ex) DEVICE FILE
N %PGBL,%PTNM,%NP
S %NP="" I '$D(^UTILITY("SVD",$J,%GBLN)) S %NP=" *** ",%FND=1
D PG(2) W !,%SFL,%NP,?10,$P($G(^DIC(%FILE,0)),U),?38,%FLD,?48,%PTO,?56,$P($G(^DIC(%PTO,0)),U)
S %PGBL=$G(^DIC(%FILE,0,"GL"))_%IEN
S %PTNM=$P(@(%PGBL_",0)"),U)
I %FILE=4020 S %PTNM=$P($G(^INRHT(%PTNM,0)),U)
W !,%PGBL_" ",?14,%PTNM,?48,$P(%GBLN,",")_" ",?62,INP01,!
Q
HEAD(%TP) ;
; Input: %TP - 1 No Target file info
; 2 Target file info in report
N %,%2,%3
S %="Data",%2="File Name",%3=""
I %TP=2 S %="Points to file",%2="",%3="Ptr ^Root(IEN"
W @IOF
W !!,"File",?10,%2,?38,"Field",?48,%
W !,"^Root(IEN",?48,%3,!
Q
PG(%TP) ;
; Input: %TP - 1 No Target file info
; 2 Target file info in report
I IOSL-5'>$Y D
.I $E(IOST)="C",INCR,$$CR^UTSRD(0,IOSL-1)
.D HEAD(%TP)
Q
INHSYS03 ;slt; 2 Oct 95 14:44;System Configuration data utility cont.
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
RSLV(INREPRT) ;resolve pointer fields to .01 values
+1 ; Input:
+2 ; INREPRT - 0 - No Report
+3 ; 1 - Display Report
+4 ;local:
+5 ; %LINE - a single line from XRF^INHSYSUT line-tag
+6 ; %FILE - the source file number
+7 ; %FLD - the source field number
+8 ; %FLDS - a string of ";" delimited field numbers
+9 ; %LEN - the number of fields to process
+10 ; %SFL - sub file number
+11 ; %SFLD - sub field number
+12 ; %Z0 - zero node from ^DD(%FILE,%FLD,
+13 ;
+14 NEW %LINE,%FILE,%FLD,I,J,%FLDS,%LEN,%SFL,%SFLD,%Z0,%FND,%NDPC,%PTO,%FILES,AA
+15 SET %FND=""
+16 IF INREPRT
DO HEAD(2)
+17 DO XRF^INHSYSUT(.%FILES)
+18 FOR AA=1:1
SET %FILE=$PIECE(%FILES,U,AA)
IF %FILE=""
QUIT
Begin DoDot:1
+19 SET %FLDS=%FILES(%FILE)
SET %LEN=$LENGTH(%FLDS,";")
+20 ;get one DD field at a time
+21 FOR J=1:1:%LEN
SET %FLD=$PIECE(%FLDS,";",J)
IF %FLD'=""
Begin DoDot:2
+22 ;if multiple
+23 IF %FLD[":"
DO SUBFLD(%FILE,%FLD)
QUIT
+24 SET %Z0=$GET(^DD(%FILE,%FLD,0))
IF %Z0=""
QUIT
+25 FOR K="2^%PTO","4^%NDPC"
SET @$PIECE(K,U,2)=$PIECE(%Z0,U,$PIECE(K,U))
+26 ;resolve ptr values
+27 DO FLD(%PTO,%NDPC,.%FND,%FILE,%FLD)
End DoDot:2
End DoDot:1
+28 IF INREPRT
IF %FND
WRITE !!,"*** Denotes pointed to file not put in package.",!!
+29 QUIT
EXPAND(INREPRT) ;Expand pointer values
+1 ; Input:
+2 ; INREPRT - 0 - No Report
+3 ; 1 - Display Report
+4 NEW INFL,INIEN,%ROOT,%FND
+5 IF INREPRT
DO HEAD(2)
+6 FOR INFL=4012,4005,4011,4000,4004,4010,4090.2,4020,4006
Begin DoDot:1
+7 SET INIEN="0"
+8 FOR
SET INIEN=$ORDER(^UTILITY($JOB,INFL,INIEN))
IF 'INIEN
QUIT
Begin DoDot:2
+9 SET %ROOT=^DIC(INFL,0,"GL")
SET %FND=0
+10 DO EXPND^INHSYS09(INIEN,INFL,%ROOT,%ROOT_INIEN_",",1,INIEN,INREPRT,INIEN,.%FND)
End DoDot:2
IF INPOP
QUIT
End DoDot:1
IF INPOP
QUIT
+11 IF INPOP
QUIT
IF INREPRT
IF %FND
WRITE !!,"*** Denotes pointed to file not put in package.",!!
+12 QUIT
+13 ;
SUBFLD(%FILE,%FLD) ;sub field processing for multiples
+1 ; %FILE - the source file number
+2 ; %FLD - the source field number
+3 NEW %SFL,%SFLDS,%SFLD,INL,%Z0,%GBL,%PTO,%NDPC,%ND,%PC,INIEN,INDA,%DIEN
+4 NEW %GBLN,I,%PTNM,%PGBL
+5 SET %SFL=$PIECE(%FLD,":",2)
SET INL=$LENGTH(%SFL,",")
+6 SET %SFLDS=$PIECE(%SFL,",",2,INL)
SET INL=INL-1
+7 SET %SFL=$PIECE(%SFL,",")
SET %FLD=$PIECE(%FLD,":")
+8 FOR I=1:1:INL
SET %SFLD=$PIECE(%SFLDS,",",I)
Begin DoDot:1
+9 SET %Z0=^DD(%SFL,%SFLD,0)
+10 FOR K="2^%PTO","3^%GBL","4^%NDPC"
SET @$PIECE(K,U,2)=$PIECE(%Z0,U,$PIECE(K,U))
+11 SET %ND=$PIECE(%NDPC,";")
SET %PC=$PIECE(%NDPC,";",2)
+12 SET INIEN=""
+13 FOR
SET INIEN=$ORDER(^UTILITY($JOB,%FILE,INIEN))
IF 'INIEN
QUIT
Begin DoDot:2
+14 SET INDA=0
+15 FOR
SET INDA=$ORDER(^UTILITY($JOB,%FILE,INIEN,%FLD,INDA))
IF 'INDA
QUIT
Begin DoDot:3
+16 SET %DIEN=$PIECE(^(INDA,%ND),U,%PC)
IF '%DIEN
QUIT
+17 SET %GBLN="^"_%GBL_%DIEN_",0)"
+18 IF '$DATA(@%GBLN)
IF '$DATA(%PASS)
Begin DoDot:4
+19 WRITE !,%SFL,?10,$PIECE($GET(^DIC(%FILE,0)),U),?38,%FLD," Broken Pointer ",%GBLN
+20 WRITE !,$GET(^DIC(%FILE,0,"GL"))_INIEN
End DoDot:4
QUIT
+21 SET INP01=$PIECE(@%GBLN,U)
+22 SET $PIECE(^UTILITY($JOB,%FILE,INIEN,%FLD,INDA,%ND),U,%PC)=INP01
+23 SET %PTO=$$NUM^INHUT5(%PTO)
+24 IF INREPRT
DO PRINT(%SFL,%FILE,%SFLD,%PTO,INP01,%GBLN,INIEN,.%FND)
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
FLD(%PTO,%NDPC,%FND,%FILE,%FLD,INOMIT) ;resolve pointer values to .01 text
+1 ; from pointed too file
+2 ;input:
+3 ; %PTO - file pointed to
+4 ; %NDPC - the node;piece
+5 ; %FND - 1 - Target file not in package
+6 ; 0 - Target file in package
+7 ; Site specific files may not be exported. If
+8 ; this is an entry in one of those files, %FND will
+9 ; be equal to one. ex) DEVICE FILE
+10 ; %FILE - the source file number
+11 ; %FLD - the source field number
+12 ; INOMIT - Omit pointer from being transported
+13 ; INOMIT(FILE#,FIELD#)
+14 ;local:
+15 ; %DIEN - the ien to convert to .01
+16 ; %IEN - the source/target file entry ien
+17 ; %ND - node
+18 ; %PC - piece
+19 ; %GBL - source global node
+20 ; INP01 - .01 internal value from source
+21 ; %NP - No pointed file being brought
+22 ;
+23 NEW %DIEN,%IEN,%ND,%PC,%GBL,INP01,%GBLN,%NP,%PGBL,%PTNM
+24 SET %ND=$PIECE(%NDPC,";")
SET %PC=$PIECE(%NDPC,";",2)
SET %PTO=+$EXTRACT(%PTO,$FIND(%PTO,"P"),$LENGTH(%PTO))
+25 ;get global being pointed to
+26 SET %GBL=^DIC(%PTO,0,"GL")
+27 SET %IEN=""
+28 FOR
SET %IEN=$ORDER(^UTILITY($JOB,%FILE,%IEN))
IF '%IEN
QUIT
Begin DoDot:1
+29 SET %DIEN=$PIECE($GET(^(%IEN,%ND)),U,%PC)
IF '%DIEN
QUIT
+30 IF $DATA(INOMIT(%FILE,%FLD))
SET $PIECE(^UTILITY($JOB,%FILE,%IEN,%ND),U,%PC)=""
QUIT
+31 SET %GBLN=%GBL_%DIEN_",0)"
+32 IF '$DATA(@%GBLN)
Begin DoDot:2
+33 WRITE !,%FILE,?10,$PIECE($GET(^DIC(%FILE,0)),U),?38,%FLD," Broken Pointer ",%GBLN
+34 WRITE !,$GET(^DIC(%FILE,0,"GL"))_%IEN
End DoDot:2
QUIT
+35 ;look at global being pointed to, set UTILITY piece to that value
+36 SET INP01=$PIECE(@%GBLN,U)
SET $PIECE(^UTILITY($JOB,%FILE,%IEN,%ND),U,%PC)=INP01
+37 IF INREPRT
DO PRINT(%FILE,%FILE,%FLD,%PTO,INP01,%GBLN,%IEN,.%FND)
End DoDot:1
+38 QUIT
PRINT(%SFL,%FILE,%FLD,%PTO,INP01,%GBLN,%IEN,%FND) ;
+1 ; %SFL - the source sub file number
+2 ; %FILE - the source file number
+3 ; %FLD - the source field number
+4 ; %PTO - file pointed to
+5 ; INP01 - .01 internal value from source
+6 ; %GBLN - target global node
+7 ; %IEN - target file entry ien
+8 ; Output: %FND - 1 - Target file not in package
+9 ; 0 - Target file in package
+10 ; Site specific files may not be exported. If
+11 ; this is an entry in one of those files, %FND will
+12 ; be equal to one. ex) DEVICE FILE
+13 NEW %PGBL,%PTNM,%NP
+14 SET %NP=""
IF '$DATA(^UTILITY("SVD",$JOB,%GBLN))
SET %NP=" *** "
SET %FND=1
+15 DO PG(2)
WRITE !,%SFL,%NP,?10,$PIECE($GET(^DIC(%FILE,0)),U),?38,%FLD,?48,%PTO,?56,$PIECE($GET(^DIC(%PTO,0)),U)
+16 SET %PGBL=$GET(^DIC(%FILE,0,"GL"))_%IEN
+17 SET %PTNM=$PIECE(@(%PGBL_",0)"),U)
+18 IF %FILE=4020
SET %PTNM=$PIECE($GET(^INRHT(%PTNM,0)),U)
+19 WRITE !,%PGBL_" ",?14,%PTNM,?48,$PIECE(%GBLN,",")_" ",?62,INP01,!
+20 QUIT
HEAD(%TP) ;
+1 ; Input: %TP - 1 No Target file info
+2 ; 2 Target file info in report
+3 NEW %,%2,%3
+4 SET %="Data"
SET %2="File Name"
SET %3=""
+5 IF %TP=2
SET %="Points to file"
SET %2=""
SET %3="Ptr ^Root(IEN"
+6 WRITE @IOF
+7 WRITE !!,"File",?10,%2,?38,"Field",?48,%
+8 WRITE !,"^Root(IEN",?48,%3,!
+9 QUIT
PG(%TP) ;
+1 ; Input: %TP - 1 No Target file info
+2 ; 2 Target file info in report
+3 IF IOSL-5'>$Y
Begin DoDot:1
+4 IF $EXTRACT(IOST)="C"
IF INCR
IF $$CR^UTSRD(0,IOSL-1)
+5 DO HEAD(%TP)
End DoDot:1
+6 QUIT
