DIPR157 ;O-OIFO/GMB-Functions: Delete SETDATA. Add DUPLICATED ;03/27/2008
;;22.0;VA FileMan;**157**;Mar 30, 1999;Build 7
;Per VHA Directive 2004-038, this routine should not be modified.
ENV ; Environmental Check
N DELFUNC,ADDFUNC
D BMES^XPDUTL("Perform Environment Check...")
D CHKSTOP
D INIT
I $D(DELFUNC) D CHKDEL
I $D(ADDFUNC) D CHKADD
D BMES^XPDUTL("Finished Environment Check.")
Q
CHKDEL ;
D BMES^XPDUTL("Checking Function(s) to be deleted from FUNCTION file ^DD(""FUNC""...")
N IEN
S IEN=0
F S IEN=$O(DELFUNC(IEN)) Q:'IEN D
. S DELFUNC=DELFUNC(IEN,0)
. D BMES^XPDUTL("...Checking for function "_DELFUNC_" at IEN "_IEN)
. I '$D(^DD("FUNC",IEN)) D Q
. . D MES^XPDUTL("...Already deleted.")
. I $D(ADDFUNC(IEN,0)),$G(^DD("FUNC",IEN,0))=ADDFUNC(IEN,0) D Q
. . D MES^XPDUTL("...Already deleted.")
. I '$$OKFUNC(.DELFUNC,IEN) D Q
. . D MES^XPDUTL("...Something's not right. Notify SD&D.")
. . S XPDQUIT=2
. D MES^XPDUTL("...Looks OK. We'll delete it in the Post-Init.")
Q
CHKADD ;
D BMES^XPDUTL("Checking Function(s) to be added to FUNCTION file ^DD(""FUNC""...")
N IEN
S IEN=0
F S IEN=$O(ADDFUNC(IEN)) Q:'IEN D
. S ADDFUNC=ADDFUNC(IEN,0)
. D BMES^XPDUTL("...Checking for function "_ADDFUNC_" at IEN "_IEN)
. I $D(^DD("FUNC",IEN)) D Q
. . D MES^XPDUTL("...Found something at that IEN. Checking it out.")
. . I $D(DELFUNC(IEN,0)),$G(^DD("FUNC",IEN,0))=DELFUNC(IEN,0) D Q
. . . D MES^XPDUTL("...It's "_DELFUNC(IEN,0)_". We'll replace it with "_ADDFUNC_" in the Post-Init.")
. . I '$$OKFUNC(.ADDFUNC,IEN) D Q
. . . S XPDQUIT=2
. . . D MES^XPDUTL("...Something's not right. Notify SD&D.")
. . D MES^XPDUTL("...Looks OK - "_ADDFUNC_" is already there.")
. D MES^XPDUTL("...It's not there. We'll add it in the Post-Init.")
Q
POSTINIT ; Post-Init
N COUNT,DELFUNC,ADDFUNC
D BMES^XPDUTL("Beginning Post-Installation...")
S COUNT=0
D INIT
I $D(DELFUNC) D DELFUNC
I $D(ADDFUNC) D ADDFUNC
D END
D BMES^XPDUTL("Finished Post-Installation.")
Q
INIT ;
; Delete the following function(s):
S DELFUNC(57,0)="SETDATA"
S DELFUNC(57,1)="S X1=X"
S DELFUNC(57,3)=2
S DELFUNC(57,9)="SETS FIRST ARGUMENT EQUAL TO THE SECOND ARGUMENT"
;
; Add the following function(s):
S ADDFUNC(57,0)="DUPLICATED"
S ADDFUNC(57,1)="S X=X"
S ADDFUNC(57,3)=1
S ADDFUNC(57,9)="Takes as argument the name of a CROSS-REFERENCED field. Returns BOOLEAN value, 1=field value is duplicated in another entry, """"=field value is unique"
Q
DELFUNC ;
D BMES^XPDUTL("Deleting Function(s) from FUNCTION file ^DD(""FUNC""...")
N IEN
S IEN=0
F S IEN=$O(DELFUNC(IEN)) Q:'IEN D
. S DELFUNC=DELFUNC(IEN,0)
. D BMES^XPDUTL("...Checking for function "_DELFUNC_" at IEN "_IEN)
. I '$D(^DD("FUNC",IEN)) D Q
. . I $D(^DD("FUNC","B",DELFUNC,IEN)) K ^(IEN)
. . D MES^XPDUTL("...Already deleted.")
. I $D(ADDFUNC(IEN,0)),$G(^DD("FUNC",IEN,0))=ADDFUNC(IEN,0) D Q
. . I $D(^DD("FUNC","B",DELFUNC,IEN)) K ^(IEN)
. . D MES^XPDUTL("...Already deleted.")
. I '$$OKFUNC(.DELFUNC,IEN) D Q
. . D MES^XPDUTL("...Something's not right. Notify SD&D.")
. D MES^XPDUTL("...Deleting Function "_DELFUNC_" ...")
. K ^DD("FUNC",IEN)
. K ^DD("FUNC","B",DELFUNC,IEN)
. D MES^XPDUTL("...Deleted.")
. S COUNT=COUNT-1
Q
ADDFUNC ;
D BMES^XPDUTL("Adding Function(s) to FUNCTION file ^DD(""FUNC""...")
N IEN,I
S IEN=0
F S IEN=$O(ADDFUNC(IEN)) Q:'IEN D
. S ADDFUNC=ADDFUNC(IEN,0)
. D BMES^XPDUTL("...Checking for function "_ADDFUNC_" at IEN "_IEN)
. I $D(^DD("FUNC",IEN)) D Q
. . D MES^XPDUTL("...Found something at that IEN. Checking it out.")
. . I '$$OKFUNC(.ADDFUNC,IEN) D Q
. . . D MES^XPDUTL("...Something's not right. Notify SD&D.")
. . D MES^XPDUTL("...Looks OK - "_ADDFUNC_" is already there.")
. D MES^XPDUTL("...Adding Function "_ADDFUNC_" ...")
. S I=""
. F S I=$O(ADDFUNC(IEN,I)) Q:I="" S ^DD("FUNC",IEN,I)=ADDFUNC(IEN,I)
. S ^DD("FUNC","B",ADDFUNC,IEN)=""
. D MES^XPDUTL("...Added.")
. S COUNT=COUNT+1
Q
OKFUNC(FUNC,IEN) ; Check existing Function
N I,OK
S I="",OK=1
F S I=$O(^DD("FUNC",IEN,I)) Q:I="" I ^(I)'=$G(FUNC(IEN,I)) D
. S OK=0
. I I=9 D MES^XPDUTL("...Node "_I_" does not match expected value.") Q
. D MES^XPDUTL("...Node "_I_"='"_NODEI_"' - Expected: '"_$G(FUNC(IEN,I))_"'")
Q:'OK 0
S I=""
F S I=$O(FUNC(IEN,I)) Q:I="" I $G(^DD("FUNC",IEN,I))'=FUNC(IEN,I) D
. S OK=0
. I I=9 D MES^XPDUTL("...Node "_I_" does not match expected value.") Q
. D MES^XPDUTL("...Node "_I_"='"_$G(^DD("FUNC",IEN,I))_"' - Expected: '"_FUNC(IEN,I)_"'")
Q OK
END ;
Q:'COUNT ; Count piece doesn't need updating
; Update 4th piece of Zeroth node
L +^DD("FUNC",0):5 S $P(^(0),U,4)=$P(^DD("FUNC",0),U,4)+COUNT I L -^DD("FUNC",0)
Q
CHKSTOP ;
; Check XPDENV 0 = Loading; 1 = Installing
I 'XPDENV Q ; Loading Distribution - No Check
;
;
INSCHK ; Do Checks During Install Only
W $C(7)
D MES^XPDUTL("** Although Queuing is allowed - it is HIGHLY recommended that ALL Users and")
D MES^XPDUTL("VISTA Background jobs be STOPPED before installation of this patch. Failure")
D MES^XPDUTL("to do so may result in 'source routine edited' error(s). Edits will be")
D MES^XPDUTL("lost and record(s) may be left in an inconsistent state, for example,")
D MES^XPDUTL("not all Cross-Referencing completed; which in turn may cause FUTURE")
D MES^XPDUTL("VistA/FileMan Hard Errors or corrupted Data. **")
;
TMCHK ; Check to see if TaskMan is still running
S X=$$TM^%ZTLOAD
I X,'$D(^%ZTSCH("WAIT")) D
. W $C(7)
. D BMES^XPDUTL("* Warning TaskMan Has NOT Been Stopped or Placed in a WAIT State!")
;
LINH ; Check to see if Logons are Inhibited
D GETENV^%ZOSV ; $P(Y,"^",2) = Installing Volume
S X=+$G(^%ZIS(14.5,"LOGON",$P(Y,"^",2)))
I 'X D
. W $C(7)
. D BMES^XPDUTL("* Warning Logons are NOT Inhibited!")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIPR157 5912 printed Sep 23, 2025@20:29:20 Page 2
DIPR157 ;O-OIFO/GMB-Functions: Delete SETDATA. Add DUPLICATED ;03/27/2008
+1 ;;22.0;VA FileMan;**157**;Mar 30, 1999;Build 7
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
ENV ; Environmental Check
+1 NEW DELFUNC,ADDFUNC
+2 DO BMES^XPDUTL("Perform Environment Check...")
+3 DO CHKSTOP
+4 DO INIT
+5 IF $DATA(DELFUNC)
DO CHKDEL
+6 IF $DATA(ADDFUNC)
DO CHKADD
+7 DO BMES^XPDUTL("Finished Environment Check.")
+8 QUIT
CHKDEL ;
+1 DO BMES^XPDUTL("Checking Function(s) to be deleted from FUNCTION file ^DD(""FUNC""...")
+2 NEW IEN
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(DELFUNC(IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET DELFUNC=DELFUNC(IEN,0)
+6 DO BMES^XPDUTL("...Checking for function "_DELFUNC_" at IEN "_IEN)
+7 IF '$DATA(^DD("FUNC",IEN))
Begin DoDot:2
+8 DO MES^XPDUTL("...Already deleted.")
End DoDot:2
QUIT
+9 IF $DATA(ADDFUNC(IEN,0))
IF $GET(^DD("FUNC",IEN,0))=ADDFUNC(IEN,0)
Begin DoDot:2
+10 DO MES^XPDUTL("...Already deleted.")
End DoDot:2
QUIT
+11 IF '$$OKFUNC(.DELFUNC,IEN)
Begin DoDot:2
+12 DO MES^XPDUTL("...Something's not right. Notify SD&D.")
+13 SET XPDQUIT=2
End DoDot:2
QUIT
+14 DO MES^XPDUTL("...Looks OK. We'll delete it in the Post-Init.")
End DoDot:1
+15 QUIT
CHKADD ;
+1 DO BMES^XPDUTL("Checking Function(s) to be added to FUNCTION file ^DD(""FUNC""...")
+2 NEW IEN
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(ADDFUNC(IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET ADDFUNC=ADDFUNC(IEN,0)
+6 DO BMES^XPDUTL("...Checking for function "_ADDFUNC_" at IEN "_IEN)
+7 IF $DATA(^DD("FUNC",IEN))
Begin DoDot:2
+8 DO MES^XPDUTL("...Found something at that IEN. Checking it out.")
+9 IF $DATA(DELFUNC(IEN,0))
IF $GET(^DD("FUNC",IEN,0))=DELFUNC(IEN,0)
Begin DoDot:3
+10 DO MES^XPDUTL("...It's "_DELFUNC(IEN,0)_". We'll replace it with "_ADDFUNC_" in the Post-Init.")
End DoDot:3
QUIT
+11 IF '$$OKFUNC(.ADDFUNC,IEN)
Begin DoDot:3
+12 SET XPDQUIT=2
+13 DO MES^XPDUTL("...Something's not right. Notify SD&D.")
End DoDot:3
QUIT
+14 DO MES^XPDUTL("...Looks OK - "_ADDFUNC_" is already there.")
End DoDot:2
QUIT
+15 DO MES^XPDUTL("...It's not there. We'll add it in the Post-Init.")
End DoDot:1
+16 QUIT
POSTINIT ; Post-Init
+1 NEW COUNT,DELFUNC,ADDFUNC
+2 DO BMES^XPDUTL("Beginning Post-Installation...")
+3 SET COUNT=0
+4 DO INIT
+5 IF $DATA(DELFUNC)
DO DELFUNC
+6 IF $DATA(ADDFUNC)
DO ADDFUNC
+7 DO END
+8 DO BMES^XPDUTL("Finished Post-Installation.")
+9 QUIT
INIT ;
+1 ; Delete the following function(s):
+2 SET DELFUNC(57,0)="SETDATA"
+3 SET DELFUNC(57,1)="S X1=X"
+4 SET DELFUNC(57,3)=2
+5 SET DELFUNC(57,9)="SETS FIRST ARGUMENT EQUAL TO THE SECOND ARGUMENT"
+6 ;
+7 ; Add the following function(s):
+8 SET ADDFUNC(57,0)="DUPLICATED"
+9 SET ADDFUNC(57,1)="S X=X"
+10 SET ADDFUNC(57,3)=1
+11 SET ADDFUNC(57,9)="Takes as argument the name of a CROSS-REFERENCED field. Returns BOOLEAN value, 1=field value is duplicated in another entry, """"=field value is unique"
+12 QUIT
DELFUNC ;
+1 DO BMES^XPDUTL("Deleting Function(s) from FUNCTION file ^DD(""FUNC""...")
+2 NEW IEN
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(DELFUNC(IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET DELFUNC=DELFUNC(IEN,0)
+6 DO BMES^XPDUTL("...Checking for function "_DELFUNC_" at IEN "_IEN)
+7 IF '$DATA(^DD("FUNC",IEN))
Begin DoDot:2
+8 IF $DATA(^DD("FUNC","B",DELFUNC,IEN))
KILL ^(IEN)
+9 DO MES^XPDUTL("...Already deleted.")
End DoDot:2
QUIT
+10 IF $DATA(ADDFUNC(IEN,0))
IF $GET(^DD("FUNC",IEN,0))=ADDFUNC(IEN,0)
Begin DoDot:2
+11 IF $DATA(^DD("FUNC","B",DELFUNC,IEN))
KILL ^(IEN)
+12 DO MES^XPDUTL("...Already deleted.")
End DoDot:2
QUIT
+13 IF '$$OKFUNC(.DELFUNC,IEN)
Begin DoDot:2
+14 DO MES^XPDUTL("...Something's not right. Notify SD&D.")
End DoDot:2
QUIT
+15 DO MES^XPDUTL("...Deleting Function "_DELFUNC_" ...")
+16 KILL ^DD("FUNC",IEN)
+17 KILL ^DD("FUNC","B",DELFUNC,IEN)
+18 DO MES^XPDUTL("...Deleted.")
+19 SET COUNT=COUNT-1
End DoDot:1
+20 QUIT
ADDFUNC ;
+1 DO BMES^XPDUTL("Adding Function(s) to FUNCTION file ^DD(""FUNC""...")
+2 NEW IEN,I
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(ADDFUNC(IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET ADDFUNC=ADDFUNC(IEN,0)
+6 DO BMES^XPDUTL("...Checking for function "_ADDFUNC_" at IEN "_IEN)
+7 IF $DATA(^DD("FUNC",IEN))
Begin DoDot:2
+8 DO MES^XPDUTL("...Found something at that IEN. Checking it out.")
+9 IF '$$OKFUNC(.ADDFUNC,IEN)
Begin DoDot:3
+10 DO MES^XPDUTL("...Something's not right. Notify SD&D.")
End DoDot:3
QUIT
+11 DO MES^XPDUTL("...Looks OK - "_ADDFUNC_" is already there.")
End DoDot:2
QUIT
+12 DO MES^XPDUTL("...Adding Function "_ADDFUNC_" ...")
+13 SET I=""
+14 FOR
SET I=$ORDER(ADDFUNC(IEN,I))
if I=""
QUIT
SET ^DD("FUNC",IEN,I)=ADDFUNC(IEN,I)
+15 SET ^DD("FUNC","B",ADDFUNC,IEN)=""
+16 DO MES^XPDUTL("...Added.")
+17 SET COUNT=COUNT+1
End DoDot:1
+18 QUIT
OKFUNC(FUNC,IEN) ; Check existing Function
+1 NEW I,OK
+2 SET I=""
SET OK=1
+3 FOR
SET I=$ORDER(^DD("FUNC",IEN,I))
if I=""
QUIT
IF ^(I)'=$GET(FUNC(IEN,I))
Begin DoDot:1
+4 SET OK=0
+5 IF I=9
DO MES^XPDUTL("...Node "_I_" does not match expected value.")
QUIT
+6 DO MES^XPDUTL("...Node "_I_"='"_NODEI_"' - Expected: '"_$GET(FUNC(IEN,I))_"'")
End DoDot:1
+7 if 'OK
QUIT 0
+8 SET I=""
+9 FOR
SET I=$ORDER(FUNC(IEN,I))
if I=""
QUIT
IF $GET(^DD("FUNC",IEN,I))'=FUNC(IEN,I)
Begin DoDot:1
+10 SET OK=0
+11 IF I=9
DO MES^XPDUTL("...Node "_I_" does not match expected value.")
QUIT
+12 DO MES^XPDUTL("...Node "_I_"='"_$GET(^DD("FUNC",IEN,I))_"' - Expected: '"_FUNC(IEN,I)_"'")
End DoDot:1
+13 QUIT OK
END ;
+1 ; Count piece doesn't need updating
if 'COUNT
QUIT
+2 ; Update 4th piece of Zeroth node
+3 LOCK +^DD("FUNC",0):5
SET $PIECE(^(0),U,4)=$PIECE(^DD("FUNC",0),U,4)+COUNT
IF $TEST
LOCK -^DD("FUNC",0)
+4 QUIT
CHKSTOP ;
+1 ; Check XPDENV 0 = Loading; 1 = Installing
+2 ; Loading Distribution - No Check
IF 'XPDENV
QUIT
+3 ;
+4 ;
INSCHK ; Do Checks During Install Only
+1 WRITE $CHAR(7)
+2 DO MES^XPDUTL("** Although Queuing is allowed - it is HIGHLY recommended that ALL Users and")
+3 DO MES^XPDUTL("VISTA Background jobs be STOPPED before installation of this patch. Failure")
+4 DO MES^XPDUTL("to do so may result in 'source routine edited' error(s). Edits will be")
+5 DO MES^XPDUTL("lost and record(s) may be left in an inconsistent state, for example,")
+6 DO MES^XPDUTL("not all Cross-Referencing completed; which in turn may cause FUTURE")
+7 DO MES^XPDUTL("VistA/FileMan Hard Errors or corrupted Data. **")
+8 ;
TMCHK ; Check to see if TaskMan is still running
+1 SET X=$$TM^%ZTLOAD
+2 IF X
IF '$DATA(^%ZTSCH("WAIT"))
Begin DoDot:1
+3 WRITE $CHAR(7)
+4 DO BMES^XPDUTL("* Warning TaskMan Has NOT Been Stopped or Placed in a WAIT State!")
End DoDot:1
+5 ;
LINH ; Check to see if Logons are Inhibited
+1 ; $P(Y,"^",2) = Installing Volume
DO GETENV^%ZOSV
+2 SET X=+$GET(^%ZIS(14.5,"LOGON",$PIECE(Y,"^",2)))
+3 IF 'X
Begin DoDot:1
+4 WRITE $CHAR(7)
+5 DO BMES^XPDUTL("* Warning Logons are NOT Inhibited!")
End DoDot:1
+6 QUIT
