- 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
