ENXIP62 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;12/15/1999
;;7.0;ENGINEERING;**62**;Aug 17, 1993
Q
;
PR ;Pre Install Entry Point
; DBIA #2878 allows update of DD global to remove cross-reference logic
N DA,DIK
; set DIK to the root of the "xref multiple"
S DIK="^DD(6926.01,.01,1,"
; set up DA array where
; DA(2) = subfile#
; DA(1) = field#
; DA = xref#
S DA(2)=6926.01,DA(1)=.01,DA=2
; call DIK to delete xref definition
D ^DIK
; NOTE: since the triggered field is with subfile 6927.03 and is being
; deleted during the post install, no clean-up needs to be taken
; for it.
;
; if patch DI*22*12 installed then use new API to delete trigger logic
; since Engr patch brings in a new definition with fewer lines of code.
S X="DDMOD" X ^%ZOSF("TEST") D:$T DELIX^DDMOD(6928,.01,2),MSG^DIALOG()
Q
;
PS ;Post Install Entry Point
N ENX
; create KIDS checkpoints with call backs
F ENX="XREF","ZZSF","ISSDTO","DELTQI" D
. S Y=$$NEWCP^XPDUTL(ENX,ENX_"^ENXIP62")
. I 'Y D BMES^XPDUTL("ERROR Creating "_ENX_" Checkpoint.")
Q
;
XREF ; build new x-ref
N DA,DIK
;
D BMES^XPDUTL(" Building new x-ref (K) for file 6926 KEYS ISSUED...")
;
; loop thru employees
S DA(1)=0 F S DA(1)=$O(^ENG("KEY",DA(1))) Q:'DA(1) D
. ; build x-ref for entries in subfile
. S DIK="^ENG(""KEY"","_DA(1)_",1,"
. S DIK(1)=".01^K"
. D ENALL^DIK
;
Q
;
ZZSF ; remove ZZ prefixes from #6928.1 local entries when not duplicate
N DA,DIE,DR,ENC,ENSF,ENSFX,X,Y
;
D BMES^XPDUTL(" Removing ZZ prefixes from ENG SPACE FUNCTION...")
;
S ENC=0 ; initialize count of modified entries
;
S DIE="^ENG(6928.1,",DR=".01///^S X=ENSFX"
; loop thru local entries in ENG SPACE FUNCTION
S ENSF="ZY" F S ENSF=$O(^ENG(6928.1,"B",ENSF)) Q:ENSF="" D
. Q:$E(ENSF,1,2)'="ZZ"
. S DA=$O(^ENG(6928.1,"B",ENSF,0)) Q:'DA
. S ENSFX=$E(ENSF,3,999)
. I ENSFX]"",'$O(^ENG(6928.1,"B",ENSFX,0)) D ^DIE S ENC=ENC+1
D MES^XPDUTL(" ZZ prefix was removed from "_ENC_" local entries.")
Q
;
ISSDTO ; Delete data dictionary and data of ISSUED TO subfile within LOCKS file
N DIU
;
I $$GET1^DID(6927.03,.01,"","LABEL")'="ISSUED TO" D Q
. D BMES^XPDUTL(" ISSUED TO subfile #6927.03 aleady deleted.")
;
D BMES^XPDUTL(" Deleting ISSUED TO subfile #6927.03...")
S DIU=6927.03,DIU(0)="SD" D EN^DIU2
;
Q
;
DELTQI ; Delete TOTAL QUANTITY ISSUED field from file 6926.01
N DIE,DA,ENFDA,ENDA,ENDA1
;
I $$GET1^DID(6926.01,2,"","LABEL")'="TOTAL QUANTITY ISSUED" D Q
. D BMES^XPDUTL(" TOTAL QUANTITY ISSUED aleady deleted.")
;
D BMES^XPDUTL(" Deleting TOTAL QUANTITY ISSUED from #6926.01...")
;
; delete data from file
; loop thru employees
S ENDA=0 F S ENDA=$O(^ENG("KEY",ENDA)) Q:'ENDA D
. ; loop thru keys
. S ENDA1=0 F S ENDA1=$O(^ENG("KEY",ENDA,1,ENDA1)) Q:'ENDA1 D
. . ; delete value in total quantity issued
. . Q:$P($G(^ENG("KEY",ENDA,1,ENDA1,0)),U,3)="" ; nothing to delete
. . K ENFDA
. . S ENFDA(6926.01,ENDA1_","_ENDA_",",2)="@"
. . D FILE^DIE("","ENFDA") D MSG^DIALOG()
;
; delete field from DD
K DA S DIK="^DD(6926.01,",DA=2,DA(1)=6926.01 D ^DIK
;
Q
;ENXIP62
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENXIP62 3191 printed Nov 22, 2024@17:07 Page 2
ENXIP62 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;12/15/1999
+1 ;;7.0;ENGINEERING;**62**;Aug 17, 1993
+2 QUIT
+3 ;
PR ;Pre Install Entry Point
+1 ; DBIA #2878 allows update of DD global to remove cross-reference logic
+2 NEW DA,DIK
+3 ; set DIK to the root of the "xref multiple"
+4 SET DIK="^DD(6926.01,.01,1,"
+5 ; set up DA array where
+6 ; DA(2) = subfile#
+7 ; DA(1) = field#
+8 ; DA = xref#
+9 SET DA(2)=6926.01
SET DA(1)=.01
SET DA=2
+10 ; call DIK to delete xref definition
+11 DO ^DIK
+12 ; NOTE: since the triggered field is with subfile 6927.03 and is being
+13 ; deleted during the post install, no clean-up needs to be taken
+14 ; for it.
+15 ;
+16 ; if patch DI*22*12 installed then use new API to delete trigger logic
+17 ; since Engr patch brings in a new definition with fewer lines of code.
+18 SET X="DDMOD"
XECUTE ^%ZOSF("TEST")
if $TEST
DO DELIX^DDMOD(6928,.01,2)
DO MSG^DIALOG()
+19 QUIT
+20 ;
PS ;Post Install Entry Point
+1 NEW ENX
+2 ; create KIDS checkpoints with call backs
+3 FOR ENX="XREF","ZZSF","ISSDTO","DELTQI"
Begin DoDot:1
+4 SET Y=$$NEWCP^XPDUTL(ENX,ENX_"^ENXIP62")
+5 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_ENX_" Checkpoint.")
End DoDot:1
+6 QUIT
+7 ;
XREF ; build new x-ref
+1 NEW DA,DIK
+2 ;
+3 DO BMES^XPDUTL(" Building new x-ref (K) for file 6926 KEYS ISSUED...")
+4 ;
+5 ; loop thru employees
+6 SET DA(1)=0
FOR
SET DA(1)=$ORDER(^ENG("KEY",DA(1)))
if 'DA(1)
QUIT
Begin DoDot:1
+7 ; build x-ref for entries in subfile
+8 SET DIK="^ENG(""KEY"","_DA(1)_",1,"
+9 SET DIK(1)=".01^K"
+10 DO ENALL^DIK
End DoDot:1
+11 ;
+12 QUIT
+13 ;
ZZSF ; remove ZZ prefixes from #6928.1 local entries when not duplicate
+1 NEW DA,DIE,DR,ENC,ENSF,ENSFX,X,Y
+2 ;
+3 DO BMES^XPDUTL(" Removing ZZ prefixes from ENG SPACE FUNCTION...")
+4 ;
+5 ; initialize count of modified entries
SET ENC=0
+6 ;
+7 SET DIE="^ENG(6928.1,"
SET DR=".01///^S X=ENSFX"
+8 ; loop thru local entries in ENG SPACE FUNCTION
+9 SET ENSF="ZY"
FOR
SET ENSF=$ORDER(^ENG(6928.1,"B",ENSF))
if ENSF=""
QUIT
Begin DoDot:1
+10 if $EXTRACT(ENSF,1,2)'="ZZ"
QUIT
+11 SET DA=$ORDER(^ENG(6928.1,"B",ENSF,0))
if 'DA
QUIT
+12 SET ENSFX=$EXTRACT(ENSF,3,999)
+13 IF ENSFX]""
IF '$ORDER(^ENG(6928.1,"B",ENSFX,0))
DO ^DIE
SET ENC=ENC+1
End DoDot:1
+14 DO MES^XPDUTL(" ZZ prefix was removed from "_ENC_" local entries.")
+15 QUIT
+16 ;
ISSDTO ; Delete data dictionary and data of ISSUED TO subfile within LOCKS file
+1 NEW DIU
+2 ;
+3 IF $$GET1^DID(6927.03,.01,"","LABEL")'="ISSUED TO"
Begin DoDot:1
+4 DO BMES^XPDUTL(" ISSUED TO subfile #6927.03 aleady deleted.")
End DoDot:1
QUIT
+5 ;
+6 DO BMES^XPDUTL(" Deleting ISSUED TO subfile #6927.03...")
+7 SET DIU=6927.03
SET DIU(0)="SD"
DO EN^DIU2
+8 ;
+9 QUIT
+10 ;
DELTQI ; Delete TOTAL QUANTITY ISSUED field from file 6926.01
+1 NEW DIE,DA,ENFDA,ENDA,ENDA1
+2 ;
+3 IF $$GET1^DID(6926.01,2,"","LABEL")'="TOTAL QUANTITY ISSUED"
Begin DoDot:1
+4 DO BMES^XPDUTL(" TOTAL QUANTITY ISSUED aleady deleted.")
End DoDot:1
QUIT
+5 ;
+6 DO BMES^XPDUTL(" Deleting TOTAL QUANTITY ISSUED from #6926.01...")
+7 ;
+8 ; delete data from file
+9 ; loop thru employees
+10 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG("KEY",ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+11 ; loop thru keys
+12 SET ENDA1=0
FOR
SET ENDA1=$ORDER(^ENG("KEY",ENDA,1,ENDA1))
if 'ENDA1
QUIT
Begin DoDot:2
+13 ; delete value in total quantity issued
+14 ; nothing to delete
if $PIECE($GET(^ENG("KEY",ENDA,1,ENDA1,0)),U,3)=""
QUIT
+15 KILL ENFDA
+16 SET ENFDA(6926.01,ENDA1_","_ENDA_",",2)="@"
+17 DO FILE^DIE("","ENFDA")
DO MSG^DIALOG()
End DoDot:2
End DoDot:1
+18 ;
+19 ; delete field from DD
+20 KILL DA
SET DIK="^DD(6926.01,"
SET DA=2
SET DA(1)=6926.01
DO ^DIK
+21 ;
+22 QUIT
+23 ;ENXIP62