XT73P44 ;SF-CIOFO/JDS KIDs Post-Init for XT*7.3*44 ;11/10/99 08:35
;;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),".")
;
; 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXT73P44 3256 printed Apr 09, 2024@21:41:30 Page 2
XT73P44 ;SF-CIOFO/JDS KIDs Post-Init for XT*7.3*44 ;11/10/99 08:35
+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 SET I=$ORDER(^XPD(9.7,"B","XT*7.3*38",I))
if I'>0
QUIT
SET XT38DATE=$PIECE($PIECE(^XPD(9.7,I,1),U,3),".")
+8 ;
+9 ; build dup pair list
+10 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
+11 ;from ien
SET DFN=+$PIECE(X,U,$PIECE(X,U,4))
+12 SET @XARRAY@(DFN,+$PIECE(X,U,$SELECT($PIECE(X,U,4)=1:2,1:1)))=I
+13 QUIT
End DoDot:1
+14 ;
+15 ; setup merge process
+16 IF $DATA(@XARRAY)
Begin DoDot:1
+17 NEW XDRXX,XDRYY,XDRMA,XDRFDA,XDRIENS
+18 SET XDRXX(15.2,"+1,",.01)="FIX XREF PROCESS"
+19 SET XDRXX(15.2,"+1,",.02)=2
+20 SET XDRXX(15.2,"+1,",.04)="U"
+21 SET XDRXX(15.2,"+1,",.09)=1
+22 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+23 WRITE !!,"FIX XREF PROCESS has been initialize."
+24 WRITE !,"This merge process will need to be restart via the MERGE package"
+25 SET XDRFDA=$GET(XDRYY(1))
+26 ;
+27 ; move dup pair list into processing array
+28 SET XDRIENS="+1,"_XDRFDA_","
+29 FOR XDRI=0:0
SET XDRI=$ORDER(@XARRAY@(XDRI))
if XDRI'>0
QUIT
Begin DoDot:2
+30 SET XDRJ=$ORDER(@XARRAY@(XDRI,0))
+31 SET XDRK=@XARRAY@(XDRI,XDRJ)
+32 KILL XDRXX,XDRYY
+33 ; ien1
SET XDRXX(15.22,XDRIENS,.01)=XDRI
+34 ; ien2
SET XDRXX(15.22,XDRIENS,.02)=XDRJ
+35 ; entry # in file #15
SET XDRXX(15.22,XDRIENS,.03)=XDRK
+36 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+37 KILL XDRXX,XDRYY,XDRMA
+38 ;
+39 ; indicate that they are in this merge process in file #15
+40 SET XDRXX(15,XDRK_",",.2)=XDRFDA
+41 DO FILE^DIE("","XDRXX")
+42 KILL XDRXX
End DoDot:2
+43 ;
+44 ; setup files to be processed
+45 SET XDRXX(15.23,XDRIENS,.01)="DATA CHECKING"
+46 SET XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
+47 SET XDRXX(15.23,XDRIENS,.03)="C"
+48 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+49 KILL XDRXX,XDRYY,XDRMA
+50 FOR XDRPACK=0:0
SET XDRPACK=$ORDER(^DIC(9.4,XDRPACK))
if XDRPACK'>0
QUIT
Begin DoDot:2
+51 FOR XDRSFILE=0:0
SET XDRSFILE=$ORDER(^DIC(9.4,XDRPACK,20,XDRSFILE))
if XDRSFILE'>0
QUIT
Begin DoDot:3
+52 IF $PIECE(^DIC(9.4,XDRPACK,20,XDRSFILE,0),U)=2
Begin DoDot:4
+53 SET XDRXX(15.23,XDRIENS,.01)=$PIECE(^DIC(9.4,XDRPACK,0),U)
+54 SET XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
+55 SET XDRXX(15.23,XDRIENS,.03)="C"
+56 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+57 KILL XDRXX,XDRYY,XDRMA
End DoDot:4
End DoDot:3
End DoDot:2
+58 ;
+59 SET XDRXX(15.23,XDRIENS,.01)="PATIENT FILE"
+60 SET XDRXX(15.23,XDRIENS,.02)=$$NOW^XLFDT
+61 SET XDRXX(15.23,XDRIENS,.03)="H"
+62 SET XDRXX(15.23,XDRIENS,1.01)=$$NOW^XLFDT
+63 SET XDRXX(15.23,XDRIENS,1.02)=0
+64 DO UPDATE^DIE("","XDRXX","XDRYY","XDRMA")
+65 QUIT
End DoDot:1
+66 QUIT
