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

INHSYS05.m

Go to the documentation of this file. 
  1. INHSYS05 ;slt,JPD,WOM; 15 Jun 99 16:27;gis sys con data installation utility 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TOOLS_460; GEN 5; 6-OCT-1997
  1.  ;COPYRIGHT 1994 SAIC
  1.  Q
  1. INST(%DRVR,%PASS,INREPRT) ;installation utility entry point
  1.  ;input:
  1.  ; %DRVR - Internal installation driver routine
  1.  ; %PASS - 0 or null - display report only
  1.  ;         1 - save off old files - create required fields
  1.  ;         2 - populate rest of file
  1.  ; INREPRT - 0 or null - off 1 - on
  1.  ;local:
  1.  ; %LINE - file information stored in ";;" comment form
  1.  ; %FNUM - file number
  1.  ; %ROOT - global root
  1.  ;
  1.  N B,%FNUM,%FLDS,%ROOT,%OIEN,%XNODE,%UNQ,Y,DA,%FILES,AA,%SAV
  1.  N DIC,X,DLAYGO,QT,I,%RQ,%MSG,%MSG2,%OMT,%FILES,%DIC0,%GLB
  1.  S INREPRT=$G(INREPRT),%PASS=$G(%PASS),(%MSG,%MSG2)=0
  1.  I '%PASS X "D EN^@%DRVR"   ;used eXecute so that ^TCQ program does not crash!
  1.  I INREPRT U IO D HEAD^INHSYSUT(%PASS)
  1.  ;set up variables
  1.  D RQ^INHSYSUT(.%RQ),OMT^INHSYSUT(.%OMT),SAVE^INHSYSUT(.%SAV),XRF^INHSYSUT(.%FILES)
  1.  S QT=$C(34)
  1.  ;Get each cross reference
  1.  F AA=1:1 S %FNUM=$P(%FILES,U,AA) Q:%FNUM=""  D
  1.  .;get root name of file
  1.  .;Cant do exact match lookup since names>30 in length
  1.  .S %ROOT=$G(^DIC(%FNUM,0,"GL")),%DIC0="X"
  1.  .I %ROOT="" W !,"Note .. DD file "_%FNUM_" is missing." Q
  1.  .I %PASS S %DIC0="LX"
  1.  .;loop thru utility using cross reference to get ien
  1.  .S %OIEN="" F  S %OIEN=$O(^UTILITY("INHSYS",$J,%FNUM,%OIEN)) Q:'%OIEN  D
  1.  ..N DA,DINUM
  1.  ..S %XNODE=^UTILITY("INHSYS",$J,%FNUM,%OIEN,0)
  1.  ..;if Transaction Type file
  1.  ..I %FNUM=4000,$P(%XNODE,U,4)]"" D
  1.  ...;get unique identifier
  1.  ...S %UNQ=$P(%XNODE,U,4),%GLB=$$RUT^INHSYSUT(%ROOT),Y=$O(@%GLB@("ID",%UNQ,""))
  1.  ...;If no unique ID laygo the file
  1.  ...I 'Y S Y=$$DIC(%ROOT,$P(%XNODE,U),%FNUM,%DIC0) D:Y<0 MSG^INHSYSUT(%XNODE,%FNUM,.%MSG,0,%PASS) Q
  1.  ...E  S Y=Y_U_$P(%XNODE,U)
  1.  ..E  S Y=$$DIC(%ROOT,$P(%XNODE,U),%FNUM,%DIC0) D:Y<0 MSG^INHSYSUT(%XNODE,%FNUM,.%MSG,0,%PASS)
  1.  ..I INREPRT,Y>0 D PG^INHSYSUT(%PASS) W !,%FNUM,?14,$P($G(^DIC(%FNUM,0)),U),?42
  1.  ..;Save ien Kill off node
  1.  ..I %PASS=1,+Y>0 D  I +Y<0 D MSG^INHSYSUT(%XNODE,%FNUM,.%MSG,0,%PASS) Q
  1.  ...;if we want to save old values from export environment
  1.  ...I $D(%SAV(%FNUM)) D FLSV^INHSYSUT(%FNUM,+Y,%ROOT)
  1.  ...S DINUM=+Y,DIK=%ROOT,DA=+Y D ^DIK
  1.  ...;create stub node
  1.  ...S Y=$$DIC(%ROOT,$P(%XNODE,U),%FNUM,%DIC0,"","",.DINUM)
  1.  ..S DA=+Y
  1.  ..I INREPRT,Y>0 D
  1.  ...W:%PASS'=1 ?42,".01",?56
  1.  ...I %FNUM=4020 W $P($G(^INRHT($P(Y,U,2),0)),U)
  1.  ...E  W:%PASS'=1 $P(Y,U,2)
  1.  ...W !,%ROOT_DA I '%PASS W !
  1.  ..I INREPRT,Y'>0,%PASS=1 W ?42,".01"
  1.  ..I '%PASS,Y>0 D CMP^INHSYS07(+Y,%ROOT,%FNUM,%OIEN,1)
  1.  ..I %PASS D STUFF(Y,%FNUM,%ROOT,"^UTILITY(""INHSYS"","_$J_","_QT_%FNUM_QT_","_%OIEN_",",1,DA,%PASS,.%MSG2,INREPRT)
  1.  ;I '%PASS,'INREPRT,'%MSG W !,"All files currently exist in this environment",!,"and will be overwritten",!
  1.  I INREPRT,%MSG2 D PG^INHSYSUT(%PASS) W !,"*** Denotes ommitted, and not filed in system."
  1.  I INREPRT D PG^INHSYSUT(%PASS)
  1.  W !!,"Pass "_%PASS_" Done! "
  1.  I INREPRT,%PASS=1,$E(IOST)="C",INCR,$$CR^UTSRD(0,IOSL-1)
  1.  Q
  1.  ;
  1. STUFF(INY,%FILNUM,%ROOT,%BFR,%LEVEL,DA,%PASS,%MSG2,INREPRT) ;recursive data stuffer 
  1.  ;input:
  1.  ; INY     - ien^.01
  1.  ; %FILNUM - file number
  1.  ; %ROOT   - global root
  1.  ; %BFR    - storage buffer
  1.  ; %LEVEL  - file/sub-file level
  1.  ; DA      - same as fileman documented DA
  1.  ; %PASS - 0 or null - report
  1.  ;         1 - save off old files - create required fields
  1.  ;         2 - populate rest of file
  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.  S %NODE=""
  1.  I %LEVEL>1,INREPRT D PG^INHSYSUT(%PASS) W !,"m ",%FILNUM,?14,$P($G(^DD(%FILNUM,0)),U)
  1.  F  S %NODE=$O(^DD(%FILNUM,"GL",%NODE)) Q:%NODE=""  D
  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(%FILNUM,"GL",%NODE1,%PIECE)) Q:%PIECE=""  D
  1.  ..S %FLDNUM=""
  1.  ..;get fieldnum for each piece of every node
  1.  ..F  S %FLDNUM=$O(^DD(%FILNUM,"GL",%NODE1,%PIECE,%FLDNUM)) Q:'%FLDNUM  D
  1.  ...I %PASS=1,'$D(%RQ(%FILNUM,%FLDNUM)) Q
  1.  ...I INREPRT D:%FLDNUM'=".01" PG^INHSYSUT(%PASS) W:%FLDNUM'=".01"!(%LEVEL=1) !,?42,%FLDNUM
  1.  ...I INREPRT,%LEVEL>1,%FLDNUM=".01" D PG^INHSYSUT(%PASS) W !,?42,%FLDNUM
  1.  ...; Don't do it because already populated in PASS 1
  1.  ...I %PASS=2,$D(%RQ(%FILNUM,%FLDNUM)) Q
  1.  ...I $D(%OMT(%FILNUM,%FLDNUM)) D:INREPRT  Q
  1.  ....D DATA^INHSYSUT($$RUT^INHSYSUT(%NBFR),%PIECE,.%DATA)
  1.  ....W " ***",?56,%DATA
  1.  ....S %MSG2=1
  1.  ...;If word processing field
  1.  ...I $$WP^INHSYSUT(+%FILNUM,%FLDNUM) D WORD(%NBFR,%ROOT,DA,%NODE,%PASS) Q
  1.  ...;If piece is 0 could be multiple
  1.  ...I %PIECE=0 D MULT(%NBFR,%NODE,%ROOT,.DA,%FILNUM,%FLDNUM,%LEVEL,%PASS,.%MSG2) Q
  1.  ...D DATA^INHSYSUT($$RUT^INHSYSUT(%NBFR),%PIECE,.%DATA)
  1.  ...I INREPRT W ?56,%DATA
  1.  ...;If not .01, if not blank, and not omitted File the data
  1.  ...I %DATA'="",%FLDNUM'=".01" D FILE^INHSYSUT(.DA,%DATA,%FLDNUM,%ROOT,INREPRT)
  1.  .S %NODE=%NODE1
  1.  Q
  1. MULT(%NBFR,%NODE,%ROOT,DA,%FILNUM,%FLDNUM,%LEVEL,%PASS,%MSG2) ;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.  ;  %FILNUM - file number
  1.  ;  %FLDNUM - field number
  1.  ;  %LEVEL  - file/sub-file level
  1.  ;  %PASS - 0 or null - report
  1.  ;            1 - save off old files - create required fields
  1.  ;            2 - populate rest of file
  1.  N %OIEN,%NRT,X,NFLN,YY,%X,%Y,%NFLN,%DIC0,INMSGID
  1.  S %DIC0="LX"
  1.  S %OIEN=0 F  S %OIEN=$O(@$$RUT^INHSYSUT(%NBFR)@(%OIEN)) Q:'%OIEN  S X=^(%OIEN,0) D
  1.  .N %NRT,ODA,%INFAKE,%DICS
  1.  .;set x to current multiple node of UTILITY global
  1.  .;get new root
  1.  .S %NRT=%ROOT_DA_","_%NODE_","
  1.  .S %NFLN=$P(^DD(%FILNUM,%FLDNUM,0),U,2)
  1.  .I +%NFLN="4001.19" D  Q
  1.  ..N INIEN
  1.  ..S INMSGID=$P(@(%NBFR_%OIEN_",0)"),U,2)
  1.  ..S INIEN=$O(^INTHU("C",INMSGID,"")) Q:'INIEN
  1.  ..D UPSINGMS^INTSUT3(DA,"NML",INIEN)
  1.  .S YY=$$DIC(%NRT,$P(X,U),%NFLN,%DIC0,.DA,%LEVEL,.INFAKE) I YY<0 D MSG^INHSYSUT(X,%NFLN,"",1,%PASS) Q
  1.  .S ODA=DA,%X="DA",%Y="ODA" M @%Y=@%X
  1.  .D SETDA(.DA,%LEVEL,+YY)
  1.  .;every time you recusion into stuff, it processes multiple
  1.  .;completely for each entry
  1.  .D STUFF(YY,+%NFLN,%NRT,%NBFR_%OIEN_",",%LEVEL+1,.DA,%PASS,.%MSG2,INREPRT)
  1.  .K DA S DA=ODA,%Y="DA",%X="ODA" M @%Y=@%X
  1.  .I INREPRT D PG^INHSYSUT(%PASS) W !,"----",!,"r "_%FILNUM
  1.  Q
  1. WORD(%NBFR,%ROOT,DA,%NODE,%PASS) ;Process word processing field
  1.  ; input:
  1.  ;   %NBFR - Utility Global Buffer
  1.  ;   %ROOT - Root node of global to stuff
  1.  ;   DA - ien
  1.  ;   %NODE - node
  1.  N %INX,%INCNT,%X,%Y,I,L
  1.  ;Check if data exists to move
  1.  I $D(@(%NBFR_"0)")) D
  1.  .;move data from utility to correct multiple
  1.  .S L=$L(%NBFR),%X=$E(%NBFR,1,L-1)_$S($E(%NBFR,L)="(":"",1:")"),%Y=%ROOT_DA_","_%NODE_")"
  1.  .M @%Y=@%X
  1.  Q
  1. SETDA(DA,%LEVEL,Y) ;Set DA level so fileman doesn't choke
  1.  ; Input:
  1.  ;    DA - ien and "Multiple" entry #'s
  1.  ;    %LEVEL - level in multiple
  1.  ;    Y - New entry number
  1.  ; Output:
  1.  ;    DA - IEN and "Multiple" entry #'s
  1.  N I
  1.  F I=%LEVEL:-1:3 S DA(I-1)=DA(I-2)
  1.  S DA(1)=DA,DA=+Y
  1.  Q
  1. DIC(DIC,X,DLAYGO,%IPS,DOA,%L,DINUM) ;dic lookup
  1.  ;input:
  1.  ;  DIC - Global Root: Can be a string or file number
  1.  ;        If a file number, this function returns -1
  1.  ;             when looking at a multiple
  1.  ;  X - Stuff this bud
  1.  ;  DLAYGO - file number and formatting
  1.  ;  %IPS - input parameter string; see DIC(0) documentation
  1.  ;  DOA  - array of previous DA values; passed by referrence
  1.  ;  %L   - current level
  1.  ;  DINUM (opt) - force this ien
  1.  ;output:
  1.  ;  Y    - What DIC returns
  1.  N G,DA,I,Y,INDD0
  1.  I DIC Q:DIC'>0!($G(DOA)&$G(%L)) -1 S DIC=$G(^DIC(DIC,0,"GL")) Q:DIC="" -1
  1.  ;Check for files whose .01 is a pointer. Currently only check 4020.
  1.  I $D(DINUM),DIC="^INRHR(" S INDD0=$G(^DD(4020,.01,0)) I $P(INDD0,U,2)["P" D  I Y<0 Q Y
  1.  .  ;Get file for next lookup
  1.  .  S INFILE="^"_$P(INDD0,U,3)
  1.  .  ;Do recursive lookup on file
  1.  .  S Y=$$DIC(INFILE,X,"","X")
  1.  .  S X=+Y
  1.  I $G(DOA),($G(%L)) D
  1.  .F I=%L:-1:2 S DA(I)=DOA(I-1)
  1.  .S DA(1)=DOA
  1.  S G=DIC_"0)" S:'$D(@G) @G="^"_DLAYGO_"^^"
  1.  S DIC(0)=%IPS
  1.  I '$D(DINUM) D ^DIC
  1.  I $D(DINUM) D ^DICN D:Y=-1
  1.  .F I=1,2 D  Q:$G(IO)=$G(IO(0))
  1.  ..I I=2,$D(IO(0))#10,$D(IO)#10 U IO(0)
  1.  ..W *7,!,!,"Warning, the GIS TRANSACTION MOVER has failed to update ",!
  1.  ..W DIC," with the .01 field=",X,!,"This could possibly be due to corruption of the"
  1.  ..W "FILEMAN data structure.",!,"This installation cannot be aborted at this time but"
  1.  ..W "YOU MUST CONTACT THE SUPPORT CENTER IMMEDIATELY",!!
  1.  ..I I=2,$D(IO)#10 U IO
  1.  Q Y