INHSZ4 ;JSH,DGH; 9 Apr 99 13:17;Script compiler REQUIRED section handler ; 11 Nov 91 6:42 AM
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 3; 17-JUL-1997
;COPYRIGHT 1988, 1989, 1990 SAIC
;
L G L^INHSZ1
;
IN ;Enter code
Q
;
REQUIRED ;Handle lines in REQUIRED section
;Enter here with LINE array set
N COMM
S COMM=$P(LINE," ") G:$$CMD^INHSZ1(COMM,"IF^ENDIF") CMD
;Line must be a required variable
Q:'$$SYNTAX^INHSZ0(LINE,"1.ANP")
N %1,%11,%2,%3,%4,%0,%5
S %0=$$LBTB^UTIL($P(LINE,";")),%2=$P(LINE,";",2) G:%0["^" COND
S %1=$$VEXP(%0)
I %1=-1 D ERROR^INHSZ0("Illegal variable format: "_%0,1) Q
S A=" I $G("_$S($E(%1)="@":"INA",1:"@INV@")_"("_%1_"))="""" D ERROR^INHS(""Required data missing: '"_$S(%2]"":%2,1:%0)_"' Cannot proceed."",2)" D L
Q
;
COND ;Conditional required check
S %1=$$LBTB^UTIL($P(%0,U)),%3=$$LBTB^UTIL($P(%0,U,2)),%5=$$LBTB^UTIL($P(%0,U,3)) S:%5]"" %5=$$LBTB^UTIL($P(%0,U,3,99))
G:$D(LVARS(%1)) LOOP
S %11=$$VEXP(%1),%4=$$VEXP(%3)
S A=" I $D("_$S($E(%3)="@":"INA",1:"@INV@")_"("_%4_"))#2,$G("_$S($E(%1)="@":"INA",1:"@INV@")_"("_%11_"))="""" "
I %5="" S A=A_"D ERROR^INHS(""Required data missing: '"_$S(%2]"":%2,1:%1)_"' Cannot proceed."",2)" D L Q
S X=%5 D ^DIM I '$D(X) D ERROR^INHSZ0("Illegal MUMPS code in command.",1) Q
S A=A_"S INREQERR=2 "_%5 D L
Q
;
LOOP ;Looping check
I '$D(LVARS(%3)) D ERROR^INHSZ0("Illegal REQUIRED syntax - Variable '"_%3_"' was not created in a loop.",1) Q
I LVARS(%3)'=LVARS(%1) D ERROR^INHSZ0("Level incompatibility error.",1) Q
S V1="@INV@("""_%3_"""",V2="@INV@("""_%1_""""
F J=1:1:LVARS(%3) D
. S V1=V1_",INI("_J_")",V2=V2_",INI("_J_")"
. S A=$S(J=1:" K INI ",1:" ")_"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_")",V2=V2_")",A=" I $G("_V2_")="""" "
D:%5=""
. S A=A_"D ERROR^INHS(""Required data missing: '"_$S(%2]"":%2,1:%1)_"' in loop interation #""_" F J=1:1:LVARS(%3) S A=A_"INI("_J_")" S:J'=LVARS(%3) A=A_"_"",""_"
. S A=A_",2)" D L
D:%5]"" Q:ER
. S X=%5 D ^DIM I '$D(X) D ERROR^INHSZ0("Illegal MUMPS code in command.",1) Q
. S A=A_"S INREQERR=2 "_%5 D L
F J=1:1:LVARS(%3) D UP^INHSZ1
Q
;
OUT ;Leaving REQUIRED section
D QCHK^INHSZ0
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 statement
G ERROR^INHSZ21
;
VEXP(%V) ;Expand a variable with subscripts
;returns -1 if format illegal
;New transform to support extended subscripts for NCPDP
;If input contains multiple nodes such as MED,FIELDID
;this returns "MED","FIELDID". TRANSFORM and REQUIRED
;sections then use extended subscripts properly. dgh
I %V[",",$TR(%V,"()")=%V N %V2 D Q %V2
.S %V2=""""_$P(%V,",")_""""
.F I=2:1:$L(%V,",") S %V2=%V2_","_""""_$P(%V,",",I)_""""
;
Q:$TR(%V,"()")=%V """"_%V_""""
I %V["(",%V'[")" Q -1
I %V[")",%V'["(" Q -1
;Need research to determine if extended logic needs to go
;here. DGH
N %S
S %S=$P(%V,"(",2,99),%S=$E(%S,1,$L(%S)-1)
Q """"_$P(%V,"(")_""","_%S
INHSZ4 ;JSH,DGH; 9 Apr 99 13:17;Script compiler REQUIRED 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 ;CHCS TOOLS_460; GEN 3; 17-JUL-1997
+4 ;COPYRIGHT 1988, 1989, 1990 SAIC
+5 ;
L GOTO L^INHSZ1
+1 ;
IN ;Enter code
+1 QUIT
+2 ;
REQUIRED ;Handle lines in REQUIRED section
+1 ;Enter here with LINE array set
+2 NEW COMM
+3 SET COMM=$PIECE(LINE," ")
IF $$CMD^INHSZ1(COMM,"IF^ENDIF")
GOTO CMD
+4 ;Line must be a required variable
+5 IF '$$SYNTAX^INHSZ0(LINE,"1.ANP")
QUIT
+6 NEW %1,%11,%2,%3,%4,%0,%5
+7 SET %0=$$LBTB^UTIL($PIECE(LINE,";"))
SET %2=$PIECE(LINE,";",2)
IF %0["^"
GOTO COND
+8 SET %1=$$VEXP(%0)
+9 IF %1=-1
DO ERROR^INHSZ0("Illegal variable format: "_%0,1)
QUIT
+10 SET A=" I $G("_$SELECT($EXTRACT(%1)="@":"INA",1:"@INV@")_"("_%1_"))="""" D ERROR^INHS(""Required data missing: '"_$SELECT(%2]"":%2,1:%0)_"' Cannot proceed."",2)"
DO L
+11 QUIT
+12 ;
COND ;Conditional required check
+1 SET %1=$$LBTB^UTIL($PIECE(%0,U))
SET %3=$$LBTB^UTIL($PIECE(%0,U,2))
SET %5=$$LBTB^UTIL($PIECE(%0,U,3))
IF %5]""
SET %5=$$LBTB^UTIL($PIECE(%0,U,3,99))
+2 IF $DATA(LVARS(%1))
GOTO LOOP
+3 SET %11=$$VEXP(%1)
SET %4=$$VEXP(%3)
+4 SET A=" I $D("_$SELECT($EXTRACT(%3)="@":"INA",1:"@INV@")_"("_%4_"))#2,$G("_$SELECT($EXTRACT(%1)="@":"INA",1:"@INV@")_"("_%11_"))="""" "
+5 IF %5=""
SET A=A_"D ERROR^INHS(""Required data missing: '"_$SELECT(%2]"":%2,1:%1)_"' Cannot proceed."",2)"
DO L
QUIT
+6 SET X=%5
DO ^DIM
IF '$DATA(X)
DO ERROR^INHSZ0("Illegal MUMPS code in command.",1)
QUIT
+7 SET A=A_"S INREQERR=2 "_%5
DO L
+8 QUIT
+9 ;
LOOP ;Looping check
+1 IF '$DATA(LVARS(%3))
DO ERROR^INHSZ0("Illegal REQUIRED syntax - Variable '"_%3_"' was not created in a loop.",1)
QUIT
+2 IF LVARS(%3)'=LVARS(%1)
DO ERROR^INHSZ0("Level incompatibility error.",1)
QUIT
+3 SET V1="@INV@("""_%3_""""
SET V2="@INV@("""_%1_""""
+4 FOR J=1:1:LVARS(%3)
Begin DoDot:1
+5 SET V1=V1_",INI("_J_")"
SET V2=V2_",INI("_J_")"
+6 SET A=$SELECT(J=1:" K INI ",1:" ")_"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
+7 SET V1=V1_")"
SET V2=V2_")"
SET A=" I $G("_V2_")="""" "
+8 IF %5=""
Begin DoDot:1
+9 SET A=A_"D ERROR^INHS(""Required data missing: '"_$SELECT(%2]"":%2,1:%1)_"' in loop interation #""_"
FOR J=1:1:LVARS(%3)
SET A=A_"INI("_J_")"
IF J'=LVARS(%3)
SET A=A_"_"",""_"
+10 SET A=A_",2)"
DO L
End DoDot:1
+11 IF %5]""
Begin DoDot:1
+12 SET X=%5
DO ^DIM
IF '$DATA(X)
DO ERROR^INHSZ0("Illegal MUMPS code in command.",1)
QUIT
+13 SET A=A_"S INREQERR=2 "_%5
DO L
End DoDot:1
IF ER
QUIT
+14 FOR J=1:1:LVARS(%3)
DO UP^INHSZ1
+15 QUIT
+16 ;
OUT ;Leaving REQUIRED section
+1 DO QCHK^INHSZ0
+2 QUIT
+3 ;
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 statement
+1 GOTO ERROR^INHSZ21
+2 ;
VEXP(%V) ;Expand a variable with subscripts
+1 ;returns -1 if format illegal
+2 ;New transform to support extended subscripts for NCPDP
+3 ;If input contains multiple nodes such as MED,FIELDID
+4 ;this returns "MED","FIELDID". TRANSFORM and REQUIRED
+5 ;sections then use extended subscripts properly. dgh
+6 IF %V[","
IF $TRANSLATE(%V,"()")=%V
NEW %V2
Begin DoDot:1
+7 SET %V2=""""_$PIECE(%V,",")_""""
+8 FOR I=2:1:$LENGTH(%V,",")
SET %V2=%V2_","_""""_$PIECE(%V,",",I)_""""
End DoDot:1
QUIT %V2
+9 ;
+10 IF $TRANSLATE(%V,"()")=%V
QUIT """"_%V_""""
+11 IF %V["("
IF %V'[")"
QUIT -1
+12 IF %V[")"
IF %V'["("
QUIT -1
+13 ;Need research to determine if extended logic needs to go
+14 ;here. DGH
+15 NEW %S
+16 SET %S=$PIECE(%V,"(",2,99)
SET %S=$EXTRACT(%S,1,$LENGTH(%S)-1)
+17 QUIT """"_$PIECE(%V,"(")_""","_%S
