- DIFROMSE ;SFISC/DCL-FILE ORDER TO RESOLVE POINTERS ;07:27 AM 2 Jun 1994
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;File Order List for Resolving Pointers
- FOLRP(DIFRFLG,DIFRTA) ;FLAGS,TARGET_ARRAY ; Creates the "DIORD" subscript
- ; structure in the transport array.
- ;FLAGS,TARGET_ARRAY
- ;*
- ;FLAGS = None
- ;*
- ;TARGET_ARRAY = CLOSED ROOT
- ; This is the Transport Array Root.
- ; "DIORD" is appended to the array root.
- ; A ordered list of files is returned
- ; in the target array. Each file is given
- ; a value to determine which file should have
- ; pointers resolved. After each file has been
- ; assigned a value it is ordered by value then
- ; by file number. If files have the same value
- ; the file number is then used to determine the
- ; order. This call is used after all the file
- ; being transported are in the "FIA" structure.
- ;*
- Q:$G(DIFRTA)']""
- N DIFRCNT,DIFRDD,DIFRF,DIFRFILE,DIFRFLD,DIFRX
- S DIFRFILE=0
- K ^TMP("DIFROMSE",$J),^TMP("DIFRORD",$J),^TMP("DIFRFILE",$J),@DIFRTA@("DIORD")
- F S DIFRFILE=$O(@DIFRTA@("FIA",DIFRFILE)) Q:DIFRFILE'>0 D
- .D FSF^DIFROMSP(DIFRFILE,"","^TMP(""DIFROMSE"",$J)")
- .Q
- S DIFRFILE=0
- F S DIFRFILE=$O(^TMP("DIFROMSE",$J,DIFRFILE)) Q:DIFRFILE'>0 D
- .S DIFRDD=0,^TMP("DIFRORD",$J,DIFRFILE)=0
- .F S DIFRDD=$O(^TMP("DIFROMSE",$J,DIFRFILE,DIFRDD)) Q:DIFRDD'>0 D
- ..S DIFRFLD=0
- ..F S DIFRFLD=$O(^DD(DIFRDD,DIFRFLD)) Q:DIFRFLD'>0 S DIFRX=$G(^(DIFRFLD,0)) D
- ...Q:$P(DIFRX,"^",2)
- ...Q:$P(DIFRX,"^",2)'["P"&($P(DIFRX,"^")'["V")
- ...S DIFRCNT=0
- ...I $P(DIFRX,"^",2)["V" D G P
- ....S DIFRF=0 F S DIFRF=$O(^DD(DIFRDD,DIFRFLD,"V","B",DIFRF)) Q:DIFRF'>0 S ^TMP("DIFRFILE",$J,DIFRF)=DIFRCNT+1
- ....Q
- ...I +$P(@("^"_$P(DIFRX,"^",3)_"0)"),"^",2)=DIFRFILE S:$G(^TMP("DIFRORD",$J,DIFRFILE))'>DIFRCNT ^(DIFRFILE)=DIFRCNT Q
- ...I $P(DIFRX,"^",2)["P" S ^TMP("DIFRFILE",$J,+$P(@("^"_$P(DIFRX,"^",3)_"0)"),"^",2))=DIFRCNT+1
- P ...S DIFRF=$O(^TMP("DIFRFILE",$J,"")) Q:DIFRF="" S DIFRCNT=^(DIFRF) K ^(DIFRF)
- ...I $G(^TMP("DIFRORD",$J,DIFRF))'>DIFRCNT S ^(DIFRF)=DIFRCNT
- ...S DIFRX=^DD(DIFRF,.01,0)
- ...I $P(DIFRX,"^",2)["P" S ^TMP("DIFRFILE",$J,+$P(@("^"_$P(DIFRX,"^",3)_"0)"),"^",2))=DIFRCNT+1 G P
- ...G:$P(DIFRX,"^",2)'["V" P
- ...S DIFRF=0 F S DIFRF=$O(^DD(DIFRDD,DIFRFLD,"V","B",DIFRF)) Q:DIFRF'>0 S ^TMP("DIFRFILE",$J,DIFRF)=DIFRCNT
- ...S DIFRCNT=DIFRCNT+1
- ...G P
- ...Q
- ..Q
- .Q
- S DIFRFILE=0
- F S DIFRFILE=$O(^TMP("DIFRORD",$J,DIFRFILE)) Q:DIFRFILE'>0 S DIFRX=^(DIFRFILE),^TMP("DIFRORD",$J,"DIORD",DIFRX,DIFRFILE)=""
- S DIFRX="",DIFRCNT=1 F S DIFRX=$O(^TMP("DIFRORD",$J,"DIORD",DIFRX),-1) Q:DIFRX="" D
- .S DIFRFILE=0 F S DIFRFILE=$O(^TMP("DIFRORD",$J,"DIORD",DIFRX,DIFRFILE)) Q:DIFRFILE'>0 D
- ..S @DIFRTA@("DIORD",DIFRCNT)=DIFRFILE,DIFRCNT=DIFRCNT+1
- D KILL
- Q
- KILL ;
- K ^TMP("DIFROMSE",$J),^TMP("DIFRORD",$J),^TMP("DIFRFILE",$J)
- Q
- ;
- CHK(DIFRFLG,DIFRSA,DIFRTA) ;CHECK FILES POINTED TO AGAINST FILES GOING OUT WITH DATA
- ;Compares the "DIORD" with the "FIA" structures
- ;FLAGS,SOURCE_ARRAY,TARGET_ARRAY
- ;*
- ;FLAGS = None
- ;*
- ;SOURCE_ARRAY = TRANSPORT ARRAY ROOT
- ;*
- ;TARGET_ARRAY = TARGET ARRAY ROOT
- ; Returns a list of files that are pointed to
- ; but not being exported. This is used after
- ; all the files being exported are in the "FIA"
- ; structure.
- ;*
- Q:$G(DIFRSA)']""
- Q:$G(DIFRTA)']""
- N DIFRX,DIFRFILE
- S DIFRX=0
- F S DIFRX=$O(@DIFRSA@("DIORD",DIFRX)) Q:DIFRX'>0 S DIFRFILE=^(DIFRX) D
- .Q:$D(@DIFRSA@("DATA",DIFRFILE))&($P($G(@DIFRSA@("FIA",DIFRFILE,0,1)),"^",5)="y")
- .S @DIFRTA@(DIFRFILE)=""
- .Q
- Q
- DIFROMSE ;SFISC/DCL-FILE ORDER TO RESOLVE POINTERS ;07:27 AM 2 Jun 1994
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;File Order List for Resolving Pointers
- FOLRP(DIFRFLG,DIFRTA) ;FLAGS,TARGET_ARRAY ; Creates the "DIORD" subscript
- +1 ; structure in the transport array.
- +2 ;FLAGS,TARGET_ARRAY
- +3 ;*
- +4 ;FLAGS = None
- +5 ;*
- +6 ;TARGET_ARRAY = CLOSED ROOT
- +7 ; This is the Transport Array Root.
- +8 ; "DIORD" is appended to the array root.
- +9 ; A ordered list of files is returned
- +10 ; in the target array. Each file is given
- +11 ; a value to determine which file should have
- +12 ; pointers resolved. After each file has been
- +13 ; assigned a value it is ordered by value then
- +14 ; by file number. If files have the same value
- +15 ; the file number is then used to determine the
- +16 ; order. This call is used after all the file
- +17 ; being transported are in the "FIA" structure.
- +18 ;*
- +19 IF $GET(DIFRTA)']""
- QUIT
- +20 NEW DIFRCNT,DIFRDD,DIFRF,DIFRFILE,DIFRFLD,DIFRX
- +21 SET DIFRFILE=0
- +22 KILL ^TMP("DIFROMSE",$JOB),^TMP("DIFRORD",$JOB),^TMP("DIFRFILE",$JOB),@DIFRTA@("DIORD")
- +23 FOR
- SET DIFRFILE=$ORDER(@DIFRTA@("FIA",DIFRFILE))
- IF DIFRFILE'>0
- QUIT
- Begin DoDot:1
- +24 DO FSF^DIFROMSP(DIFRFILE,"","^TMP(""DIFROMSE"",$J)")
- +25 QUIT
- End DoDot:1
- +26 SET DIFRFILE=0
- +27 FOR
- SET DIFRFILE=$ORDER(^TMP("DIFROMSE",$JOB,DIFRFILE))
- IF DIFRFILE'>0
- QUIT
- Begin DoDot:1
- +28 SET DIFRDD=0
- SET ^TMP("DIFRORD",$JOB,DIFRFILE)=0
- +29 FOR
- SET DIFRDD=$ORDER(^TMP("DIFROMSE",$JOB,DIFRFILE,DIFRDD))
- IF DIFRDD'>0
- QUIT
- Begin DoDot:2
- +30 SET DIFRFLD=0
- +31 FOR
- SET DIFRFLD=$ORDER(^DD(DIFRDD,DIFRFLD))
- IF DIFRFLD'>0
- QUIT
- SET DIFRX=$GET(^(DIFRFLD,0))
- Begin DoDot:3
- +32 IF $PIECE(DIFRX,"^",2)
- QUIT
- +33 IF $PIECE(DIFRX,"^",2)'["P"&($PIECE(DIFRX,"^")'["V")
- QUIT
- +34 SET DIFRCNT=0
- +35 IF $PIECE(DIFRX,"^",2)["V"
- Begin DoDot:4
- +36 SET DIFRF=0
- FOR
- SET DIFRF=$ORDER(^DD(DIFRDD,DIFRFLD,"V","B",DIFRF))
- IF DIFRF'>0
- QUIT
- SET ^TMP("DIFRFILE",$JOB,DIFRF)=DIFRCNT+1
- +37 QUIT
- End DoDot:4
- GOTO P
- +38 IF +$PIECE(@("^"_$PIECE(DIFRX,"^",3)_"0)"),"^",2)=DIFRFILE
- IF $GET(^TMP("DIFRORD",$JOB,DIFRFILE))'>DIFRCNT
- SET ^(DIFRFILE)=DIFRCNT
- QUIT
- +39 IF $PIECE(DIFRX,"^",2)["P"
- SET ^TMP("DIFRFILE",$JOB,+$PIECE(@("^"_$PIECE(DIFRX,"^",3)_"0)"),"^",2))=DIFRCNT+1
- P SET DIFRF=$ORDER(^TMP("DIFRFILE",$JOB,""))
- IF DIFRF=""
- QUIT
- SET DIFRCNT=^(DIFRF)
- KILL ^(DIFRF)
- +1 IF $GET(^TMP("DIFRORD",$JOB,DIFRF))'>DIFRCNT
- SET ^(DIFRF)=DIFRCNT
- +2 SET DIFRX=^DD(DIFRF,.01,0)
- +3 IF $PIECE(DIFRX,"^",2)["P"
- SET ^TMP("DIFRFILE",$JOB,+$PIECE(@("^"_$PIECE(DIFRX,"^",3)_"0)"),"^",2))=DIFRCNT+1
- GOTO P
- +4 IF $PIECE(DIFRX,"^",2)'["V"
- GOTO P
- +5 SET DIFRF=0
- FOR
- SET DIFRF=$ORDER(^DD(DIFRDD,DIFRFLD,"V","B",DIFRF))
- IF DIFRF'>0
- QUIT
- SET ^TMP("DIFRFILE",$JOB,DIFRF)=DIFRCNT
- +6 SET DIFRCNT=DIFRCNT+1
- +7 GOTO P
- +8 QUIT
- End DoDot:3
- +9 QUIT
- End DoDot:2
- +10 QUIT
- End DoDot:1
- +11 SET DIFRFILE=0
- +12 FOR
- SET DIFRFILE=$ORDER(^TMP("DIFRORD",$JOB,DIFRFILE))
- IF DIFRFILE'>0
- QUIT
- SET DIFRX=^(DIFRFILE)
- SET ^TMP("DIFRORD",$JOB,"DIORD",DIFRX,DIFRFILE)=""
- +13 SET DIFRX=""
- SET DIFRCNT=1
- FOR
- SET DIFRX=$ORDER(^TMP("DIFRORD",$JOB,"DIORD",DIFRX),-1)
- IF DIFRX=""
- QUIT
- Begin DoDot:1
- +14 SET DIFRFILE=0
- FOR
- SET DIFRFILE=$ORDER(^TMP("DIFRORD",$JOB,"DIORD",DIFRX,DIFRFILE))
- IF DIFRFILE'>0
- QUIT
- Begin DoDot:2
- +15 SET @DIFRTA@("DIORD",DIFRCNT)=DIFRFILE
- SET DIFRCNT=DIFRCNT+1
- End DoDot:2
- End DoDot:1
- +16 DO KILL
- +17 QUIT
- KILL ;
- +1 KILL ^TMP("DIFROMSE",$JOB),^TMP("DIFRORD",$JOB),^TMP("DIFRFILE",$JOB)
- +2 QUIT
- +3 ;
- CHK(DIFRFLG,DIFRSA,DIFRTA) ;CHECK FILES POINTED TO AGAINST FILES GOING OUT WITH DATA
- +1 ;Compares the "DIORD" with the "FIA" structures
- +2 ;FLAGS,SOURCE_ARRAY,TARGET_ARRAY
- +3 ;*
- +4 ;FLAGS = None
- +5 ;*
- +6 ;SOURCE_ARRAY = TRANSPORT ARRAY ROOT
- +7 ;*
- +8 ;TARGET_ARRAY = TARGET ARRAY ROOT
- +9 ; Returns a list of files that are pointed to
- +10 ; but not being exported. This is used after
- +11 ; all the files being exported are in the "FIA"
- +12 ; structure.
- +13 ;*
- +14 IF $GET(DIFRSA)']""
- QUIT
- +15 IF $GET(DIFRTA)']""
- QUIT
- +16 NEW DIFRX,DIFRFILE
- +17 SET DIFRX=0
- +18 FOR
- SET DIFRX=$ORDER(@DIFRSA@("DIORD",DIFRX))
- IF DIFRX'>0
- QUIT
- SET DIFRFILE=^(DIFRX)
- Begin DoDot:1
- +19 IF $DATA(@DIFRSA@("DATA",DIFRFILE))&($PIECE($GET(@DIFRSA@("FIA",DIFRFILE,0,1)),"^",5)="y")
- QUIT
- +20 SET @DIFRTA@(DIFRFILE)=""
- +21 QUIT
- End DoDot:1
- +22 QUIT
