- 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
