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