- XUMF5AT ;ISS/PAVEL - XUMF5 MD5 Hash Testing API ;06/17/05
- ;;8.0;KERNEL;**383**;July 10, 1995
- ;
- ;;original name was 'VESOUHSH' ; Secure hash functions
- ;;(c) Copyright 1994 - 2004, ESI Technology Corp, Natick MA
- ;; This source code contains the intellectual property of its copyright holder(s),
- ;; and is made available under a license. If you are not familiar with the terms
- ;; of the license, please refer to the license.txt file that is a part of the
- ;; distribution kit.
- ; THIS IS TESTING VERSION
- Q
- ;;**************************************************
- ;;MD5 'R'egular portion of the code. This will handle
- ;; one string at a time.
- ;;**************************************************
- ;
- TESTR ; Run Regular test suite and verify values
- N OK
- S OK=1
- S:$$HEX^XUMF5AU($$MD5R^XUMF5AU(""))'="d98c1dd404b2008f980980e97e42f8ec" OK=0
- W !,"MD5 for """" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU(""))
- W !,"MD5 reversed for """" =",$$MAIN^XUMF5BYT($$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU(""))))
- S:$$HEX^XUMF5AU($$MD5R^XUMF5AU("a"))'="b975c10ca8b6f1c0e299c33161267769" OK=0
- W !,"MD5 for ""a"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("a"))
- W !,"MD5 reversed for ""a"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("a")))
- S:$$HEX^XUMF5AU($$MD5R^XUMF5AU("abc"))'="98500190b04fd23c7d3f96d6727fe128" OK=0
- W !,"MD5 for ""abc"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("abc"))
- W !,"MD5 reversed for ""abc"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("abc")))
- S:$$HEX^XUMF5AU($$MD5R^XUMF5AU("message digest"))'="7d696bf98d93b77c312f5a52d061f1aa" OK=0
- W !,"MD5 for ""message digest"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("message digest"))
- W !,"MD5 reversed for ""message digest"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("message digest")))
- S:$$HEX^XUMF5AU($$MD5R^XUMF5AU("abcdefghijklmnopqrstuvwxyz"))'="d7d3fcc300e492616c49fb7d3be167ca" OK=0
- W !,"MD5 for ""abcdefghijklmnopqrstuvwxyz"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("abcdefghijklmnopqrstuvwxyz"))
- W !,"MD5 reversed for ""abcdefghijklmnopqrstuvwxyz"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("abcdefghijklmnopqrstuvwxyz")))
- S:$$HEX^XUMF5AU($$MD5R^XUMF5AU("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))'="98ab74d1f5d977d22c1c61a59f9d419f" OK=0
- W !,"MD5 for ""ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))
- W !,"MD5 reversed for ""ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")))
- S:$$HEX^XUMF5AU($$MD5R^XUMF5AU("12345678901234567890123456789012345678901234567890123456789012345678901234567890"))'="a2f4ed5755c9e32b2eda49ac7ab60721" OK=0
- W !,"MD5 for ""12345678901234567890123456789012345678901234567890123456789012345678901234567890"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("12345678901234567890123456789012345678901234567890123456789012345678901234567890"))
- W !,"MD5 reversed for ""12345678901234567890123456789012345678901234567890123456789012345678901234567890"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("12345678901234567890123456789012345678901234567890123456789012345678901234567890")))
- I OK=1 W !,"Tests passed." Q
- W !,"Tests failed."
- Q
- TESTE ; Run Enhanced test suite and verify values
- N OK,MYABCD
- S OK=1
- S MYA=$C(1,35,69,103)
- S MYB=$C(137,171,205,239)
- S MYC=$C(254,220,186,152)
- S MYD=$C(118,84,50,16)
- S MYABCD=MYA_MYB_MYC_MYD
- S:$$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,""))'="d98c1dd404b2008f980980e97e42f8ec" OK=0
- S:$$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"a"))'="b975c10ca8b6f1c0e299c33161267769" OK=0
- S:$$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"abc"))'="98500190b04fd23c7d3f96d6727fe128" OK=0
- S:$$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"message digest"))'="7d696bf98d93b77c312f5a52d061f1aa" OK=0
- S:$$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"abcdefghijklmnopqrstuvwxyz"))'="d7d3fcc300e492616c49fb7d3be167ca" OK=0
- S:$$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))'="98ab74d1f5d977d22c1c61a59f9d419f" OK=0
- S:$$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"12345678901234567890123456789012345678901234567890123456789012345678901234567890"))'="a2f4ed5755c9e32b2eda49ac7ab60721" OK=0
- I OK=1 W !,"Tests passed." Q
- W !,"Tests failed."
- Q
- ;Pavel's testing stuff
- ;FIND DEPENDENCY for loaded packages...
- ;Scann whole environment for discrepances...
- FDEP N DIC,Y,X,IEN,TMP,ERR,X0,START,RR
- S X0=0,START=1
- K ^TMP("LIST",$J)
- F K ^TMP("DEP",$J),^TMP("DEPX",$J) S X0=$O(^XPD(9.6,"B",X0)) Q:'$L(X0) S IEN=$O(^XPD(9.6,"B",X0,0)) Q:'IEN D
- .I START W !!,?5,"****** Builds, for which not all required packages have been installed ******",! S START=0
- .I $$GETDEP(IEN,1) W !,"IEN: ",IEN,?10,X0 S ^TMP("LIST",$J,X0)=IEN
- K ^TMP("DEP",$J),^TMP("DEPX",$J)
- R !!,"Do you want detail list tree for each one ?? N// ",RR:60
- Q:'$L(RR)!(RR["^") Q:$E($TR(RR,"y","Y"))'="Y"
- S X0=""
- F S X0=$O(^TMP("LIST",$J,X0)) Q:'$L(X0) S IEN=^(X0) D
- .K ^TMP("DEP",$J),^TMP("DEPX",$J)
- .S LEV=1 I '$$GETDEP(IEN,LEV) W !,"No dependency for: ",$P(Y,U,2) Q
- .S OK=0 F Q:$$LOOP(LEV) S LEV=LEV+1
- .S $P(II,"-",79)="-"
- .W !!!,"****** Required builds of ",X0," NOT installed on system ******",!,II
- .S LEV=0 F S LEV=$O(^TMP("DEP",$J,LEV)) Q:'LEV S II=0 F S II=$O(^TMP("DEP",$J,LEV,II)) Q:'II W !,"LEV: ",LEV,?8,II,?20,$P(^(II),U),?45,$P(^(II),U,2)
- W !!!,"DONE",!
- Q
- BUILD ;ENTRY FOR CHECKING OF DEPENDENCY TREE
- N DIC,Y,X,IEN,TMP,ERR
- 1 K ^TMP("DEP",$J),^TMP("DEPX",$J)
- S DIC=9.6,DIC(0)="AZEQZ" D ^DIC Q:Y=-1 S IEN=+Y_","
- S LEV=1
- I '$$GETDEP(IEN,LEV) W !,"No dependency for: ",$P(Y,U,2) G 1
- ;Recursive loop for dependencies
- ;Loop and delete entry which is loaded.
- S OK=0
- F Q:$$LOOP(LEV) S LEV=LEV+1
- S $P(II,"-",75)="-"
- W !!,?4,"****** Required builds of ",$P(Y,U,2)," NOT installed on system ******",!,II
- S LEV=0 F S LEV=$O(^TMP("DEP",$J,LEV)) Q:'LEV S II=0 F S II=$O(^TMP("DEP",$J,LEV,II)) Q:'II W !,"LEV: ",LEV,?8,II,?20,$P(^(II),U),?45,$P(^(II),U,2)
- Q W ! G 1
- ;
- Q
- LOOP(LEV) ;LOOP and Kill if not dependencess
- N II,OK,X1,Y,DIC,X,IEN,TMP
- S II=0
- F S II=$O(^TMP("DEP",LEV,II)) Q:'$L(II) D
- .I '$$REQB(II,$P(^TMP("DEP",LEV,II),U)) K ^TMP("DEP",$J,LEV,II) Q
- ;Now we have deleted all entries/packages already installed.. and set level + 1 depencencees...
- S II=0,OK=1
- F S II=$O(^TMP("DEP",$J,LEV,II)) Q:'$L(II) D
- .Q:'$$GETDEP(II_",",LEV+1)
- .S OK=0
- Q OK
- GETDEP(IEN,LEV) ;
- N TMP1,X1,DIC,Y,X
- D GETS^DIQ(9.6,IEN,"11*",,"TMP1","ERR")
- I $D(ERR) D Q
- .W !,"Error in subfile # 9.611",!
- S X1=0 F S X1=$O(TMP1(9.611,X1)) Q:'$L(X1) D
- .S X=TMP1(9.611,X1,.01),DIC=9.6,DIC(0)="XZ" D ^DIC Q:Y=-1
- .Q:'$$REQB(+Y,$G(TMP1(9.611,X1,.01)))
- .S:'$D(^TMP("DEPX",$J,+Y)) ^TMP("DEP",$J,LEV,+Y)=TMP1(9.611,X1,.01)_U_TMP1(9.611,X1,1)
- .S ^TMP("DEPX",$J,+Y,LEV)=""
- Q $S($D(^TMP("DEP",$J,LEV)):1,1:0)
- REQB(IEN,XPDX) ;check for Required Builds
- ;returns 0=ok, 1=failed kill global, 2=failed leave global
- Q:'$L($G(XPDX)) 0
- N XPDACT,XPDBLD,XPDI,XPDQ,XPDQUIT,XPDX0,X,Y,Z
- S XPDQUIT=0,XPDI=0
- S XPDQ=0,X=$$PKG^XPDUTL(XPDX),Y=$$VER^XPDUTL(XPDX),Z=$$VERSION^XPDUTL(X) D
- .Q:Z>Y
- .I XPDX'["*" S:Z<Y XPDQ=2
- .E S:'$$PATCH^XPDUTL(XPDX) XPDQ=1
- .;quit if patch is already on system
- .Q:'XPDQ
- .;quit if patch is sequenced prior within this build
- .I $D(XPDT("NM",XPDX)),(XPDT("NM",XPDX)<XPDT("NM",XPDNM)) S XPDQ=0 Q
- .S XPDQUIT=1
- Q XPDQUIT
- XUMF5AT ;ISS/PAVEL - XUMF5 MD5 Hash Testing API ;06/17/05
- +1 ;;8.0;KERNEL;**383**;July 10, 1995
- +2 ;
- +3 ;;original name was 'VESOUHSH' ; Secure hash functions
- +4 ;;(c) Copyright 1994 - 2004, ESI Technology Corp, Natick MA
- +5 ;; This source code contains the intellectual property of its copyright holder(s),
- +6 ;; and is made available under a license. If you are not familiar with the terms
- +7 ;; of the license, please refer to the license.txt file that is a part of the
- +8 ;; distribution kit.
- +9 ; THIS IS TESTING VERSION
- +10 QUIT
- +11 ;;**************************************************
- +12 ;;MD5 'R'egular portion of the code. This will handle
- +13 ;; one string at a time.
- +14 ;;**************************************************
- +15 ;
- TESTR ; Run Regular test suite and verify values
- +1 NEW OK
- +2 SET OK=1
- +3 IF $$HEX^XUMF5AU($$MD5R^XUMF5AU(""))'="d98c1dd404b2008f980980e97e42f8ec"
- SET OK=0
- +4 WRITE !,"MD5 for """" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU(""))
- +5 WRITE !,"MD5 reversed for """" =",$$MAIN^XUMF5BYT($$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU(""))))
- +6 IF $$HEX^XUMF5AU($$MD5R^XUMF5AU("a"))'="b975c10ca8b6f1c0e299c33161267769"
- SET OK=0
- +7 WRITE !,"MD5 for ""a"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("a"))
- +8 WRITE !,"MD5 reversed for ""a"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("a")))
- +9 IF $$HEX^XUMF5AU($$MD5R^XUMF5AU("abc"))'="98500190b04fd23c7d3f96d6727fe128"
- SET OK=0
- +10 WRITE !,"MD5 for ""abc"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("abc"))
- +11 WRITE !,"MD5 reversed for ""abc"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("abc")))
- +12 IF $$HEX^XUMF5AU($$MD5R^XUMF5AU("message digest"))'="7d696bf98d93b77c312f5a52d061f1aa"
- SET OK=0
- +13 WRITE !,"MD5 for ""message digest"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("message digest"))
- +14 WRITE !,"MD5 reversed for ""message digest"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("message digest")))
- +15 IF $$HEX^XUMF5AU($$MD5R^XUMF5AU("abcdefghijklmnopqrstuvwxyz"))'="d7d3fcc300e492616c49fb7d3be167ca"
- SET OK=0
- +16 WRITE !,"MD5 for ""abcdefghijklmnopqrstuvwxyz"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("abcdefghijklmnopqrstuvwxyz"))
- +17 WRITE !,"MD5 reversed for ""abcdefghijklmnopqrstuvwxyz"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("abcdefghijklmnopqrstuvwxyz")))
- +18 IF $$HEX^XUMF5AU($$MD5R^XUMF5AU("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))'="98ab74d1f5d977d22c1c61a59f9d419f"
- SET OK=0
- +19 WRITE !,"MD5 for ""ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))
- +20 WRITE !,"MD5 reversed for ""ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")))
- +21 IF $$HEX^XUMF5AU($$MD5R^XUMF5AU("12345678901234567890123456789012345678901234567890123456789012345678901234567890"))'="a2f4ed5755c9e32b2eda49ac7ab60721"
- SET OK=0
- +22 WRITE !,"MD5 for ""12345678901234567890123456789012345678901234567890123456789012345678901234567890"" =",$$HEX^XUMF5AU($$MD5R^XUMF5AU("12345678901234567890123456789012345678901234567890123456789012345678901234567890"))
- +23 WRITE !,"MD5 reversed for ""12345678901234567890123456789012345678901234567890123456789012345678901234567890"" =",$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5R^XUMF5AU("12345678901234567890123456789012345678901234567890123456789012345678901234567890")))
- +24 IF OK=1
- WRITE !,"Tests passed."
- QUIT
- +25 WRITE !,"Tests failed."
- +26 QUIT
- TESTE ; Run Enhanced test suite and verify values
- +1 NEW OK,MYABCD
- +2 SET OK=1
- +3 SET MYA=$CHAR(1,35,69,103)
- +4 SET MYB=$CHAR(137,171,205,239)
- +5 SET MYC=$CHAR(254,220,186,152)
- +6 SET MYD=$CHAR(118,84,50,16)
- +7 SET MYABCD=MYA_MYB_MYC_MYD
- +8 IF $$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,""))'="d98c1dd404b2008f980980e97e42f8ec"
- SET OK=0
- +9 IF $$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"a"))'="b975c10ca8b6f1c0e299c33161267769"
- SET OK=0
- +10 IF $$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"abc"))'="98500190b04fd23c7d3f96d6727fe128"
- SET OK=0
- +11 IF $$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"message digest"))'="7d696bf98d93b77c312f5a52d061f1aa"
- SET OK=0
- +12 IF $$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"abcdefghijklmnopqrstuvwxyz"))'="d7d3fcc300e492616c49fb7d3be167ca"
- SET OK=0
- +13 IF $$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))'="98ab74d1f5d977d22c1c61a59f9d419f"
- SET OK=0
- +14 IF $$HEX^XUMF5AU($$MD5E^XUMF5AU(MYABCD,"12345678901234567890123456789012345678901234567890123456789012345678901234567890"))'="a2f4ed5755c9e32b2eda49ac7ab60721"
- SET OK=0
- +15 IF OK=1
- WRITE !,"Tests passed."
- QUIT
- +16 WRITE !,"Tests failed."
- +17 QUIT
- +18 ;Pavel's testing stuff
- +19 ;FIND DEPENDENCY for loaded packages...
- +20 ;Scann whole environment for discrepances...
- FDEP NEW DIC,Y,X,IEN,TMP,ERR,X0,START,RR
- +1 SET X0=0
- SET START=1
- +2 KILL ^TMP("LIST",$JOB)
- +3 FOR
- KILL ^TMP("DEP",$JOB),^TMP("DEPX",$JOB)
- SET X0=$ORDER(^XPD(9.6,"B",X0))
- IF '$LENGTH(X0)
- QUIT
- SET IEN=$ORDER(^XPD(9.6,"B",X0,0))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +4 IF START
- WRITE !!,?5,"****** Builds, for which not all required packages have been installed ******",!
- SET START=0
- +5 IF $$GETDEP(IEN,1)
- WRITE !,"IEN: ",IEN,?10,X0
- SET ^TMP("LIST",$JOB,X0)=IEN
- End DoDot:1
- +6 KILL ^TMP("DEP",$JOB),^TMP("DEPX",$JOB)
- +7 READ !!,"Do you want detail list tree for each one ?? N// ",RR:60
- +8 IF '$LENGTH(RR)!(RR["^")
- QUIT
- IF $EXTRACT($TRANSLATE(RR,"y","Y"))'="Y"
- QUIT
- +9 SET X0=""
- +10 FOR
- SET X0=$ORDER(^TMP("LIST",$JOB,X0))
- IF '$LENGTH(X0)
- QUIT
- SET IEN=^(X0)
- Begin DoDot:1
- +11 KILL ^TMP("DEP",$JOB),^TMP("DEPX",$JOB)
- +12 SET LEV=1
- IF '$$GETDEP(IEN,LEV)
- WRITE !,"No dependency for: ",$PIECE(Y,U,2)
- QUIT
- +13 SET OK=0
- FOR
- IF $$LOOP(LEV)
- QUIT
- SET LEV=LEV+1
- +14 SET $PIECE(II,"-",79)="-"
- +15 WRITE !!!,"****** Required builds of ",X0," NOT installed on system ******",!,II
- +16 SET LEV=0
- FOR
- SET LEV=$ORDER(^TMP("DEP",$JOB,LEV))
- IF 'LEV
- QUIT
- SET II=0
- FOR
- SET II=$ORDER(^TMP("DEP",$JOB,LEV,II))
- IF 'II
- QUIT
- WRITE !,"LEV: ",LEV,?8,II,?20,$PIECE(^(II),U),?45,$PIECE(^(II),U,2)
- End DoDot:1
- +17 WRITE !!!,"DONE",!
- +18 QUIT
- BUILD ;ENTRY FOR CHECKING OF DEPENDENCY TREE
- +1 NEW DIC,Y,X,IEN,TMP,ERR
- 1 KILL ^TMP("DEP",$JOB),^TMP("DEPX",$JOB)
- +1 SET DIC=9.6
- SET DIC(0)="AZEQZ"
- DO ^DIC
- IF Y=-1
- QUIT
- SET IEN=+Y_","
- +2 SET LEV=1
- +3 IF '$$GETDEP(IEN,LEV)
- WRITE !,"No dependency for: ",$PIECE(Y,U,2)
- GOTO 1
- +4 ;Recursive loop for dependencies
- +5 ;Loop and delete entry which is loaded.
- +6 SET OK=0
- +7 FOR
- IF $$LOOP(LEV)
- QUIT
- SET LEV=LEV+1
- +8 SET $PIECE(II,"-",75)="-"
- +9 WRITE !!,?4,"****** Required builds of ",$PIECE(Y,U,2)," NOT installed on system ******",!,II
- +10 SET LEV=0
- FOR
- SET LEV=$ORDER(^TMP("DEP",$JOB,LEV))
- IF 'LEV
- QUIT
- SET II=0
- FOR
- SET II=$ORDER(^TMP("DEP",$JOB,LEV,II))
- IF 'II
- QUIT
- WRITE !,"LEV: ",LEV,?8,II,?20,$PIECE(^(II),U),?45,$PIECE(^(II),U,2)
- Q WRITE !
- GOTO 1
- +1 ;
- +2 QUIT
- LOOP(LEV) ;LOOP and Kill if not dependencess
- +1 NEW II,OK,X1,Y,DIC,X,IEN,TMP
- +2 SET II=0
- +3 FOR
- SET II=$ORDER(^TMP("DEP",LEV,II))
- IF '$LENGTH(II)
- QUIT
- Begin DoDot:1
- +4 IF '$$REQB(II,$PIECE(^TMP("DEP",LEV,II),U))
- KILL ^TMP("DEP",$JOB,LEV,II)
- QUIT
- End DoDot:1
- +5 ;Now we have deleted all entries/packages already installed.. and set level + 1 depencencees...
- +6 SET II=0
- SET OK=1
- +7 FOR
- SET II=$ORDER(^TMP("DEP",$JOB,LEV,II))
- IF '$LENGTH(II)
- QUIT
- Begin DoDot:1
- +8 IF '$$GETDEP(II_",",LEV+1)
- QUIT
- +9 SET OK=0
- End DoDot:1
- +10 QUIT OK
- GETDEP(IEN,LEV) ;
- +1 NEW TMP1,X1,DIC,Y,X
- +2 DO GETS^DIQ(9.6,IEN,"11*",,"TMP1","ERR")
- +3 IF $DATA(ERR)
- Begin DoDot:1
- +4 WRITE !,"Error in subfile # 9.611",!
- End DoDot:1
- QUIT
- +5 SET X1=0
- FOR
- SET X1=$ORDER(TMP1(9.611,X1))
- IF '$LENGTH(X1)
- QUIT
- Begin DoDot:1
- +6 SET X=TMP1(9.611,X1,.01)
- SET DIC=9.6
- SET DIC(0)="XZ"
- DO ^DIC
- IF Y=-1
- QUIT
- +7 IF '$$REQB(+Y,$GET(TMP1(9.611,X1,.01)))
- QUIT
- +8 IF '$DATA(^TMP("DEPX",$JOB,+Y))
- SET ^TMP("DEP",$JOB,LEV,+Y)=TMP1(9.611,X1,.01)_U_TMP1(9.611,X1,1)
- +9 SET ^TMP("DEPX",$JOB,+Y,LEV)=""
- End DoDot:1
- +10 QUIT $SELECT($DATA(^TMP("DEP",$JOB,LEV)):1,1:0)
- REQB(IEN,XPDX) ;check for Required Builds
- +1 ;returns 0=ok, 1=failed kill global, 2=failed leave global
- +2 IF '$LENGTH($GET(XPDX))
- QUIT 0
- +3 NEW XPDACT,XPDBLD,XPDI,XPDQ,XPDQUIT,XPDX0,X,Y,Z
- +4 SET XPDQUIT=0
- SET XPDI=0
- +5 SET XPDQ=0
- SET X=$$PKG^XPDUTL(XPDX)
- SET Y=$$VER^XPDUTL(XPDX)
- SET Z=$$VERSION^XPDUTL(X)
- Begin DoDot:1
- +6 IF Z>Y
- QUIT
- +7 IF XPDX'["*"
- IF Z<Y
- SET XPDQ=2
- +8 IF '$TEST
- IF '$$PATCH^XPDUTL(XPDX)
- SET XPDQ=1
- +9 ;quit if patch is already on system
- +10 IF 'XPDQ
- QUIT
- +11 ;quit if patch is sequenced prior within this build
- +12 IF $DATA(XPDT("NM",XPDX))
- IF (XPDT("NM",XPDX)<XPDT("NM",XPDNM))
- SET XPDQ=0
- QUIT
- +13 SET XPDQUIT=1
- End DoDot:1
- +14 QUIT XPDQUIT