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 ;
