INHSZ3 ;JSH; 16 Mar 92 08:36;Script compiler TRANSFORM section handler ; 11 Nov 91 6:42 AM
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
L G L^INHSZ1
;
IN ;Enter code
Q
;
OUT ;Exit code
Q
;
TRANS ;Handle lines in TRANSFORM section
;Enter here with LINE array set to current line
;Get command
N COMM
S COMM=$P(LINE," ") G:$$CMD^INHSZ1(COMM,"IF^ENDIF^ERROR^") CMD
;Line must be a <var>$<expression> line
Q:'$$SYNTAX^INHSZ0(LINE,"1.ANP."" ""1.2""$""."" "".1""^""1.E")
N V,E,V1,INR,TRC,REQ
S REQ=$P(LINE,"$",2)=""
S V=$P($TR(LINE,"$"," ")," "),E=$$LBTB^UTIL($P(LINE,"$",2+REQ,999))
S V1=$$VEXP^INHSZ4(V) I V1=-1 D ERROR^INHSZ0("Illegal variable format: "_V,1) Q
S INR=$D(LVARS(V)),INM=$E(E)="^"
I 'INM D Q:ER
. S DIC=.5,DIC(0)="",X=$P(E,"(") D ^DIC K DIC
. I Y<0 D ERROR^INHSZ0("Function not found for transform.",1) Q
. S TRC=$G(^DD("FUNC",+Y,1))
. I E["(" S X=E D Q:ER
.. I INR N DICOMPX S DICOMPX(V)="@INV@("""_V_""",INI)"
.. D DICOMP^INHSZ21(.X) I '$D(X) D ERROR^INHSZ0("Illegal function call: '"_E_"'") Q
.. S TRC=X
I INM D Q:ER
. ;Function is MUMPS code
. S X=$E(E,2,999) ;D ^DIM I '$D(X) D ERROR^INHSZ0("Invalid MUMPS code in transform function.",1) Q
. S TRC=X
I 'INR S A=" S (INX,X)=$G(@INV@("_V1_"))" D L S A=" "_TRC D L S A=" S @INV@("_V1_")=$G(X)" D L D G Q
. S A=" I '$D(X) D ERROR^INHS(""Variable '"_V_"' failed input transform. "_$S('REQ:"Processing continues.",1:"Cannot Proceed.")_""","_(REQ*2)_"),ERROR^INHS("" Value = '""_INX_""'"",0)" D L
S V1="@INV@("""_V_""""
F J=1:1:LVARS(V) D
. S V1=V1_",INI("_J_")"
. S A=" S INI("_J_")=0 F S INI("_J_")=$O("_V1_")) Q:'INI("_J_") S INI=INI("_J_") D" D L,DOWN^INHSZ1("")
S V1=V1_")",A=" S (INX,X)="_V1 D L S A=" "_TRC D L S A=" S "_V1_"=$G(X) I '$D(X) D ERROR^INHS(""Variable '"_V_"' failed input transform in iteration #""_" F J=1:1:LVARS(V) S A=A_"INI("_J_")" S:J'=LVARS(V) A=A_"_"",""_"
S A=A_"_"". "_$S('REQ:"Processing continues.",1:"Cannot Proceed.")_""","_(REQ*2)_"),ERROR^INHS("" Value = '""_INX_""'"",0)" D L
F J=1:1:LVARS(V) D UP^INHSZ1
;
Q S A=" K DXS" D L
Q
;
CMD ;It is a command
G @$$CASECONV^UTIL(COMM,"U")
;
IF ;IF statement
G IF^INHSZ21
;
ENDIF ;ENDIF statement
G ENDIF^INHSZ21
;
ERROR ;ERROR command
G ERROR^INHSZ21
;
INHSZ3 ;JSH; 16 Mar 92 08:36;Script compiler TRANSFORM section handler ; 11 Nov 91 6:42 AM
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
L GOTO L^INHSZ1
+1 ;
IN ;Enter code
+1 QUIT
+2 ;
OUT ;Exit code
+1 QUIT
+2 ;
TRANS ;Handle lines in TRANSFORM section
+1 ;Enter here with LINE array set to current line
+2 ;Get command
+3 NEW COMM
+4 SET COMM=$PIECE(LINE," ")
IF $$CMD^INHSZ1(COMM,"IF^ENDIF^ERROR^")
GOTO CMD
+5 ;Line must be a <var>$<expression> line
+6 IF '$$SYNTAX^INHSZ0(LINE,"1.ANP."" ""1.2""$""."" "".1""^""1.E")
QUIT
+7 NEW V,E,V1,INR,TRC,REQ
+8 SET REQ=$PIECE(LINE,"$",2)=""
+9 SET V=$PIECE($TRANSLATE(LINE,"$"," ")," ")
SET E=$$LBTB^UTIL($PIECE(LINE,"$",2+REQ,999))
+10 SET V1=$$VEXP^INHSZ4(V)
IF V1=-1
DO ERROR^INHSZ0("Illegal variable format: "_V,1)
QUIT
+11 SET INR=$DATA(LVARS(V))
SET INM=$EXTRACT(E)="^"
+12 IF 'INM
Begin DoDot:1
+13 SET DIC=.5
SET DIC(0)=""
SET X=$PIECE(E,"(")
DO ^DIC
KILL DIC
+14 IF Y<0
DO ERROR^INHSZ0("Function not found for transform.",1)
QUIT
+15 SET TRC=$GET(^DD("FUNC",+Y,1))
+16 IF E["("
SET X=E
Begin DoDot:2
+17 IF INR
NEW DICOMPX
SET DICOMPX(V)="@INV@("""_V_""",INI)"
+18 DO DICOMP^INHSZ21(.X)
IF '$DATA(X)
DO ERROR^INHSZ0("Illegal function call: '"_E_"'")
QUIT
+19 SET TRC=X
End DoDot:2
IF ER
QUIT
End DoDot:1
IF ER
QUIT
+20 IF INM
Begin DoDot:1
+21 ;Function is MUMPS code
+22 ;D ^DIM I '$D(X) D ERROR^INHSZ0("Invalid MUMPS code in transform function.",1) Q
SET X=$EXTRACT(E,2,999)
+23 SET TRC=X
End DoDot:1
IF ER
QUIT
+24 IF 'INR
SET A=" S (INX,X)=$G(@INV@("_V1_"))"
DO L
SET A=" "_TRC
DO L
SET A=" S @INV@("_V1_")=$G(X)"
DO L
Begin DoDot:1
+25 SET A=" I '$D(X) D ERROR^INHS(""Variable '"_V_"' failed input transform. "_$SELECT('REQ:"Processing continues.",1:"Cannot Proceed.")_""","_(REQ*2)_"),ERROR^INHS("" Value = '""_INX_""'"",0)"
DO L
End DoDot:1
GOTO Q
+26 SET V1="@INV@("""_V_""""
+27 FOR J=1:1:LVARS(V)
Begin DoDot:1
+28 SET V1=V1_",INI("_J_")"
+29 SET A=" S INI("_J_")=0 F S INI("_J_")=$O("_V1_")) Q:'INI("_J_") S INI=INI("_J_") D"
DO L
DO DOWN^INHSZ1("")
End DoDot:1
+30 SET V1=V1_")"
SET A=" S (INX,X)="_V1
DO L
SET A=" "_TRC
DO L
SET A=" S "_V1_"=$G(X) I '$D(X) D ERROR^INHS(""Variable '"_V_"' failed input transform in iteration #""_"
FOR J=1:1:LVARS(V)
SET A=A_"INI("_J_")"
IF J'=LVARS(V)
SET A=A_"_"",""_"
+31 SET A=A_"_"". "_$SELECT('REQ:"Processing continues.",1:"Cannot Proceed.")_""","_(REQ*2)_"),ERROR^INHS("" Value = '""_INX_""'"",0)"
DO L
+32 FOR J=1:1:LVARS(V)
DO UP^INHSZ1
+33 ;
Q SET A=" K DXS"
DO L
+1 QUIT
+2 ;
CMD ;It is a command
+1 GOTO @$$CASECONV^UTIL(COMM,"U")
+2 ;
IF ;IF statement
+1 GOTO IF^INHSZ21
+2 ;
ENDIF ;ENDIF statement
+1 GOTO ENDIF^INHSZ21
+2 ;
ERROR ;ERROR command
+1 GOTO ERROR^INHSZ21
+2 ;
