SR160UT0.m

SR160UT0 ;BIR/ADM - SR*3*160 UTILITY, CONTINUED ;01/18/07

 ;;3.0; Surgery ;**160**;24 Jun 93;Build 7

 Q

PEX F SRJ=0: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

 .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 ;;36247,36248,36260,36261,36262,36299,36400,36405,36406,36410,36415,36416,36420,36425,36430

 ;;36440,36450,36455,36460,36468,36469,36470,36471,36481,36488,36489,36490,36491,36493,36500

 ;;36510,36511,36512,36513,36514,36515,36516,36520,36522,36530,36531,36532,36533,36534,36535

 ;;36536,36537,36540,36550,36555,36556,36557,36558,36559,36560,36561,36563,36565,36566,36568

 ;;36569,36570,36571,36575,36576,36577,36578,36580,36581,36582,36583,36584,36585,36589,36590

 ;;36595,36596,36597,36600,36620,36625,36640,36660,36680,36800,36810,36815,36820,36821,36822

 ;;36823,36825,36830,36831,36832,36833,36835,36870,37183,37195,37200,37205,37206,37207,37208

 ;;37209,37215,37216,37250,37251,37501,37609,37620,37785,38200,38204,38205,38206,38207,38208

 ;;38209,38210,38211,38212,38213,38214,38215,38221,38240,38241,38242,38500,38505,38510,38520

 ;;38525,38530,38790,38792,38794,40490,40799,40806,40808,40831,41010,41015,41100,41105,41108

 ;;41115,41250,41251,41252,41510,41520,41800,41805,41870,41872,41874,41877,41899,42000,42100

 ;;42180,42182,42280,42281,42310,42400,42405,42600,42650,42660,42800,42802,42804,42806,42820

 ;;42821,42825,42826,42830,42831,42835,42836,42860,42970,42971,43200,43201,43202,43204,43205

 ;;43215,43216,43217,43219,43220,43226,43227,43228,43231,43232,43234,43235,43236,43237,43238

 ;;43239,43240,43241,43242,43243,43244,43245,43246,43247,43248,43249,43250,43251,43255,43256

 ;;43257,43258,43259,43260,43261,43262,43263,43264,43265,43267,43268,43269,43271,43272,43450

 ;;43453,43456,43458,43460,43499,43600,43653,43750,43752,43760,43761,43830,44015,44100,44132

 ;;44133,44135,44136,44137,44201,44300,44360,44361,44363,44364,44365,44366,44369,44370,44372

 ;;44373,44376,44377,44378,44379,44380,44382,44383,44385,44386,44388,44389,44390,44391,44392

 ;;44393,44394,44397,44500,44715,44720,44721,44901,45100,45300,45303,45305,45307,45308,45309

 ;;45315,45317,45320,45321,45327,45330,45331,45332,45333,45334,45335,45337,45338,45339,45340

 ;;45341,45342,45345,45355,45378,45379,45380,45381,45382,45383,45384,45385,45386,45387,45500

 ;;45520,45900,45915,45990,46050,46070,46080,46083,46200,46210,46211,46220,46221,46230,46250

 ;;46255,46257,46258,46260,46261,46262,46270,46275,46280,46285,46288,46320,46500,46505,46600

 ;;46604,46606,46608,46610,46611,46612,46614,46615,46754,46900,46910,46916,46917,46922,46934

 ;;46935,46936,46937,46938,46945,46946,47000,47011,47100,47133,47135,47136,47140,47141,47142

 ;;47143,47144,47145,47146,47147,47490,47500,47505,47510,47511,47525,47530,47552,47553,47554

 ;;47555,47556,47701,47801,48102,48400,48550,48551,48552,48554,48556,49041,49180,49320,49400

 ;;49419,49420,49421,49422,49423,49424,49427,49428,49429,49491,49492,49495,49496,49500,49501

 ;;50040,50080,50081,50200,50300,50320,50323,50325,50327,50328,50329,50390,50392,50393,50394

 ;;50398,50547,50551,50553,50555,50557,50559,50561,50562,50570,50572,50574,50575,50576,50578

 ;;50580,50590,50592,50600,50605,50684,50686,50688,50690,50951,50953,50955,50957,50959,50961

 ;;50970,50972,50974,50976,50978,50980,51000,51005,51010,51600,51605,51610,51700,51701,51702

 ;;51703,51705,51710,51715,51720,51725,51726,51736,51741,51772,51784,51785,51792,51795,51797

 ;;51798,52000,52001,52005,52007,52010,52204,52214,52224,52250,52260,52265,52270,52275,52276

 ;;52277,52281,52282,52283,52285,52290,52300,52301,52305,52310,52315,52317,52318,52327,52332

 ;;52334,52335,52336,52337,52338,52339,52343,52351,52352,52353,52354,52355,53020,53025,53060

 ;;53200,53270,53275,53600,53601,53620,53621,53660,53661,53670,53850,54000,54001,54055,54056

 ;;54060,54100,54105,54150,54152,54160,54161,54162,54200,54230,54231,54235,54240,54250,54400

 ;;54401,54402,54405,54406,54407,54408,54409,54410,54415,54416,54450,54500,54505,54510,54512

 ;;54520,54530,54535,54700,54800,54820,54830,55000,55250,55300,55400,55500,55520,55559,55700

 ;;55705,55859,55870,56300,56301,56302,56346,56347,56351,56360,56361,56362,56363,56605,56606

 ;;56700,56820,57020,57022,57023,57100,57105,57150,57160,57170,57180,57287,57410,57420,57421

 ;;57452,57454,57456,57500,57510,57511,57513,57520,57700,58100,58300,58301,58321,58322,58323

 ;;58340,58345,58346,58353,58545,58546,58550,58551,58553,58555,58558,58559,58560,58561,58562

 ;;58563,58660,58661,58662,58670,58671,58672,58673,58679,58823,58900,58970,58974,58976,59000

 ;;59001,59012,59015,59020,59025,59030,59050,59051,59070,59072,59074,59076,59100,59160,59200

 ;;59300,59320,59325,59400,59409,59410,59412,59414,59425,59426,59430,59510,59514,59515,59525

 ;;59561,59610,59612,59614,59618,59840,59841,59850,59851,59852,59855,59856,59857,59866,59870

 ;;59871,59897,59899,60001,60100,61001,61026,61050,61055,61070,61140,61623,61720,61735,61770

 ;;61790,61791,61793,61868,62140,62141,62142,62143,62146,62147,62163,62201,62223,62252,62263

 ;;62264,62268,62269,62270,62272,62273,62274,62275,62276,62277,62278,62279,62280,62281,62282

 ;;62284,62286,62287,62288,62289,62290,62291,62292,62294,62310,62311,62318,62319,62355,62367

 ;;63600,63610,63615,63650,64400,64402,64405,64408,64410,64412,64413,64415,64416,64417,64418

 ;;64420,64421,64425,64430,64435,64445,64446,64447,64448,64449,64450,64470,64472,64475,64476

 ;;64479,64480,64483,64484,64505,64508,64510,64517,64520,64530,64550,64553,64555,64560,64561

 ;;64565,64577,64580,64600,64605,64610,64612,64613,64614,64620,64622,64623,64626,64627,64630

 ;;64640,64680,64681,64716,64718,64719,64721,64732,64734,64736,64738,64740,64742,64744,64746

 ;;64752,64755,64760,64761,64763,64766,64771,64772,64774,64776,64778,64782,64783,64784,64786

 ;;64787,64788,64790,64792,64795,64820,64822,64823,64999,65091,65093,65101,65103,65105,65110

 ;;65112,65114,65125,65130,65135,65140,65150,65155,65175,65205,65210,65220,65222,65235,65260

 ;;65265,65270,65272,65273,65275,65280,65285,65286,65290,65400,65410,65420,65426,65430,65435

 ;;65436,65450,65600,65710,65730,65750,65755,65760,65765,65767,65770,65771,65772,65775,65800

 ;;65805,65810,65815,65820,65850,65855,65860,65865,65870,65875,65880,65900,65920,65930,66020

 ;;66030,66130,66150,66155,66160,66165,66170,66172,66180,66185,66220,66225,66250,66500,66505

 ;;66600,66605,66625,66630,66635,66680,66682,66700,66710,66720,66740,66761,66762,66770,66820

 ;;66821,66825,66830,66840,66850,66852,66920,66930,66940,66982,66983,66984,66985,66986,66990

 ;;66999,67005,67010,67015,67025,67027,67028,67030,67031,67036,67038,67039,67040,67101,67105

 ;;67107,67108,67109,67110,67112,67115,67120,67121,67141,67145,67208,67210,67218,67220,67221

 ;;67225,67227,67228,67250,67255,67299,67311,67312,67314,67316,67318,67320,67331,67332,67334

 ;;67335,67340,67343,67345,67350,67399,67400,67405,67412,67413,67414,67415,67420,67430,67440

 ;;67445,67450,67500,67505,67515,67550,67560,67570,67599,67700,67710,67715,67800,67801,67805

 ;;67808,67810,67820,67825,67830,67835,67840,67850,67875,67880,67882,67900,67901,67902,67903

 ;;67904,67906,67908,67909,67911,67912,67914,67915,67916,67917,67921,67922,67923,67924,67930

 ;;67935,67938,67950,67961,67966,67971,67973,67974,67975,67999,68020,68040,68100,68110,68115

 ;;68130,68135,68200,68320,68325,68326,68328,68330,68335,68340,68360,68362,68371,68399,68400

 ;;68420,68440,68500,68505,68510,68520,68525,68530,68540,68550,68700,68705,68720,68745,68750

 ;;68760,68761,68770,68800,68801,68810,68811,68815,68820,68825,68830,68840,68850,68899,69000

 ;;69005,69020,69090,69100,69105,69110,69120,69140,69145,69150,69155,69200,69205,69210,69220

 ;;69222,69300,69310,69320,69399,69400,69401,69405,69410,69420,69421,69424,69433,69436,69440

 ;;69450,69501,69502,69505,69511,69530,69535,69540,69550,69552,69554,69601,69602,69603,69604

 ;;69605,69610,69620,69631,69632,69633,69635,69636,69637,69641,69642,69643,69644,69645,69646

 ;;69650,69660,69661,69662,69666,69667,69670,69676,69700,69710,69711,69720,69725,69740,69745

 ;;69799,69801,69802,69805,69806,69820,69840,69905,69910,69915,69930,69949,69950,69955,69960

 ;;69970,69979

