INHS ;JSH; 16 Nov 95 16:45;Interface - Script utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
ERROR(MESS,TYPE) ;Report an error in a script
;MESS = error message (if passed by reference it may contain subscripts)
;TYPE = type of error:
; 1 = Non-fatal
; 2 = Fatal (default)
;
S:$G(TYPE)="" TYPE=2
S INSTERR=$S(INSTERR>TYPE:INSTERR,1:TYPE)
I $D(MESS)<9 S MESS(1)=$G(MESS)
N I
S I=0 F S I=$O(MESS(I)) Q:'I S INHERCNT=$G(INHERCNT)+1,INHERR(INHERCNT)=MESS(I)
Q
;
SREPERR(UIF,ERROR) ;Script reports an error
;UIF = entry # in UIF
;ERROR = array of error messages
;
;First, log in UIF
D ULOG^INHU(UIF,"",.ERROR)
;Log in the IEF
D END^INHE(UIF,.ERROR)
Q
;
MC ;Check if time to move variables to a global
Q:INV["^"
I $S<INSMIN M ^UTILITY("INV",$J)=INV K INV S INV="^UTILITY(""INV"",$J)"
Q
MC1 ;Check if time to move variables to a global
Q:INVTMP["^"
I $S<INSMIN M ^UTILITY("INVTMP",$J)=INVTMP K INVTMP S INVTMP="^UTILITY(""INVTMP"",$J)"
Q
MC2 ;Check if time to move variables to a global
Q:%INV["^"
I $S<INSMIN M ^UTILITY("%INV",$J)=%INV K %INV S %INV="^UTILITY(""%INV"",$J)"
Q
;
WP(%D,%F,%V,%M) ;Word processing store
;%D = file # which contains the multiple field [REQD]
;%F = WP field # within %D [REQD]
;%V = reference whose next level descendents have text [REQD]
; ex. @%V@(1) has first node, @%V@(2) has second node, etc.
;%M = mode of operation (0:default = OVERWRITE, 1 = APPEND) [REQD]
;Assumes DIE set to current global reference
;Assumes the DA array is properly constructed
Q:'$G(%D)!'$G(%F)!'$D(DA)!($G(DIE)="")!($G(%V)="") Q:'$D(^DD(%D,%F)) S %M=+$G(%M)
N N,G,I,%,J
S N=$P($P(^DD(%D,%F,0),U,4),";") Q:'$L(N)
S:$D(@%V)<9 @%V@(1)=@%V
S G=DIE_DA_","_$S(+N=N:N,1:""""_N_"""")_")" L +@G
I '%M D Q
. K @G S (%,I)=0 F S I=$O(@%V@(I)) Q:'I S %=%+1,@G@(I,0)=@%V@(I)
. S @G@(0)=U_U_%_U_%_U_DT L -@G
S (%,I)=0 F Q:'$O(@G@(I)) S %=%+1,I=$O(@G@(I))
S J=0 F S J=$O(@%V@(J)) Q:'J S %=%+1,I=I+1,@G@(I,0)=@%V@(J)
S @G@(0)=U_U_%_U_%_U_DT L -@G
Q
;
GSAVE(%G) ;Save array into message - called from within a script
;%G = array reference [eg. ^UTILITY("X",2, ]
;DO NOT include variables in %G!
Q:%G=""
N A,B,C S A=%G,C=$L(A),B=$E(A,1,$L(A)-1) S:B["(" B=B_")" Q:$D(@B)<9
F S B=$Q(@B) Q:$E(B,1,C)'=A S LCT=LCT+1,^UTILITY("INH",$J,LCT)=$E(B,C+1,256),LCT=LCT+1,^UTILITY("INH",$J,LCT)=@B
Q
;
GLOAD(%G) ;Load array from message beginning at the current position
;%G = root reference where data should go
; [eg. ^UTILITY(10, ]
Q:%G=""
N X,Y
F D GET^INHOU(UIF,0) Q:'$D(LINE) S X=LINE D GET^INHOU(UIF,0) Q:'$D(LINE) S Y=LINE,@(%G_X_"=Y")
Q
INHS ;JSH; 16 Nov 95 16:45;Interface - Script utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
ERROR(MESS,TYPE) ;Report an error in a script
+1 ;MESS = error message (if passed by reference it may contain subscripts)
+2 ;TYPE = type of error:
+3 ; 1 = Non-fatal
+4 ; 2 = Fatal (default)
+5 ;
+6 IF $GET(TYPE)=""
SET TYPE=2
+7 SET INSTERR=$SELECT(INSTERR>TYPE:INSTERR,1:TYPE)
+8 IF $DATA(MESS)<9
SET MESS(1)=$GET(MESS)
+9 NEW I
+10 SET I=0
FOR
SET I=$ORDER(MESS(I))
IF 'I
QUIT
SET INHERCNT=$GET(INHERCNT)+1
SET INHERR(INHERCNT)=MESS(I)
+11 QUIT
+12 ;
SREPERR(UIF,ERROR) ;Script reports an error
+1 ;UIF = entry # in UIF
+2 ;ERROR = array of error messages
+3 ;
+4 ;First, log in UIF
+5 DO ULOG^INHU(UIF,"",.ERROR)
+6 ;Log in the IEF
+7 DO END^INHE(UIF,.ERROR)
+8 QUIT
+9 ;
MC ;Check if time to move variables to a global
+1 IF INV["^"
QUIT
+2 IF $STORAGE<INSMIN
MERGE ^UTILITY("INV",$JOB)=INV
KILL INV
SET INV="^UTILITY(""INV"",$J)"
+3 QUIT
MC1 ;Check if time to move variables to a global
+1 IF INVTMP["^"
QUIT
+2 IF $STORAGE<INSMIN
MERGE ^UTILITY("INVTMP",$JOB)=INVTMP
KILL INVTMP
SET INVTMP="^UTILITY(""INVTMP"",$J)"
+3 QUIT
MC2 ;Check if time to move variables to a global
+1 IF %INV["^"
QUIT
+2 IF $STORAGE<INSMIN
MERGE ^UTILITY("%INV",$JOB)=%INV
KILL %INV
SET %INV="^UTILITY(""%INV"",$J)"
+3 QUIT
+4 ;
WP(%D,%F,%V,%M) ;Word processing store
+1 ;%D = file # which contains the multiple field [REQD]
+2 ;%F = WP field # within %D [REQD]
+3 ;%V = reference whose next level descendents have text [REQD]
+4 ; ex. @%V@(1) has first node, @%V@(2) has second node, etc.
+5 ;%M = mode of operation (0:default = OVERWRITE, 1 = APPEND) [REQD]
+6 ;Assumes DIE set to current global reference
+7 ;Assumes the DA array is properly constructed
+8 IF '$GET(%D)!'$GET(%F)!'$DATA(DA)!($GET(DIE)="")!($GET(%V)="")
QUIT
IF '$DATA(^DD(%D,%F))
QUIT
SET %M=+$GET(%M)
+9 NEW N,G,I,%,J
+10 SET N=$PIECE($PIECE(^DD(%D,%F,0),U,4),";")
IF '$LENGTH(N)
QUIT
+11 IF $DATA(@%V)<9
SET @%V@(1)=@%V
+12 SET G=DIE_DA_","_$SELECT(+N=N:N,1:""""_N_"""")_")"
LOCK +@G
+13 IF '%M
Begin DoDot:1
+14 KILL @G
SET (%,I)=0
FOR
SET I=$ORDER(@%V@(I))
IF 'I
QUIT
SET %=%+1
SET @G@(I,0)=@%V@(I)
+15 SET @G@(0)=U_U_%_U_%_U_DT
LOCK -@G
End DoDot:1
QUIT
+16 SET (%,I)=0
FOR
IF '$ORDER(@G@(I))
QUIT
SET %=%+1
SET I=$ORDER(@G@(I))
+17 SET J=0
FOR
SET J=$ORDER(@%V@(J))
IF 'J
QUIT
SET %=%+1
SET I=I+1
SET @G@(I,0)=@%V@(J)
+18 SET @G@(0)=U_U_%_U_%_U_DT
LOCK -@G
+19 QUIT
+20 ;
GSAVE(%G) ;Save array into message - called from within a script
+1 ;%G = array reference [eg. ^UTILITY("X",2, ]
+2 ;DO NOT include variables in %G!
+3 IF %G=""
QUIT
+4 NEW A,B,C
SET A=%G
SET C=$LENGTH(A)
SET B=$EXTRACT(A,1,$LENGTH(A)-1)
IF B["("
SET B=B_")"
IF $DATA(@B)<9
QUIT
+5 FOR
SET B=$QUERY(@B)
IF $EXTRACT(B,1,C)'=A
QUIT
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=$EXTRACT(B,C+1,256)
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=@B
+6 QUIT
+7 ;
GLOAD(%G) ;Load array from message beginning at the current position
+1 ;%G = root reference where data should go
+2 ; [eg. ^UTILITY(10, ]
+3 IF %G=""
QUIT
+4 NEW X,Y
+5 FOR
DO GET^INHOU(UIF,0)
IF '$DATA(LINE)
QUIT
SET X=LINE
DO GET^INHOU(UIF,0)
IF '$DATA(LINE)
QUIT
SET Y=LINE
SET @(%G_X_"=Y")
+6 QUIT
