SR206UT3.m

SR206UT3 ;HPS/JSG - FY22 CPT EXCLUSION UTILITY, CONTINUED ;May 10, 2022@15:25

 ;;3.0;Surgery;**206**;24 Jun 93;Build 2

 ;

 Q

EX ; populate the CPT EXCLUSIONS file (#137)

 F SRJ=1:1 S SRLIST=$P($T(LIST+SRJ)," ;;",2) Q:SRLIST=""  F SRI=1:1 S SRX=$P(SRLIST,",",SRI) Q:SRX=""  I $D(^ICPT("B",SRX)) D INT

 Q

INT S SRY=0,SRY=$O(^ICPT("B",SRX,SRY)) Q:SRY=""

 K DA,DIC,DD,DO,DINUM S (DINUM,X)=SRY,DIC="^SRO(137,",DIC(0)="L" D FILE^DICN

 Q

LIST ;

 ;;90875,90876,90880,90882,90885,90887,90889,90899,90901,90912,90913,90935,90937

 ;;90940,90945,90947,90951,90952,90953,90954,90955,90956,90957,90958,90959,90960

 ;;90961,90962,90963,90964,90965,90966,90967,90968,90969,90970,90989,90993,90997

 ;;90999,91010,91013,91020,91022,91030,91034,91035,91037,91038,91040,91065,91110

 ;;91111,91112,91113,91117,91120,91122,91132,91133,91200,91299,91300,91301,91302

 ;;91303,91304,92002,92004,92012,92014,92015,92018,92019,92020,92025,92060,92065

 ;;92071,92072,92081,92082,92083,92100,92132,92133,92134,92136,92145,92201,92202

 ;;92227,92228,92229,92230,92235,92240,92242,92250,92260,92265,92270,92273,92274

 ;;92283,92284,92285,92286,92287,92310,92311,92312,92313,92314,92315,92316,92317

 ;;92325,92326,92340,92341,92342,92352,92353,92354,92355,92358,92370,92371,92499

 ;;92502,92504,92507,92508,92511,92512,92516,92517,92518,92519,92520,92521,92522

 ;;92523,92524,92526,92531,92532,92533,92534,92537,92538,92540,92541,92542,92544

 ;;92545,92546,92547,92548,92549,92550,92551,92552,92553,92555,92556,92557,92558

 ;;92559,92560,92561,92562,92563,92564,92565,92567,92568,92570,92571,92572,92575

 ;;92576,92577,92579,92582,92583,92584,92587,92588,92590,92591,92592,92593,92594

 ;;92595,92596,92597,92601,92602,92603,92604,92605,92606,92607,92608,92609,92610

 ;;92611,92612,92613,92614,92615,92616,92617,92618,92620,92621,92625,92626,92627

 ;;92630,92633,92640,92650,92651,92652,92653,92700,92920,92921,92924,92925,92928

 ;;92929,92933,92934,92937,92938,92941,92943,92944,92950,92953,92960,92961,92970

 ;;92971,92973,92974,92975,92977,92978,92979,92986,92987,92990,92997,92998,93000

 ;;93005,93010,93015,93016,93017,93018,93024,93025,93040,93041,93042,93050,93224

 ;;93225,93226,93227,93228,93229,93241,93242,93243,93244,93245,93246,93247,93248

 ;;93260,93261,93264,93268,93270,93271,93272,93278,93279,93280,93281,93282,93283

 ;;93284,93285,93286,93287,93288,93289,93290,93291,93292,93293,93294,93295,93296

 ;;93297,93298,93303,93304,93306,93307,93308,93312,93313,93314,93315,93316,93317

 ;;93318,93319,93320,93321,93325,93350,93351,93352,93355,93356,93451,93452,93453

 ;;93454,93455,93456,93457,93458,93459,93460,93461,93462,93463,93464,93503,93505

 ;;93530,93531,93532,93533,93561,93562,93563,93564,93565,93566,93567,93568,93571

 ;;93572,93580,93581,93582,93583,93593,93594,93595,93596,93597,93598,93600,93602

 ;;93603,93609,93610,93612,93613,93615,93616,93618,93619,93620,93621,93622,93623

 ;;93624,93631,93640,93641,93642,93644,93650,93653,93654,93655,93656,93657,93660

 ;;93662,93668,93701,93702,93724,93740,93745,93750,93770,93784,93786,93788,93790

 ;;93792,93793,93797,93798,93799,93880,93882,93886,93888,93890,93892,93893,93895

 ;;93922,93923,93924,93925,93926,93930,93931,93970,93971,93975,93976,93978,93979

 ;;93980,93981,93985,93986,93990,93998,94002,94003,94004,94005,94010,94011,94012

 ;;94013,94014,94015,94016,94060,94070,94150,94200,94375,94450,94452,94453,94610

 ;;94617,94618,94619,94621,94625,94626,94640,94642,94644,94645,94660,94662,94664

 ;;94667,94668,94669,94680,94681,94690,94726,94727,94728,94729,94760,94761,94762

 ;;94772,94774,94775,94776,94777,94780,94781,94799,95004,95012,95017,95018,95024

 ;;95027,95028,95044,95052,95056,95060,95065,95070,95076,95079,95115,95117,95120

 ;;95125,95130,95131,95132,95133,95134,95144,95145,95146,95147,95148,95149,95165

 ;;95170,95180,95199,95249,95250,95251,95700,95705,95706,95707,95708,95709,95710

 ;;95711,95712,95713,95714,95715,95716,95717,95718,95719,95720,95721,95722,95723

 ;;95724,95725,95726,95782,95783,95800,95801,95803,95805,95806,95807,95808,95810

 ;;95811,95812,95813,95816,95819,95822,95824,95829,95830,95836,95851,95852,95857

 ;;95860,95861,95863,95864,95865,95866,95867,95868,95869,95870,95872,95873,95874

 ;;95875,95885,95886,95887,95905,95907,95908,95909,95910,95911,95912,95913,95921

 ;;95922,95923,95924,95925,95926,95927,95928,95929,95930,95933,95937,95938,95939

 ;;95940,95941,95943,95954,95955,95957,95958,95961,95962,95965,95966,95967,95970

 ;;95971,95972,95976,95977,95980,95981,95982,95983,95984,95990,95991,95992,95999

 ;;96000,96001,96002,96003,96004,96020,96040,96105,96110,96112,96113,96116,96121

 ;;96125,96127,96130,96131,96132,96133,96136,96137,96138,96139,96146,96156,96158

 ;;96159,96160,96161,96164,96165,96167,96168,96170,96171,96360,96361,96365,96366

 ;;96367,96368,96369,96370,96371,96372,96373,96374,96375,96376,96377,96379,96401

 ;;96402,96405,96406,96409,96411,96413,96415,96416,96417,96420,96422,96423,96425

 ;;96440,96446,96450,96521,96522,96523,96542,96549,96567,96570,96571,96573,96574

 ;;96900,96902,96904,96910,96912,96913,96920,96921,96922,96931,96932,96933,96934

 ;;96935,96936,96999,97010,97012,97014,97016,97018,97022,97024,97026,97028,97032

 ;;97033,97034,97035,97036,97039,97110,97112,97113,97116,97124,97129,97130,97139

 ;;97140,97150,97151,97152,97153,97154,97155,97156,97157,97158,97161,97162,97163

 ;;97164,97165,97166,97167,97168,97169,97170,97171,97172,97530,97533,97535,97537

 ;;97542,97545,97546,97597,97598,97602,97605,97606,97607,97608,97610,97750,97755

 ;;97760,97761,97763,97799,97802,97803,97804,97810,97811,97813,97814,98925,98926

 ;;98927,98928,98929,98940,98941,98942,98943,98960,98961,98962,98966,98967,98968

 ;;98970,98971,98972,98975,98976,98977,98980,98981,99000,99001,99002,99024,99026

 ;;99027,99050,99051,99053,99056,99058,99060,99070,99071,99072,99075,99078,99080

 ;;99082,99091,99100,99116,99135,99140,99151,99152,99153,99155,99156,99157,99170

 ;;99172,99173,99174,99175,99177,99183,99184,99188,99190,99191,99192,99195,99199

 ;;99202,99203,99204,99205,99211,99212,99213,99214,99215,

 ;;99217,99218,99219,99220,99221,99222,99223,99224,99225,99226,99231,99232,99233

 ;;99234,99235,99236,99238,99239,99241,99242,99243,99244,99245,99251,99252,99253

 ;;99254,99255,99281,99282,99283,99284,99285,99288,99291,99292,99304,99305,99306

 ;;99307,99308,99309,99310,99315,99316,99318,99324,99325,99326,99327,99328,99334

 ;;99335,99336,99337,99339,99340,99341,99342,99343,99344,99345,99347,99348,99349

 ;;99350,99354,99355,99356,99357,99358,99359,99360,99366,99367,99368,99374,99375

 ;;99377,99378,99379,99380,99381,99382,99383,99384,99385,99386,99387,99391,99392

 ;;99393,99394,99395,99396,99397,99401,99402,99403,99404,99406,99407,99408,99409

 ;;99411,99412,99415,99416,99417,99420,99421,99422,99423,99424,99425,99426,99427

 ;;99429,99437,99439,99441,99442,99443,99446,99447,99448,99449,99450,99451,99452

 ;;99453,99454,99455,99456,99457,99458,99460,99461,99462,99463,99464,99465,99466

 ;;99467,99468,99469,99471,99472,99473,99474,99475,99476,99477,99478,99479,99480

 ;;99483,99484,99485,99486,99487,99489,99490,99491,99492,99493,99494,99495,99496

 ;;99497,99498,99499,99500,99501,99502,99503,99504,99505,99506,99507,99509,99510

 ;;99511,99512,99600,99601,99602,99605,99606,99607

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SR206UT3   7284     printed  Nov 22, 2024@17:48:27                                                                                                                                                                                                    Page 2

SR206UT3  ;HPS/JSG - FY22 CPT EXCLUSION UTILITY, CONTINUED ;May 10, 2022@15:25

 +1       ;;3.0;Surgery;**206**;24 Jun 93;Build 2

 +2       ;

 +3        QUIT 

EX        ; populate the CPT EXCLUSIONS file (#137)

 +1        FOR SRJ=1:1

               SET SRLIST=$PIECE($TEXT(LIST+SRJ)," ;;",2)

               if SRLIST=""

                   QUIT 

               FOR SRI=1:1

                   SET SRX=$PIECE(SRLIST,",",SRI)

                   if SRX=""

                       QUIT 

                   IF $DATA(^ICPT("B",SRX))

                       DO INT

 +2        QUIT 

INT        SET SRY=0

           SET SRY=$ORDER(^ICPT("B",SRX,SRY))

           if SRY=""

               QUIT 

 +1        KILL DA,DIC,DD,DO,DINUM

           SET (DINUM,X)=SRY

           SET DIC="^SRO(137,"

           SET DIC(0)="L"

           DO FILE^DICN

 +2        QUIT 

LIST      ;

 +1       ;;90875,90876,90880,90882,90885,90887,90889,90899,90901,90912,90913,90935,90937

 +2       ;;90940,90945,90947,90951,90952,90953,90954,90955,90956,90957,90958,90959,90960

 +3       ;;90961,90962,90963,90964,90965,90966,90967,90968,90969,90970,90989,90993,90997

 +4       ;;90999,91010,91013,91020,91022,91030,91034,91035,91037,91038,91040,91065,91110

 +5       ;;91111,91112,91113,91117,91120,91122,91132,91133,91200,91299,91300,91301,91302

 +6       ;;91303,91304,92002,92004,92012,92014,92015,92018,92019,92020,92025,92060,92065

 +7       ;;92071,92072,92081,92082,92083,92100,92132,92133,92134,92136,92145,92201,92202

 +8       ;;92227,92228,92229,92230,92235,92240,92242,92250,92260,92265,92270,92273,92274

 +9       ;;92283,92284,92285,92286,92287,92310,92311,92312,92313,92314,92315,92316,92317

 +10      ;;92325,92326,92340,92341,92342,92352,92353,92354,92355,92358,92370,92371,92499

 +11      ;;92502,92504,92507,92508,92511,92512,92516,92517,92518,92519,92520,92521,92522

 +12      ;;92523,92524,92526,92531,92532,92533,92534,92537,92538,92540,92541,92542,92544

 +13      ;;92545,92546,92547,92548,92549,92550,92551,92552,92553,92555,92556,92557,92558

 +14      ;;92559,92560,92561,92562,92563,92564,92565,92567,92568,92570,92571,92572,92575

 +15      ;;92576,92577,92579,92582,92583,92584,92587,92588,92590,92591,92592,92593,92594

 +16      ;;92595,92596,92597,92601,92602,92603,92604,92605,92606,92607,92608,92609,92610

 +17      ;;92611,92612,92613,92614,92615,92616,92617,92618,92620,92621,92625,92626,92627

 +18      ;;92630,92633,92640,92650,92651,92652,92653,92700,92920,92921,92924,92925,92928

 +19      ;;92929,92933,92934,92937,92938,92941,92943,92944,92950,92953,92960,92961,92970

 +20      ;;92971,92973,92974,92975,92977,92978,92979,92986,92987,92990,92997,92998,93000

 +21      ;;93005,93010,93015,93016,93017,93018,93024,93025,93040,93041,93042,93050,93224

 +22      ;;93225,93226,93227,93228,93229,93241,93242,93243,93244,93245,93246,93247,93248

 +23      ;;93260,93261,93264,93268,93270,93271,93272,93278,93279,93280,93281,93282,93283

 +24      ;;93284,93285,93286,93287,93288,93289,93290,93291,93292,93293,93294,93295,93296

 +25      ;;93297,93298,93303,93304,93306,93307,93308,93312,93313,93314,93315,93316,93317

 +26      ;;93318,93319,93320,93321,93325,93350,93351,93352,93355,93356,93451,93452,93453

 +27      ;;93454,93455,93456,93457,93458,93459,93460,93461,93462,93463,93464,93503,93505

 +28      ;;93530,93531,93532,93533,93561,93562,93563,93564,93565,93566,93567,93568,93571

 +29      ;;93572,93580,93581,93582,93583,93593,93594,93595,93596,93597,93598,93600,93602

 +30      ;;93603,93609,93610,93612,93613,93615,93616,93618,93619,93620,93621,93622,93623

 +31      ;;93624,93631,93640,93641,93642,93644,93650,93653,93654,93655,93656,93657,93660

 +32      ;;93662,93668,93701,93702,93724,93740,93745,93750,93770,93784,93786,93788,93790

 +33      ;;93792,93793,93797,93798,93799,93880,93882,93886,93888,93890,93892,93893,93895

 +34      ;;93922,93923,93924,93925,93926,93930,93931,93970,93971,93975,93976,93978,93979

 +35      ;;93980,93981,93985,93986,93990,93998,94002,94003,94004,94005,94010,94011,94012

 +36      ;;94013,94014,94015,94016,94060,94070,94150,94200,94375,94450,94452,94453,94610

 +37      ;;94617,94618,94619,94621,94625,94626,94640,94642,94644,94645,94660,94662,94664

 +38      ;;94667,94668,94669,94680,94681,94690,94726,94727,94728,94729,94760,94761,94762

 +39      ;;94772,94774,94775,94776,94777,94780,94781,94799,95004,95012,95017,95018,95024

 +40      ;;95027,95028,95044,95052,95056,95060,95065,95070,95076,95079,95115,95117,95120

 +41      ;;95125,95130,95131,95132,95133,95134,95144,95145,95146,95147,95148,95149,95165

 +42      ;;95170,95180,95199,95249,95250,95251,95700,95705,95706,95707,95708,95709,95710

 +43      ;;95711,95712,95713,95714,95715,95716,95717,95718,95719,95720,95721,95722,95723

 +44      ;;95724,95725,95726,95782,95783,95800,95801,95803,95805,95806,95807,95808,95810

 +45      ;;95811,95812,95813,95816,95819,95822,95824,95829,95830,95836,95851,95852,95857

 +46      ;;95860,95861,95863,95864,95865,95866,95867,95868,95869,95870,95872,95873,95874

 +47      ;;95875,95885,95886,95887,95905,95907,95908,95909,95910,95911,95912,95913,95921

 +48      ;;95922,95923,95924,95925,95926,95927,95928,95929,95930,95933,95937,95938,95939

 +49      ;;95940,95941,95943,95954,95955,95957,95958,95961,95962,95965,95966,95967,95970

 +50      ;;95971,95972,95976,95977,95980,95981,95982,95983,95984,95990,95991,95992,95999

 +51      ;;96000,96001,96002,96003,96004,96020,96040,96105,96110,96112,96113,96116,96121

 +52      ;;96125,96127,96130,96131,96132,96133,96136,96137,96138,96139,96146,96156,96158

 +53      ;;96159,96160,96161,96164,96165,96167,96168,96170,96171,96360,96361,96365,96366

 +54      ;;96367,96368,96369,96370,96371,96372,96373,96374,96375,96376,96377,96379,96401

 +55      ;;96402,96405,96406,96409,96411,96413,96415,96416,96417,96420,96422,96423,96425

 +56      ;;96440,96446,96450,96521,96522,96523,96542,96549,96567,96570,96571,96573,96574

 +57      ;;96900,96902,96904,96910,96912,96913,96920,96921,96922,96931,96932,96933,96934

 +58      ;;96935,96936,96999,97010,97012,97014,97016,97018,97022,97024,97026,97028,97032

 +59      ;;97033,97034,97035,97036,97039,97110,97112,97113,97116,97124,97129,97130,97139

 +60      ;;97140,97150,97151,97152,97153,97154,97155,97156,97157,97158,97161,97162,97163

 +61      ;;97164,97165,97166,97167,97168,97169,97170,97171,97172,97530,97533,97535,97537

 +62      ;;97542,97545,97546,97597,97598,97602,97605,97606,97607,97608,97610,97750,97755

 +63      ;;97760,97761,97763,97799,97802,97803,97804,97810,97811,97813,97814,98925,98926

 +64      ;;98927,98928,98929,98940,98941,98942,98943,98960,98961,98962,98966,98967,98968

 +65      ;;98970,98971,98972,98975,98976,98977,98980,98981,99000,99001,99002,99024,99026

 +66      ;;99027,99050,99051,99053,99056,99058,99060,99070,99071,99072,99075,99078,99080

 +67      ;;99082,99091,99100,99116,99135,99140,99151,99152,99153,99155,99156,99157,99170

 +68      ;;99172,99173,99174,99175,99177,99183,99184,99188,99190,99191,99192,99195,99199

 +69      ;;99202,99203,99204,99205,99211,99212,99213,99214,99215,

 +70      ;;99217,99218,99219,99220,99221,99222,99223,99224,99225,99226,99231,99232,99233

 +71      ;;99234,99235,99236,99238,99239,99241,99242,99243,99244,99245,99251,99252,99253

 +72      ;;99254,99255,99281,99282,99283,99284,99285,99288,99291,99292,99304,99305,99306

 +73      ;;99307,99308,99309,99310,99315,99316,99318,99324,99325,99326,99327,99328,99334

 +74      ;;99335,99336,99337,99339,99340,99341,99342,99343,99344,99345,99347,99348,99349

 +75      ;;99350,99354,99355,99356,99357,99358,99359,99360,99366,99367,99368,99374,99375

 +76      ;;99377,99378,99379,99380,99381,99382,99383,99384,99385,99386,99387,99391,99392

 +77      ;;99393,99394,99395,99396,99397,99401,99402,99403,99404,99406,99407,99408,99409

 +78      ;;99411,99412,99415,99416,99417,99420,99421,99422,99423,99424,99425,99426,99427

 +79      ;;99429,99437,99439,99441,99442,99443,99446,99447,99448,99449,99450,99451,99452

 +80      ;;99453,99454,99455,99456,99457,99458,99460,99461,99462,99463,99464,99465,99466

 +81      ;;99467,99468,99469,99471,99472,99473,99474,99475,99476,99477,99478,99479,99480

 +82      ;;99483,99484,99485,99486,99487,99489,99490,99491,99492,99493,99494,99495,99496

 +83      ;;99497,99498,99499,99500,99501,99502,99503,99504,99505,99506,99507,99509,99510

 +84      ;;99511,99512,99600,99601,99602,99605,99606,99607