INHSYSE ;JPD;3 Sep 96;Save single file entries
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 5; 14-APR-1997
;COPYRIGHT 1996 SAIC
Q
EN ;Entry point for single element mover
N INPOP,INRTN,INROU K ^UTILITY($J)
S INPOP=0
S INRTN=$$READ
Q:INRTN=""
D START^INHSYS09
Q:'$D(^UTILITY($J))
D RTNBFR(INRTN,.INROU)
D NTRNL^INHSYS04(.INROU,$E($O(INROU(""),-1),1,6)_"W")
Q
RTNBFR(%TT,INROU) ;routine buffer/builder machine
;input:
; %TT --> (required) Routine name to store data in
;output:
; INROU --> array of compiled routines in the IB* name-space.
; format: INROU(routine name)=""
;local:
; %RTN --> routine root name to build
; %NODE --> global node result of $Q
; %DATA --> string of data
; INMAX --> maximum allowable routine source size
; INOS --> operating system ien
; INZI --> code to insert line into the routine directory
; %ODD --> odd numbered offset
; %EVEN --> even numbered offset
;
N %CC,%LC,INMAX,INOS,INZI,%RTN,%NODE,%DATA,%T,%RTNBFR,%ODD,%EVEN,%RC
K ^UTILITY($J,0)
S INMAX=^DD("ROU"),INOS=^("OS"),INZI=^("OS",INOS,"ZS")
S %CC=INMAX*2,%LC=0,%RC="00",%NODE="^UTILITY($J)"
S %RTN="IB"_$E(%TT,1,4)
S %RTNBFR="^UTILITY(""""INHSYS"""","
F S %NODE=$Q(@%NODE) Q:$QS(%NODE,1)'=$J D
.S %DATA=@%NODE
.I %CC+$L(%DATA)+$L(%NODE)'<INMAX D NEWR^INHSYS04
.D LN^INHSYS04(" ;;"_%NODE,.%CC,.%LC)
.D LN^INHSYS04(" ;;"_%DATA,.%CC,.%LC)
I $O(^UTILITY($J,0,0)) D
.D LN^INHSYS04(" Q",.%CC,.%LC) S X=%RTN_$S($L(%RC)=1:"0"_%RC,1:%RC) X INZI W !,X_" filed." S INROU(X)=""
.K ^UTILITY($J,0)
K ^UTILITY($J)
Q
READ(INX) ;read 4 characters
S INX=$G(INX)
I INX="" S INX="Enter last 4 character of sir for routine name: "
F D Q:'$$CHECK
.S INRTN=$$READ^%ZTF(1,4,INX,"",13)
Q INRTN
CHECK() ;check validity of 4 characters
N INLN
I INRTN="^" S INRTN="" Q 0
Q:INRTN="" 0
S INLN=$L(INRTN)
I INLN,INLN<4 W !,"You must enter EXACTLY 4 characters",! Q 1
I $D(^INRHT("ID",INRTN)) D Q 1
.W !,"The 4 characters you chose are the same as a unique ID"
.W !,"Choose different characters",!
I $F(INRTN," ") W !,"Name cannot have spaces",! Q 1
Q 0
RESTORE(%DRVR) ;Restore data from any element
;Loop through PASS1 and PASS2
N %PASS,%LFILES,AA,%SAV,DFN,INMSG
D ENV^UTIL,^%ZIST
S INREPRT=+$G(INREPRT)
K ^UTILITY($J),^UTILITY("INHSYS",$J),^UTILITY("INHSYSUT",$J)
D EN^@%DRVR
I $D(^UTILITY("INHSYS")) F %PASS=1:1:2 D INST(%DRVR,.%PASS,INREPRT,.INFLD,.INMSG)
I $D(INMSG) D COMP(.INMSG)
;Clean up ^UTILITY/Remove IB routines
K ^UTILITY($J),^UTILITY("INHSYS",$J),^UTILITY("INHSYSUT",$J)
W !!,"File transfer completed."
Q
INST(%DRVR,%PASS,INREPRT,INFLD,INMSG) ;installation utility entry pnt
;input:
; %DRVR - Internal installation driver routine
; %PASS - 0 or null - display report only
; 1 - save off old files - create required fields
; 2 - populate rest of file
; INREPRT - 0 or null - off 1 - on
; INFLD - Array of 4012 Script Generator Field entries
;Output:
; INMSG - Array of GIS entries
;local:
; %LINE - file information stored in ";;" comment form
; %FNUM - file number
; %ROOT - global root
;
N B,%FNUM,%FLDS,%ROOT,%OIEN,%XNODE,%UNQ,Y,DA,%FILES,AA,%SAV
N DIC,X,DLAYGO,QT,I,%RQ,%MSG,%MSG2,%OMT,%FILES,%DIC0,%GLB,INPOP,INFLD
D ENV^UTIL
S INREPRT=$G(INREPRT),%PASS=$G(%PASS),(%MSG,%MSG2)=0,INPOP=0,INCR=1
S INFLG=$G(INFLG)
I '%PASS D EN^@%DRVR
I INREPRT U IO D HEAD^INHSYSUT(%PASS)
S QT=$C(34)
S %FNUM="" F S %FNUM=$O(^UTILITY("INHSYS",$J,%FNUM)) Q:%FNUM="" D
.;get root name of file
.S %ROOT=$G(^DIC(%FNUM,0,"GL")),%DIC0="X"
.I %ROOT="" W !,"Note .. DD file "_%FNUM_" is missing." Q
.I %PASS S %DIC0="LX"
.;loop thru utility using cross reference to get ien
.S %OIEN="" F S %OIEN=$O(^UTILITY("INHSYS",$J,%FNUM,%OIEN)) Q:'%OIEN D
..N DA,DINUM
..S %XNODE=$G(^UTILITY("INHSYS",$J,%FNUM,%OIEN,0))
..I %XNODE="" Q
..S Y=0
..;Universal Interface custom
..I %FNUM=4001 S Y=$O(^INTHU("C",$P(%XNODE,U,5),""))
..;not criteria file
..I %FNUM'="4001.1",'Y S Y=$$DIC^INHSYS05(%ROOT,$P(%XNODE,U),%FNUM,%DIC0) D:Y<0 MSG^INHSYSUT(%XNODE,%FNUM,.%MSG,0,%PASS)
..;Criteria file custom code
..I %FNUM="4001.1" D
...N INOPT
...S INOPT("TYPE")="TEST"
...S (DIPA("DA"),Y)=$$NEW^INHUTC1(.INOPT,"U")
...I Y<0 W !,"ERROR - UNABLE TO CREATE NEW CRITERIA" Q
..;patient file
..I %FNUM=2,%PASS=1 S DFN=+Y
..;Files that require message to recompile
..I %FNUM=4012!(%FNUM=4010)!(%FNUM=4012.1)!(%FNUM=4011) S INMSG(%FNUM,+Y)=$P(Y,U,2)
..I INREPRT,Y>0 D PG^INHSYSUT(%PASS) W !,%FNUM,?14,$P($G(^DIC(%FNUM,0)),U),?42
..;Save ien Kill off node
..I %PASS=1,+Y>0 D I +Y<0 D MSG^INHSYSUT(%XNODE,%FNUM,.%MSG,0,%PASS) Q
...S DINUM=+Y,DIK=%ROOT,DA=+Y D ^DIK
...;create stub node
...S Y=$$DIC^INHSYS05(%ROOT,$P(%XNODE,U),%FNUM,%DIC0,"","",.DINUM)
..S DA=+Y
..I INREPRT,Y>0 D
...W:%PASS'=1 ?42,".01",?56
...W:%PASS'=1 $P(Y,U,2)
...W !,%ROOT_DA I '%PASS W !
..I INREPRT,Y'>0,%PASS=1 W ?42,".01"
..I '%PASS,Y>0 D CMP^INHSYS07(+Y,%ROOT,%FNUM,%OIEN,1)
..I %PASS D STUFF^INHSYS05(Y,%FNUM,%ROOT,"^UTILITY(""INHSYS"","_$J_","_QT_%FNUM_QT_","_%OIEN_",",1,DA,%PASS,.%MSG2,INREPRT)
I INREPRT,%MSG2 D PG^INHSYSUT(%PASS) W !,"*** Denotes ommitted, and not filed in system."
I INREPRT D PG^INHSYSUT(%PASS) W !!,"Pass "_%PASS_" Done! "
I INREPRT,%PASS=1,$E(IOST)="C",INCR,$$CR^UTSRD(0,IOSL-1)
Q
;
PKG(CLASS,RTN) ;Create package of routines in VMS flat file
; Input:
; CLASS - name of flat file that stores saved routines
; RTN - Name of beginning routine name to store in sequence
; in the flat file.
N %RTN K ^UTILITY($J)
D ENV^UTIL
S %RTN=RTN
D ORDER^INHUT3("^ ","%RTN",RTN,"$E(%RTN,1,$L(RTN))'=RTN","S ^UTILITY($J,%RTN)=""""")
D SAVEROU^INZTTC(CLASS)
Q
UPKG(FNAME) ;replace routine into environment from flat file
; Input:
; FNAME - Flat file name. Should end with .TT extention
D FN^ZCMSLD1(FNAME,0)
Q
COMP(INMSG) ;Compile Script Generator Messages
; Input: INMSG - Array of Script Generator Fields and Segments
; format - INMSG(4010,ien)
; INMSG(4012,ien)
;
N INFL,INIEN,INMS,Y,INGALL
;get messages related to Script Data Types
I $D(INMSG(4012.1)) D GETMSGDT^INHSYSU1(.INMSG,.INMS)
;loop through in order of most likely to occur
F INFL=4012,4010,4011 I $D(INMSG(INFL)) D
.S INIEN="" F S INIEN=$O(INMSG(INFL,INIEN)) Q:INIEN="" D
..;Get Script Generator Messages related to field
..I INFL=4012 D GETMSGF^INHSYSU1(INIEN,.INMS,.INMSG) Q
..;Get Script Generator Messages related to segment
..I INFL=4010 D GETMSGS^INHSYSU1(INIEN,.INMS,.INMSG) Q
..;Get Script Generator Messages from saved message
..I INFL=4011 S INMS(INIEN)=""
;compile Script Generator Messages
S INMS="",INGALL=1 F S (INMS,Y)=$O(INMS(INMS)) Q:'Y D EN^INHSGZ
Q
SV2FLT(INAME,INDONE) ;Save utility stuff to flat file
; Input:
; INAME - Name of flat file
; Output: INDONE 0 did not finish 1 finished
N %NODE,%DATA,$ET,INDATE
S INDONE=0
Q:'$D(^UTILITY($J))
S %NODE="^UTILITY($J)",$ZT="ERR^INHSYSE"
S INAME=$$OPENSEQ^%ZTFS1(INAME,"BW")
I INAME="" W !,"Unable to open file" Q
U INAME
S INDATE=$$CDATASC^%ZTFDT($H,2,1)
W $P(INDATE,"@")_" "_$P(INDATE,"@",2),!,"Interactive Test Utility Save"
F S %NODE=$Q(@%NODE) Q:$QS(%NODE,1)'=$J D
.S %DATA=@%NODE
.W !,%NODE
.W !,%DATA
W !,"**END**",!,"**END**"
I $$CLOSESEQ^%ZTFS1(INAME)
S INDONE=1
Q
RSFRFLT(INAME) ;Restore from flat file
;Input: - INAME - Name of flat file to restore from
N X,N,%RTNBFR,%ODD,%EVEN,%DATIM,%HEAD,$ET
K ^UTILITY("INHSYS",$J)
S %RTNBFR="^UTILITY(""INHSYS"",",$ZE="",$ZT="ERR^INHSYSE"
S INAME=$$OPENSEQ^%ZTFS1(INAME,"RB")
I INAME="" W !,"Unable to open file" Q
U INAME
R %DATIM:0,%HEAD:0
I %HEAD="Interactive Test Utility Save" D
.F R %ODD:0 Q:'$T Q:%ODD="**END**" D
..R %EVEN:0 Q:'$T
..Q:%EVEN="**END**"
..S X=%RTNBFR_$J_","_$P(%ODD,",",2,99)
..S @X=%EVEN
S X=$$CLOSESEQ^%ZTFS1(INAME)
Q
ERR ;if error occurs on save or restore
S X=$$CLOSESEQ^%ZTFS1(INAME),$ZT=""
W !,"An error has ocurred"
Q
INHSYSE ;JPD;3 Sep 96;Save single file entries
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;CHCS TOOLS_460; GEN 5; 14-APR-1997
+4 ;COPYRIGHT 1996 SAIC
+5 QUIT
EN ;Entry point for single element mover
+1 NEW INPOP,INRTN,INROU
KILL ^UTILITY($JOB)
+2 SET INPOP=0
+3 SET INRTN=$$READ
+4 IF INRTN=""
QUIT
+5 DO START^INHSYS09
+6 IF '$DATA(^UTILITY($JOB))
QUIT
+7 DO RTNBFR(INRTN,.INROU)
+8 DO NTRNL^INHSYS04(.INROU,$EXTRACT($ORDER(INROU(""),-1),1,6)_"W")
+9 QUIT
RTNBFR(%TT,INROU) ;routine buffer/builder machine
+1 ;input:
+2 ; %TT --> (required) Routine name to store data in
+3 ;output:
+4 ; INROU --> array of compiled routines in the IB* name-space.
+5 ; format: INROU(routine name)=""
+6 ;local:
+7 ; %RTN --> routine root name to build
+8 ; %NODE --> global node result of $Q
+9 ; %DATA --> string of data
+10 ; INMAX --> maximum allowable routine source size
+11 ; INOS --> operating system ien
+12 ; INZI --> code to insert line into the routine directory
+13 ; %ODD --> odd numbered offset
+14 ; %EVEN --> even numbered offset
+15 ;
+16 NEW %CC,%LC,INMAX,INOS,INZI,%RTN,%NODE,%DATA,%T,%RTNBFR,%ODD,%EVEN,%RC
+17 KILL ^UTILITY($JOB,0)
+18 SET INMAX=^DD("ROU")
SET INOS=^("OS")
SET INZI=^("OS",INOS,"ZS")
+19 SET %CC=INMAX*2
SET %LC=0
SET %RC="00"
SET %NODE="^UTILITY($J)"
+20 SET %RTN="IB"_$EXTRACT(%TT,1,4)
+21 SET %RTNBFR="^UTILITY(""""INHSYS"""","
+22 FOR
SET %NODE=$QUERY(@%NODE)
IF $QSUBSCRIPT(%NODE,1)'=$JOB
QUIT
Begin DoDot:1
+23 SET %DATA=@%NODE
+24 IF %CC+$LENGTH(%DATA)+$LENGTH(%NODE)'<INMAX
DO NEWR^INHSYS04
+25 DO LN^INHSYS04(" ;;"_%NODE,.%CC,.%LC)
+26 DO LN^INHSYS04(" ;;"_%DATA,.%CC,.%LC)
End DoDot:1
+27 IF $ORDER(^UTILITY($JOB,0,0))
Begin DoDot:1
+28 DO LN^INHSYS04(" Q",.%CC,.%LC)
SET X=%RTN_$SELECT($LENGTH(%RC)=1:"0"_%RC,1:%RC)
XECUTE INZI
WRITE !,X_" filed."
SET INROU(X)=""
+29 KILL ^UTILITY($JOB,0)
End DoDot:1
+30 KILL ^UTILITY($JOB)
+31 QUIT
READ(INX) ;read 4 characters
+1 SET INX=$GET(INX)
+2 IF INX=""
SET INX="Enter last 4 character of sir for routine name: "
+3 FOR
Begin DoDot:1
+4 SET INRTN=$$READ^%ZTF(1,4,INX,"",13)
End DoDot:1
IF '$$CHECK
QUIT
+5 QUIT INRTN
CHECK() ;check validity of 4 characters
+1 NEW INLN
+2 IF INRTN="^"
SET INRTN=""
QUIT 0
+3 IF INRTN=""
QUIT 0
+4 SET INLN=$LENGTH(INRTN)
+5 IF INLN
IF INLN<4
WRITE !,"You must enter EXACTLY 4 characters",!
QUIT 1
+6 IF $DATA(^INRHT("ID",INRTN))
Begin DoDot:1
+7 WRITE !,"The 4 characters you chose are the same as a unique ID"
+8 WRITE !,"Choose different characters",!
End DoDot:1
QUIT 1
+9 IF $FIND(INRTN," ")
WRITE !,"Name cannot have spaces",!
QUIT 1
+10 QUIT 0
RESTORE(%DRVR) ;Restore data from any element
+1 ;Loop through PASS1 and PASS2
+2 NEW %PASS,%LFILES,AA,%SAV,DFN,INMSG
+3 DO ENV^UTIL
DO ^%ZIST
+4 SET INREPRT=+$GET(INREPRT)
+5 KILL ^UTILITY($JOB),^UTILITY("INHSYS",$JOB),^UTILITY("INHSYSUT",$JOB)
+6 DO EN^@%DRVR
+7 IF $DATA(^UTILITY("INHSYS"))
FOR %PASS=1:1:2
DO INST(%DRVR,.%PASS,INREPRT,.INFLD,.INMSG)
+8 IF $DATA(INMSG)
DO COMP(.INMSG)
+9 ;Clean up ^UTILITY/Remove IB routines
+10 KILL ^UTILITY($JOB),^UTILITY("INHSYS",$JOB),^UTILITY("INHSYSUT",$JOB)
+11 WRITE !!,"File transfer completed."
+12 QUIT
INST(%DRVR,%PASS,INREPRT,INFLD,INMSG) ;installation utility entry pnt
+1 ;input:
+2 ; %DRVR - Internal installation driver routine
+3 ; %PASS - 0 or null - display report only
+4 ; 1 - save off old files - create required fields
+5 ; 2 - populate rest of file
+6 ; INREPRT - 0 or null - off 1 - on
+7 ; INFLD - Array of 4012 Script Generator Field entries
+8 ;Output:
+9 ; INMSG - Array of GIS entries
+10 ;local:
+11 ; %LINE - file information stored in ";;" comment form
+12 ; %FNUM - file number
+13 ; %ROOT - global root
+14 ;
+15 NEW B,%FNUM,%FLDS,%ROOT,%OIEN,%XNODE,%UNQ,Y,DA,%FILES,AA,%SAV
+16 NEW DIC,X,DLAYGO,QT,I,%RQ,%MSG,%MSG2,%OMT,%FILES,%DIC0,%GLB,INPOP,INFLD
+17 DO ENV^UTIL
+18 SET INREPRT=$GET(INREPRT)
SET %PASS=$GET(%PASS)
SET (%MSG,%MSG2)=0
SET INPOP=0
SET INCR=1
+19 SET INFLG=$GET(INFLG)
+20 IF '%PASS
DO EN^@%DRVR
+21 IF INREPRT
USE IO
DO HEAD^INHSYSUT(%PASS)
+22 SET QT=$CHAR(34)
+23 SET %FNUM=""
FOR
SET %FNUM=$ORDER(^UTILITY("INHSYS",$JOB,%FNUM))
IF %FNUM=""
QUIT
Begin DoDot:1
+24 ;get root name of file
+25 SET %ROOT=$GET(^DIC(%FNUM,0,"GL"))
SET %DIC0="X"
+26 IF %ROOT=""
WRITE !,"Note .. DD file "_%FNUM_" is missing."
QUIT
+27 IF %PASS
SET %DIC0="LX"
+28 ;loop thru utility using cross reference to get ien
+29 SET %OIEN=""
FOR
SET %OIEN=$ORDER(^UTILITY("INHSYS",$JOB,%FNUM,%OIEN))
IF '%OIEN
QUIT
Begin DoDot:2
+30 NEW DA,DINUM
+31 SET %XNODE=$GET(^UTILITY("INHSYS",$JOB,%FNUM,%OIEN,0))
+32 IF %XNODE=""
QUIT
+33 SET Y=0
+34 ;Universal Interface custom
+35 IF %FNUM=4001
SET Y=$ORDER(^INTHU("C",$PIECE(%XNODE,U,5),""))
+36 ;not criteria file
+37 IF %FNUM'="4001.1"
IF 'Y
SET Y=$$DIC^INHSYS05(%ROOT,$PIECE(%XNODE,U),%FNUM,%DIC0)
IF Y<0
DO MSG^INHSYSUT(%XNODE,%FNUM,.%MSG,0,%PASS)
+38 ;Criteria file custom code
+39 IF %FNUM="4001.1"
Begin DoDot:3
+40 NEW INOPT
+41 SET INOPT("TYPE")="TEST"
+42 SET (DIPA("DA"),Y)=$$NEW^INHUTC1(.INOPT,"U")
+43 IF Y<0
WRITE !,"ERROR - UNABLE TO CREATE NEW CRITERIA"
QUIT
End DoDot:3
+44 ;patient file
+45 IF %FNUM=2
IF %PASS=1
SET DFN=+Y
+46 ;Files that require message to recompile
+47 IF %FNUM=4012!(%FNUM=4010)!(%FNUM=4012.1)!(%FNUM=4011)
SET INMSG(%FNUM,+Y)=$PIECE(Y,U,2)
+48 IF INREPRT
IF Y>0
DO PG^INHSYSUT(%PASS)
WRITE !,%FNUM,?14,$PIECE($GET(^DIC(%FNUM,0)),U),?42
+49 ;Save ien Kill off node
+50 IF %PASS=1
IF +Y>0
Begin DoDot:3
+51 SET DINUM=+Y
SET DIK=%ROOT
SET DA=+Y
DO ^DIK
+52 ;create stub node
+53 SET Y=$$DIC^INHSYS05(%ROOT,$PIECE(%XNODE,U),%FNUM,%DIC0,"","",.DINUM)
End DoDot:3
IF +Y<0
DO MSG^INHSYSUT(%XNODE,%FNUM,.%MSG,0,%PASS)
QUIT
+54 SET DA=+Y
+55 IF INREPRT
IF Y>0
Begin DoDot:3
+56 IF %PASS'=1
WRITE ?42,".01",?56
+57 IF %PASS'=1
WRITE $PIECE(Y,U,2)
+58 WRITE !,%ROOT_DA
IF '%PASS
WRITE !
End DoDot:3
+59 IF INREPRT
IF Y'>0
IF %PASS=1
WRITE ?42,".01"
+60 IF '%PASS
IF Y>0
DO CMP^INHSYS07(+Y,%ROOT,%FNUM,%OIEN,1)
+61 IF %PASS
DO STUFF^INHSYS05(Y,%FNUM,%ROOT,"^UTILITY(""INHSYS"","_$JOB_","_QT_%FNUM_QT_","_%OIEN_",",1,DA,%PASS,.%MSG2,INREPRT)
End DoDot:2
End DoDot:1
+62 IF INREPRT
IF %MSG2
DO PG^INHSYSUT(%PASS)
WRITE !,"*** Denotes ommitted, and not filed in system."
+63 IF INREPRT
DO PG^INHSYSUT(%PASS)
WRITE !!,"Pass "_%PASS_" Done! "
+64 IF INREPRT
IF %PASS=1
IF $EXTRACT(IOST)="C"
IF INCR
IF $$CR^UTSRD(0,IOSL-1)
+65 QUIT
+66 ;
PKG(CLASS,RTN) ;Create package of routines in VMS flat file
+1 ; Input:
+2 ; CLASS - name of flat file that stores saved routines
+3 ; RTN - Name of beginning routine name to store in sequence
+4 ; in the flat file.
+5 NEW %RTN
KILL ^UTILITY($JOB)
+6 DO ENV^UTIL
+7 SET %RTN=RTN
+8 DO ORDER^INHUT3("^ ","%RTN",RTN,"$E(%RTN,1,$L(RTN))'=RTN","S ^UTILITY($J,%RTN)=""""")
+9 DO SAVEROU^INZTTC(CLASS)
+10 QUIT
UPKG(FNAME) ;replace routine into environment from flat file
+1 ; Input:
+2 ; FNAME - Flat file name. Should end with .TT extention
+3 DO FN^ZCMSLD1(FNAME,0)
+4 QUIT
COMP(INMSG) ;Compile Script Generator Messages
+1 ; Input: INMSG - Array of Script Generator Fields and Segments
+2 ; format - INMSG(4010,ien)
+3 ; INMSG(4012,ien)
+4 ;
+5 NEW INFL,INIEN,INMS,Y,INGALL
+6 ;get messages related to Script Data Types
+7 IF $DATA(INMSG(4012.1))
DO GETMSGDT^INHSYSU1(.INMSG,.INMS)
+8 ;loop through in order of most likely to occur
+9 FOR INFL=4012,4010,4011
IF $DATA(INMSG(INFL))
Begin DoDot:1
+10 SET INIEN=""
FOR
SET INIEN=$ORDER(INMSG(INFL,INIEN))
IF INIEN=""
QUIT
Begin DoDot:2
+11 ;Get Script Generator Messages related to field
+12 IF INFL=4012
DO GETMSGF^INHSYSU1(INIEN,.INMS,.INMSG)
QUIT
+13 ;Get Script Generator Messages related to segment
+14 IF INFL=4010
DO GETMSGS^INHSYSU1(INIEN,.INMS,.INMSG)
QUIT
+15 ;Get Script Generator Messages from saved message
+16 IF INFL=4011
SET INMS(INIEN)=""
End DoDot:2
End DoDot:1
+17 ;compile Script Generator Messages
+18 SET INMS=""
SET INGALL=1
FOR
SET (INMS,Y)=$ORDER(INMS(INMS))
IF 'Y
QUIT
DO EN^INHSGZ
+19 QUIT
SV2FLT(INAME,INDONE) ;Save utility stuff to flat file
+1 ; Input:
+2 ; INAME - Name of flat file
+3 ; Output: INDONE 0 did not finish 1 finished
+4 NEW %NODE,%DATA,$ETRAP,INDATE
+5 SET INDONE=0
+6 IF '$DATA(^UTILITY($JOB))
QUIT
+7 SET %NODE="^UTILITY($J)"
SET $ZT="ERR^INHSYSE"
+8 SET INAME=$$OPENSEQ^%ZTFS1(INAME,"BW")
+9 IF INAME=""
WRITE !,"Unable to open file"
QUIT
+10 USE INAME
+11 SET INDATE=$$CDATASC^%ZTFDT($HOROLOG,2,1)
+12 WRITE $PIECE(INDATE,"@")_" "_$PIECE(INDATE,"@",2),!,"Interactive Test Utility Save"
+13 FOR
SET %NODE=$QUERY(@%NODE)
IF $QSUBSCRIPT(%NODE,1)'=$JOB
QUIT
Begin DoDot:1
+14 SET %DATA=@%NODE
+15 WRITE !,%NODE
+16 WRITE !,%DATA
End DoDot:1
+17 WRITE !,"**END**",!,"**END**"
+18 IF $$CLOSESEQ^%ZTFS1(INAME)
+19 SET INDONE=1
+20 QUIT
RSFRFLT(INAME) ;Restore from flat file
+1 ;Input: - INAME - Name of flat file to restore from
+2 NEW X,N,%RTNBFR,%ODD,%EVEN,%DATIM,%HEAD,$ETRAP
+3 KILL ^UTILITY("INHSYS",$JOB)
+4 SET %RTNBFR="^UTILITY(""INHSYS"","
SET $ZE=""
SET $ZT="ERR^INHSYSE"
+5 SET INAME=$$OPENSEQ^%ZTFS1(INAME,"RB")
+6 IF INAME=""
WRITE !,"Unable to open file"
QUIT
+7 USE INAME
+8 READ %DATIM:0,%HEAD:0
+9 IF %HEAD="Interactive Test Utility Save"
Begin DoDot:1
+10 FOR
READ %ODD:0
IF '$TEST
QUIT
IF %ODD="**END**"
QUIT
Begin DoDot:2
+11 READ %EVEN:0
IF '$TEST
QUIT
+12 IF %EVEN="**END**"
QUIT
+13 SET X=%RTNBFR_$JOB_","_$PIECE(%ODD,",",2,99)
+14 SET @X=%EVEN
End DoDot:2
End DoDot:1
+15 SET X=$$CLOSESEQ^%ZTFS1(INAME)
+16 QUIT
ERR ;if error occurs on save or restore
+1 SET X=$$CLOSESEQ^%ZTFS1(INAME)
SET $ZT=""
+2 WRITE !,"An error has ocurred"
+3 QUIT
