- DICA2 ;SEA/TOAD-VA FileMan: Updater, Pre-Processor Part 2 ;8:12 AM 10 Jun 1998
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- IEN(DIFILE,DIEN,DIDA,DIRULE,DIOK) ;
- ; ENTRY POINT--return whether the IEN String is valid
- ; proc, DIEN passed by value
- I $G(DIFILE("C"))'=DIFILE D PARENTS^DIDU1(.DIFILE,DIRULE)
- I $E(DIEN,$L(DIEN))'="," D ERR^DICA3(304,"",DIEN) Q
- I DIFILE("L")+1'=$L(DIEN,",") D ERR^DICA3(205,"",DIEN,"",DIFILE) Q
- I $E(DIEN)=","!(DIEN[",,") D ERR^DICA3(307,"",DIEN) Q
- K @DIRULE@("TEMP")
- PIECES ;
- K DIDA N DICRSR,DIOUT S DIOUT=0 F DICRSR=1:1 D Q:DIOUT!$G(DIERR)
- . N DIPIECE S DIPIECE=$P(DIEN,",",DICRSR)
- . N DIRIGHT S DIRIGHT=$P(DIEN,",",DICRSR+1,99999)
- . I DIPIECE="" S DIOUT=1,DIOK=1 Q
- . D PIECE(.DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,.DIDA,DIRIGHT,.DIOK)
- . I $G(DIERR) S DIOK=0 Q
- . I 'DIOK D ERR^DICA3($S(DIOK=0:308,1:310),"",DIEN) Q
- . Q
- I $G(DIERR) Q
- ALLGOOD ;
- M @DIRULE@("SEQ")=@DIRULE@("TEMP")
- N DIN S DIN="S DIFILE="_DIFILE_",DIENTRY="""_DIEN_""""
- S @DIRULE@("ORDER",@DIRULE@("OP"),DIFILE("L"),DIFILE,@DIRULE@("NUM"))=DIN
- Q
- ;
- PIECE(DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,DIDA,DIRIGHT,DIOK) ;
- ; IEN--return whether a piece of the IEN String is valid
- ; proc, DIF, DIOK, & DIRULE passed by ref
- N DICHECK,DIF,DIPREFIX,DIR,DISEQ
- S DIF=DIFILE(DICRSR)
- I DIPIECE'["+",DIRIGHT["+" S DIOK=0 Q
- FILING I +DIPIECE=DIPIECE,$E(DIPIECE)'="+" D Q
- . S DIOK=DIPIECE>0 I 'DIOK Q
- . S DIOK=DIRIGHT'["+"&(DIRIGHT'["?") I 'DIOK Q
- . S DIR=$G(@DIRULE@("ROOT",DIF,","_DIRIGHT))
- . I DIR="" D
- . . S DIR=$$ROOT^DIQGU(DIF,","_DIRIGHT,1,1)
- . . S @DIRULE@("ROOT",DIF,","_DIRIGHT)=DIR
- . S DIOK=$P($G(@DIR@(DIPIECE,0)),U)'=""
- . I 'DIOK D ERR^DICA3(601,DIFILE,DIPIECE_","_DIRIGHT) Q
- . I DICRSR=1 S DIDA=DIPIECE
- . E S DIDA(DICRSR-1)=DIPIECE
- . I DICRSR'=1 Q
- . S @DIRULE@("OP")=4
- . S @DIRULE@("NUM")=DIPIECE
- PREFIX S DIPREFIX=$E(DIPIECE,1,2) I DIPREFIX'="?+" S DIPREFIX=$E(DIPREFIX)
- I DIPREFIX'="+",DIPREFIX'="?",DIPREFIX'="?+" S DIOK=0 Q
- ;
- GOODPC I $P(DIPIECE,DIPREFIX,2,9999)?1N.N S DIOK=1 D Q
- . S DISEQ=$P(DIPIECE,DIPREFIX,2,999)
- . I +DISEQ'=DISEQ S DIOK=0 Q
- FIRSTPC . I DICRSR=1 D
- . . S @DIRULE@("OP")=$S(DIPREFIX="?":1,DIPREFIX="?+":2,1:3)
- . . S @DIRULE@("NUM")=DISEQ
- WHEREPC . S DICHECK=""
- . I $D(@DIRULE@("SEQ",DISEQ)) S DICHECK=$NA(@DIRULE@("SEQ"))
- . E I $D(@DIRULE@("TEMP",DISEQ)) S DICHECK=$NA(@DIRULE@("TEMP"))
- ILLEGAL . I DICHECK'="" D I 'DIOK Q
- . . I $O(@DICHECK@(DISEQ,""))'=DIPREFIX S DIOK="C" Q
- . . I $O(@DICHECK@(DISEQ,DIPREFIX,""))'=DIF S DIOK="C" Q
- . . I $G(@DICHECK@(DISEQ,DIPREFIX,DIF))'=DIRIGHT S DIOK="C" Q
- . I DICHECK="",'$D(@DIFDA@(DIF,DIPIECE_","_DIRIGHT)) S DIOK="C" Q
- LEARN . S @DIRULE@("TEMP",DISEQ,DIPREFIX,DIF)=DIRIGHT
- . I DICRSR=1 S DIDA=DIPREFIX
- . E S DIDA(DICRSR-1)=DIPREFIX
- ;
- BADPIEC S DIOK=0 Q
- DICA2 ;SEA/TOAD-VA FileMan: Updater, Pre-Processor Part 2 ;8:12 AM 10 Jun 1998
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- IEN(DIFILE,DIEN,DIDA,DIRULE,DIOK) ;
- +1 ; ENTRY POINT--return whether the IEN String is valid
- +2 ; proc, DIEN passed by value
- +3 IF $GET(DIFILE("C"))'=DIFILE
- DO PARENTS^DIDU1(.DIFILE,DIRULE)
- +4 IF $EXTRACT(DIEN,$LENGTH(DIEN))'=","
- DO ERR^DICA3(304,"",DIEN)
- QUIT
- +5 IF DIFILE("L")+1'=$LENGTH(DIEN,",")
- DO ERR^DICA3(205,"",DIEN,"",DIFILE)
- QUIT
- +6 IF $EXTRACT(DIEN)=","!(DIEN[",,")
- DO ERR^DICA3(307,"",DIEN)
- QUIT
- +7 KILL @DIRULE@("TEMP")
- PIECES ;
- +1 KILL DIDA
- NEW DICRSR,DIOUT
- SET DIOUT=0
- FOR DICRSR=1:1
- Begin DoDot:1
- +2 NEW DIPIECE
- SET DIPIECE=$PIECE(DIEN,",",DICRSR)
- +3 NEW DIRIGHT
- SET DIRIGHT=$PIECE(DIEN,",",DICRSR+1,99999)
- +4 IF DIPIECE=""
- SET DIOUT=1
- SET DIOK=1
- QUIT
- +5 DO PIECE(.DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,.DIDA,DIRIGHT,.DIOK)
- +6 IF $GET(DIERR)
- SET DIOK=0
- QUIT
- +7 IF 'DIOK
- DO ERR^DICA3($SELECT(DIOK=0:308,1:310),"",DIEN)
- QUIT
- +8 QUIT
- End DoDot:1
- IF DIOUT!$GET(DIERR)
- QUIT
- +9 IF $GET(DIERR)
- QUIT
- ALLGOOD ;
- +1 MERGE @DIRULE@("SEQ")=@DIRULE@("TEMP")
- +2 NEW DIN
- SET DIN="S DIFILE="_DIFILE_",DIENTRY="""_DIEN_""""
- +3 SET @DIRULE@("ORDER",@DIRULE@("OP"),DIFILE("L"),DIFILE,@DIRULE@("NUM"))=DIN
- +4 QUIT
- +5 ;
- PIECE(DIFILE,DIFDA,DIRULE,DICRSR,DIPIECE,DIDA,DIRIGHT,DIOK) ;
- +1 ; IEN--return whether a piece of the IEN String is valid
- +2 ; proc, DIF, DIOK, & DIRULE passed by ref
- +3 NEW DICHECK,DIF,DIPREFIX,DIR,DISEQ
- +4 SET DIF=DIFILE(DICRSR)
- +5 IF DIPIECE'["+"
- IF DIRIGHT["+"
- SET DIOK=0
- QUIT
- FILING IF +DIPIECE=DIPIECE
- IF $EXTRACT(DIPIECE)'="+"
- Begin DoDot:1
- +1 SET DIOK=DIPIECE>0
- IF 'DIOK
- QUIT
- +2 SET DIOK=DIRIGHT'["+"&(DIRIGHT'["?")
- IF 'DIOK
- QUIT
- +3 SET DIR=$GET(@DIRULE@("ROOT",DIF,","_DIRIGHT))
- +4 IF DIR=""
- Begin DoDot:2
- +5 SET DIR=$$ROOT^DIQGU(DIF,","_DIRIGHT,1,1)
- +6 SET @DIRULE@("ROOT",DIF,","_DIRIGHT)=DIR
- End DoDot:2
- +7 SET DIOK=$PIECE($GET(@DIR@(DIPIECE,0)),U)'=""
- +8 IF 'DIOK
- DO ERR^DICA3(601,DIFILE,DIPIECE_","_DIRIGHT)
- QUIT
- +9 IF DICRSR=1
- SET DIDA=DIPIECE
- +10 IF '$TEST
- SET DIDA(DICRSR-1)=DIPIECE
- +11 IF DICRSR'=1
- QUIT
- +12 SET @DIRULE@("OP")=4
- +13 SET @DIRULE@("NUM")=DIPIECE
- End DoDot:1
- QUIT
- PREFIX SET DIPREFIX=$EXTRACT(DIPIECE,1,2)
- IF DIPREFIX'="?+"
- SET DIPREFIX=$EXTRACT(DIPREFIX)
- +1 IF DIPREFIX'="+"
- IF DIPREFIX'="?"
- IF DIPREFIX'="?+"
- SET DIOK=0
- QUIT
- +2 ;
- GOODPC IF $PIECE(DIPIECE,DIPREFIX,2,9999)?1N.N
- SET DIOK=1
- Begin DoDot:1
- +1 SET DISEQ=$PIECE(DIPIECE,DIPREFIX,2,999)
- +2 IF +DISEQ'=DISEQ
- SET DIOK=0
- QUIT
- FIRSTPC IF DICRSR=1
- Begin DoDot:2
- +1 SET @DIRULE@("OP")=$SELECT(DIPREFIX="?":1,DIPREFIX="?+":2,1:3)
- +2 SET @DIRULE@("NUM")=DISEQ
- End DoDot:2
- WHEREPC SET DICHECK=""
- +1 IF $DATA(@DIRULE@("SEQ",DISEQ))
- SET DICHECK=$NAME(@DIRULE@("SEQ"))
- +2 IF '$TEST
- IF $DATA(@DIRULE@("TEMP",DISEQ))
- SET DICHECK=$NAME(@DIRULE@("TEMP"))
- ILLEGAL IF DICHECK'=""
- Begin DoDot:2
- +1 IF $ORDER(@DICHECK@(DISEQ,""))'=DIPREFIX
- SET DIOK="C"
- QUIT
- +2 IF $ORDER(@DICHECK@(DISEQ,DIPREFIX,""))'=DIF
- SET DIOK="C"
- QUIT
- +3 IF $GET(@DICHECK@(DISEQ,DIPREFIX,DIF))'=DIRIGHT
- SET DIOK="C"
- QUIT
- End DoDot:2
- IF 'DIOK
- QUIT
- +4 IF DICHECK=""
- IF '$DATA(@DIFDA@(DIF,DIPIECE_","_DIRIGHT))
- SET DIOK="C"
- QUIT
- LEARN SET @DIRULE@("TEMP",DISEQ,DIPREFIX,DIF)=DIRIGHT
- +1 IF DICRSR=1
- SET DIDA=DIPREFIX
- +2 IF '$TEST
- SET DIDA(DICRSR-1)=DIPREFIX
- End DoDot:1
- QUIT
- +3 ;
- BADPIEC SET DIOK=0
- QUIT
