AZX1SMOD ;IHS/PAO/AEF - COMPARE KIDS TRANSPORT GLOBAL WITH LOCAL SOFTWARE MODS
;;1.0;ANNE'S SPECIAL ROUTINES;;JUN 26, 2007
;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This routine checks the contents of the specified KIDS transport
;;patch or package file against the contents of the AZX1 LOCAL
;;SOFTWARE MODIFICATIONS to see if any mods will be clobbered by the
;;patch/package installation.
;;
;;$$END
;
N I,X F I=1:1 S X=$T(DESC+I) Q:X["$$END" W !,$P(X,";;",2)
Q
EN ;EP -- MAIN ENTRY POINT
;
N FILE,OUT,PATH
;
D DESC
;
D GETFILE(.PATH,.FILE)
;
D LOOP
;
D PAWS(.OUT)
;
K ^TMP("AZX1",$J)
Q
LOOP ;----- LOOP THROUGH ^XTMP("XPDI") GLOBAL
;
N CNT,D0,D1,D2,ITEM,X
;
Q:'$D(^TMP("AZX1",$J))
;
W !!,"Checking AZX1 LOCAL SOFTWARE MODIFICATIONS file...",!!
;
S CNT=0
S D0=0
F S D0=$O(^TMP("AZX1",$J,"BLD",D0)) Q:'D0 D
. S D1=0
. F S D1=$O(^TMP("AZX1",$J,"BLD",D0,"KRN",D1)) Q:'D1 D
. . S ITEM=""
. . F S ITEM=$O(^TMP("AZX1",$J,"BLD",D0,"KRN",D1,"NM","B",ITEM)) Q:ITEM']"" D
. . . S X=ITEM
. . . I "^.4^.401^.402^.403"[D1 S X=$P(X," FILE")
. . . D PRT(D1,X,.CNT)
;
W !!,CNT," modifications found!"
Q
PRT(D1,X,CNT) ;
;----- PRINT ONE ITEM
;
; D1 = ITEM TYPE
; X = ITEM NAME
;
N TYPE
;
Q:'$D(^AZX1SMOD("D",D1,X))
;
S CNT=$G(CNT)+1
S TYPE=$$SOC(D1,1993001,.04)
W !,TYPE," '",ITEM,"' appears to have a local modification."
Q
SOC(X,FIL,FLD) ;
;---- RESOLVE SET OF CODES
;
; X = CODE TO RESOLVE
; FIL = FILE CONTAINING SOC FIELD
; FLD = SOC FIELD
;
N Y,Z
;
S Y=""
I X]"" D
. S Z=$G(^DD(FIL,FLD,0))
. I Z[X D
. . S Y=$P($P(Z,X_":",2),";")
Q Y
ASK(D0) ;
;----- PROMPT FOR INSTALL NAME
;
N DIC,X,Y
;
S DIC="^XPD(9.7,"
S DIC(0)="AEMQ"
S DIC("A")="Enter INSTALL NAME: "
D ^DIC
S D0=+Y
Q
GETFILE(PATH,FILE) ;
;----- READ CONTENTS OF KIDS TRANSPORT FILE AND PUT IN ^TMP GLOBAL
;
S OUT=0
;
D PATH(.PATH,.OUT)
Q:OUT
D FILE(.FILE,.OUT)
Q:OUT
;
D READ(PATH,FILE,.OUT)
Q:OUT
;
Q
READ(PATH,FILE,OUT) ;
;----- READ CONTENTS OF DATA FILE AND PUT INTO ^TMP GLOBAL
;
N CNT,END,GR,I,POP,X,Y
;
K ^TMP("AZX1",$J)
S GR="^TMP(""AZX1"","_$J_","
S OUT=0
S END=0
S CNT=0
W !,"READING FILE "_PATH_FILE_" ..."
D OPEN^%ZISH("FILE",PATH,FILE,"R")
I POP D
. W !?5,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
. S OUT=1
Q:OUT
U IO R X,Y
Q:X'["KIDS Distribution"
U IO R X,Y
Q:X'["**KIDS**"
U IO R X,Y
Q:X'["**INSTALL NAME**"
F I=1:1 D Q:END
. U IO R X,Y:DTIME
. I $$STATUS^%ZISH S END=1
. Q:END
. I X["**END**" S END=1
. Q:END
. I Y["**END**" S END=1
. Q:END
. Q:X']""
. Q:$E(X,$L(X))'=")"
. S CNT=CNT+1
. S @(GR_X)=Y
. I '(CNT#100) U 0 W "."
;
D CLOSE^%ZISH("FILE")
Q
PATH(PATH,OUT) ;
;----- PROMPT FOR DIRECTORY PATH WHERE DATA FILE RESIDES
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S PATH=""
S OUT=0
S DIR(0)="FA"
S DIR("A")="Select DIRECTORY: "
S DIR("?")="Enter the PATH or DIRECTORY where the data file resides, e.g., D:\EXPORT\"
D ^DIR
I $D(DTOUT)!($D(DIRUT))!($D(DUOUT)) S OUT=1
Q:OUT
S X=Y
D DF^%ZISH(.X)
S PATH=X
Q
FILE(FILE,OUT) ;
;----- PROMPT FOR DATA FILE
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
;
S FILE=""
S DIR(0)="FA"
S DIR("A")="Select FILE: "
S DIR("?")="Enter the name of the data file"
D ^DIR
I $D(DTOUT)!($D(DIRUT))!($D(DUOUT))!($D(DIROUT))!(Y[U) S OUT=1
Q:$G(OUT)
S FILE=Y
Q
PAWS(OUT) ;
;----- ISSUE 'RETURN' PROMPT
;
N DIR,X,Y
Q:$E($G(IOST),1,2)'="C-"
W !
S DIR(0)="E"
D ^DIR
I 'Y S OUT=1
Q
AZX1SMOD ;IHS/PAO/AEF - COMPARE KIDS TRANSPORT GLOBAL WITH LOCAL SOFTWARE MODS
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;JUN 26, 2007
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine checks the contents of the specified KIDS transport
+3 ;;patch or package file against the contents of the AZX1 LOCAL
+4 ;;SOFTWARE MODIFICATIONS to see if any mods will be clobbered by the
+5 ;;patch/package installation.
+6 ;;
+7 ;;$$END
+8 ;
+9 NEW I,X
FOR I=1:1
SET X=$TEXT(DESC+I)
IF X["$$END"
QUIT
WRITE !,$PIECE(X,";;",2)
+10 QUIT
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW FILE,OUT,PATH
+3 ;
+4 DO DESC
+5 ;
+6 DO GETFILE(.PATH,.FILE)
+7 ;
+8 DO LOOP
+9 ;
+10 DO PAWS(.OUT)
+11 ;
+12 KILL ^TMP("AZX1",$JOB)
+13 QUIT
LOOP ;----- LOOP THROUGH ^XTMP("XPDI") GLOBAL
+1 ;
+2 NEW CNT,D0,D1,D2,ITEM,X
+3 ;
+4 IF '$DATA(^TMP("AZX1",$JOB))
QUIT
+5 ;
+6 WRITE !!,"Checking AZX1 LOCAL SOFTWARE MODIFICATIONS file...",!!
+7 ;
+8 SET CNT=0
+9 SET D0=0
+10 FOR
SET D0=$ORDER(^TMP("AZX1",$JOB,"BLD",D0))
IF 'D0
QUIT
Begin DoDot:1
+11 SET D1=0
+12 FOR
SET D1=$ORDER(^TMP("AZX1",$JOB,"BLD",D0,"KRN",D1))
IF 'D1
QUIT
Begin DoDot:2
+13 SET ITEM=""
+14 FOR
SET ITEM=$ORDER(^TMP("AZX1",$JOB,"BLD",D0,"KRN",D1,"NM","B",ITEM))
IF ITEM']""
QUIT
Begin DoDot:3
+15 SET X=ITEM
+16 IF "^.4^.401^.402^.403"[D1
SET X=$PIECE(X," FILE")
+17 DO PRT(D1,X,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 WRITE !!,CNT," modifications found!"
+20 QUIT
PRT(D1,X,CNT) ;
+1 ;----- PRINT ONE ITEM
+2 ;
+3 ; D1 = ITEM TYPE
+4 ; X = ITEM NAME
+5 ;
+6 NEW TYPE
+7 ;
+8 IF '$DATA(^AZX1SMOD("D",D1,X))
QUIT
+9 ;
+10 SET CNT=$GET(CNT)+1
+11 SET TYPE=$$SOC(D1,1993001,.04)
+12 WRITE !,TYPE," '",ITEM,"' appears to have a local modification."
+13 QUIT
SOC(X,FIL,FLD) ;
+1 ;---- RESOLVE SET OF CODES
+2 ;
+3 ; X = CODE TO RESOLVE
+4 ; FIL = FILE CONTAINING SOC FIELD
+5 ; FLD = SOC FIELD
+6 ;
+7 NEW Y,Z
+8 ;
+9 SET Y=""
+10 IF X]""
Begin DoDot:1
+11 SET Z=$GET(^DD(FIL,FLD,0))
+12 IF Z[X
Begin DoDot:2
+13 SET Y=$PIECE($PIECE(Z,X_":",2),";")
End DoDot:2
End DoDot:1
+14 QUIT Y
ASK(D0) ;
+1 ;----- PROMPT FOR INSTALL NAME
+2 ;
+3 NEW DIC,X,Y
+4 ;
+5 SET DIC="^XPD(9.7,"
+6 SET DIC(0)="AEMQ"
+7 SET DIC("A")="Enter INSTALL NAME: "
+8 DO ^DIC
+9 SET D0=+Y
+10 QUIT
GETFILE(PATH,FILE) ;
+1 ;----- READ CONTENTS OF KIDS TRANSPORT FILE AND PUT IN ^TMP GLOBAL
+2 ;
+3 SET OUT=0
+4 ;
+5 DO PATH(.PATH,.OUT)
+6 IF OUT
QUIT
+7 DO FILE(.FILE,.OUT)
+8 IF OUT
QUIT
+9 ;
+10 DO READ(PATH,FILE,.OUT)
+11 IF OUT
QUIT
+12 ;
+13 QUIT
READ(PATH,FILE,OUT) ;
+1 ;----- READ CONTENTS OF DATA FILE AND PUT INTO ^TMP GLOBAL
+2 ;
+3 NEW CNT,END,GR,I,POP,X,Y
+4 ;
+5 KILL ^TMP("AZX1",$JOB)
+6 SET GR="^TMP(""AZX1"","_$JOB_","
+7 SET OUT=0
+8 SET END=0
+9 SET CNT=0
+10 WRITE !,"READING FILE "_PATH_FILE_" ..."
+11 DO OPEN^%ZISH("FILE",PATH,FILE,"R")
+12 IF POP
Begin DoDot:1
+13 WRITE !?5,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
+14 SET OUT=1
End DoDot:1
+15 IF OUT
QUIT
+16 USE IO
READ X,Y
+17 IF X'["KIDS Distribution"
QUIT
+18 USE IO
READ X,Y
+19 IF X'["**KIDS**"
QUIT
+20 USE IO
READ X,Y
+21 IF X'["**INSTALL NAME**"
QUIT
+22 FOR I=1:1
Begin DoDot:1
+23 USE IO
READ X,Y:DTIME
+24 IF $$STATUS^%ZISH
SET END=1
+25 IF END
QUIT
+26 IF X["**END**"
SET END=1
+27 IF END
QUIT
+28 IF Y["**END**"
SET END=1
+29 IF END
QUIT
+30 IF X']""
QUIT
+31 IF $EXTRACT(X,$LENGTH(X))'=")"
QUIT
+32 SET CNT=CNT+1
+33 SET @(GR_X)=Y
+34 IF '(CNT#100)
USE 0
WRITE "."
End DoDot:1
IF END
QUIT
+35 ;
+36 DO CLOSE^%ZISH("FILE")
+37 QUIT
PATH(PATH,OUT) ;
+1 ;----- PROMPT FOR DIRECTORY PATH WHERE DATA FILE RESIDES
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET PATH=""
+6 SET OUT=0
+7 SET DIR(0)="FA"
+8 SET DIR("A")="Select DIRECTORY: "
+9 SET DIR("?")="Enter the PATH or DIRECTORY where the data file resides, e.g., D:\EXPORT\"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))
SET OUT=1
+12 IF OUT
QUIT
+13 SET X=Y
+14 DO DF^%ZISH(.X)
+15 SET PATH=X
+16 QUIT
FILE(FILE,OUT) ;
+1 ;----- PROMPT FOR DATA FILE
+2 ;
+3 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET FILE=""
+6 SET DIR(0)="FA"
+7 SET DIR("A")="Select FILE: "
+8 SET DIR("?")="Enter the name of the data file"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DIROUT))!(Y[U)
SET OUT=1
+11 IF $GET(OUT)
QUIT
+12 SET FILE=Y
+13 QUIT
PAWS(OUT) ;
+1 ;----- ISSUE 'RETURN' PROMPT
+2 ;
+3 NEW DIR,X,Y
+4 IF $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+5 WRITE !
+6 SET DIR(0)="E"
+7 DO ^DIR
+8 IF 'Y
SET OUT=1
+9 QUIT
