AICDNTEG.m

AICDNTEG ;INTEGRITY CHECKER;NOV 08, 1991

 ;;3.51;IHS ICD/CPT lookup & grouper;;NOV 08, 1991

 ;

START ;

 NEW BYTE,COUNT,RTN

 K ^UTILITY($J)

 F I=1:1 S X=$T(LIST+I) Q:X=""  S X=$P(X,";;",2),R=$P(X,"^",1),B=$P(X,"^",2),C=$P(X,"^",3),^UTILITY($J,R)=B_"^"_C

 F I=1:1:6 S X=$P($T(@("LINE"_I)),";;",2,99),@("XBINTEG("_I_")=X")

 X XBINTEG(1)

 Q

 ;

LINE1 ;;X XBINTEG(2),XBINTEG(6)

LINE2 ;;S RTN="" F  S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""  W !,RTN ZL @RTN S (BYTE,COUNT)=0 S X=$T(+1),X=$P(X," [ ",1) X XBINTEG(4),XBINTEG(3),XBINTEG(5)

LINE3 ;;F I=2:1 S X=$T(+I) Q:X=""  X XBINTEG(4)

LINE4 ;;F J=1:1 S Y=$E(X,J) Q:Y=""  S BYTE=BYTE+1,COUNT=COUNT+$A(Y)

LINE5 ;;S B=$P(^(RTN),"^",1),C=$P(^(RTN),"^",2) I B'=BYTE!(C'=COUNT) W "  has been modified"

LINE6 ;;K XBINTEG,B,C,I,J,R,X,Y

 ;

LIST ;

 ;;AICDADK^1502^100551

 ;;AICDADK1^3278^205355

 ;;AICDEFDX^255^16809

 ;;AICDEFOP^257^17005

 ;;AICDESDX^259^17169

 ;;AICDESOP^261^17365

 ;;AICDGRP^1204^76911

 ;;AICDGRP1^3052^183939

 ;;AICDGRP2^1285^88440

 ;;AICDI001^4756^281491

 ;;AICDI002^4648^280410

 ;;AICDI003^1140^65336

 ;;AICDI004^4647^275373

 ;;AICDI005^4713^283768

 ;;AICDI006^289^15953

 ;;AICDI007^4722^277481

 ;;AICDI008^4670^270049

 ;;AICDI009^566^32748

 ;;AICDI010^3205^186906

 ;;AICDI011^3906^235486

 ;;AICDI012^453^25170

 ;;AICDI013^4699^305249

 ;;AICDI014^4660^318157

 ;;AICDI015^4686^312787

 ;;AICDI016^4720^324387

 ;;AICDI017^4660^312262

 ;;AICDI018^4693^328958

 ;;AICDI019^4123^277458

 ;;AICDINI0^366^24289

 ;;AICDINI1^2351^141220

 ;;AICDINI2^1337^82944

 ;;AICDINI3^2858^168006

 ;;AICDINIT^2796^171924

 ;;AICDKSCH^2389^154752

 ;;AICDKWI0^412^25834

 ;;AICDKWI9^412^25849

 ;;AICDKWIC^1932^124089

 ;;AICDKWIP^362^23210

 ;;AICDKWL^1561^97384

 ;;AICDKWL1^3411^219197

 ;;AICDKWL2^2837^183948

 ;;AICDKWLD^1840^117754

 ;;AICDPOST^657^45152

 ;;AICDPREI^2157^145022

 ;;AICDPRTD^930^58264

 ;;AICDPRTO^930^58293

 ;;AICDTICD^1036^62759

 ;;AICDTIL^856^59528

 ;;AICDTOKN^1407^89387

AICDNTEG  ;INTEGRITY CHECKER;NOV 08, 1991

 +1       ;;3.51;IHS ICD/CPT lookup & grouper;;NOV 08, 1991

 +2       ;

