Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHSZ4

INHSZ4.m

Go to the documentation of this file. 
  1. 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
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TOOLS_460; GEN 3; 17-JUL-1997
  1.  ;COPYRIGHT 1988, 1989, 1990 SAIC
  1.  ;
  1. L G L^INHSZ1
  1.  ;
  1. IN ;Enter code
  1.  Q
  1.  ;
  1. REQUIRED ;Handle lines in REQUIRED section
  1.  ;Enter here with LINE array set
  1.  N COMM
  1.  S COMM=$P(LINE," ") G:$$CMD^INHSZ1(COMM,"IF^ENDIF") CMD
  1.  ;Line must be a required variable
  1.  Q:'$$SYNTAX^INHSZ0(LINE,"1.ANP")
  1.  N %1,%11,%2,%3,%4,%0,%5
  1.  S %0=$$LBTB^UTIL($P(LINE,";")),%2=$P(LINE,";",2) G:%0["^" COND
  1.  S %1=$$VEXP(%0)
  1.  I %1=-1 D ERROR^INHSZ0("Illegal variable format: "_%0,1) Q
  1.  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
  1.  Q
  1.  ;
  1. COND ;Conditional required check
  1.  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))
  1.  G:$D(LVARS(%1)) LOOP
  1.  S %11=$$VEXP(%1),%4=$$VEXP(%3)
  1.  S A=" I $D("_$S($E(%3)="@":"INA",1:"@INV@")_"("_%4_"))#2,$G("_$S($E(%1)="@":"INA",1:"@INV@")_"("_%11_"))="""" "
  1.  I %5="" S A=A_"D ERROR^INHS(""Required data missing: '"_$S(%2]"":%2,1:%1)_"'  Cannot proceed."",2)" D L Q
  1.  S X=%5 D ^DIM I '$D(X) D ERROR^INHSZ0("Illegal MUMPS code in command.",1) Q
  1.  S A=A_"S INREQERR=2 "_%5 D L
  1.  Q
  1.  ;
  1. LOOP ;Looping check
  1.  I '$D(LVARS(%3)) D ERROR^INHSZ0("Illegal REQUIRED syntax - Variable '"_%3_"' was not created in a loop.",1) Q
  1.  I LVARS(%3)'=LVARS(%1) D ERROR^INHSZ0("Level incompatibility error.",1) Q
  1.  S V1="@INV@("""_%3_"""",V2="@INV@("""_%1_""""
  1.  F J=1:1:LVARS(%3) D
  1.  . S V1=V1_",INI("_J_")",V2=V2_",INI("_J_")"
  1.  . 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("")
  1.  S V1=V1_")",V2=V2_")",A=" I $G("_V2_")="""" "
  1.  D:%5=""
  1.  . 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_"_"",""_"
  1.  . S A=A_",2)" D L
  1.  D:%5]""  Q:ER
  1.  . S X=%5 D ^DIM I '$D(X) D ERROR^INHSZ0("Illegal MUMPS code in command.",1) Q
  1.  . S A=A_"S INREQERR=2 "_%5 D L
  1.  F J=1:1:LVARS(%3) D UP^INHSZ1
  1.  Q
  1.  ;
  1. OUT ;Leaving REQUIRED section
  1.  D QCHK^INHSZ0
  1.  Q
  1.  ;
  1. CMD ;It is a command
  1.  G @$$CASECONV^UTIL(COMM,"U")
  1.  ;
  1. IF ;IF statement
  1.  G IF^INHSZ21
  1.  ;
  1. ENDIF ;ENDIF statement
  1.  G ENDIF^INHSZ21
  1.  ;
  1. ERROR ;ERROR statement
  1.  G ERROR^INHSZ21
  1.  ;
  1. VEXP(%V) ;Expand a variable with subscripts
  1.  ;returns -1 if format illegal
  1.  ;New transform to support extended subscripts for NCPDP
  1.  ;If input contains multiple nodes such as MED,FIELDID
  1.  ;this returns "MED","FIELDID". TRANSFORM and REQUIRED
  1.  ;sections then use extended subscripts properly. dgh
  1.  I %V[",",$TR(%V,"()")=%V N %V2 D  Q %V2
  1.  .S %V2=""""_$P(%V,",")_""""
  1.  .F I=2:1:$L(%V,",") S %V2=%V2_","_""""_$P(%V,",",I)_""""
  1.  ;
  1.  Q:$TR(%V,"()")=%V """"_%V_""""
  1.  I %V["(",%V'[")" Q -1
  1.  I %V[")",%V'["(" Q -1
  1.  ;Need research to determine if extended logic needs to go
  1.  ;here. DGH
  1.  N %S
  1.  S %S=$P(%V,"(",2,99),%S=$E(%S,1,$L(%S)-1)
  1.  Q """"_$P(%V,"(")_""","_%S