- DINTEG3 ;SFISC/dizSUMB FILEMAN-FileMan checksum checker ;MAR 30, 1999 13:20
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;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")
- G CONT^DINTEG4
- 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 ;;
- DIKK ;;8668460
- DIKK1 ;;2999261
- DIKK2 ;;7003020
- DIKKDD ;;619322
- DIKKFORM ;;4020610
- DIKKP ;;4960174
- DIKKUTL ;;7891682
- DIKKUTL1 ;;7440382
- DIKKUTL2 ;;3321012
- DIKKUTL3 ;;5832605
- DIKKUTL4 ;;5542445
- DIKZ ;;10002654
- DIKZ0 ;;10320064
- DIKZ1 ;;9229373
- DIKZ11 ;;4558086
- DIKZ2 ;;5046219
- DIL ;;6333527
- DIL0 ;;5148814
- DIL1 ;;6856617
- DIL11 ;;5151125
- DIL2 ;;9004976
- DILF ;;2130649
- DILFD ;;231253
- DILIBF ;;7474309
- DILL ;;6100960
- DIM ;;2236006
- DIM1 ;;6135531
- DIM2 ;;4310650
- DIM3 ;;4265731
- DIM4 ;;3292224
- DINIT ;;14206897
- DINIT0 ;;5228258
- DINIT001 ;;14508772
- DINIT002 ;;13588488
- DINIT003 ;;1581370
- DINIT004 ;;11043470
- DINIT005 ;;10186263
- DINIT006 ;;11577960
- DINIT007 ;;10157790
- DINIT008 ;;10934076
- DINIT009 ;;10025795
- DINIT00A ;;10964723
- DINIT00B ;;10114739
- DINIT00C ;;11848580
- DINIT00D ;;9602595
- DINIT00E ;;9681953
- DINIT00F ;;10204123
- DINIT00G ;;10224518
- DINIT00H ;;8865487
- DINIT00I ;;8471256
- DINIT00J ;;7134655
- DINIT00K ;;7241879
- DINIT00L ;;9874316
- DINIT00M ;;10643142
- DINIT00N ;;10071584
- DINIT00O ;;11551621
- DINIT00P ;;8727020
- DINIT00Q ;;15168785
- DINIT00R ;;14638500
- DINIT00S ;;10098710
- DINIT00T ;;12267505
- DINIT00U ;;9544524
- DINIT00V ;;11149620
- DINIT00W ;;11855494
- DINIT00X ;;9838636
- DINIT00Y ;;8368445
- DINIT00Z ;;9947320
- DINIT010 ;;1380027
- DINIT011 ;;11943970
- DINIT012 ;;4026838
- DINIT013 ;;6100108
- DINIT02 ;;2462843
- DINIT07 ;;3740650
- DINIT08 ;;7989773
- DINIT0F0 ;;6212996
- DINIT0F1 ;;5527731
- DINIT0F2 ;;6166174
- DINIT0F3 ;;4903781
- DINIT0F4 ;;6382515
- DINIT0F5 ;;7697568
- DINIT0F6 ;;6316746
- DINIT0F7 ;;4711128
- DINIT0F8 ;;7102472
- DINIT0F9 ;;6185855
- DINIT0FA ;;7807085
- DINIT0FB ;;9020615
- DINIT0FC ;;5772591
- DINIT0FD ;;6456159
- DINIT0FE ;;5897346
- DINIT0FF ;;8836421
- DINIT0FG ;;8409070
- DINIT0FH ;;8855011
- DINIT0FI ;;5372744
- DINIT0FJ ;;5577122
- DINIT0FK ;;5843271
- DINIT0FL ;;9505191
- DINIT0FM ;;19265777
- DINIT0FN ;;11731152
- DINIT1 ;;6609056
- DINIT11 ;;7807097
- DINIT11A ;;9397074
- DINIT11B ;;3195420
- DINIT11C ;;6005195
- DINIT12 ;;8644619
- DINIT120 ;;13978285
- DINIT121 ;;13775662
- DINIT122 ;;14151880
- DINIT123 ;;15919572
- DINIT124 ;;18245323
- DINIT125 ;;14791473
- DINIT126 ;;14076027
- DINIT127 ;;1844442
- DINIT13 ;;6745649
- DINIT14 ;;3422144
- DINIT2 ;;729944
- DINIT20 ;;8343419
- DINIT21 ;;3404826
- DINIT22 ;;1548661
- DINIT220 ;;487349
- DINIT24 ;;11140614
- DINIT25 ;;8381842
- DINIT250 ;;4565635
- DINIT255 ;;3074177
- DINIT26 ;;7320579
- DINIT260 ;;7558780
- DINIT27 ;;8893587
- DINTEG3 ;SFISC/dizSUMB FILEMAN-FileMan checksum checker ;MAR 30, 1999 13:20
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +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 GOTO CONT^DINTEG4
- +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 ;;
- DIKK ;;8668460
- DIKK1 ;;2999261
- DIKK2 ;;7003020
- DIKKDD ;;619322
- DIKKFORM ;;4020610
- DIKKP ;;4960174
- DIKKUTL ;;7891682
- DIKKUTL1 ;;7440382
- DIKKUTL2 ;;3321012
- DIKKUTL3 ;;5832605
- DIKKUTL4 ;;5542445
- DIKZ ;;10002654
- DIKZ0 ;;10320064
- DIKZ1 ;;9229373
- DIKZ11 ;;4558086
- DIKZ2 ;;5046219
- DIL ;;6333527
- DIL0 ;;5148814
- DIL1 ;;6856617
- DIL11 ;;5151125
- DIL2 ;;9004976
- DILF ;;2130649
- DILFD ;;231253
- DILIBF ;;7474309
- DILL ;;6100960
- DIM ;;2236006
- DIM1 ;;6135531
- DIM2 ;;4310650
- DIM3 ;;4265731
- DIM4 ;;3292224
- DINIT ;;14206897
- DINIT0 ;;5228258
- DINIT001 ;;14508772
- DINIT002 ;;13588488
- DINIT003 ;;1581370
- DINIT004 ;;11043470
- DINIT005 ;;10186263
- DINIT006 ;;11577960
- DINIT007 ;;10157790
- DINIT008 ;;10934076
- DINIT009 ;;10025795
- DINIT00A ;;10964723
- DINIT00B ;;10114739
- DINIT00C ;;11848580
- DINIT00D ;;9602595
- DINIT00E ;;9681953
- DINIT00F ;;10204123
- DINIT00G ;;10224518
- DINIT00H ;;8865487
- DINIT00I ;;8471256
- DINIT00J ;;7134655
- DINIT00K ;;7241879
- DINIT00L ;;9874316
- DINIT00M ;;10643142
- DINIT00N ;;10071584
- DINIT00O ;;11551621
- DINIT00P ;;8727020
- DINIT00Q ;;15168785
- DINIT00R ;;14638500
- DINIT00S ;;10098710
- DINIT00T ;;12267505
- DINIT00U ;;9544524
- DINIT00V ;;11149620
- DINIT00W ;;11855494
- DINIT00X ;;9838636
- DINIT00Y ;;8368445
- DINIT00Z ;;9947320
- DINIT010 ;;1380027
- DINIT011 ;;11943970
- DINIT012 ;;4026838
- DINIT013 ;;6100108
- DINIT02 ;;2462843
- DINIT07 ;;3740650
- DINIT08 ;;7989773
- DINIT0F0 ;;6212996
- DINIT0F1 ;;5527731
- DINIT0F2 ;;6166174
- DINIT0F3 ;;4903781
- DINIT0F4 ;;6382515
- DINIT0F5 ;;7697568
- DINIT0F6 ;;6316746
- DINIT0F7 ;;4711128
- DINIT0F8 ;;7102472
- DINIT0F9 ;;6185855
- DINIT0FA ;;7807085
- DINIT0FB ;;9020615
- DINIT0FC ;;5772591
- DINIT0FD ;;6456159
- DINIT0FE ;;5897346
- DINIT0FF ;;8836421
- DINIT0FG ;;8409070
- DINIT0FH ;;8855011
- DINIT0FI ;;5372744
- DINIT0FJ ;;5577122
- DINIT0FK ;;5843271
- DINIT0FL ;;9505191
- DINIT0FM ;;19265777
- DINIT0FN ;;11731152
- DINIT1 ;;6609056
- DINIT11 ;;7807097
- DINIT11A ;;9397074
- DINIT11B ;;3195420
- DINIT11C ;;6005195
- DINIT12 ;;8644619
- DINIT120 ;;13978285
- DINIT121 ;;13775662
- DINIT122 ;;14151880
- DINIT123 ;;15919572
- DINIT124 ;;18245323
- DINIT125 ;;14791473
- DINIT126 ;;14076027
- DINIT127 ;;1844442
- DINIT13 ;;6745649
- DINIT14 ;;3422144
- DINIT2 ;;729944
- DINIT20 ;;8343419
- DINIT21 ;;3404826
- DINIT22 ;;1548661
- DINIT220 ;;487349
- DINIT24 ;;11140614
- DINIT25 ;;8381842
- DINIT250 ;;4565635
- DINIT255 ;;3074177
- DINIT26 ;;7320579
- DINIT260 ;;7558780
- DINIT27 ;;8893587