SR160UT0  ;BIR/ADM - SR*3*160 UTILITY, CONTINUED ;01/18/07

 +1       ;;3.0; Surgery ;**160**;24 Jun 93;Build 7

 +2        QUIT 

PEX        FOR SRJ=0: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))

                       Begin DoDot:1

 +1                        SET SRY=0

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

                           IF SRY=""

                               QUIT 

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

                           SET (DINUM,X)=SRY

                           SET DIC="^SRO(137,"

                           SET DIC(0)="L"

                           DO FILE^DICN

                       End DoDot:1

 +3        QUIT 

LIST      ;;36247,36248,36260,36261,36262,36299,36400,36405,36406,36410,36415,36416,36420,36425,36430

 +1       ;;36440,36450,36455,36460,36468,36469,36470,36471,36481,36488,36489,36490,36491,36493,36500

 +2       ;;36510,36511,36512,36513,36514,36515,36516,36520,36522,36530,36531,36532,36533,36534,36535

 +3       ;;36536,36537,36540,36550,36555,36556,36557,36558,36559,36560,36561,36563,36565,36566,36568

 +4       ;;36569,36570,36571,36575,36576,36577,36578,36580,36581,36582,36583,36584,36585,36589,36590

 +5       ;;36595,36596,36597,36600,36620,36625,36640,36660,36680,36800,36810,36815,36820,36821,36822

 +6       ;;36823,36825,36830,36831,36832,36833,36835,36870,37183,37195,37200,37205,37206,37207,37208

 +7       ;;37209,37215,37216,37250,37251,37501,37609,37620,37785,38200,38204,38205,38206,38207,38208

 +8       ;;38209,38210,38211,38212,38213,38214,38215,38221,38240,38241,38242,38500,38505,38510,38520

 +9       ;;38525,38530,38790,38792,38794,40490,40799,40806,40808,40831,41010,41015,41100,41105,41108

 +10      ;;41115,41250,41251,41252,41510,41520,41800,41805,41870,41872,41874,41877,41899,42000,42100

 +11      ;;42180,42182,42280,42281,42310,42400,42405,42600,42650,42660,42800,42802,42804,42806,42820

 +12      ;;42821,42825,42826,42830,42831,42835,42836,42860,42970,42971,43200,43201,43202,43204,43205

 +13      ;;43215,43216,43217,43219,43220,43226,43227,43228,43231,43232,43234,43235,43236,43237,43238

 +14      ;;43239,43240,43241,43242,43243,43244,43245,43246,43247,43248,43249,43250,43251,43255,43256

 +15      ;;43257,43258,43259,43260,43261,43262,43263,43264,43265,43267,43268,43269,43271,43272,43450

 +16      ;;43453,43456,43458,43460,43499,43600,43653,43750,43752,43760,43761,43830,44015,44100,44132

 +17      ;;44133,44135,44136,44137,44201,44300,44360,44361,44363,44364,44365,44366,44369,44370,44372

 +18      ;;44373,44376,44377,44378,44379,44380,44382,44383,44385,44386,44388,44389,44390,44391,44392

 +19      ;;44393,44394,44397,44500,44715,44720,44721,44901,45100,45300,45303,45305,45307,45308,45309

 +20      ;;45315,45317,45320,45321,45327,45330,45331,45332,45333,45334,45335,45337,45338,45339,45340

 +21      ;;45341,45342,45345,45355,45378,45379,45380,45381,45382,45383,45384,45385,45386,45387,45500

 +22      ;;45520,45900,45915,45990,46050,46070,46080,46083,46200,46210,46211,46220,46221,46230,46250

 +23      ;;46255,46257,46258,46260,46261,46262,46270,46275,46280,46285,46288,46320,46500,46505,46600

 +24      ;;46604,46606,46608,46610,46611,46612,46614,46615,46754,46900,46910,46916,46917,46922,46934

 +25      ;;46935,46936,46937,46938,46945,46946,47000,47011,47100,47133,47135,47136,47140,47141,47142

 +26      ;;47143,47144,47145,47146,47147,47490,47500,47505,47510,47511,47525,47530,47552,47553,47554

 +27      ;;47555,47556,47701,47801,48102,48400,48550,48551,48552,48554,48556,49041,49180,49320,49400

 +28      ;;49419,49420,49421,49422,49423,49424,49427,49428,49429,49491,49492,49495,49496,49500,49501

 +29      ;;50040,50080,50081,50200,50300,50320,50323,50325,50327,50328,50329,50390,50392,50393,50394

 +30      ;;50398,50547,50551,50553,50555,50557,50559,50561,50562,50570,50572,50574,50575,50576,50578

 +31      ;;50580,50590,50592,50600,50605,50684,50686,50688,50690,50951,50953,50955,50957,50959,50961

 +32      ;;50970,50972,50974,50976,50978,50980,51000,51005,51010,51600,51605,51610,51700,51701,51702

 +33      ;;51703,51705,51710,51715,51720,51725,51726,51736,51741,51772,51784,51785,51792,51795,51797

 +34      ;;51798,52000,52001,52005,52007,52010,52204,52214,52224,52250,52260,52265,52270,52275,52276

 +35      ;;52277,52281,52282,52283,52285,52290,52300,52301,52305,52310,52315,52317,52318,52327,52332

 +36      ;;52334,52335,52336,52337,52338,52339,52343,52351,52352,52353,52354,52355,53020,53025,53060

 +37      ;;53200,53270,53275,53600,53601,53620,53621,53660,53661,53670,53850,54000,54001,54055,54056

 +38      ;;54060,54100,54105,54150,54152,54160,54161,54162,54200,54230,54231,54235,54240,54250,54400

 +39      ;;54401,54402,54405,54406,54407,54408,54409,54410,54415,54416,54450,54500,54505,54510,54512

 +40      ;;54520,54530,54535,54700,54800,54820,54830,55000,55250,55300,55400,55500,55520,55559,55700

 +41      ;;55705,55859,55870,56300,56301,56302,56346,56347,56351,56360,56361,56362,56363,56605,56606

 +42      ;;56700,56820,57020,57022,57023,57100,57105,57150,57160,57170,57180,57287,57410,57420,57421

 +43      ;;57452,57454,57456,57500,57510,57511,57513,57520,57700,58100,58300,58301,58321,58322,58323

 +44      ;;58340,58345,58346,58353,58545,58546,58550,58551,58553,58555,58558,58559,58560,58561,58562

 +45      ;;58563,58660,58661,58662,58670,58671,58672,58673,58679,58823,58900,58970,58974,58976,59000

 +46      ;;59001,59012,59015,59020,59025,59030,59050,59051,59070,59072,59074,59076,59100,59160,59200

 +47      ;;59300,59320,59325,59400,59409,59410,59412,59414,59425,59426,59430,59510,59514,59515,59525

 +48      ;;59561,59610,59612,59614,59618,59840,59841,59850,59851,59852,59855,59856,59857,59866,59870

 +49      ;;59871,59897,59899,60001,60100,61001,61026,61050,61055,61070,61140,61623,61720,61735,61770

 +50      ;;61790,61791,61793,61868,62140,62141,62142,62143,62146,62147,62163,62201,62223,62252,62263

 +51      ;;62264,62268,62269,62270,62272,62273,62274,62275,62276,62277,62278,62279,62280,62281,62282

 +52      ;;62284,62286,62287,62288,62289,62290,62291,62292,62294,62310,62311,62318,62319,62355,62367

 +53      ;;63600,63610,63615,63650,64400,64402,64405,64408,64410,64412,64413,64415,64416,64417,64418

 +54      ;;64420,64421,64425,64430,64435,64445,64446,64447,64448,64449,64450,64470,64472,64475,64476

 +55      ;;64479,64480,64483,64484,64505,64508,64510,64517,64520,64530,64550,64553,64555,64560,64561

 +56      ;;64565,64577,64580,64600,64605,64610,64612,64613,64614,64620,64622,64623,64626,64627,64630

 +57      ;;64640,64680,64681,64716,64718,64719,64721,64732,64734,64736,64738,64740,64742,64744,64746

 +58      ;;64752,64755,64760,64761,64763,64766,64771,64772,64774,64776,64778,64782,64783,64784,64786

 +59      ;;64787,64788,64790,64792,64795,64820,64822,64823,64999,65091,65093,65101,65103,65105,65110

 +60      ;;65112,65114,65125,65130,65135,65140,65150,65155,65175,65205,65210,65220,65222,65235,65260

 +61      ;;65265,65270,65272,65273,65275,65280,65285,65286,65290,65400,65410,65420,65426,65430,65435

 +62      ;;65436,65450,65600,65710,65730,65750,65755,65760,65765,65767,65770,65771,65772,65775,65800

 +63      ;;65805,65810,65815,65820,65850,65855,65860,65865,65870,65875,65880,65900,65920,65930,66020

 +64      ;;66030,66130,66150,66155,66160,66165,66170,66172,66180,66185,66220,66225,66250,66500,66505

 +65      ;;66600,66605,66625,66630,66635,66680,66682,66700,66710,66720,66740,66761,66762,66770,66820

 +66      ;;66821,66825,66830,66840,66850,66852,66920,66930,66940,66982,66983,66984,66985,66986,66990

 +67      ;;66999,67005,67010,67015,67025,67027,67028,67030,67031,67036,67038,67039,67040,67101,67105

 +68      ;;67107,67108,67109,67110,67112,67115,67120,67121,67141,67145,67208,67210,67218,67220,67221

 +69      ;;67225,67227,67228,67250,67255,67299,67311,67312,67314,67316,67318,67320,67331,67332,67334

 +70      ;;67335,67340,67343,67345,67350,67399,67400,67405,67412,67413,67414,67415,67420,67430,67440

 +71      ;;67445,67450,67500,67505,67515,67550,67560,67570,67599,67700,67710,67715,67800,67801,67805

 +72      ;;67808,67810,67820,67825,67830,67835,67840,67850,67875,67880,67882,67900,67901,67902,67903

 +73      ;;67904,67906,67908,67909,67911,67912,67914,67915,67916,67917,67921,67922,67923,67924,67930

 +74      ;;67935,67938,67950,67961,67966,67971,67973,67974,67975,67999,68020,68040,68100,68110,68115

 +75      ;;68130,68135,68200,68320,68325,68326,68328,68330,68335,68340,68360,68362,68371,68399,68400

 +76      ;;68420,68440,68500,68505,68510,68520,68525,68530,68540,68550,68700,68705,68720,68745,68750

 +77      ;;68760,68761,68770,68800,68801,68810,68811,68815,68820,68825,68830,68840,68850,68899,69000

 +78      ;;69005,69020,69090,69100,69105,69110,69120,69140,69145,69150,69155,69200,69205,69210,69220

 +79      ;;69222,69300,69310,69320,69399,69400,69401,69405,69410,69420,69421,69424,69433,69436,69440

 +80      ;;69450,69501,69502,69505,69511,69530,69535,69540,69550,69552,69554,69601,69602,69603,69604

 +81      ;;69605,69610,69620,69631,69632,69633,69635,69636,69637,69641,69642,69643,69644,69645,69646

 +82      ;;69650,69660,69661,69662,69666,69667,69670,69676,69700,69710,69711,69720,69725,69740,69745

 +83      ;;69799,69801,69802,69805,69806,69820,69840,69905,69910,69915,69930,69949,69950,69955,69960

 +84      ;;69970,69979