XT73P44 ;SF-CIOFO/JDS KIDs Post-Init for XT*7.3*44 ;11/10/99 08:35 [ 01/07/2003 2:34 PM ]
;;KIDs Post-Init
;
; LR - Entry point for clean-up of the ^DPT(ien,"LR") node
; that was corrected in patch XT*7.3*36. All past merge
; pairs will be search to see if a two piece "LR" node
; exist on the "TO" record and clean-up where necessary.
;
; XREF - Entry point for clean-up of records that didn't get
; completely merged because of problems in the x-ref
; processing. These problems have been fixed in patch
; XT*7.3*44.
;
EN ;
D LR
D XREF
Q
;
LR ;
N I,IEN
W !,"Processing merged pairs to check 'LR' node's .."
F I=0:0 S I=$O(^XDRM(I)) Q:I'>0 D
. S IEN=+$P(^XDRM(I,0),U,2)
. I $D(^DPT(IEN,"LR")) S ^DPT(IEN,"LR")=$P(^DPT(IEN,"LR"),U)
. W "."
W !!,"'LR' node clean-up completed"
Q
;
XREF ;
N I,X,DFN,XARRAY,XT38DATE
S XARRAY=$NA(^TMP("XDRXREF",$J))
K @XARRAY
;
; set XT*7.3*38 date
S I=""
;S I=$O(^XPD(9.7,"B","XT*7.3*38",I)) Q:I'>0 S XT38DATE=$P($P(^XPD(9.7,I,1),U,3),".") ;AEF 01/02/03 COMMENTED OUT AND REPLACED BY LINE BELOW
S I=$O(^XPD(9.7,"B","XT*7.3*38",I)) Q:I'>0 S XT38DATE=$P($P(^XPD(9.7,I,0),U,3),".") ;AEF 01/02/03 TO CHANGE NODE FROM 1 TO 0 TO PREVENT <UNDEF>XREF+7^XT73P44 ERROR
;
; build dup pair list
F I=0:0 S I=$O(^VA(15,I)) Q:I'>0 S X=^(I,0) I $P($P(X,U),";",2)="DPT(",$P(X,U,5)=2,XT38DATE'>$P(X,U,8) D
. S DFN=+$P(X,U,$P(X,U,4)) ;from ien
. S @XARRAY@(DFN,+$P(X,U,$S($P(X,U,4)=1:2,1:1)))=I
. Q
;
; setup merge process
I $D(@XARRAY) D
. N XDRXX,XDRYY,XDRMA,XDRFDA,XDRIENS
. S XDRXX(15.2,"+1,",.01)="FIX XREF PROCESS"
. S XDRXX(15.2,"+1,",.02)=2
. S XDRXX(15.2,"+1,",.04)="U"
. S XDRXX(15.2,"+1,",.09)=1
. D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
. W !!,"FIX XREF PROCESS has been initialize."
. W !,"This merge process will need to be restart via the MERGE package"
. S XDRFDA=$G(XDRYY(1))
. ;
. ; move dup pair list into processing array
. S XDRIENS="+1,"_XDRFDA_","
. F XDRI=0:0 S XDRI=$O(@XARRAY@(XDRI)) Q:XDRI'>0 D
. . S XDRJ=$O(@XARRAY@(XDRI,0))
. . S XDRK=@XARRAY@(XDRI,XDRJ)
. . K XDRXX,XDRYY
. . S XDRXX(15.22,XDRIENS,.01)=XDRI ; ien1
. . S XDRXX(15.22,XDRIENS,.02)=XDRJ ; ien2
. . S XDRXX(15.22,XDRIENS,.03)=XDRK ; entry # in file #15
. . D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
. . K XDRXX,XDRYY,XDRMA
. . ;
. . ; indicate that they are in this merge process in file #15
. . S XDRXX(15,XDRK_",",.2)=XDRFDA
. . D FILE^DIE("","XDRXX")
. . K XDRXX
. ;
. ; setup files to be processed
. S XDRXX(15.23,XDRIENS,.01)="DATA CHECKING"
. S XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
. S XDRXX(15.23,XDRIENS,.03)="C"
. D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
. K XDRXX,XDRYY,XDRMA
. F XDRPACK=0:0 S XDRPACK=$O(^DIC(9.4,XDRPACK)) Q:XDRPACK'>0 D
. . F XDRSFILE=0:0 S XDRSFILE=$O(^DIC(9.4,XDRPACK,20,XDRSFILE)) Q:XDRSFILE'>0 D
. . . I $P(^DIC(9.4,XDRPACK,20,XDRSFILE,0),U)=2 D
. . . . S XDRXX(15.23,XDRIENS,.01)=$P(^DIC(9.4,XDRPACK,0),U)
. . . . S XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
. . . . S XDRXX(15.23,XDRIENS,.03)="C"
. . . . D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
. . . . K XDRXX,XDRYY,XDRMA
. ;
. S XDRXX(15.23,XDRIENS,.01)="PATIENT FILE"
. S XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
. S XDRXX(15.23,XDRIENS,.03)="H"
. S XDRXX(15.23,XDRIENS,1.01)=$$NOW^XLFDT
. S XDRXX(15.23,XDRIENS,1.02)=0
. D UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
. Q
Q
XT73P44 ;SF-CIOFO/JDS KIDs Post-Init for XT*7.3*44 ;11/10/99 08:35 [ 01/07/2003 2:34 PM ]
+1 ;;KIDs Post-Init
+2 ;
+3 ; LR - Entry point for clean-up of the ^DPT(ien,"LR") node
+4 ; that was corrected in patch XT*7.3*36. All past merge
+5 ; pairs will be search to see if a two piece "LR" node
+6 ; exist on the "TO" record and clean-up where necessary.
+7 ;
+8 ; XREF - Entry point for clean-up of records that didn't get
+9 ; completely merged because of problems in the x-ref
+10 ; processing. These problems have been fixed in patch
+11 ; XT*7.3*44.
+12 ;
EN ;
+1 DO LR
+2 DO XREF
+3 QUIT
+4 ;
LR ;
+1 NEW I,IEN
+2 WRITE !,"Processing merged pairs to check 'LR' node's .."
+3 FOR I=0:0
SET I=$ORDER(^XDRM(I))
IF I'>0
QUIT
Begin DoDot:1
+4 SET IEN=+$PIECE(^XDRM(I,0),U,2)
+5 IF $DATA(^DPT(IEN,"LR"))
SET ^DPT(IEN,"LR")=$PIECE(^DPT(IEN,"LR"),U)
+6 WRITE "."
End DoDot:1
+7 WRITE !!,"'LR' node clean-up completed"
+8 QUIT
+9 ;
XREF ;
+1 NEW I,X,DFN,XARRAY,XT38DATE
+2 SET XARRAY=$NAME(^TMP("XDRXREF",$JOB))
+3 KILL @XARRAY
+4 ;
+5 ; set XT*7.3*38 date
+6 SET I=""
+7 ;S I=$O(^XPD(9.7,"B","XT*7.3*38",I)) Q:I'>0 S XT38DATE=$P($P(^XPD(9.7,I,1),U,3),".") ;AEF 01/02/03 COMMENTED OUT AND REPLACED BY LINE BELOW
+8 ;AEF 01/02/03 TO CHANGE NODE FROM 1 TO 0 TO PREVENT <UNDEF>XREF+7^XT73P44 ERROR
SET I=$ORDER(^XPD(9.7,"B","XT*7.3*38",I))
IF I'>0
QUIT
SET XT38DATE=$PIECE($PIECE(^XPD(9.7,I,0),U,3),".")
+9 ;
+10 ; build dup pair list
+11 FOR I=0:0
SET I=$ORDER(^VA(15,I))
IF I'>0
QUIT
SET X=^(I,0)
IF $PIECE($PIECE(X,U),";",2)="DPT("
IF $PIECE(X,U,5)=2
IF XT38DATE'>$PIECE(X,U,8)
Begin DoDot:1
+12 ;from ien
SET DFN=+$PIECE(X,U,$PIECE(X,U,4))
+13 SET @XARRAY@(DFN,+$PIECE(X,U,$SELECT($PIECE(X,U,4)=1:2,1:1)))=I
+14 QUIT
End DoDot:1
+15 ;
+16 ; setup merge process
+17 IF $DATA(@XARRAY)
Begin DoDot:1
+18 NEW XDRXX,XDRYY,XDRMA,XDRFDA,XDRIENS
+19 SET XDRXX(15.2,"+1,",.01)="FIX XREF PROCESS"
+20 SET XDRXX(15.2,"+1,",.02)=2
+21 SET XDRXX(15.2,"+1,",.04)="U"
+22 SET XDRXX(15.2,"+1,",.09)=1
+23 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+24 WRITE !!,"FIX XREF PROCESS has been initialize."
+25 WRITE !,"This merge process will need to be restart via the MERGE package"
+26 SET XDRFDA=$GET(XDRYY(1))
+27 ;
+28 ; move dup pair list into processing array
+29 SET XDRIENS="+1,"_XDRFDA_","
+30 FOR XDRI=0:0
SET XDRI=$ORDER(@XARRAY@(XDRI))
IF XDRI'>0
QUIT
Begin DoDot:2
+31 SET XDRJ=$ORDER(@XARRAY@(XDRI,0))
+32 SET XDRK=@XARRAY@(XDRI,XDRJ)
+33 KILL XDRXX,XDRYY
+34 ; ien1
SET XDRXX(15.22,XDRIENS,.01)=XDRI
+35 ; ien2
SET XDRXX(15.22,XDRIENS,.02)=XDRJ
+36 ; entry # in file #15
SET XDRXX(15.22,XDRIENS,.03)=XDRK
+37 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+38 KILL XDRXX,XDRYY,XDRMA
+39 ;
+40 ; indicate that they are in this merge process in file #15
+41 SET XDRXX(15,XDRK_",",.2)=XDRFDA
+42 DO FILE^DIE("","XDRXX")
+43 KILL XDRXX
End DoDot:2
+44 ;
+45 ; setup files to be processed
+46 SET XDRXX(15.23,XDRIENS,.01)="DATA CHECKING"
+47 SET XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
+48 SET XDRXX(15.23,XDRIENS,.03)="C"
+49 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+50 KILL XDRXX,XDRYY,XDRMA
+51 FOR XDRPACK=0:0
SET XDRPACK=$ORDER(^DIC(9.4,XDRPACK))
IF XDRPACK'>0
QUIT
Begin DoDot:2
+52 FOR XDRSFILE=0:0
SET XDRSFILE=$ORDER(^DIC(9.4,XDRPACK,20,XDRSFILE))
IF XDRSFILE'>0
QUIT
Begin DoDot:3
+53 IF $PIECE(^DIC(9.4,XDRPACK,20,XDRSFILE,0),U)=2
Begin DoDot:4
+54 SET XDRXX(15.23,XDRIENS,.01)=$PIECE(^DIC(9.4,XDRPACK,0),U)
+55 SET XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
+56 SET XDRXX(15.23,XDRIENS,.03)="C"
+57 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+58 KILL XDRXX,XDRYY,XDRMA
End DoDot:4
End DoDot:3
End DoDot:2
+59 ;
+60 SET XDRXX(15.23,XDRIENS,.01)="PATIENT FILE"
+61 SET XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
+62 SET XDRXX(15.23,XDRIENS,.03)="H"
+63 SET XDRXX(15.23,XDRIENS,1.01)=$$NOW^XLFDT
+64 SET XDRXX(15.23,XDRIENS,1.02)=0
+65 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+66 QUIT
End DoDot:1
+67 QUIT
