Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHSYS09

INHSYS09.m

Go to the documentation of this file. 
  1. INHSYS09 ;JPD; 5 Nov 98 13:29;gis sys con data installation utility 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  Q
  1. START ;Single element transaction mover entry point
  1.  ; This routine copy data from file entry to ^UTILITY($J,%FILE,%IEN
  1.  ; Then expand the pointer fields to their actual value
  1.  N INREPRT,INPOP,INCR,INNTRIES
  1.  S INPOP=0,INCR=1
  1.  D ENV^UTIL
  1.  D DEBOFF
  1.  W @IOF
  1.  D GETFLE(.INNTRIES)
  1.  I $D(INNTRIES) D
  1.  .W !,"Do you want a report of what the file points to"
  1.  .S INREPRT=$$YN^%ZTF(0)
  1.  .I INREPRT D HEAD^INHSYS03(2)
  1.  .S %FILE="" F  S %FILE=$O(INNTRIES(%FILE)) Q:%FILE=""  D
  1.  ..S %OIEN="" F  S %OIEN=$O(INNTRIES(%FILE,%OIEN)) Q:%OIEN=""  D
  1.  ...D COPY(%FILE,%OIEN,INREPRT)
  1.  Q
  1. GETFLE(INNTRIES) ;Get file entry
  1.  ; Output:
  1.  ;   INNTRIES - Array of Files and entries
  1.  ;   format - INNTRIES(FILE,IEN)="ENTRY NAME"
  1.  N %FIL,DIC,Y
  1.  F  D  Q:%FIL=-1
  1.  .S DIC="^DIC(",DIC(0)="AEQ",DIC("A")="Enter File Name:  "
  1.  .D ^DIC
  1.  .S %FIL=+Y
  1.  .I +%FIL>0 F  D GETELE(.INNTRIES,.Y) Q:Y=-1
  1.  Q
  1. GETELE(INNTRIES,Y) ;Get file element
  1.  ; Output:
  1.  ;   INNTRIES - Array of Files and entries
  1.  ;   format - INNTRIES(FILE,IEN)="ENTRY NAME"
  1.  ;   Y - File element entry
  1.  N DIC
  1.  S DIC(0)="AEQ",DIC("A")="Enter File Element Name:  "
  1.  S (%GBL,DIC)=^DIC($P(%FIL,U),0,"GL")
  1.  D ^DIC
  1.  I Y>0 S INNTRIES(%FIL,+Y)=$P(Y,U,2)
  1.  Q
  1. COPY(%FILE,%OIEN,INREPRT,INOMIT) ;Front end expand any pointer any file
  1.  ; %FILE - File Number
  1.  ; %OIEN - Internal Entry Number
  1.  ; INREPRT - 0 no report 1 yes
  1.  ; INOMIT - Array of file and field to omit from transporting
  1.  N %ROOT,%X,%Y,%SVIEN
  1.  K ^UTILITY($J,%FILE,%OIEN)
  1.  S %ROOT=^DIC(%FILE,0,"GL"),%SVIEN=%OIEN
  1.  ;Copy data to ^UTILITY global
  1.  S %Y="^UTILITY("_$J_","_%FILE_","_%OIEN_")",%X=%ROOT_%OIEN_")"
  1.  M @%Y=@%X
  1.  ;Expand pointers
  1.  D EXPND(%OIEN,%FILE,%ROOT,%ROOT_%OIEN_",",1,%OIEN,INREPRT,%SVIEN,0,.INOMIT)
  1.  Q
  1. EXPND(INY,%FILE,%ROOT,%BFR,%LEVL,DA,INREPRT,%SVIEN,%FND,INOMIT) ;Expand pointers 
  1.  ;input:
  1.  ; INY     - ien^.01
  1.  ; %FILE - file number
  1.  ; %ROOT   - global root
  1.  ; %BFR    - storage buffer
  1.  ; %LEVL  - file/sub-file level
  1.  ; DA      - same as fileman documented DA
  1.  ; INREPRT - if 1 reporting in effect, either user
  1.  ;               requested or flat file
  1.  ; %SVIEN - top level ien since we could be in a multiple
  1.  ;          used at PRINT^INHSYS03 if INREPRT
  1.  ;  %FND - 1 - Target file not in package
  1.  ;         0 - Target file in package
  1.  ;   Site specific files may not be exported. If
  1.  ;   this is an entry in one of those files, %FND will
  1.  ;   be equal to one. ex) DEVICE FILE
  1.  ; INOMIT - Array of fields that are pointers to omit from package
  1.  ;          INOMIT(FILE#,FIELD#)
  1.  ;local:
  1.  ; %NODE   - node
  1.  ; %PIECE  - uparrow piece
  1.  ; %FLDNUM - field number
  1.  ; %OIEN   - old ien for sub-files
  1.  ; %NBFR   - the new storage buffer root name
  1.  ; %DATA   - node data strage variable
  1.  ; P01     - .01 value
  1.  ; %NRT    - new global root
  1.  ;
  1.  N %NODE,%NODE1,%PIECE,%FLDNUM,DIE,%OIEN,%NBFR,%DATA,P01,%NRT,YY,DR,I,J
  1.  N %Z0
  1.  S %NODE=""
  1.  F  S %NODE=$O(^DD(%FILE,"GL",%NODE)) Q:%NODE=""  D  Q:INPOP
  1.  .S %NODE1=%NODE
  1.  .I $L(%NODE),+%NODE'=%NODE S %NODE=""""_%NODE_""""
  1.  .;set new storage buffer root name
  1.  .S %NBFR=%BFR_%NODE_","
  1.  .;Loop through DD to get each piece of every node
  1.  .S %PIECE=""
  1.  .F  S %PIECE=$O(^DD(%FILE,"GL",%NODE1,%PIECE)) Q:%PIECE=""  D  Q:INPOP
  1.  ..S %FLDNUM=""
  1.  ..;get fieldnum for each piece of every node
  1.  ..F  S %FLDNUM=$O(^DD(%FILE,"GL",%NODE1,%PIECE,%FLDNUM)) Q:'%FLDNUM  D  Q:INPOP
  1.  ...;If word processing field
  1.  ...I $$WP^INHSYSUT(+%FILE,%FLDNUM) Q
  1.  ...;If piece is 0 could be multiple
  1.  ...I %PIECE=0 D MULT(%NBFR,%NODE,%ROOT,.DA,%FILE,%FLDNUM,%LEVL,%SVIEN,.%FND) Q
  1.  ...S %Z0=$G(^DD(%FILE,%FLDNUM,0))
  1.  ...;If piece is not a pointer quit
  1.  ...I $P(%Z0,U,2)'["P" Q
  1.  ...D DATA^INHSYSUT($$RUT^INHSYSUT(%NBFR),%PIECE,.%DATA)
  1.  ...I %DATA="" Q
  1.  ...F K="2^%PTO","4^%NDPC" S @$P(K,U,2)=$P(%Z0,U,$P(K,U))
  1.  ...I %LEVL>1 D MULT2(%NDPC,%FILE,%FLDNUM,%NBFR,%DATA,%SVIEN,INREPRT,.%FND) Q
  1.  ...D FLD^INHSYS03(%PTO,%NDPC,.%FND,%FILE,%FLDNUM,.INOMIT)
  1.  .Q:INPOP  S %NODE=%NODE1
  1.  Q
  1. MULT(%NBFR,%NODE,%ROOT,DA,%FILE,%FLDNUM,%LEVL,%SVIEN,%FND) ;Process multiple
  1.  ;This module will process multiple as if it were an entire
  1.  ;node and process each entry one piece at a time
  1.  ;  %NBFR   - the new storage buffer root name
  1.  ;  %NODE   - node
  1.  ;  %ROOT   - global root
  1.  ;  DA - ien and "Multiple entry"
  1.  ;  %FILE - file number
  1.  ;  %FLDNUM - field number
  1.  ;  %LEVL  - file/sub-file level
  1.  N %OIEN,%NRT,X,NFLN,YY,%X,%Y,%NFLN,%DIC0,%Z0,%GBL
  1.  S %DIC0="X"
  1.  S %OIEN=0 F  S %OIEN=$O(@$$RUT^INHSYSUT(%NBFR)@(%OIEN)) Q:'%OIEN  D
  1.  .N %NRT,ODA
  1.  .;set x to current multiple node of UTILITY global
  1.  .S X=^(%OIEN,0)
  1.  .;get new root
  1.  .S %NRT=%ROOT_DA_","_%NODE_","
  1.  .S %NFLN=$P(^DD(%FILE,%FLDNUM,0),U,2)
  1.  .S %Z0=$G(^DD(%FILE,%FLDNUM,0))
  1.  .I $P(%Z0,U,2)["P" D  I YY<0 D MSG^INHSYSUT(X,%NFLN,"",1,0) Q
  1.  ..S %GBL="^"_$P(^DD(+%NFLN,.01,0),U,3)
  1.  ..S X="`"_+X
  1.  ..S YY=$$DIC^INHSYS05(%GBL,$P(X,U),%NFLN,%DIC0,.DA,%LEVL)
  1.  .I $P(%Z0,U,2)'["P" S YY=$$DIC^INHSYS05(%NRT,$P(X,U),%NFLN,%DIC0,.DA,%LEVL) I YY<0 D MSG^INHSYSUT(X,%NFLN,"",1,0) Q
  1.  .S ODA=DA,%X="DA",%Y="ODA" M @%Y=@%X ;D %XY^%RCR
  1.  .D SETDA(.DA,%LEVL,+YY)
  1.  .;every time you recusion into stuff, it processes multiple
  1.  .;completely for each entry
  1.  .D EXPND(YY,+%NFLN,%NRT,%NBFR_%OIEN_",",%LEVL+1,.DA,INREPRT,%SVIEN,.%FND)
  1.  .K DA S DA=ODA,%Y="DA",%X="ODA" M @%Y=@%X ;D %XY^%RCR
  1.  Q
  1. SETDA(DA,%LEVL,Y) ;Set DA level so fileman doesn't choke
  1.  ; Input:
  1.  ;    DA - ien and "Multiple" entry #'s
  1.  ;    %LEVL - level in multiple
  1.  ;    Y - New entry number
  1.  ; Output:
  1.  ;    DA - IEN and "Multiple" entry #'s
  1.  N I
  1.  F I=%LEVL:-1:3 S DA(I-1)=DA(I-2)
  1.  S DA(1)=DA,DA=+Y
  1.  Q
  1. MULT2(%NDPC,%FILE,%FLD,%NBFR,%DATA,%SVIEN,INREPRT,%FND) ;Process multiple
  1.  ; Input:
  1.  ;  %NDPC - The node;piece
  1.  ;  %FILE - Source file number
  1.  ;  %FLD - Source field number
  1.  ;  %NBFR - Buffer of data
  1.  ;  %DATA - ien to be expanded
  1.  ;  %SVIEN - top level ien, used in PRINT^INHSYS03
  1.  ;  INREPRT - 0 no report 1 report
  1.  ;  %FND - 1 - Target file not in package
  1.  ;         0 - Target file in package
  1.  ;   Site specific files may not be exported. If
  1.  ;   this is an entry in one of those files, %FND will
  1.  ;   be equal to one. ex) DEVICE FILE
  1.  N INP01,%GBFR,%GBL,%PTO,%UPFL,%GBLN,%NOD
  1.  S %PC=$P(%NDPC,";",2)
  1.  ;Global root of file pointed to
  1.  S %GBL="^"_$P(^DD(+%FILE,%FLD,0),U,3)
  1.  ; File number of pointed to file
  1.  S %PTO=$P(^DD(+%FILE,%FLD,0),U,2)
  1.  S %PTO=+$E(%PTO,$F(%PTO,"P"),$L(%PTO))
  1.  S %GBLN=%GBL_%DATA_",0)"
  1.  I '$D(@%GBLN) W !,%FILE,?10,$P($G(^DIC(%FILE,0)),U),?38,%FLD,"   Broken Pointer  ",%GBLN S INPOP=1 Q
  1.  ;.01 of pointed to file
  1.  S INP01=$P(@%GBLN,U)
  1.  S %NOD=$P(%NBFR,@"^DIC($$UP^INHSYSUT(%FILE),0,""GL"")",2)
  1.  S %GBFR=$$RUT^INHSYSUT("^UTILITY("_$J_","_$$UP^INHSYSUT(%FILE)_","_%NOD)
  1.  S $P(@%GBFR,U,%PC)=INP01
  1.  ;Root source file
  1.  S %UPFL=$$UP^INHSYSUT(%FILE)
  1.  I INREPRT D PRINT^INHSYS03(%FILE,%UPFL,%FLD,%PTO,INP01,%GBLN,%SVIEN,.%FND)
  1.  Q
  1.  ;
  1. DEBOFF ;Turn off debug for all background process
  1.  N INBN,INBD,INBP
  1.  S INBN="" F  S INBN=$O(^INTHPC("B",INBN))  Q:INBN=""  D
  1.  .S INBD=$O(^INTHPC("B",INBN,0))
  1.  .I $D(^INTHPC(INBD,9)) D
  1.  ..S INBP=$P(^INTHPC(INBD,9),U,1)
  1.  ..I INBP>0 D
  1.  ...W !,"WARNING: Debug will be turned off for Background Process: ",INBN
  1.  ...R !!?25,"Press <RETURN> To Continue",X:$S($D(DTIME):DTIME,1:300)
  1.  ...S DR="9.01///@",DA=INBD,DIE=4004 D ^DIE
  1.  Q
  1.  ;