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 ---[H[J[2J[HDINTEG5 3105 printed Dec 13, 2024@02:52:10 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
