XUGET ; SF/XAK - PACKAGE INTEGRITY CHECKER ;12/14/92 11:47 ; [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;;Jul 10, 1995
1 W ! S DIR("A",1)="This answer is case sensitive.",DIR("A")="Select PACKAGE PREFIX",DIR(0)="FO^2:4"
S DIR("?")="Prefix must be 2 to 4 characters in length.",DIR("??")="^D H^XUGET"
D ^DIR G END:$D(DIRUT) S X=X_"NTEG"
X ^%ZOSF("TEST") I '$T W !!?5,"Integrity program does not exist." G 1
W ! S XD="^"_X S %ZIS="Q" D ^%ZIS G END:POP
I $D(IO("Q")) K IO("Q") S ZTRTN="GO^XUGET",ZTSAVE("XD")="",ZTDESC="ROUTINE INTEGRITY CHECKER",ZTIO=ION D ^%ZTLOAD G 1
GO W !,"Running "_XD_"..." D @XD G END:$D(ZTSK)
G 1
H ;
S DZ="?",DIC="^DIC(9.4,",DIC(0)="QE",D="C",DIC("S")="N X S X=$P(^(0),U,2)_""NTEG"" X ^%ZOSF(""TEST"")"
S DIC("W")="W ?15,$P(^(0),U)" D DQ^DICQ
K %,%Y,DD,DIX,DIY,DO,DISYS,D,DIC,DZ
Q
END K %I,ZTSK,XD,IO("Q"),POP,LN,I,L,X,DIR,DIRUT S U="^" Q
XUGET ; SF/XAK - PACKAGE INTEGRITY CHECKER ;12/14/92 11:47 ; [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;;Jul 10, 1995
1 WRITE !
SET DIR("A",1)="This answer is case sensitive."
SET DIR("A")="Select PACKAGE PREFIX"
SET DIR(0)="FO^2:4"
+1 SET DIR("?")="Prefix must be 2 to 4 characters in length."
SET DIR("??")="^D H^XUGET"
+2 DO ^DIR
IF $DATA(DIRUT)
GOTO END
SET X=X_"NTEG"
+3 XECUTE ^%ZOSF("TEST")
IF '$TEST
WRITE !!?5,"Integrity program does not exist."
GOTO 1
+4 WRITE !
SET XD="^"_X
SET %ZIS="Q"
DO ^%ZIS
IF POP
GOTO END
+5 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="GO^XUGET"
SET ZTSAVE("XD")=""
SET ZTDESC="ROUTINE INTEGRITY CHECKER"
SET ZTIO=ION
DO ^%ZTLOAD
GOTO 1
GO WRITE !,"Running "_XD_"..."
DO @XD
IF $DATA(ZTSK)
GOTO END
+1 GOTO 1
H ;
+1 SET DZ="?"
SET DIC="^DIC(9.4,"
SET DIC(0)="QE"
SET D="C"
SET DIC("S")="N X S X=$P(^(0),U,2)_""NTEG"" X ^%ZOSF(""TEST"")"
+2 SET DIC("W")="W ?15,$P(^(0),U)"
DO DQ^DICQ
+3 KILL %,%Y,DD,DIX,DIY,DO,DISYS,D,DIC,DZ
+4 QUIT
END KILL %I,ZTSK,XD,IO("Q"),POP,LN,I,L,X,DIR,DIRUT
SET U="^"
QUIT