- 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