INHSYS06 ;JPD; 26 Oct 95 14:49;gis sys con data installation utility
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
PASS3 ;Pass 3 Update with old selected existing fields
N %FLNM,%FLDNM,%IEN,%ROOT,%NBFR,%PIECE,%DD,%NODE,%UTBFR,INSV,INROOT
N %SAV
S %PASS=3
D SAVE^INHSYSUT(.%SAV)
S %NBFR="^UTILITY(""INHSYSUT"","_$J_","
S %FLNM="" F S %FLNM=$O(%SAV(%FLNM)) Q:%FLNM="" D
.S %ROOT=^DIC($$UP^INHSYSUT(%FLNM),0,"GL")
.S %FLDNM="" F S %FLDNM=$O(%SAV(%FLNM,%FLDNM)) Q:%FLDNM="" D
..S %IEN=""
..F S %IEN=$O(^UTILITY("INHSYSUT",$J,%FLNM,%IEN)) Q:%IEN="" D
...I '$D(@(%ROOT_%IEN_",0)")) W !,"error, file entry"_%ROOT_%IEN_" and data does not exist!" Q
...I '$D(^DD(%FLNM,%FLDNM)) W !,"Note.. field not in Data Dictionary. File "_%FLNM_" Field "_%FLDNM,!," Entry ",$P(@(%ROOT_%IEN_",0)"),U)_" may be missing data." Q
...S %DD=^DD(%FLNM,%FLDNM,0),%NODE=$P($P(%DD,U,4),";")
...;If word proc field
...I $$WP^INHSYSUT(%FLNM,%FLDNM) D WORD^INHSYS05(%NBFR,%ROOT,%IEN,%NODE,0) Q
...;If multiple
...I $P($P(^DD(%FLNM,%FLDNM,0),U,4),";",2)=0 D MULT(%ROOT,%IEN,%FLNM,%FLDNM,%NBFR,.INSV) Q
...;all other fields
...S %PIECE=$P($P(%DD,U,4),";",2)
...S %UTBFR=%NBFR_%FLNM_","_%IEN_","_%NODE_","
...D DATA^INHSYSUT($$RUT^INHSYSUT(%UTBFR),%PIECE,.%DATA)
...I %DATA'="" D FILE^INHSYSUT(%IEN,%DATA,%FLDNM,%ROOT,0) S INSV(%ROOT,%IEN)=""
I $D(INSV) W !,"Re-Indexing files"
S INROOT="",DA=""
F S INROOT=$O(INSV(INROOT)) Q:INROOT="" F S DA=$O(INSV(INROOT,DA)) Q:DA="" D
.S DIK=INROOT D IX^DIK
W !,"Pass 3 Done!"
Q
MULT(%ROOT,DA,%FLNM,%FLDNM,%NBFR,INSV) ;
; Input:
; %ROOT - Root node of global to stuff
; DA - ien
; %FLNM - Fileman File number
; %FLDNM - Fileman Field number
; %NBFR - Utility global
; INSV - list of files and iens that get updated
N %NODE,%X,%Y
S %NODE=$P($P(^DD(%FLNM,%FLDNM,0),U,4),";")
;S %X=%NBFR_%FLNM_","_DA_","_%NODE_","
;S %Y=%ROOT_DA_","_%NODE_","
;D %XY^%RCR
S %X=%NBFR_%FLNM_","_DA_","_%NODE_")",%Y=%ROOT_DA_","_%NODE_")"
M @%Y=@%X
S INSV(%ROOT,DA)=""
Q
WORD ;
Q
DUPCK ;Duplicate cross "B" Cross reference checker"
N INA,INB,INFOUND,INFST
F %ROOT="^INRHT(","^INRHD(","^INRHS(","^INTHPC(","^INTHL7M(","^INTHL7S(","^INTHL7F(","^INVD(","^INTHL7FT(" D
.S INA=""
.F S INA=$O(@(%ROOT_"""B"","""_INA_""")")) Q:INA="" D
..S INFOUND=0,INFST=""
..S INB="" F S INB=$O(@(%ROOT_"""B"","""_INA_""","""_INB_""")")) Q:INB="" D
...I INFOUND D
....W !!,"Duplicate ""B"" CROSS REFERENCE "_%ROOT_"""B"""_","_""""_INA_""""_","_""""_INFST_""""_")"
....W !,"Duplicate ""B"" CROSS REFERENCE "_%ROOT_"""B"""_","_""""_INA_""""_","_""""_INB_""""_")"
...S INFST=INB,INFOUND=1
Q
PASS4 ;Recompile entries from interface script file
N INIEN,SCR,INX
S %PASS=4
W !,"Recompiling Scripts - Pass 4"
S INIEN=0 F S INIEN=$O(^UTILITY("INHSYS",$J,4006,INIEN)) Q:'INIEN D
.S INX=$P(^UTILITY("INHSYS",$J,4006,INIEN,0),U) Q:INX=""
.S SCR=$O(^INRHS("B",INX,"")) Q:SCR=""
.D EN^INHSZ
W !,"Pass 4 complete!"
Q
INHSYS06 ;JPD; 26 Oct 95 14:49;gis sys con data installation utility
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
PASS3 ;Pass 3 Update with old selected existing fields
+1 NEW %FLNM,%FLDNM,%IEN,%ROOT,%NBFR,%PIECE,%DD,%NODE,%UTBFR,INSV,INROOT
+2 NEW %SAV
+3 SET %PASS=3
+4 DO SAVE^INHSYSUT(.%SAV)
+5 SET %NBFR="^UTILITY(""INHSYSUT"","_$JOB_","
+6 SET %FLNM=""
FOR
SET %FLNM=$ORDER(%SAV(%FLNM))
IF %FLNM=""
QUIT
Begin DoDot:1
+7 SET %ROOT=^DIC($$UP^INHSYSUT(%FLNM),0,"GL")
+8 SET %FLDNM=""
FOR
SET %FLDNM=$ORDER(%SAV(%FLNM,%FLDNM))
IF %FLDNM=""
QUIT
Begin DoDot:2
+9 SET %IEN=""
+10 FOR
SET %IEN=$ORDER(^UTILITY("INHSYSUT",$JOB,%FLNM,%IEN))
IF %IEN=""
QUIT
Begin DoDot:3
+11 IF '$DATA(@(%ROOT_%IEN_",0)"))
WRITE !,"error, file entry"_%ROOT_%IEN_" and data does not exist!"
QUIT
+12 IF '$DATA(^DD(%FLNM,%FLDNM))
WRITE !,"Note.. field not in Data Dictionary. File "_%FLNM_" Field "_%FLDNM,!," Entry ",$PIECE(@(%ROOT_%IEN_",0)"),U)_" may be missing data."
QUIT
+13 SET %DD=^DD(%FLNM,%FLDNM,0)
SET %NODE=$PIECE($PIECE(%DD,U,4),";")
+14 ;If word proc field
+15 IF $$WP^INHSYSUT(%FLNM,%FLDNM)
DO WORD^INHSYS05(%NBFR,%ROOT,%IEN,%NODE,0)
QUIT
+16 ;If multiple
+17 IF $PIECE($PIECE(^DD(%FLNM,%FLDNM,0),U,4),";",2)=0
DO MULT(%ROOT,%IEN,%FLNM,%FLDNM,%NBFR,.INSV)
QUIT
+18 ;all other fields
+19 SET %PIECE=$PIECE($PIECE(%DD,U,4),";",2)
+20 SET %UTBFR=%NBFR_%FLNM_","_%IEN_","_%NODE_","
+21 DO DATA^INHSYSUT($$RUT^INHSYSUT(%UTBFR),%PIECE,.%DATA)
+22 IF %DATA'=""
DO FILE^INHSYSUT(%IEN,%DATA,%FLDNM,%ROOT,0)
SET INSV(%ROOT,%IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF $DATA(INSV)
WRITE !,"Re-Indexing files"
+24 SET INROOT=""
SET DA=""
+25 FOR
SET INROOT=$ORDER(INSV(INROOT))
IF INROOT=""
QUIT
FOR
SET DA=$ORDER(INSV(INROOT,DA))
IF DA=""
QUIT
Begin DoDot:1
+26 SET DIK=INROOT
DO IX^DIK
End DoDot:1
+27 WRITE !,"Pass 3 Done!"
+28 QUIT
MULT(%ROOT,DA,%FLNM,%FLDNM,%NBFR,INSV) ;
+1 ; Input:
+2 ; %ROOT - Root node of global to stuff
+3 ; DA - ien
+4 ; %FLNM - Fileman File number
+5 ; %FLDNM - Fileman Field number
+6 ; %NBFR - Utility global
+7 ; INSV - list of files and iens that get updated
+8 NEW %NODE,%X,%Y
+9 SET %NODE=$PIECE($PIECE(^DD(%FLNM,%FLDNM,0),U,4),";")
+10 ;S %X=%NBFR_%FLNM_","_DA_","_%NODE_","
+11 ;S %Y=%ROOT_DA_","_%NODE_","
+12 ;D %XY^%RCR
+13 SET %X=%NBFR_%FLNM_","_DA_","_%NODE_")"
SET %Y=%ROOT_DA_","_%NODE_")"
+14 MERGE @%Y=@%X
+15 SET INSV(%ROOT,DA)=""
+16 QUIT
WORD ;
+1 QUIT
DUPCK ;Duplicate cross "B" Cross reference checker"
+1 NEW INA,INB,INFOUND,INFST
+2 FOR %ROOT="^INRHT(","^INRHD(","^INRHS(","^INTHPC(","^INTHL7M(","^INTHL7S(","^INTHL7F(","^INVD(","^INTHL7FT("
Begin DoDot:1
+3 SET INA=""
+4 FOR
SET INA=$ORDER(@(%ROOT_"""B"","""_INA_""")"))
IF INA=""
QUIT
Begin DoDot:2
+5 SET INFOUND=0
SET INFST=""
+6 SET INB=""
FOR
SET INB=$ORDER(@(%ROOT_"""B"","""_INA_""","""_INB_""")"))
IF INB=""
QUIT
Begin DoDot:3
+7 IF INFOUND
Begin DoDot:4
+8 WRITE !!,"Duplicate ""B"" CROSS REFERENCE "_%ROOT_"""B"""_","_""""_INA_""""_","_""""_INFST_""""_")"
+9 WRITE !,"Duplicate ""B"" CROSS REFERENCE "_%ROOT_"""B"""_","_""""_INA_""""_","_""""_INB_""""_")"
End DoDot:4
+10 SET INFST=INB
SET INFOUND=1
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
PASS4 ;Recompile entries from interface script file
+1 NEW INIEN,SCR,INX
+2 SET %PASS=4
+3 WRITE !,"Recompiling Scripts - Pass 4"
+4 SET INIEN=0
FOR
SET INIEN=$ORDER(^UTILITY("INHSYS",$JOB,4006,INIEN))
IF 'INIEN
QUIT
Begin DoDot:1
+5 SET INX=$PIECE(^UTILITY("INHSYS",$JOB,4006,INIEN,0),U)
IF INX=""
QUIT
+6 SET SCR=$ORDER(^INRHS("B",INX,""))
IF SCR=""
QUIT
+7 DO EN^INHSZ
End DoDot:1
+8 WRITE !,"Pass 4 complete!"
+9 QUIT
