INHSYSUT ;JPD/WOM; 23 Aug 1999 12:26;gis sys con data installation utility
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 5; 6-OCT-1997
;COPYRIGHT 1994 SAIC
Q
;
MSG(%X,%FNUM,%MSG,%MULT,%PASS) ;Display message if DIC lookup failed
; Input:
; %X - Entry we tried to look up Using DIC
; %FNUM - File number
; %MULT - 0 Not a multiple
; 1 Multiple
; Output:
; %MSG - 1 - Flag We have a message
N %TP,QT
S %TP="File",%MULT=$G(%MULT),QT=$C(34)
I %MULT S %TP="Multiple"
D PG^INHSYS03(%PASS)
W !!,%TP_" entry "_QT_$P(%X,U)_QT_" does not exist for "_%TP_" "_%FNUM,!,"or is a duplicate entry!",!
I %MULT W "If entry is a pointer, it will have to be entered by hand",!
S %MSG=1
Q
RQ(%RQ) ;Required fields
;output: %RQ - Required fields array
N I
F I=4000,4005,4006,4004,4011,4010,4012,4090.2,4020 S %RQ(I,.01)=""
F I=.02,.04,.08 S %RQ(4000,I)=""
Q
OMT(%OMT) ;fields to omit from updating
;Output:
; %OMT - Fields to omit
; If a file/field is found in this array, it will not
; be updated in Pass 2
;
N I
F I=.01 S %OMT(4005.01,I)=""
F I=1,.01 S %OMT(4005.02,I)=""
F I=3.01,1,5,7.01,7.03,9 S %OMT(4005,I)=""
F I=.03,7.02,7.04,7.05 S %OMT(4004,I)=""
Q
SAVE(%SAV) ;Save values from import environment
; Output:
; %SAV - File and field to save value from
; Files/fields to restore the site specific data
;
; Programmers note:
; The DEVICE field (.03) in the BACKGROUND PROCESS CONTROL (4004)
; was originally part of the %SAV array. This field was
; omitted for two reasons. First, the field should no longer be
; used by the GIS. Secondly, the field has an input transform that
; causes the ^DIE call at tag FILE^INHSYSUT to ask for user input
; if the string being stuffed is found in more than one entry.
; This file/field should not be removed from array %OMT. The value
; of this field will be NULL after running the GIS Transaction
; Mover.
;
N I
F I=.05 S %SAV(4000,I)=""
F I=.02,5,6,7.02,7.04,7.05,1.01,1.2,1.3,1.4,1.5,1.6,1.8,1.9,1.1,1.11,1.12,1.14,10.01,10.02 S %SAV(4004,I)=""
F I=3.01,1,5,7.01,7.02,7.03,9 S %SAV(4005,I)=""
Q
FLSV(%XRF,%OIEN,%ROOT) ;Save old file in temp global
; Input
; %XRF - File number
; %OIEN - ien of file saving
; %ROOT - Root file name
N %X,%Y
S %X=%ROOT_%OIEN_")",%Y="^UTILITY(""INHSYSUT"",$J,%XRF,%OIEN)"
M @%Y=@%X
;S %X=%ROOT_%OIEN_",",%Y="^UTILITY(""INHSYSUT"",$J,%XRF,%OIEN,"
;D %XY^%RCR
Q
LIST(INSELTT) ;selectable list of parent and child transaction types
;output:
; INSELTT --> array of selected transaction types
;local:
; INPAR --> parent TT
; INCHLD --> child TT
;
;Note: Does not put TT in INSELTT if the UNIQUE IDENTIFIER is
; blank
N INPAR,DWLRF,DWLB,DWL,DWLMK,DWLR,DWLMK1,INTT,I,INS,INIEN
S INPAR="",I=0 F S INPAR=$O(^INRHT("B",INPAR)) Q:INPAR="" D
.S INIEN=$O(^INRHT("B",INPAR,"")) Q:$P(^INRHT(INIEN,0),"^",4)=""
.S I=I+1,INTT(1,I)=INPAR,INTT(1,I,0)=INIEN_"^c",INTT(2,I)="Child"
.I $D(^INRHT("AC",INIEN)) S INTT(1,I,0)=INIEN_"^p",INTT(2,I)="Parent"
S DWLRF="INTT",DWLB="2^5^12^60^8",DWL="HEL0,20F1WXXM-1A2"
S DWL("TITLE")="D HDR^INHSYSUT"
F D ^DWL Q:DWLR'="E" D EXPAND^INHSYSUT
I " ^ ^^ "[(" "_DWLR_" ")!'$D(DWLMK) S INSELTT=0 Q
S INS="" F I=1:1 S INS=$O(DWLMK(1,INS)) Q:'INS D
.S INSELTT=I,INSELTT(DWLMK(1,INS))=INTT(1,INS,0)_"^"_$$LB^UTIL(INTT(1,INS))
Q
HDR ;header for list processor
X DIJC("H")
W $$SETXY^%ZTF(0,4),$$CENTER^INHUTIL("Transaction Type List",80)
W $$SETXY^%ZTF(0,18),"Use <FIND> Key to find desired Transaction."
W $$SETXY^%ZTF(0,19),"Use <SELECT> Key to pick a Transaction Type to process"
X DIJC("L")
Q
LOCKFL(INLKFLS,INEX) ;Lock files that will be used and check for zero node
; Input: INEX - if TRUE, then this is called during
; IMPORT so only lock those files affected
; Output:
; INLKFLS - Locked files
; Returns 0 to continue 1 to quit
I $D(IO)#10,$D(IO(0))#10 I IO'=IO(0) U IO(0)
N %FNUM,%LFLG,%ROOT,%FILES,AA
S %LFLG=0 S:'$D(INEX) INEX=0
D XRF(.%FILES)
F AA=1:1 S %FNUM=$P(%FILES,U,AA) Q:%FNUM="" D Q:INPOP
.I INEX,'$D(^UTILITY("INHSYS",$J,%FNUM)) Q
.S %ROOT=$P(^DIC(%FNUM,0,"GL"),"(")
.I '$$LOCK(%ROOT,%FNUM) S (%LFLG,INPOP)=1
.S INLKFLS(%ROOT)=%FNUM
.S %ROOT=^DIC(%FNUM,0,"GL")_"0)"
.I $D(@%ROOT)#10'=1 W *7,!,"File Corruption in the "_%FNUM_" file!" S (%LFLG,INPOP)=1
I %LFLG D
.W !!,"You will have to try later",!!!!
.I $$CR^UTSRD(0,IOSL-1)
I $D(IO)#10,$D(IO(0))#10 I IO'=IO(0) U IO
Q %LFLG
LOCK(%ROOT,%FILNM) ;Lock other users from this file
; %ROOT - Global file node to lock
; %FILNM - File Name
N INLOK S INLOK=1
L +@%ROOT:3
E S INLOK=0 W *7,!,"Another terminal is editing the "_%FILNM_" file!"
Q INLOK
UNLK(%FILE) ;Unlock file
N I F I=1:1:3 L -@%FILE
Q
RPRT1(%LEVEL,%FILNM,ND) ;Do report
; Input:
; %LEVEL - Level of pointer
; %FILNM - File Number
; ND - Node
N I
D PG^INHSYS03(1)
W ! F I=1:1:%LEVEL W "."
W ?%LEVEL,%FILNM,?%LEVEL+14,$P($G(^DIC(%FILNM,0)),U),?%LEVEL+42,".01",?%LEVEL+48
I %FILNM'=4020 W $P(@(ND),U)
E W $P($G(^INRHT($P(@(ND),U),0)),U)
W !,?%LEVEL,ND
Q
EXPAND ;Expand logic for list processor
;
N INS,DA,DIC
I '$D(DWLMK) W "SELECT an item to expand on.",*7
E D
.S INS="" S INS=$O(DWLMK(1,INS))
.S DA=+@(DWLRF_"(1,"_INS_",0)"),DIC="^INRHT("
.D EN^DIQ
I $$CR^UTSRD(0,IOSL-1)
Q
FILE(DA,%DATA,%FLDNUM,DIE,INREPRT) ;file data
; Input:
; DA - ien and "Multiple entry"
; %DATA - What to file
; %FLDNUM - Field Number
; DIE - Global to file
; INREPRT - 0 - No report
; 1 - Report
N X,DG,DNM,DQ,DIEZ,D0,D1,D2,D3,D4,D5,D6,D7,INY,FILNUM
;
; Don't stuff data for fields that are site specific except
; on Pass 3
S FILNUM=$P(@(DIE_"0)"),U,2) I %PASS'=3,$D(%SAV(FILNUM,%FLDNUM))!($D(%OMT(FILNUM,%FLDNUM))) Q
I INREPRT=2 W ?70,DIE
I DA'>0 D Q
.W !,"NON-EXISTENT OR DUPLICATE ENTRY! for "_$G(DIE)_" field #"_$G(%FLDNUM)_" Data: "_$G(%DATA)_" %XNODE="_$G(%XNODE)
.D FLSUMERR^INHSYS11(FILNUM,%FLDNUM,DA,$P($G(%XNODE),U),DIE)
S DR="S INY=0;"_%FLDNUM_"///^S X=%DATA;S INY=1"
D ^DIE
I '$G(INY) D
.W ?56," NO DATA FILED for ",DIE," field #",%FLDNUM," Data: ",%DATA
.D FLSUMERR^INHSYS11(FILNUM,%FLDNUM,DA,%DATA,DIE)
Q
DATA(%B,%P,%D) ;retrieve the data from the buffer
;input:
; %B - buffer
; %P - If an integer, uparrow piece to return
; If the first character is "E", then extract data
;output:
; %D - Data
S %D=""
I $E(%P)="E",$D(@%B)#2 S %D=$E(@%B,+$E(%P,2,99),+$P(%P,",",2)) Q
I $D(@%B)#2 S %D=$P(@%B,U,%P)
Q
RUT(%ROOT) ;modify global root to indirection format
;%ROOT - Global root
N Y
;get last value of root,set to all but last value & concact w/ ) or ""
S Y=$E(%ROOT,$L(%ROOT)),Y=$E(%ROOT,1,$L(%ROOT)-1)_$S(Y=",":")",1:"")
Q Y
;
UP(FN) ;goes up & up searching for the top level file number
;input:
; FN - the current sub-level file number
N Y
I '$D(^DD(FN,0,"UP")) S Y=FN
E S Y=$$UP(^("UP"))
Q Y
;
PG(%PASS) ;Page check
; Input:
; %PASS - Which PASS
I IOSL-5'>$Y D
.I $E(IOST)="C",INCR,$$CR^UTSRD(0,IOSL-1)
.D HEAD(%PASS)
Q
HEAD(%PASS) ;header for destination report
; Input:
; %PASS - Which pass is being run
W @IOF
I %PASS=1 W $$CENTER^INHUTIL("Pass 1 Required Fields",80)
I %PASS=2 W $$CENTER^INHUTIL("Pass 2 All Fields",80)
W !!,"File Number",?14,"File Name",?42,"Field Number",?56,"Data"
W !,"^Root(IEN",!
Q
WP(FIL,FLD) ;word process field
;input:
; FIL - file number
; FLD - field number
; Returns 0 false 1 true
N Y
I $P(^DD(FIL,FLD,0),U,2) S Y=$$WP(+$P(^(0),U,2),.01)
Q $P(^(0),U,2)["W"
;
XRF(%FILES) ;cross reference of files and fields requiring some resolution
; Output:
; %FILES(FILE#)=fields
;':' delimiter separates field # and sub-file #
;',' delimiter separates sub-file # and sub-field #
;';' delimiter separates fields
;i.e. field[:sub-file,sub-field,...][;field...] etc.
; Subnodes used at RSLV^INHSYS03
S %FILES="4012^4005^4011^4000^4004^4010^4090.2^4020^4006"
S %FILES(4012)=".02;10:4012.02,.01;50"
S %FILES(4005)=".02;.1"
S %FILES(4011)=".05;1:4011.01,.01,.11;2:4011.02,.01;100;101"
S %FILES(4000)=".02;.03;.06;.09;.17"
S %FILES(4004)=".07"
S %FILES(4010)="1:4010.01,.01"
S %FILES(4090.2)=".02"
S %FILES(4020)=".01;.02"
S %FILES(4006)=".03"
Q
INHSYSUT ;JPD/WOM; 23 Aug 1999 12:26;gis sys con data installation utility
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;CHCS TOOLS_460; GEN 5; 6-OCT-1997
+4 ;COPYRIGHT 1994 SAIC
+5 QUIT
+6 ;
MSG(%X,%FNUM,%MSG,%MULT,%PASS) ;Display message if DIC lookup failed
+1 ; Input:
+2 ; %X - Entry we tried to look up Using DIC
+3 ; %FNUM - File number
+4 ; %MULT - 0 Not a multiple
+5 ; 1 Multiple
+6 ; Output:
+7 ; %MSG - 1 - Flag We have a message
+8 NEW %TP,QT
+9 SET %TP="File"
SET %MULT=$GET(%MULT)
SET QT=$CHAR(34)
+10 IF %MULT
SET %TP="Multiple"
+11 DO PG^INHSYS03(%PASS)
+12 WRITE !!,%TP_" entry "_QT_$PIECE(%X,U)_QT_" does not exist for "_%TP_" "_%FNUM,!,"or is a duplicate entry!",!
+13 IF %MULT
WRITE "If entry is a pointer, it will have to be entered by hand",!
+14 SET %MSG=1
+15 QUIT
RQ(%RQ) ;Required fields
+1 ;output: %RQ - Required fields array
+2 NEW I
+3 FOR I=4000,4005,4006,4004,4011,4010,4012,4090.2,4020
SET %RQ(I,.01)=""
+4 FOR I=.02,.04,.08
SET %RQ(4000,I)=""
+5 QUIT
OMT(%OMT) ;fields to omit from updating
+1 ;Output:
+2 ; %OMT - Fields to omit
+3 ; If a file/field is found in this array, it will not
+4 ; be updated in Pass 2
+5 ;
+6 NEW I
+7 FOR I=.01
SET %OMT(4005.01,I)=""
+8 FOR I=1,.01
SET %OMT(4005.02,I)=""
+9 FOR I=3.01,1,5,7.01,7.03,9
SET %OMT(4005,I)=""
+10 FOR I=.03,7.02,7.04,7.05
SET %OMT(4004,I)=""
+11 QUIT
SAVE(%SAV) ;Save values from import environment
+1 ; Output:
+2 ; %SAV - File and field to save value from
+3 ; Files/fields to restore the site specific data
+4 ;
+5 ; Programmers note:
+6 ; The DEVICE field (.03) in the BACKGROUND PROCESS CONTROL (4004)
+7 ; was originally part of the %SAV array. This field was
+8 ; omitted for two reasons. First, the field should no longer be
+9 ; used by the GIS. Secondly, the field has an input transform that
+10 ; causes the ^DIE call at tag FILE^INHSYSUT to ask for user input
+11 ; if the string being stuffed is found in more than one entry.
+12 ; This file/field should not be removed from array %OMT. The value
+13 ; of this field will be NULL after running the GIS Transaction
+14 ; Mover.
+15 ;
+16 NEW I
+17 FOR I=.05
SET %SAV(4000,I)=""
+18 FOR I=.02,5,6,7.02,7.04,7.05,1.01,1.2,1.3,1.4,1.5,1.6,1.8,1.9,1.1,1.11,1.12,1.14,10.01,10.02
SET %SAV(4004,I)=""
+19 FOR I=3.01,1,5,7.01,7.02,7.03,9
SET %SAV(4005,I)=""
+20 QUIT
FLSV(%XRF,%OIEN,%ROOT) ;Save old file in temp global
+1 ; Input
+2 ; %XRF - File number
+3 ; %OIEN - ien of file saving
+4 ; %ROOT - Root file name
+5 NEW %X,%Y
+6 SET %X=%ROOT_%OIEN_")"
SET %Y="^UTILITY(""INHSYSUT"",$J,%XRF,%OIEN)"
+7 MERGE @%Y=@%X
+8 ;S %X=%ROOT_%OIEN_",",%Y="^UTILITY(""INHSYSUT"",$J,%XRF,%OIEN,"
+9 ;D %XY^%RCR
+10 QUIT
LIST(INSELTT) ;selectable list of parent and child transaction types
+1 ;output:
+2 ; INSELTT --> array of selected transaction types
+3 ;local:
+4 ; INPAR --> parent TT
+5 ; INCHLD --> child TT
+6 ;
+7 ;Note: Does not put TT in INSELTT if the UNIQUE IDENTIFIER is
+8 ; blank
+9 NEW INPAR,DWLRF,DWLB,DWL,DWLMK,DWLR,DWLMK1,INTT,I,INS,INIEN
+10 SET INPAR=""
SET I=0
FOR
SET INPAR=$ORDER(^INRHT("B",INPAR))
IF INPAR=""
QUIT
Begin DoDot:1
+11 SET INIEN=$ORDER(^INRHT("B",INPAR,""))
IF $PIECE(^INRHT(INIEN,0),"^",4)=""
QUIT
+12 SET I=I+1
SET INTT(1,I)=INPAR
SET INTT(1,I,0)=INIEN_"^c"
SET INTT(2,I)="Child"
+13 IF $DATA(^INRHT("AC",INIEN))
SET INTT(1,I,0)=INIEN_"^p"
SET INTT(2,I)="Parent"
End DoDot:1
+14 SET DWLRF="INTT"
SET DWLB="2^5^12^60^8"
SET DWL="HEL0,20F1WXXM-1A2"
+15 SET DWL("TITLE")="D HDR^INHSYSUT"
+16 FOR
DO ^DWL
IF DWLR'="E"
QUIT
DO EXPAND^INHSYSUT
+17 IF " ^ ^^ "[(" "_DWLR_" ")!'$DATA(DWLMK)
SET INSELTT=0
QUIT
+18 SET INS=""
FOR I=1:1
SET INS=$ORDER(DWLMK(1,INS))
IF 'INS
QUIT
Begin DoDot:1
+19 SET INSELTT=I
SET INSELTT(DWLMK(1,INS))=INTT(1,INS,0)_"^"_$$LB^UTIL(INTT(1,INS))
End DoDot:1
+20 QUIT
HDR ;header for list processor
+1 XECUTE DIJC("H")
+2 WRITE $$SETXY^%ZTF(0,4),$$CENTER^INHUTIL("Transaction Type List",80)
+3 WRITE $$SETXY^%ZTF(0,18),"Use <FIND> Key to find desired Transaction."
+4 WRITE $$SETXY^%ZTF(0,19),"Use <SELECT> Key to pick a Transaction Type to process"
+5 XECUTE DIJC("L")
+6 QUIT
LOCKFL(INLKFLS,INEX) ;Lock files that will be used and check for zero node
+1 ; Input: INEX - if TRUE, then this is called during
+2 ; IMPORT so only lock those files affected
+3 ; Output:
+4 ; INLKFLS - Locked files
+5 ; Returns 0 to continue 1 to quit
+6 IF $DATA(IO)#10
IF $DATA(IO(0))#10
IF IO'=IO(0)
USE IO(0)
+7 NEW %FNUM,%LFLG,%ROOT,%FILES,AA
+8 SET %LFLG=0
IF '$DATA(INEX)
SET INEX=0
+9 DO XRF(.%FILES)
+10 FOR AA=1:1
SET %FNUM=$PIECE(%FILES,U,AA)
IF %FNUM=""
QUIT
Begin DoDot:1
+11 IF INEX
IF '$DATA(^UTILITY("INHSYS",$JOB,%FNUM))
QUIT
+12 SET %ROOT=$PIECE(^DIC(%FNUM,0,"GL"),"(")
+13 IF '$$LOCK(%ROOT,%FNUM)
SET (%LFLG,INPOP)=1
+14 SET INLKFLS(%ROOT)=%FNUM
+15 SET %ROOT=^DIC(%FNUM,0,"GL")_"0)"
+16 IF $DATA(@%ROOT)#10'=1
WRITE *7,!,"File Corruption in the "_%FNUM_" file!"
SET (%LFLG,INPOP)=1
End DoDot:1
IF INPOP
QUIT
+17 IF %LFLG
Begin DoDot:1
+18 WRITE !!,"You will have to try later",!!!!
+19 IF $$CR^UTSRD(0,IOSL-1)
End DoDot:1
+20 IF $DATA(IO)#10
IF $DATA(IO(0))#10
IF IO'=IO(0)
USE IO
+21 QUIT %LFLG
LOCK(%ROOT,%FILNM) ;Lock other users from this file
+1 ; %ROOT - Global file node to lock
+2 ; %FILNM - File Name
+3 NEW INLOK
SET INLOK=1
+4 LOCK +@%ROOT:3
+5 IF '$TEST
SET INLOK=0
WRITE *7,!,"Another terminal is editing the "_%FILNM_" file!"
+6 QUIT INLOK
UNLK(%FILE) ;Unlock file
+1 NEW I
FOR I=1:1:3
LOCK -@%FILE
+2 QUIT
RPRT1(%LEVEL,%FILNM,ND) ;Do report
+1 ; Input:
+2 ; %LEVEL - Level of pointer
+3 ; %FILNM - File Number
+4 ; ND - Node
+5 NEW I
+6 DO PG^INHSYS03(1)
+7 WRITE !
FOR I=1:1:%LEVEL
WRITE "."
+8 WRITE ?%LEVEL,%FILNM,?%LEVEL+14,$PIECE($GET(^DIC(%FILNM,0)),U),?%LEVEL+42,".01",?%LEVEL+48
+9 IF %FILNM'=4020
WRITE $PIECE(@(ND),U)
+10 IF '$TEST
WRITE $PIECE($GET(^INRHT($PIECE(@(ND),U),0)),U)
+11 WRITE !,?%LEVEL,ND
+12 QUIT
EXPAND ;Expand logic for list processor
+1 ;
+2 NEW INS,DA,DIC
+3 IF '$DATA(DWLMK)
WRITE "SELECT an item to expand on.",*7
+4 IF '$TEST
Begin DoDot:1
+5 SET INS=""
SET INS=$ORDER(DWLMK(1,INS))
+6 SET DA=+@(DWLRF_"(1,"_INS_",0)")
SET DIC="^INRHT("
+7 DO EN^DIQ
End DoDot:1
+8 IF $$CR^UTSRD(0,IOSL-1)
+9 QUIT
FILE(DA,%DATA,%FLDNUM,DIE,INREPRT) ;file data
+1 ; Input:
+2 ; DA - ien and "Multiple entry"
+3 ; %DATA - What to file
+4 ; %FLDNUM - Field Number
+5 ; DIE - Global to file
+6 ; INREPRT - 0 - No report
+7 ; 1 - Report
+8 NEW X,DG,DNM,DQ,DIEZ,D0,D1,D2,D3,D4,D5,D6,D7,INY,FILNUM
+9 ;
+10 ; Don't stuff data for fields that are site specific except
+11 ; on Pass 3
+12 SET FILNUM=$PIECE(@(DIE_"0)"),U,2)
IF %PASS'=3
IF $DATA(%SAV(FILNUM,%FLDNUM))!($DATA(%OMT(FILNUM,%FLDNUM)))
QUIT
+13 IF INREPRT=2
WRITE ?70,DIE
+14 IF DA'>0
Begin DoDot:1
+15 WRITE !,"NON-EXISTENT OR DUPLICATE ENTRY! for "_$GET(DIE)_" field #"_$GET(%FLDNUM)_" Data: "_$GET(%DATA)_" %XNODE="_$GET(%XNODE)
+16 DO FLSUMERR^INHSYS11(FILNUM,%FLDNUM,DA,$PIECE($GET(%XNODE),U),DIE)
End DoDot:1
QUIT
+17 SET DR="S INY=0;"_%FLDNUM_"///^S X=%DATA;S INY=1"
+18 DO ^DIE
+19 IF '$GET(INY)
Begin DoDot:1
+20 WRITE ?56," NO DATA FILED for ",DIE," field #",%FLDNUM," Data: ",%DATA
+21 DO FLSUMERR^INHSYS11(FILNUM,%FLDNUM,DA,%DATA,DIE)
End DoDot:1
+22 QUIT
DATA(%B,%P,%D) ;retrieve the data from the buffer
+1 ;input:
+2 ; %B - buffer
+3 ; %P - If an integer, uparrow piece to return
+4 ; If the first character is "E", then extract data
+5 ;output:
+6 ; %D - Data
+7 SET %D=""
+8 IF $EXTRACT(%P)="E"
IF $DATA(@%B)#2
SET %D=$EXTRACT(@%B,+$EXTRACT(%P,2,99),+$PIECE(%P,",",2))
QUIT
+9 IF $DATA(@%B)#2
SET %D=$PIECE(@%B,U,%P)
+10 QUIT
RUT(%ROOT) ;modify global root to indirection format
+1 ;%ROOT - Global root
+2 NEW Y
+3 ;get last value of root,set to all but last value & concact w/ ) or ""
+4 SET Y=$EXTRACT(%ROOT,$LENGTH(%ROOT))
SET Y=$EXTRACT(%ROOT,1,$LENGTH(%ROOT)-1)_$SELECT(Y=",":")",1:"")
+5 QUIT Y
+6 ;
UP(FN) ;goes up & up searching for the top level file number
+1 ;input:
+2 ; FN - the current sub-level file number
+3 NEW Y
+4 IF '$DATA(^DD(FN,0,"UP"))
SET Y=FN
+5 IF '$TEST
SET Y=$$UP(^("UP"))
+6 QUIT Y
+7 ;
PG(%PASS) ;Page check
+1 ; Input:
+2 ; %PASS - Which PASS
+3 IF IOSL-5'>$Y
Begin DoDot:1
+4 IF $EXTRACT(IOST)="C"
IF INCR
IF $$CR^UTSRD(0,IOSL-1)
+5 DO HEAD(%PASS)
End DoDot:1
+6 QUIT
HEAD(%PASS) ;header for destination report
+1 ; Input:
+2 ; %PASS - Which pass is being run
+3 WRITE @IOF
+4 IF %PASS=1
WRITE $$CENTER^INHUTIL("Pass 1 Required Fields",80)
+5 IF %PASS=2
WRITE $$CENTER^INHUTIL("Pass 2 All Fields",80)
+6 WRITE !!,"File Number",?14,"File Name",?42,"Field Number",?56,"Data"
+7 WRITE !,"^Root(IEN",!
+8 QUIT
WP(FIL,FLD) ;word process field
+1 ;input:
+2 ; FIL - file number
+3 ; FLD - field number
+4 ; Returns 0 false 1 true
+5 NEW Y
+6 IF $PIECE(^DD(FIL,FLD,0),U,2)
SET Y=$$WP(+$PIECE(^(0),U,2),.01)
+7 QUIT $PIECE(^(0),U,2)["W"
+8 ;
XRF(%FILES) ;cross reference of files and fields requiring some resolution
+1 ; Output:
+2 ; %FILES(FILE#)=fields
+3 ;':' delimiter separates field # and sub-file #
+4 ;',' delimiter separates sub-file # and sub-field #
+5 ;';' delimiter separates fields
+6 ;i.e. field[:sub-file,sub-field,...][;field...] etc.
+7 ; Subnodes used at RSLV^INHSYS03
+8 SET %FILES="4012^4005^4011^4000^4004^4010^4090.2^4020^4006"
+9 SET %FILES(4012)=".02;10:4012.02,.01;50"
+10 SET %FILES(4005)=".02;.1"
+11 SET %FILES(4011)=".05;1:4011.01,.01,.11;2:4011.02,.01;100;101"
+12 SET %FILES(4000)=".02;.03;.06;.09;.17"
+13 SET %FILES(4004)=".07"
+14 SET %FILES(4010)="1:4010.01,.01"
+15 SET %FILES(4090.2)=".02"
+16 SET %FILES(4020)=".01;.02"
+17 SET %FILES(4006)=".03"
+18 QUIT
