- 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
