DINTEG5.m

DINTEG5 ;SFISC/dizSUMB FILEMAN-FileMan checksum checker ;MAR 30, 1999  13:20

 ;;22.0;VA FileMan;;Mar 30, 1999;Build 1

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 S DIZ4="I 1" D DSP,INI

CONT F DIZ1=1:1 S DIZ2=$T(ROU+DIZ1) Q:DIZ2=""  S X=$P(DIZ2," ",1),DIZ3=$P(DIZ2,";",3) X DIZ4 I $T W !,X X DIZTEST W:'$T ?28,DIZ6 S:'$T DIZ3=0 X:DIZ3 DIZSUM W ?10,$S('DIZ3:"",DIZ3'=Y:$C(7)_"Calculated "_Y_", off by "_(Y-DIZ3),1:"ok")

 ;

 S X="" F  S X=$O(^UTILITY($J,X)) Q:X=""  W !,X,?10,"not a routine in this INTEGRITY checker"

 K D,D1,D2,D3,X,Y,DIZ,DIZ1,DIZ2,DIZ3,DIZ4,DIZ5,DIZ6,DIZTEST,DIZSUM,DISYS,DIZSEL,^UTILITY($J) Q

ONE D INI S DIZSEL=$S($D(^%ZOSF("RSEL")):^("RSEL"),1:"F  S DIR(0)=""FO^1:8"",DIR(""A"")=""ROUTINE NAME"" D ^DIR Q:$D(DIRUT)  X DIZTEST W:'$T ?28,DIZ6 I $T S ^UTILITY($J,Y)=""""")

 S DIZ4="I $D(^UTILITY($J,X)) K ^(X)" D DSP

 W !,"Check a subset of routines:" K ^UTILITY($J) X DIZSEL

 W ! G CONT

DSP S X=$T(+2) W !!,"Checksum routine created on "_$P(X,";",6)_" by "_$P(X,";",4)_" V"_$P(X,";",3) Q

INI K ^UTILITY($J) D OS^DII S DIZTEST=$S($D(^DD("OS",DISYS,18)):^(18),1:"I $T(^@X)]"""""),DIZ5="",DIZ6=$C(7)_"Routine not in UCI"

 S DIZSUM="ZL @X S Y=0 F D=1,3:1 S D1=$T(+D),D3=$F(D1,"" "") Q:'D3  S D3=$S($E(D1,D3)'="";"":$L(D1),$E(D1,D3+1)="";"":$L(D1),1:D3-2) F D2=1:1:D3 S Y=$A(D1,D2)*D2+Y" Q

ROU ;;

DIQGDD0 ;;1846736

DIQGDDF ;;1999058

DIQGDDT ;;7439520

DIQGDDU ;;1578963

DIQGQ ;;15845121

DIQGU ;;4828002

DIQGU0 ;;3019674

DIQQ ;;10195940

DIQQ1 ;;1279104

DIQQQ ;;5024310

DIR ;;8925710

DIR0 ;;5505897

DIR01 ;;4710189

DIR02 ;;2241633

DIR03 ;;4452265

DIR0H ;;2000761

DIR0K ;;1519785

DIR0W ;;3089175

DIR1 ;;11551993

DIR2 ;;9383057

DIR3 ;;2913754

DIRCR ;;3369745

DIRQ ;;968045

DIS ;;8082470

DIS0 ;;7360682

DIS1 ;;5931795

DIS2 ;;5717533

DIS3 ;;1548747

DIT ;;9006532

DIT0 ;;2588866

DIT1 ;;10465331

DIT2 ;;2621259

DIT3 ;;5880904

DITC ;;8730630

DITC0 ;;3191582

DITC1 ;;5739425

DITC2 ;;9411545

DITC3 ;;4586809

DITM ;;3764313

DITM1 ;;3291696

DITM2 ;;4300014

DITMGM1 ;;3241730

DITMGM2 ;;3998925

DITMGM2A ;;7225704

DITMGM2B ;;3795853

DITMGM2C ;;3476209

DITMGMRG ;;4234244

DITMGMRI ;;3560391

DITMU1 ;;267174

