- INHSZ71 ;JSH; 19 Aug 93 10:11;Interface compiler - INHSZ7 (cont'd) ; 11 Nov 91 6:42 AM
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- L G L^INHSZ1
- ;
- MULT ;Enter a multiple section
- I 'LOOKUP D ERROR^INHSZ0("LOOKUP section required to process a multiple.",1) Q
- N F,V,%1,X,Z,DIC
- S %1=$$LBTB^UTIL($P(LINE,COMM,2,99)),F=$P(%1,";"),V=$P(%1,";",2)
- I F="" D ERROR^INHSZ0("Missing field in MULT command",1) Q
- I V="" D ERROR^INHSZ0("Missing variable name in MULT command",1) Q
- S DIC="^DD("_+FILE_",",DIC(0)="",X=F D ^DIC I Y<0 D ERROR^INHSZ0("Field '"_F_"' not found in file #"_+FILE,1) Q
- S F=+Y
- S Z=^DD(+FILE,+F,0),(MULT0,X)=$P(Z,U,2) I 'X D ERROR^INHSZ0("Field '"_$P(Z,U)_"' is not a multiple",1) Q
- I $P(^DD(+X,.01,0),U,2)["W" D ERROR^INHSZ0("Field '"_$P(Z,U)_"' is not a multiple",1) Q
- I '$D(DICOMPX(V)) D ERROR^INHSZ0("Multiple identifier variable is unknown.",1) Q
- S A=" ;"_LINE D L
- S A=" D:$G(INDA)>0" D L,DOWN^INHSZ1("")
- I $D(LVARS(V)),LVARS(V)>SLVL D Q
- . S MULT=MULT+1,MNODE(MULT)=$P($P(Z,U,4),";") S:'MNODE(MULT) MNODE(MULT)=""""_MNODE(MULT)_"""" D MDOWN,RLB^INHSZ51 S REPEAT1=0,REPEAT(MULT)=1
- S A=" N MDESC,FIELD S IDENT="_$$VEXP^INHSZ51(V)_",MDESC(2)="" .01 = ""_IDENT" D L
- S LPARAM="",IDENT=1,MCNT=2,MULT=MULT+1,MNODE(MULT)=$P($P(Z,U,4),";") S:'MNODE(MULT) MNODE(MULT)=""""_MNODE(MULT)_"""" D MDOWN S (REPEAT,REPEAT(MULT))=0 Q
- Q
- ;
- ENDMULT ;End a MULT section
- I 'MULT D ERROR^INHSZ0("There is no active MULT section to end",1) Q
- I REPEAT D UP^INHSZ1,MUP,UP^INHSZ1 S SLVL=SLVL-1,REPEAT=REPEAT(MULT) Q
- D MUP,UP^INHSZ1 S REPEAT=REPEAT(MULT) Q
- ;
- MDOWN ;move down a multiple level
- N I S A=" S MULT=MULT+1,INDA(0)=INDA,INDA=0 F I=MULT:-1:1 S INDA(I)=INDA(I-1)" D L S A=" K INDA(0) S INDA=0" D L
- MFSET S FILE=FILE1 F I=MULT:-1:1 S FILE=FILE_"INDA("_I_"),"_MNODE(MULT-I+1)_","
- S $P(FILE,U)=+X Q
- ;
- MUP ;move up a multiple level
- S A=" F I=1:1:MULT S INDA(I-1)=INDA(I)" D L
- S A=" S INDA=INDA(0) K INDA(0) S MULT=MULT-1" D L
- K LOOKUP(MULT) S MULT=MULT-1,X=FILE1 G MFSET
- ;
- OTHER ;Move to another file
- I MULT!OTHER D ERROR^INHSZ0("Cannot nest an OTHER block.",1) Q
- N %1,DIC,X,Y
- S %1=$$LBTB^UTIL($P(LINE,COMM,2,99)),F=$$LBTB^UTIL($P(%1,";")),V=$$LBTB^UTIL($P(%1,";",2))
- I F="" D ERROR^INHSZ0("File missing from OTHER command.",1) Q
- I V="" D ERROR^INHSZ0("Variable missing from OTHER command.",1) Q
- I '$D(DICOMPX(V)) D WARN^INHSZ0("Identifier variable in OTHER command not known.",1)
- I F,'$D(^DIC(F,0)) D ERROR^INHSZ0("File #"_F_" not found.",1) Q
- I 'F D Q:ER
- . S DIC=1,DIC(0)="",X=F X "N F D ^DIC" I Y<0 D ERROR^INHSZ0("File '"_F_"' is unknown or ambiguous.",1) Q
- . S F=+Y
- S FILE("OTHER")=FILE1,(FILE1,FILE)=F_^DIC(F,0,"GL"),OTHER=1,OTHER("LOOK")=0
- S A=" ;"_LINE D L
- I '$D(LVARS(V)) D Q
- . S A=" S INOTHER(""DA"")=$G(INDA)" D L
- . S A=" K MDESC S INDA=0,IDENT=$G(@INV@("""_V_""")),MDESC(2)="" .01 = ""_IDENT K FIELD" D L
- . S LPARAM="",IDENT=1,MCNT=2 Q
- ;Looping OTHER section
- S A=" S INOTHER(""DA"")=$G(INDA)" D L,RLB^INHSZ51 S REPEAT1=0,REPEAT(0)=1
- Q
- ;
- ENDOTHER ;End of other section
- I REPEAT D UP^INHSZ1 S SLVL=SLVL-1,(REPEAT(0),REPEAT)=0
- S OTHER=0,(FILE1,FILE)=FILE("OTHER")
- S A=" S INDA=INOTHER(""DA"")" D L
- Q
- ;
- INHSZ71 ;JSH; 19 Aug 93 10:11;Interface compiler - INHSZ7 (cont'd) ; 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 ;
- MULT ;Enter a multiple section
- +1 IF 'LOOKUP
- DO ERROR^INHSZ0("LOOKUP section required to process a multiple.",1)
- QUIT
- +2 NEW F,V,%1,X,Z,DIC
- +3 SET %1=$$LBTB^UTIL($PIECE(LINE,COMM,2,99))
- SET F=$PIECE(%1,";")
- SET V=$PIECE(%1,";",2)
- +4 IF F=""
- DO ERROR^INHSZ0("Missing field in MULT command",1)
- QUIT
- +5 IF V=""
- DO ERROR^INHSZ0("Missing variable name in MULT command",1)
- QUIT
- +6 SET DIC="^DD("_+FILE_","
- SET DIC(0)=""
- SET X=F
- DO ^DIC
- IF Y<0
- DO ERROR^INHSZ0("Field '"_F_"' not found in file #"_+FILE,1)
- QUIT
- +7 SET F=+Y
- +8 SET Z=^DD(+FILE,+F,0)
- SET (MULT0,X)=$PIECE(Z,U,2)
- IF 'X
- DO ERROR^INHSZ0("Field '"_$PIECE(Z,U)_"' is not a multiple",1)
- QUIT
- +9 IF $PIECE(^DD(+X,.01,0),U,2)["W"
- DO ERROR^INHSZ0("Field '"_$PIECE(Z,U)_"' is not a multiple",1)
- QUIT
- +10 IF '$DATA(DICOMPX(V))
- DO ERROR^INHSZ0("Multiple identifier variable is unknown.",1)
- QUIT
- +11 SET A=" ;"_LINE
- DO L
- +12 SET A=" D:$G(INDA)>0"
- DO L
- DO DOWN^INHSZ1("")
- +13 IF $DATA(LVARS(V))
- IF LVARS(V)>SLVL
- Begin DoDot:1
- +14 SET MULT=MULT+1
- SET MNODE(MULT)=$PIECE($PIECE(Z,U,4),";")
- IF 'MNODE(MULT)
- SET MNODE(MULT)=""""_MNODE(MULT)_""""
- DO MDOWN
- DO RLB^INHSZ51
- SET REPEAT1=0
- SET REPEAT(MULT)=1
- End DoDot:1
- QUIT
- +15 SET A=" N MDESC,FIELD S IDENT="_$$VEXP^INHSZ51(V)_",MDESC(2)="" .01 = ""_IDENT"
- DO L
- +16 SET LPARAM=""
- SET IDENT=1
- SET MCNT=2
- SET MULT=MULT+1
- SET MNODE(MULT)=$PIECE($PIECE(Z,U,4),";")
- IF 'MNODE(MULT)
- SET MNODE(MULT)=""""_MNODE(MULT)_""""
- DO MDOWN
- SET (REPEAT,REPEAT(MULT))=0
- QUIT
- +17 QUIT
- +18 ;
- ENDMULT ;End a MULT section
- +1 IF 'MULT
- DO ERROR^INHSZ0("There is no active MULT section to end",1)
- QUIT
- +2 IF REPEAT
- DO UP^INHSZ1
- DO MUP
- DO UP^INHSZ1
- SET SLVL=SLVL-1
- SET REPEAT=REPEAT(MULT)
- QUIT
- +3 DO MUP
- DO UP^INHSZ1
- SET REPEAT=REPEAT(MULT)
- QUIT
- +4 ;
- MDOWN ;move down a multiple level
- +1 NEW I
- SET A=" S MULT=MULT+1,INDA(0)=INDA,INDA=0 F I=MULT:-1:1 S INDA(I)=INDA(I-1)"
- DO L
- SET A=" K INDA(0) S INDA=0"
- DO L
- MFSET SET FILE=FILE1
- FOR I=MULT:-1:1
- SET FILE=FILE_"INDA("_I_"),"_MNODE(MULT-I+1)_","
- +1 SET $PIECE(FILE,U)=+X
- QUIT
- +2 ;
- MUP ;move up a multiple level
- +1 SET A=" F I=1:1:MULT S INDA(I-1)=INDA(I)"
- DO L
- +2 SET A=" S INDA=INDA(0) K INDA(0) S MULT=MULT-1"
- DO L
- +3 KILL LOOKUP(MULT)
- SET MULT=MULT-1
- SET X=FILE1
- GOTO MFSET
- +4 ;
- OTHER ;Move to another file
- +1 IF MULT!OTHER
- DO ERROR^INHSZ0("Cannot nest an OTHER block.",1)
- QUIT
- +2 NEW %1,DIC,X,Y
- +3 SET %1=$$LBTB^UTIL($PIECE(LINE,COMM,2,99))
- SET F=$$LBTB^UTIL($PIECE(%1,";"))
- SET V=$$LBTB^UTIL($PIECE(%1,";",2))
- +4 IF F=""
- DO ERROR^INHSZ0("File missing from OTHER command.",1)
- QUIT
- +5 IF V=""
- DO ERROR^INHSZ0("Variable missing from OTHER command.",1)
- QUIT
- +6 IF '$DATA(DICOMPX(V))
- DO WARN^INHSZ0("Identifier variable in OTHER command not known.",1)
- +7 IF F
- IF '$DATA(^DIC(F,0))
- DO ERROR^INHSZ0("File #"_F_" not found.",1)
- QUIT
- +8 IF 'F
- Begin DoDot:1
- +9 SET DIC=1
- SET DIC(0)=""
- SET X=F
- XECUTE "N F D ^DIC"
- IF Y<0
- DO ERROR^INHSZ0("File '"_F_"' is unknown or ambiguous.",1)
- QUIT
- +10 SET F=+Y
- End DoDot:1
- IF ER
- QUIT
- +11 SET FILE("OTHER")=FILE1
- SET (FILE1,FILE)=F_^DIC(F,0,"GL")
- SET OTHER=1
- SET OTHER("LOOK")=0
- +12 SET A=" ;"_LINE
- DO L
- +13 IF '$DATA(LVARS(V))
- Begin DoDot:1
- +14 SET A=" S INOTHER(""DA"")=$G(INDA)"
- DO L
- +15 SET A=" K MDESC S INDA=0,IDENT=$G(@INV@("""_V_""")),MDESC(2)="" .01 = ""_IDENT K FIELD"
- DO L
- +16 SET LPARAM=""
- SET IDENT=1
- SET MCNT=2
- QUIT
- End DoDot:1
- QUIT
- +17 ;Looping OTHER section
- +18 SET A=" S INOTHER(""DA"")=$G(INDA)"
- DO L
- DO RLB^INHSZ51
- SET REPEAT1=0
- SET REPEAT(0)=1
- +19 QUIT
- +20 ;
- ENDOTHER ;End of other section
- +1 IF REPEAT
- DO UP^INHSZ1
- SET SLVL=SLVL-1
- SET (REPEAT(0),REPEAT)=0
- +2 SET OTHER=0
- SET (FILE1,FILE)=FILE("OTHER")
- +3 SET A=" S INDA=INOTHER(""DA"")"
- DO L
- +4 QUIT
- +5 ;
