DIPR157.m

DIPR157 ;O-OIFO/GMB-Functions: Delete SETDATA. Add DUPLICATED ;03/27/2008

 ;;22.0;VA FileMan;**157**;Mar 30, 1999;Build 9

 ;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

DIPR157   ;O-OIFO/GMB-Functions: Delete SETDATA. Add DUPLICATED ;03/27/2008

 +1       ;;22.0;VA FileMan;**157**;Mar 30, 1999;Build 9

 +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