DITMU2 ;;1127015

DITMU3 ;;422892

DITMU4 ;;7174363

DITP ;;6552936

DITR ;;5528738

DITR1 ;;7434301

DIU ;;4154847

DIU0 ;;6435132

DIU1 ;;9899497

DIU2 ;;4715210

DIU20 ;;3002389

DIU21 ;;6146003

DIU3 ;;6911213

DIU31 ;;9874154

DIU4 ;;5389344

DIU5 ;;251900

DIUTL ;;1393463

DIV ;;3841210

DIVC ;;4408241

DIVR ;;8571704

DIVR1 ;;10947202

DIVRE ;;7154469

DIVRE1 ;;634136

DIVU ;;3100544

DIWE ;;6032247

DIWE1 ;;6185993

DIWE11 ;;4308475

DIWE12 ;;5612992

DIWE2 ;;6639751

DIWE3 ;;11694484

DIWE4 ;;9685833

DIWE5 ;;7891987

DIWF ;;5538065

DIWP ;;5138047

DIWW ;;5644162

DIX ;;2522654

DIXC ;;4724715

DMSQ ;;10102863

DMSQD ;;8773197

DMSQE ;;843826

DMSQF ;;9792265

DMSQF1 ;;8518725

DMSQF2 ;;8370804

DMSQP ;;2371815

DMSQP1 ;;3565656

DMSQP2 ;;6721470

DMSQP3 ;;11874271

DMSQP4 ;;2151271

DMSQP5 ;;5423594

DMSQP6 ;;10074783

DMSQS ;;3197279

DMSQT ;;11672859

DMSQT1 ;;1181888

DMSQU ;;10591593

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DINTEG5   3105     printed  Apr 09, 2024@21:50:08                                                                                                                                                                                                     Page 2

DINTEG5   ;SFISC/dizSUMB FILEMAN-FileMan checksum checker ;MAR 30, 1999  13:20

 +1       ;;22.0;VA FileMan;;Mar 30, 1999;Build 1

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        SET DIZ4="I 1"

           DO DSP

           DO INI

CONT       FOR DIZ1=1:1

               SET DIZ2=$TEXT(ROU+DIZ1)

               if DIZ2=""

                   QUIT 

               SET X=$PIECE(DIZ2," ",1)

               SET DIZ3=$PIECE(DIZ2,";",3)

               XECUTE DIZ4

               IF $TEST

                   WRITE !,X

                   XECUTE DIZTEST

                   if '$TEST

                       WRITE ?28,DIZ6

                   if '$TEST

                       SET DIZ3=0

                   if DIZ3

                       XECUTE DIZSUM

                   WRITE ?10,$SELECT('DIZ3:"",DIZ3'=Y:$CHAR(7)_"Calculated "_Y_", off by "_(Y-DIZ3),1:"ok")

 +1       ;

 +2        SET X=""

           FOR 

               SET X=$ORDER(^UTILITY($JOB,X))

               if X=""

                   QUIT 

               WRITE !,X,?10,"not a routine in this INTEGRITY checker"

 +3        KILL D,D1,D2,D3,X,Y,DIZ,DIZ1,DIZ2,DIZ3,DIZ4,DIZ5,DIZ6,DIZTEST,DIZSUM,DISYS,DIZSEL,^UTILITY($JOB)

           QUIT 

ONE        DO INI

           SET DIZSEL=$SELECT($DATA(^%ZOSF("RSEL")):^("RSEL"),1:"F  S DIR(0)=""FO^1:8"",DIR(""A"")=""ROUTINE NAME"" D ^DIR Q:$D(DIRUT)  X DIZTEST W:'$T ?28,DIZ6 I $T S ^UTILITY($J,Y)=""""")

 +1        SET DIZ4="I $D(^UTILITY($J,X)) K ^(X)"

           DO DSP

 +2        WRITE !,"Check a subset of routines:"

           KILL ^UTILITY($JOB)

           XECUTE DIZSEL

 +3        WRITE !

           GOTO CONT

DSP        SET X=$TEXT(+2)

           WRITE !!,"Checksum routine created on "_$PIECE(X,";",6)_" by "_$PIECE(X,";",4)_" V"_$PIECE(X,";",3)

           QUIT 

INI        KILL ^UTILITY($JOB)

           DO OS^DII

           SET DIZTEST=$SELECT($DATA(^DD("OS",DISYS,18)):^(18),1:"I $T(^@X)]""""")

           SET DIZ5=""

           SET DIZ6=$CHAR(7)_"Routine not in UCI"

 +1        SET DIZSUM="ZL @X S Y=0 F D=1,3:1 S D1=$T(+D),D3=$F(D1,"" "") Q:'D3  S D3=$S($E(D1,D3)'="";"":$L(D1),$E(D1,D3+1)="";"":$L(D1),1:D3-2) F D2=1:1:D3 S Y=$A(D1,D2)*D2+Y"

           QUIT 

