- 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
