DG702PST ;BAY/JAT;
;;5.3;Registration;**702**;Aug 13,1993
;
; This is a post-init routine for DG*5.3*702
; The purpose is to relink File #2 and File #20 records
;
; do environment check
ENV S XPDABORT=""
D PROGCHK(.XPDABORT)
I XPDABORT="" K XPDABORT
Q
PROGCHK(XPDABORT) ; checks for necessary programmer variables
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
.D MES^XPDUTL("Your programming variables are not set up properly.")
.D MES^XPDUTL("Installation aborted.")
.S XPDABORT=2
Q
;
CLEANUP ;
D BMES^XPDUTL("Synchronize Patient file records with file #20")
N DGIEN,DG20IEN,DG2PTR,DG2NAME,DG20PTR,DG20NAME,FDATA,DIERR,DGSTUFF,DA,DIK,CNT
S CNT=0
S DGIEN=0
F S DGIEN=$O(^VA(20,"BB",2,.01,DGIEN)) Q:'DGIEN D
.Q:DGIEN'[",0,"
.S DG20IEN=$O(^VA(20,"BB",2,.01,DGIEN,0))
.S DG2PTR=$P(DGIEN,",")
.S DG2NAME=$P($G(^DPT(DG2PTR,0)),U)
.S DG20PTR=$P($G(^DPT(DG2PTR,"NAME")),U)
.S DG20NAME=$P(^VA(20,DG20IEN,1),U)_","_$P(^VA(20,DG20IEN,1),U,2)
.I $P(^VA(20,DG20IEN,1),U,3)'="" S DG20NAME=DG20NAME_" "_$P(^VA(20,DG20IEN,1),U,3)
.I $P(^VA(20,DG20IEN,1),U,5)'="" S DG20NAME=DG20NAME_" "_$P(^VA(20,DG20IEN,1),U,5)
.I DG2NAME'=DG20NAME Q
.;repoint the Patient file record to the good file 20 record
.K FDATA,DIERR
.S FDATA(2,DG2PTR_",",1.01)=DG20IEN
.D FILE^DIE("","FDATA","DIERR")
.K FDATA,DIERR
.;kill the bad file 20 record - MUST KILL BEFORE REPOINTING THE OTHER
.S DA=DG20PTR
.S DIK="^VA(20,"
.D ^DIK
.K DA,DIK
.;repoint the good file 20 record to the Patient file record
.S DGSTUFF=DG2PTR_","
.S FDATA(20,DG20IEN_",",.03)=DGSTUFF
.D FILE^DIE("","FDATA","DIERR")
.K FDATA,DIERR
.D MES^XPDUTL("Patient file DFN "_DG2PTR_" synchronized with file #20 record IEN "_DG20IEN)
.S CNT=CNT+1
D BMES^XPDUTL("Total number of Patient file records synchronized: "_CNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG702PST 1858 printed Dec 13, 2024@02:40:38 Page 2
DG702PST ;BAY/JAT;
+1 ;;5.3;Registration;**702**;Aug 13,1993
+2 ;
+3 ; This is a post-init routine for DG*5.3*702
+4 ; The purpose is to relink File #2 and File #20 records
+5 ;
+6 ; do environment check
ENV SET XPDABORT=""
+1 DO PROGCHK(.XPDABORT)
+2 IF XPDABORT=""
KILL XPDABORT
+3 QUIT
PROGCHK(XPDABORT) ; checks for necessary programmer variables
+1 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+2 DO MES^XPDUTL("Your programming variables are not set up properly.")
+3 DO MES^XPDUTL("Installation aborted.")
+4 SET XPDABORT=2
End DoDot:1
+5 QUIT
+6 ;
CLEANUP ;
+1 DO BMES^XPDUTL("Synchronize Patient file records with file #20")
+2 NEW DGIEN,DG20IEN,DG2PTR,DG2NAME,DG20PTR,DG20NAME,FDATA,DIERR,DGSTUFF,DA,DIK,CNT
+3 SET CNT=0
+4 SET DGIEN=0
+5 FOR
SET DGIEN=$ORDER(^VA(20,"BB",2,.01,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+6 if DGIEN'[",0,"
QUIT
+7 SET DG20IEN=$ORDER(^VA(20,"BB",2,.01,DGIEN,0))
+8 SET DG2PTR=$PIECE(DGIEN,",")
+9 SET DG2NAME=$PIECE($GET(^DPT(DG2PTR,0)),U)
+10 SET DG20PTR=$PIECE($GET(^DPT(DG2PTR,"NAME")),U)
+11 SET DG20NAME=$PIECE(^VA(20,DG20IEN,1),U)_","_$PIECE(^VA(20,DG20IEN,1),U,2)
+12 IF $PIECE(^VA(20,DG20IEN,1),U,3)'=""
SET DG20NAME=DG20NAME_" "_$PIECE(^VA(20,DG20IEN,1),U,3)
+13 IF $PIECE(^VA(20,DG20IEN,1),U,5)'=""
SET DG20NAME=DG20NAME_" "_$PIECE(^VA(20,DG20IEN,1),U,5)
+14 IF DG2NAME'=DG20NAME
QUIT
+15 ;repoint the Patient file record to the good file 20 record
+16 KILL FDATA,DIERR
+17 SET FDATA(2,DG2PTR_",",1.01)=DG20IEN
+18 DO FILE^DIE("","FDATA","DIERR")
+19 KILL FDATA,DIERR
+20 ;kill the bad file 20 record - MUST KILL BEFORE REPOINTING THE OTHER
+21 SET DA=DG20PTR
+22 SET DIK="^VA(20,"
+23 DO ^DIK
+24 KILL DA,DIK
+25 ;repoint the good file 20 record to the Patient file record
+26 SET DGSTUFF=DG2PTR_","
+27 SET FDATA(20,DG20IEN_",",.03)=DGSTUFF
+28 DO FILE^DIE("","FDATA","DIERR")
+29 KILL FDATA,DIERR
+30 DO MES^XPDUTL("Patient file DFN "_DG2PTR_" synchronized with file #20 record IEN "_DG20IEN)
+31 SET CNT=CNT+1
End DoDot:1
+32 DO BMES^XPDUTL("Total number of Patient file records synchronized: "_CNT)
+33 QUIT
