- DG53705I ;ALB/TMK - DG*5.3*705 Pre-Install Routine ; 05-APR-2006
- ;;5.3;Registration;**705**;Aug 13, 1993
- ;
- EN ; Description: This entry point will be used as a driver for
- ; pre-installation updates.
- ; DBIA: 4542 for direct DD global access/kills and for one-time
- ; call to Fileman PT node cleanup (PT^DDUCHK1)
- ;
- ; If the patch DVB*4*54 was not installed, skip the cleanup
- N %
- K ^TMP("DG*5.3*705",$J)
- S %=$$CKUPD^DG53705E()
- I '% D Q
- . N ZMES,I
- . F I=1,2 S ZMES(I)=" "
- . S ZMES(3)="**** PATCH IS BEING INSTALLED IN NON-UPDATE MODE ****"
- . S ZMES(4)=" "
- . S ZMES(5)="NOTE: THE SYSTEM HAS DETERMINED THAT YOUR PATIENT FILE DOES NOT HAVE BAD"
- . S ZMES(6)=" DATA FROM PATCH DVB*4*54. THEREFORE, THE STATUS OF PATCH DG*5.3*705"
- . S ZMES(7)=" WILL BE 'INSTALLED', HOWEVER NO UPDATES TO YOUR SYSTEM WILL BE MADE."
- . D MES^XPDUTL(.ZMES)
- ;
- D BMES^XPDUTL("**** PATCH IS BEING INSTALLED IN UPDATE MODE ****")
- D DELMISC
- D DELPTR
- D DELXREF
- D DELID
- D DELDESCR
- D DONE
- Q
- ;
- DELMISC ; Delete various miscellaneous nodes:
- ; write access, help, executable help, audit, etc
- D BMES^XPDUTL(">>> Deleting bad write access, help, audit, other miscellaneous nodes")
- K ^DD(2,.12113,9),^DD(2,.14112,9)
- K ^DD(2,.108,3)
- K ^DD(2,.391,4)
- F Z=.01,.2924,.3111,.3192,991.07 K ^DD(2,Z,"AUDIT")
- K ^DD(2.312,.18,"AUDIT")
- K ^DIC(2,0,"AUDIT")
- K ^DD(2,0,"VR")
- K ^DD(2,0,"VRPK")
- K ^DIC(2,"%",7,0)
- K ^DIC(2,"%","B","QAM",7)
- D STEP
- Q
- ;
- DELPTR ; Delete bad pointer nodes
- N Z,Z0
- D BMES^XPDUTL(">>> Deleting bad pointer nodes")
- S DDUCFI=2,DDUCFIX=1 D PT^DDUCHK1 ; IA
- D STEP
- Q
- ;
- DELID ; Delete bad identifier nodes
- N Z
- D BMES^XPDUTL(">>> Deleting bad identifier nodes")
- F Z=.2924,.302,.351,"GARB","WARD","WR","ZREW" K ^DD(2,0,"ID",Z)
- D STEP
- Q
- ;
- DELDESCR ;Delete excess description nodes
- N Z
- D BMES^XPDUTL(">>> Deleting bad field description nodes")
- S Z=1 F S Z=$O(^DD(2,.107,21,Z)) Q:'Z K ^DD(2,.107,21,Z,0)
- D STEP
- Q
- ;
- DELXREF ; Delete cross references and indexes
- N DGZ,DGZF,DGZFLD,DGZN,DGDEL,DGXREF,X,Z
- D BMES^XPDUTL(">>> Deleting bad cross references and indexes")
- ;
- ; Delete indexes 'ADGFM01', 'ADGFM03', 'ADGFM09', 'ADGFM351'
- F DGZ="ADGFM01","ADGFM03","ADGFM09","ADGFM351" D DELIXN^DDMOD(2,DGZ)
- ; Delete a trigger xref for file 2.01, field 100.03
- S Z=0 F S Z=$O(^DD(2.01,100.03,1,Z)) Q:'Z I $P($G(^DD(2.01,100.03,1,Z,0)),U,3,5)="TRIGGER^20^.01" D DELIX^DDMOD(2.01,100.03,Z) Q
- ;
- F Z=2:1 S X=$P($T(@("XREF+"_Z)),";;",2) Q:X="" S DGZ(+X,+$P(X,U,2),$P(X,U,4))=$P(X,U,3) ;Extracts xrefs to delete
- ;
- S DGZF=0
- F S DGZF=$O(DGZ(DGZF)) Q:'DGZF S DGZFLD=0 F S DGZFLD=$O(DGZ(DGZF,DGZFLD)) Q:'DGZFLD S DGZN="" F S DGZN=$O(DGZ(DGZF,DGZFLD,DGZN)) Q:DGZN="" D
- . S DGZ=$G(DGZ(DGZF,DGZFLD,DGZN))
- . I 'DGZ,'$$CHK1(DGZF,DGZFLD,DGZN) K ^DD(DGZF,0,"IX",DGZN,DGZF,DGZFLD)
- . I DGZ S Z=$$CHK2(DGZF,DGZFLD,DGZN,DGZ) I Z D DELIX^DDMOD(DGZF,DGZFLD,Z)
- K ^TMP("DIERR",$J)
- D STEP
- Q
- ;
- CHK1(FILE,FLD,XREFNM) ; Check if xref exists
- ; Functon returns 1 if it exists, 0 if it doesn't
- N Z,OK
- S (OK,Z)=0
- F S Z=$O(^DD(FILE,FLD,1,Z)) Q:'Z I $P($G(^(Z,0)),U,2)=XREFNM S OK=1 Q
- Q OK
- ;
- CHK2(FILE,FLD,XREFNM,XREFNO) ; Returns ien of xref
- N Z,NUM
- S Z=0
- S NUM=$S($P($G(^DD(FILE,FLD,1,XREFNO,0)),U,2)=XREFNM:XREFNO,1:0)
- I 'NUM F S Z=$O(^DD(FILE,FLD,1,Z)) Q:'Z I $P($G(^DD(FILE,FLD,1,Z,0)),U,2)=XREFNM S NUM=Z Q
- Q NUM
- ;
- STEP D BMES^XPDUTL(">>> Step Completed.")
- Q
- ;
- DONE D BMES^XPDUTL(">>> Pre-install Cleanup Completed.")
- S ^TMP("DG*5.3*705",$J)="1^PATCH DVB*4*54 INSTALLED"
- Q
- ;
- CLEAN ; Erase TMP global used to screen DD update
- K ^TMP("DG*5.3*705",$J)
- Q
- ;
- XREF ; Xrefs that must be deleted
- ;; Pieces are: File #^Fld #^xref default #or null^xref name
- ;;2^.01^^AHL
- ;;2^.02^^AHL2
- ;;2^.03^^AHL3
- ;;2^.03^5^DGFCMON
- ;;2^.05^993^AENR05
- ;;2^.06^^AHL5
- ;;2^.09^^AHL4
- ;;2^.102^^A4EC
- ;;2^.118^3^AENR118
- ;;2^.121^1^AENR121
- ;;2^.12111^1^AENR12111
- ;;2^.1219^1^AENR1219
- ;;2^.14111^1^AENR14111
- ;;2^.152^4^AU
- ;;2^.1656^1^AENR1656
- ;;2^.293^1^AENR293
- ;;2^.302^^ACP
- ;;2^.302^^AP
- ;;2^.3025^3^AENR3025
- ;;2^.3025^^CHK4
- ;;2^.304^1^AENR304
- ;;2^.307^1^AENR307
- ;;2^.3111^2^AENR3111
- ;;2^.31115^^AEMP
- ;;2^.31115^992^AENR31115
- ;;2^.31115^^MAC
- ;;2^.312^2^AENR312
- ;;2^.313^992^AENR313
- ;;2^.3192^1^AENR3192
- ;;2^.32102^^AI
- ;;2^.32103^^AK
- ;;2^.323^992^AENR323
- ;;2^.351^^AEXP
- ;;2^.351^^AHL6
- ;;2^.351^^AT
- ;;2^.353^1^AENR353
- ;;2^.354^1^AENR354
- ;;2^.361^^AR
- ;;2^.3611^3^AENR3611
- ;;2^.3612^2^AENR3612
- ;;2^.3615^1^AENR3615
- ;;2^.3617^1^AENR3617
- ;;2^.3618^1^AENR3618
- ;;2^.36205^^BEN
- ;;2^.36205^^CHK1
- ;;2^.36215^^CHK2
- ;;2^.36235^^CHK3
- ;;2^.381^^AT
- ;;2^.382^1^AENR382
- ;;2^.391^1^AENR391
- ;;2^.392^1^AENR392
- ;;2^.393^1^AENR393
- ;;2^.394^1^AENR394
- ;;2^.395^1^AENR395
- ;;2^.532^2^AENR532
- ;;2^.533^1^AENR533
- ;;2^1010.1511^1^AENR10101511
- ;;2^1010.159^1^AENR1010159
- ;;2^1901^2^AN
- ;;2.04^.01^1^AENR01
- ;;2.04^2^1^AENR2
- ;;2.04^3^1^AENR3
- ;;2.312^.01^6^AENR01
- ;;2.312^.18^2^AENR18
- ;;2.312^1^2^AENR1
- ;;2.312^2^1^AENR2
- ;;2.312^3^2^AENR3
- ;;2.312^6^1^AENR6
- ;;2.312^8^2^AENR8
- ;;2.312^17^1^AENR17
- ;;2.396^.01^2^AENR01
- ;;2.397^.01^2^AENR01
- ;;2.397^1^1^AENR1
- ;;2.398^.01^2^AENR01
- ;;2.398^1^1^AENR1
- ;;2.398^2^1^AENR2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53705I 5359 printed Feb 19, 2025@00:04:31 Page 2
- DG53705I ;ALB/TMK - DG*5.3*705 Pre-Install Routine ; 05-APR-2006
- +1 ;;5.3;Registration;**705**;Aug 13, 1993
- +2 ;
- EN ; Description: This entry point will be used as a driver for
- +1 ; pre-installation updates.
- +2 ; DBIA: 4542 for direct DD global access/kills and for one-time
- +3 ; call to Fileman PT node cleanup (PT^DDUCHK1)
- +4 ;
- +5 ; If the patch DVB*4*54 was not installed, skip the cleanup
- +6 NEW %
- +7 KILL ^TMP("DG*5.3*705",$JOB)
- +8 SET %=$$CKUPD^DG53705E()
- +9 IF '%
- Begin DoDot:1
- +10 NEW ZMES,I
- +11 FOR I=1,2
- SET ZMES(I)=" "
- +12 SET ZMES(3)="**** PATCH IS BEING INSTALLED IN NON-UPDATE MODE ****"
- +13 SET ZMES(4)=" "
- +14 SET ZMES(5)="NOTE: THE SYSTEM HAS DETERMINED THAT YOUR PATIENT FILE DOES NOT HAVE BAD"
- +15 SET ZMES(6)=" DATA FROM PATCH DVB*4*54. THEREFORE, THE STATUS OF PATCH DG*5.3*705"
- +16 SET ZMES(7)=" WILL BE 'INSTALLED', HOWEVER NO UPDATES TO YOUR SYSTEM WILL BE MADE."
- +17 DO MES^XPDUTL(.ZMES)
- End DoDot:1
- QUIT
- +18 ;
- +19 DO BMES^XPDUTL("**** PATCH IS BEING INSTALLED IN UPDATE MODE ****")
- +20 DO DELMISC
- +21 DO DELPTR
- +22 DO DELXREF
- +23 DO DELID
- +24 DO DELDESCR
- +25 DO DONE
- +26 QUIT
- +27 ;
- DELMISC ; Delete various miscellaneous nodes:
- +1 ; write access, help, executable help, audit, etc
- +2 DO BMES^XPDUTL(">>> Deleting bad write access, help, audit, other miscellaneous nodes")
- +3 KILL ^DD(2,.12113,9),^DD(2,.14112,9)
- +4 KILL ^DD(2,.108,3)
- +5 KILL ^DD(2,.391,4)
- +6 FOR Z=.01,.2924,.3111,.3192,991.07
- KILL ^DD(2,Z,"AUDIT")
- +7 KILL ^DD(2.312,.18,"AUDIT")
- +8 KILL ^DIC(2,0,"AUDIT")
- +9 KILL ^DD(2,0,"VR")
- +10 KILL ^DD(2,0,"VRPK")
- +11 KILL ^DIC(2,"%",7,0)
- +12 KILL ^DIC(2,"%","B","QAM",7)
- +13 DO STEP
- +14 QUIT
- +15 ;
- DELPTR ; Delete bad pointer nodes
- +1 NEW Z,Z0
- +2 DO BMES^XPDUTL(">>> Deleting bad pointer nodes")
- +3 ; IA
- SET DDUCFI=2
- SET DDUCFIX=1
- DO PT^DDUCHK1
- +4 DO STEP
- +5 QUIT
- +6 ;
- DELID ; Delete bad identifier nodes
- +1 NEW Z
- +2 DO BMES^XPDUTL(">>> Deleting bad identifier nodes")
- +3 FOR Z=.2924,.302,.351,"GARB","WARD","WR","ZREW"
- KILL ^DD(2,0,"ID",Z)
- +4 DO STEP
- +5 QUIT
- +6 ;
- DELDESCR ;Delete excess description nodes
- +1 NEW Z
- +2 DO BMES^XPDUTL(">>> Deleting bad field description nodes")
- +3 SET Z=1
- FOR
- SET Z=$ORDER(^DD(2,.107,21,Z))
- if 'Z
- QUIT
- KILL ^DD(2,.107,21,Z,0)
- +4 DO STEP
- +5 QUIT
- +6 ;
- DELXREF ; Delete cross references and indexes
- +1 NEW DGZ,DGZF,DGZFLD,DGZN,DGDEL,DGXREF,X,Z
- +2 DO BMES^XPDUTL(">>> Deleting bad cross references and indexes")
- +3 ;
- +4 ; Delete indexes 'ADGFM01', 'ADGFM03', 'ADGFM09', 'ADGFM351'
- +5 FOR DGZ="ADGFM01","ADGFM03","ADGFM09","ADGFM351"
- DO DELIXN^DDMOD(2,DGZ)
- +6 ; Delete a trigger xref for file 2.01, field 100.03
- +7 SET Z=0
- FOR
- SET Z=$ORDER(^DD(2.01,100.03,1,Z))
- if 'Z
- QUIT
- IF $PIECE($GET(^DD(2.01,100.03,1,Z,0)),U,3,5)="TRIGGER^20^.01"
- DO DELIX^DDMOD(2.01,100.03,Z)
- QUIT
- +8 ;
- +9 ;Extracts xrefs to delete
- FOR Z=2:1
- SET X=$PIECE($TEXT(@("XREF+"_Z)),";;",2)
- if X=""
- QUIT
- SET DGZ(+X,+$PIECE(X,U,2),$PIECE(X,U,4))=$PIECE(X,U,3)
- +10 ;
- +11 SET DGZF=0
- +12 FOR
- SET DGZF=$ORDER(DGZ(DGZF))
- if 'DGZF
- QUIT
- SET DGZFLD=0
- FOR
- SET DGZFLD=$ORDER(DGZ(DGZF,DGZFLD))
- if 'DGZFLD
- QUIT
- SET DGZN=""
- FOR
- SET DGZN=$ORDER(DGZ(DGZF,DGZFLD,DGZN))
- if DGZN=""
- QUIT
- Begin DoDot:1
- +13 SET DGZ=$GET(DGZ(DGZF,DGZFLD,DGZN))
- +14 IF 'DGZ
- IF '$$CHK1(DGZF,DGZFLD,DGZN)
- KILL ^DD(DGZF,0,"IX",DGZN,DGZF,DGZFLD)
- +15 IF DGZ
- SET Z=$$CHK2(DGZF,DGZFLD,DGZN,DGZ)
- IF Z
- DO DELIX^DDMOD(DGZF,DGZFLD,Z)
- End DoDot:1
- +16 KILL ^TMP("DIERR",$JOB)
- +17 DO STEP
- +18 QUIT
- +19 ;
- CHK1(FILE,FLD,XREFNM) ; Check if xref exists
- +1 ; Functon returns 1 if it exists, 0 if it doesn't
- +2 NEW Z,OK
- +3 SET (OK,Z)=0
- +4 FOR
- SET Z=$ORDER(^DD(FILE,FLD,1,Z))
- if 'Z
- QUIT
- IF $PIECE($GET(^(Z,0)),U,2)=XREFNM
- SET OK=1
- QUIT
- +5 QUIT OK
- +6 ;
- CHK2(FILE,FLD,XREFNM,XREFNO) ; Returns ien of xref
- +1 NEW Z,NUM
- +2 SET Z=0
- +3 SET NUM=$SELECT($PIECE($GET(^DD(FILE,FLD,1,XREFNO,0)),U,2)=XREFNM:XREFNO,1:0)
- +4 IF 'NUM
- FOR
- SET Z=$ORDER(^DD(FILE,FLD,1,Z))
- if 'Z
- QUIT
- IF $PIECE($GET(^DD(FILE,FLD,1,Z,0)),U,2)=XREFNM
- SET NUM=Z
- QUIT
- +5 QUIT NUM
- +6 ;
- STEP DO BMES^XPDUTL(">>> Step Completed.")
- +1 QUIT
- +2 ;
- DONE DO BMES^XPDUTL(">>> Pre-install Cleanup Completed.")
- +1 SET ^TMP("DG*5.3*705",$JOB)="1^PATCH DVB*4*54 INSTALLED"
- +2 QUIT
- +3 ;
- CLEAN ; Erase TMP global used to screen DD update
- +1 KILL ^TMP("DG*5.3*705",$JOB)
- +2 QUIT
- +3 ;
- XREF ; Xrefs that must be deleted
- +1 ;; Pieces are: File #^Fld #^xref default #or null^xref name
- +2 ;;2^.01^^AHL
- +3 ;;2^.02^^AHL2
- +4 ;;2^.03^^AHL3
- +5 ;;2^.03^5^DGFCMON
- +6 ;;2^.05^993^AENR05
- +7 ;;2^.06^^AHL5
- +8 ;;2^.09^^AHL4
- +9 ;;2^.102^^A4EC
- +10 ;;2^.118^3^AENR118
- +11 ;;2^.121^1^AENR121
- +12 ;;2^.12111^1^AENR12111
- +13 ;;2^.1219^1^AENR1219
- +14 ;;2^.14111^1^AENR14111
- +15 ;;2^.152^4^AU
- +16 ;;2^.1656^1^AENR1656
- +17 ;;2^.293^1^AENR293
- +18 ;;2^.302^^ACP
- +19 ;;2^.302^^AP
- +20 ;;2^.3025^3^AENR3025
- +21 ;;2^.3025^^CHK4
- +22 ;;2^.304^1^AENR304
- +23 ;;2^.307^1^AENR307
- +24 ;;2^.3111^2^AENR3111
- +25 ;;2^.31115^^AEMP
- +26 ;;2^.31115^992^AENR31115
- +27 ;;2^.31115^^MAC
- +28 ;;2^.312^2^AENR312
- +29 ;;2^.313^992^AENR313
- +30 ;;2^.3192^1^AENR3192
- +31 ;;2^.32102^^AI
- +32 ;;2^.32103^^AK
- +33 ;;2^.323^992^AENR323
- +34 ;;2^.351^^AEXP
- +35 ;;2^.351^^AHL6
- +36 ;;2^.351^^AT
- +37 ;;2^.353^1^AENR353
- +38 ;;2^.354^1^AENR354
- +39 ;;2^.361^^AR
- +40 ;;2^.3611^3^AENR3611
- +41 ;;2^.3612^2^AENR3612
- +42 ;;2^.3615^1^AENR3615
- +43 ;;2^.3617^1^AENR3617
- +44 ;;2^.3618^1^AENR3618
- +45 ;;2^.36205^^BEN
- +46 ;;2^.36205^^CHK1
- +47 ;;2^.36215^^CHK2
- +48 ;;2^.36235^^CHK3
- +49 ;;2^.381^^AT
- +50 ;;2^.382^1^AENR382
- +51 ;;2^.391^1^AENR391
- +52 ;;2^.392^1^AENR392
- +53 ;;2^.393^1^AENR393
- +54 ;;2^.394^1^AENR394
- +55 ;;2^.395^1^AENR395
- +56 ;;2^.532^2^AENR532
- +57 ;;2^.533^1^AENR533
- +58 ;;2^1010.1511^1^AENR10101511
- +59 ;;2^1010.159^1^AENR1010159
- +60 ;;2^1901^2^AN
- +61 ;;2.04^.01^1^AENR01
- +62 ;;2.04^2^1^AENR2
- +63 ;;2.04^3^1^AENR3
- +64 ;;2.312^.01^6^AENR01
- +65 ;;2.312^.18^2^AENR18
- +66 ;;2.312^1^2^AENR1
- +67 ;;2.312^2^1^AENR2
- +68 ;;2.312^3^2^AENR3
- +69 ;;2.312^6^1^AENR6
- +70 ;;2.312^8^2^AENR8
- +71 ;;2.312^17^1^AENR17
- +72 ;;2.396^.01^2^AENR01
- +73 ;;2.397^.01^2^AENR01
- +74 ;;2.397^1^1^AENR1
- +75 ;;2.398^.01^2^AENR01
- +76 ;;2.398^1^1^AENR1
- +77 ;;2.398^2^1^AENR2