START     ;

 +1        NEW BYTE,COUNT,RTN

 +2        KILL ^UTILITY($JOB)

 +3        FOR I=1:1

               SET X=$TEXT(LIST+I)

               IF X=""

                   QUIT 

               SET X=$PIECE(X,";;",2)

               SET R=$PIECE(X,"^",1)

               SET B=$PIECE(X,"^",2)

               SET C=$PIECE(X,"^",3)

               SET ^UTILITY($JOB,R)=B_"^"_C

 +4        FOR I=1:1:6

               SET X=$PIECE($TEXT(@("LINE"_I)),";;",2,99)

               SET @("XBINTEG("_I_")=X")

 +5        XECUTE XBINTEG(1)

 +6        QUIT 

 +7       ;

LINE1     ;;X XBINTEG(2),XBINTEG(6)

LINE2     ;;S RTN="" F  S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""  W !,RTN ZL @RTN S (BYTE,COUNT)=0 S X=$T(+1),X=$P(X," [ ",1) X XBINTEG(4),XBINTEG(3),XBINTEG(5)

LINE3     ;;F I=2:1 S X=$T(+I) Q:X=""  X XBINTEG(4)

LINE4     ;;F J=1:1 S Y=$E(X,J) Q:Y=""  S BYTE=BYTE+1,COUNT=COUNT+$A(Y)

LINE5     ;;S B=$P(^(RTN),"^",1),C=$P(^(RTN),"^",2) I B'=BYTE!(C'=COUNT) W "  has been modified"

LINE6     ;;K XBINTEG,B,C,I,J,R,X,Y

 +1       ;

LIST      ;

 +1       ;;AICDADK^1502^100551

 +2       ;;AICDADK1^3278^205355

 +3       ;;AICDEFDX^255^16809

 +4       ;;AICDEFOP^257^17005

 +5       ;;AICDESDX^259^17169

 +6       ;;AICDESOP^261^17365

 +7       ;;AICDGRP^1204^76911

 +8       ;;AICDGRP1^3052^183939

 +9       ;;AICDGRP2^1285^88440

 +10      ;;AICDI001^4756^281491

 +11      ;;AICDI002^4648^280410

 +12      ;;AICDI003^1140^65336

 +13      ;;AICDI004^4647^275373

 +14      ;;AICDI005^4713^283768

 +15      ;;AICDI006^289^15953

 +16      ;;AICDI007^4722^277481

 +17      ;;AICDI008^4670^270049

 +18      ;;AICDI009^566^32748

 +19      ;;AICDI010^3205^186906

 +20      ;;AICDI011^3906^235486

 +21      ;;AICDI012^453^25170

 +22      ;;AICDI013^4699^305249

 +23      ;;AICDI014^4660^318157

 +24      ;;AICDI015^4686^312787

 +25      ;;AICDI016^4720^324387

 +26      ;;AICDI017^4660^312262

 +27      ;;AICDI018^4693^328958

 +28      ;;AICDI019^4123^277458

 +29      ;;AICDINI0^366^24289

 +30      ;;AICDINI1^2351^141220

 +31      ;;AICDINI2^1337^82944

 +32      ;;AICDINI3^2858^168006

 +33      ;;AICDINIT^2796^171924

 +34      ;;AICDKSCH^2389^154752

 +35      ;;AICDKWI0^412^25834

 +36      ;;AICDKWI9^412^25849

 +37      ;;AICDKWIC^1932^124089

 +38      ;;AICDKWIP^362^23210

 +39      ;;AICDKWL^1561^97384

 +40      ;;AICDKWL1^3411^219197

 +41      ;;AICDKWL2^2837^183948

 +42      ;;AICDKWLD^1840^117754

 +43      ;;AICDPOST^657^45152

 +44      ;;AICDPREI^2157^145022

 +45      ;;AICDPRTD^930^58264

 +46      ;;AICDPRTO^930^58293

 +47      ;;AICDTICD^1036^62759

 +48      ;;AICDTIL^856^59528

 +49      ;;AICDTOKN^1407^89387