ROU       ;;

DIQGDD0   ;;1846736

DIQGDDF   ;;1999058

DIQGDDT   ;;7439520

DIQGDDU   ;;1578963

DIQGQ     ;;15845121

DIQGU     ;;4828002

DIQGU0    ;;3019674

DIQQ      ;;10195940

DIQQ1     ;;1279104

DIQQQ     ;;5024310

DIR       ;;8925710

DIR0      ;;5505897

DIR01     ;;4710189

DIR02     ;;2241633

DIR03     ;;4452265

DIR0H     ;;2000761

DIR0K     ;;1519785

DIR0W     ;;3089175

DIR1      ;;11551993

DIR2      ;;9383057

DIR3      ;;2913754

DIRCR     ;;3369745

DIRQ      ;;968045

DIS       ;;8082470

DIS0      ;;7360682

DIS1      ;;5931795

DIS2      ;;5717533

DIS3      ;;1548747

DIT       ;;9006532

DIT0      ;;2588866

DIT1      ;;10465331

DIT2      ;;2621259

DIT3      ;;5880904

DITC      ;;8730630

DITC0     ;;3191582

DITC1     ;;5739425

DITC2     ;;9411545

DITC3     ;;4586809

DITM      ;;3764313

DITM1     ;;3291696

DITM2     ;;4300014

DITMGM1   ;;3241730

DITMGM2   ;;3998925

DITMGM2A  ;;7225704

DITMGM2B  ;;3795853

DITMGM2C  ;;3476209

DITMGMRG  ;;4234244

DITMGMRI  ;;3560391

DITMU1    ;;267174

DITMU2    ;;1127015

DITMU3    ;;422892

DITMU4    ;;7174363

DITP      ;;6552936

DITR      ;;5528738

DITR1     ;;7434301

DIU       ;;4154847

DIU0      ;;6435132

DIU1      ;;9899497

DIU2      ;;4715210

DIU20     ;;3002389

DIU21     ;;6146003

DIU3      ;;6911213

DIU31     ;;9874154

DIU4      ;;5389344

DIU5      ;;251900

DIUTL     ;;1393463

DIV       ;;3841210

DIVC      ;;4408241

DIVR      ;;8571704

DIVR1     ;;10947202

DIVRE     ;;7154469

DIVRE1    ;;634136

DIVU      ;;3100544

DIWE      ;;6032247

DIWE1     ;;6185993

DIWE11    ;;4308475

DIWE12    ;;5612992

DIWE2     ;;6639751

DIWE3     ;;11694484

DIWE4     ;;9685833

DIWE5     ;;7891987

DIWF      ;;5538065

DIWP      ;;5138047

DIWW      ;;5644162

DIX       ;;2522654

DIXC      ;;4724715

DMSQ      ;;10102863

DMSQD     ;;8773197

DMSQE     ;;843826

DMSQF     ;;9792265

DMSQF1    ;;8518725

DMSQF2    ;;8370804

DMSQP     ;;2371815

DMSQP1    ;;3565656

DMSQP2    ;;6721470

DMSQP3    ;;11874271

DMSQP4    ;;2151271

DMSQP5    ;;5423594

DMSQP6    ;;10074783

DMSQS     ;;3197279

DMSQT     ;;11672859

DMSQT1    ;;1181888

DMSQU     ;;10591593