- 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 ;
