DIFROMSX ;SFIRMFO/DCM/TKW-MOVE INDEX FILE ENTRIES ;12:31 PM 31 Oct 2001 [ 04/02/2003 8:25 AM ]
;;22.0;VA FileMan;**1001**;APR 1, 2003
;;22.0;VA FileMan;**1,11,92**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
DDIXOUT(DIFRFILE,DIFRF2,DIFRFDD,DIFRTA) ; retrieve INDEX entries for file
; DIFRFILE=top level file#
; DIFRF2=current file/subfile #
; DIFRFDD=1 if sending full DD
; DIFRTA=Global reference of transport global.
N DIFRNAME,DIFRD0,DIFRD1,DIFRF,DIFRFLD,DIOUT,X,DICNT1,DICNT2
S DIFRNAME="",DIOUT=0
F S DIFRNAME=$O(^DD("IX","BB",DIFRF2,DIFRNAME)) Q:DIFRNAME="" D Q:DIOUT
. S DIFRD0=$O(^DD("IX","BB",DIFRF2,DIFRNAME,0)) Q:'DIFRD0
. S (DIFRD1,DICNT1,DICNT2)=0
. F S DIFRD1=$O(^DD("IX",DIFRD0,11.1,DIFRD1)) Q:'DIFRD1 D Q:DIOUT
. . S X=$G(^DD("IX",DIFRD0,11.1,DIFRD1,0))
. . S DIFRF=$P(X,U,3),DIFRFLD=$P(X,U,4) Q:'DIFRFLD!('DIFRF)
. . S DICNT1=DICNT1+1,X=$$FNO^DILIBF(DIFRF)
. . I '$D(@DIFRTA@("^DD",X,DIFRF,DIFRFLD)) D Q
. . . Q:'DIFRFDD&($G(@DIFRTA@("FIA",X,DIFRF))'=0)
. . . D ERR1(DIFRF,DIFRFLD,DIFRNAME,"INDEX") Q
. . S DICNT2=DICNT2+1
. . Q
. Q:DIOUT I DICNT2=0,'DIFRFDD Q
. ;I DICNT1'=DICNT2 D ERR2(DIFRF2,DIFRNAME,"INDEX") Q
. M @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME)=^DD("IX",DIFRD0)
. K @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME,11.1,"AC")
. K @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME,11.1,"B")
. K @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME,11.1,"BB")
. Q
Q
;
DDIXIN(DIFRFILE,DIFRF2,DIFRSA) ; Install INDEX file entries for file DIFRFILE
; DIFRFILE=source file#
; DIFRF2=current file/subfile#
; DIFRSA=name of array containing incoming data.
N DIFRER,DIFRIN,DIFRNAME,DIFRD1,DIOUT,DIFRIN1,DIFRF,DIFRFLD,X
I '$D(^DD(.11)) S DIFRER("FILE")=.11 D BLD^DIALOG(401,.DIFRER) Q
S DIFRIN=$NA(@DIFRSA@("IX",DIFRFILE,DIFRF2))
S DIFRNAME=""
F S DIFRNAME=$O(@DIFRIN@(DIFRNAME)) Q:DIFRNAME="" D
. S (DIFRD1,DIOUT)=0,DIFRIN1=$NA(@DIFRIN@(DIFRNAME))
. F S DIFRD1=$O(@DIFRIN1@(11.1,DIFRD1)) Q:'DIFRD1 D Q:DIOUT
. . S X=$G(@DIFRIN1@(11.1,DIFRD1,0))
. . S DIFRF=$P(X,U,3),DIFRFLD=$P(X,U,4)
. . I 'DIFRF!('DIFRFLD) Q
. . I '$D(^DD(DIFRF,DIFRFLD,0)) D ERR3(DIFRF,DIFRFLD,DIFRNAME,"INDEX") Q
. . I $O(^DD(DIFRF,DIFRFLD,5,0)) D
. . . Q:$D(^TMP("DIFROMS2",$J,"TRIG",DIFRFILE,DIFRF,DIFRFLD))
. . . D TRMOD^DICR(DIFRF,DIFRFLD)
. . . S ^TMP("DIFROMS2",$J,"TRIG",DIFRFLD,DIFRF,DIFRFLD)="" Q
. . Q
. Q:DIOUT
. N DIEN,DIK,DA,DIC,DO
. S DIEN=$O(^DD("IX","BB",DIFRF2,DIFRNAME,0))
. I DIEN D N DINUM S DINUM=DIEN
. . S DIK="^DD(""IX"",",DA=DIEN N DIEN D ^DIK Q
. S DIC="^DD(""IX"",",DIC(0)="L",DIC("DR")=".02///^S X="_""""_DIFRNAME_"""",X=DIFRF2 D FILE^DICN S DIEN=+Y
. I DIEN'>0 D ERR4(DIFRF2,DIFRNAME,"INDEX") Q
. M ^DD("IX",DIEN)=@DIFRIN1
. K DIK,DA S DIK="^DD(""IX"",",DA=DIEN D IX1^DIK
. Q
Q
;
ERR1(DIFRF,DIFRFLD,DIFRNAME,DIFRTYPE) ;
N DIFRER S DIFRER(1)=DIFRFLD
S DIFRER(2)=DIFRF
S DIFRER(3)=DIFRNAME,DIFRER(4)=DIFRTYPE
D BLD^DIALOG(9543,.DIFRER) S DIOUT=1 Q
ERR2(DIFRF2,DIFRNAME,DIFRTYPE) ;
N DIFRER S DIFRER(1)=DIFRNAME,DIFRER(2)=DIFRTYPE
S DIFRER(3)=DIFRF2
D BLD^DIALOG(9544,.DIFRER) Q
ERR3(DIFRF,DIFRFLD,DIFRNAME,DIFRTYPE) ;
N DIFRER S DIFRER(1)=DIFRTYPE,DIFRER(2)=DIFRNAME
S DIFRER(3)=DIFRFLD
S DIFRER(4)=DIFRF
D BLD^DIALOG(9545,.DIFRER) S DIOUT=1 Q
ERR4(DIFRF2,DIFRNAME,DIFRTYPE) ;
N DIFRER S DIFRER(1)=DIFRTYPE,DIFRER(2)=DIFRNAME,DIFRER(3)=DIFRF2
D BLD^DIALOG(9549,.DIFRER) Q
;
;9543 Field |1| of file |2|, part of '|3|' |4| entry, is missing from the transport global...
;9544 Field(s) that are part of |1| |2| entry are missing from the transport global.
;9545 |1| entry |2| not installed. The REFERENCE FIELD |3| in file |4| does not exist on the system.
;9549 |1| "|2|" on file |3| not installed, FILE^DICN call failed.
;
DIFROMSX ;SFIRMFO/DCM/TKW-MOVE INDEX FILE ENTRIES ;12:31 PM 31 Oct 2001 [ 04/02/2003 8:25 AM ]
+1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
+2 ;;22.0;VA FileMan;**1,11,92**;Mar 30, 1999
+3 ;Per VHA Directive 10-93-142, this routine should not be modified.
DDIXOUT(DIFRFILE,DIFRF2,DIFRFDD,DIFRTA) ; retrieve INDEX entries for file
+1 ; DIFRFILE=top level file#
+2 ; DIFRF2=current file/subfile #
+3 ; DIFRFDD=1 if sending full DD
+4 ; DIFRTA=Global reference of transport global.
+5 NEW DIFRNAME,DIFRD0,DIFRD1,DIFRF,DIFRFLD,DIOUT,X,DICNT1,DICNT2
+6 SET DIFRNAME=""
SET DIOUT=0
+7 FOR
SET DIFRNAME=$ORDER(^DD("IX","BB",DIFRF2,DIFRNAME))
IF DIFRNAME=""
QUIT
Begin DoDot:1
+8 SET DIFRD0=$ORDER(^DD("IX","BB",DIFRF2,DIFRNAME,0))
IF 'DIFRD0
QUIT
+9 SET (DIFRD1,DICNT1,DICNT2)=0
+10 FOR
SET DIFRD1=$ORDER(^DD("IX",DIFRD0,11.1,DIFRD1))
IF 'DIFRD1
QUIT
Begin DoDot:2
+11 SET X=$GET(^DD("IX",DIFRD0,11.1,DIFRD1,0))
+12 SET DIFRF=$PIECE(X,U,3)
SET DIFRFLD=$PIECE(X,U,4)
IF 'DIFRFLD!('DIFRF)
QUIT
+13 SET DICNT1=DICNT1+1
SET X=$$FNO^DILIBF(DIFRF)
+14 IF '$DATA(@DIFRTA@("^DD",X,DIFRF,DIFRFLD))
Begin DoDot:3
+15 IF 'DIFRFDD&($GET(@DIFRTA@("FIA",X,DIFRF))'=0)
QUIT
+16 DO ERR1(DIFRF,DIFRFLD,DIFRNAME,"INDEX")
QUIT
End DoDot:3
QUIT
+17 SET DICNT2=DICNT2+1
+18 QUIT
End DoDot:2
IF DIOUT
QUIT
+19 IF DIOUT
QUIT
IF DICNT2=0
IF 'DIFRFDD
QUIT
+20 ;I DICNT1'=DICNT2 D ERR2(DIFRF2,DIFRNAME,"INDEX") Q
+21 MERGE @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME)=^DD("IX",DIFRD0)
+22 KILL @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME,11.1,"AC")
+23 KILL @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME,11.1,"B")
+24 KILL @DIFRTA@("IX",DIFRFILE,DIFRF2,DIFRNAME,11.1,"BB")
+25 QUIT
End DoDot:1
IF DIOUT
QUIT
+26 QUIT
+27 ;
DDIXIN(DIFRFILE,DIFRF2,DIFRSA) ; Install INDEX file entries for file DIFRFILE
+1 ; DIFRFILE=source file#
+2 ; DIFRF2=current file/subfile#
+3 ; DIFRSA=name of array containing incoming data.
+4 NEW DIFRER,DIFRIN,DIFRNAME,DIFRD1,DIOUT,DIFRIN1,DIFRF,DIFRFLD,X
+5 IF '$DATA(^DD(.11))
SET DIFRER("FILE")=.11
DO BLD^DIALOG(401,.DIFRER)
QUIT
+6 SET DIFRIN=$NAME(@DIFRSA@("IX",DIFRFILE,DIFRF2))
+7 SET DIFRNAME=""
+8 FOR
SET DIFRNAME=$ORDER(@DIFRIN@(DIFRNAME))
IF DIFRNAME=""
QUIT
Begin DoDot:1
+9 SET (DIFRD1,DIOUT)=0
SET DIFRIN1=$NAME(@DIFRIN@(DIFRNAME))
+10 FOR
SET DIFRD1=$ORDER(@DIFRIN1@(11.1,DIFRD1))
IF 'DIFRD1
QUIT
Begin DoDot:2
+11 SET X=$GET(@DIFRIN1@(11.1,DIFRD1,0))
+12 SET DIFRF=$PIECE(X,U,3)
SET DIFRFLD=$PIECE(X,U,4)
+13 IF 'DIFRF!('DIFRFLD)
QUIT
+14 IF '$DATA(^DD(DIFRF,DIFRFLD,0))
DO ERR3(DIFRF,DIFRFLD,DIFRNAME,"INDEX")
QUIT
+15 IF $ORDER(^DD(DIFRF,DIFRFLD,5,0))
Begin DoDot:3
+16 IF $DATA(^TMP("DIFROMS2",$JOB,"TRIG",DIFRFILE,DIFRF,DIFRFLD))
QUIT
+17 DO TRMOD^DICR(DIFRF,DIFRFLD)
+18 SET ^TMP("DIFROMS2",$JOB,"TRIG",DIFRFLD,DIFRF,DIFRFLD)=""
QUIT
End DoDot:3
+19 QUIT
End DoDot:2
IF DIOUT
QUIT
+20 IF DIOUT
QUIT
+21 NEW DIEN,DIK,DA,DIC,DO
+22 SET DIEN=$ORDER(^DD("IX","BB",DIFRF2,DIFRNAME,0))
+23 IF DIEN
Begin DoDot:2
+24 SET DIK="^DD(""IX"","
SET DA=DIEN
NEW DIEN
DO ^DIK
QUIT
End DoDot:2
NEW DINUM
SET DINUM=DIEN
+25 SET DIC="^DD(""IX"","
SET DIC(0)="L"
SET DIC("DR")=".02///^S X="_""""_DIFRNAME_""""
SET X=DIFRF2
DO FILE^DICN
SET DIEN=+Y
+26 IF DIEN'>0
DO ERR4(DIFRF2,DIFRNAME,"INDEX")
QUIT
+27 MERGE ^DD("IX",DIEN)=@DIFRIN1
+28 KILL DIK,DA
SET DIK="^DD(""IX"","
SET DA=DIEN
DO IX1^DIK
+29 QUIT
End DoDot:1
+30 QUIT
+31 ;
ERR1(DIFRF,DIFRFLD,DIFRNAME,DIFRTYPE) ;
+1 NEW DIFRER
SET DIFRER(1)=DIFRFLD
+2 SET DIFRER(2)=DIFRF
+3 SET DIFRER(3)=DIFRNAME
SET DIFRER(4)=DIFRTYPE
+4 DO BLD^DIALOG(9543,.DIFRER)
SET DIOUT=1
QUIT
ERR2(DIFRF2,DIFRNAME,DIFRTYPE) ;
+1 NEW DIFRER
SET DIFRER(1)=DIFRNAME
SET DIFRER(2)=DIFRTYPE
+2 SET DIFRER(3)=DIFRF2
+3 DO BLD^DIALOG(9544,.DIFRER)
QUIT
ERR3(DIFRF,DIFRFLD,DIFRNAME,DIFRTYPE) ;
+1 NEW DIFRER
SET DIFRER(1)=DIFRTYPE
SET DIFRER(2)=DIFRNAME
+2 SET DIFRER(3)=DIFRFLD
+3 SET DIFRER(4)=DIFRF
+4 DO BLD^DIALOG(9545,.DIFRER)
SET DIOUT=1
QUIT
ERR4(DIFRF2,DIFRNAME,DIFRTYPE) ;
+1 NEW DIFRER
SET DIFRER(1)=DIFRTYPE
SET DIFRER(2)=DIFRNAME
SET DIFRER(3)=DIFRF2
+2 DO BLD^DIALOG(9549,.DIFRER)
QUIT
+3 ;
+4 ;9543 Field |1| of file |2|, part of '|3|' |4| entry, is missing from the transport global...
+5 ;9544 Field(s) that are part of |1| |2| entry are missing from the transport global.
+6 ;9545 |1| entry |2| not installed. The REFERENCE FIELD |3| in file |4| does not exist on the system.
+7 ;9549 |1| "|2|" on file |3| not installed, FILE^DICN call failed.
+8 ;
