FBX2P158 ;WCIOFO/SLT-PATCH INSTALL ROUTINE ;5/27/2006
;;3.5;FEE BASIS;**158**;JAN 30, 1995;Build 94
Q
;
CSGR ; entry point for establishing CARC/RARC relationships
D MES^XPDUTL(" Establishing CARC/RARC Relationships...")
N STR,I,CARC,RARC,SCNR,CAGCLST,CAGC,PC,CAGCI,CNT,FDA,RARCI,TAG,J,RLN,RARCLST,CARCI
S I=1 F S STR=$T(CSGRTBL+I) Q:$P(STR,";;",2)["THE END" D
. S STR=$P(STR,";;",2)
. S CARC=$P(STR,";")
. I '$D(^FB(161.91,"B",CARC)) Q
. S CARCI=$O(^FB(161.91,"B",CARC,"")) Q:'CARCI
. S $P(^FB(161.91,CARCI,0),U,3)="" ;clear scenario
. D DCAGC(CARCI),DRARC(CARCI) ;clear CAGC and RARC codes
. S SCNR=+$P(STR,";",2)
. S:SCNR $P(^FB(161.91,CARCI,0),U,3)=SCNR ;set business scenario
. ;
. S CAGCLST=$P(STR,";",3) ;get the CAGC list
. I CAGCLST]"" D ; update CAGCs
. . S CNT=$L(CAGCLST,U)-1 ; number of CAGCs
. . F PC=1:1:CNT D
. . . S CAGC=$P(CAGCLST,U,PC) Q:CAGC']""
. . . I '$D(^FB(161.92,"B",CAGC)) Q
. . . S CAGCI=$O(^FB(161.92,"B",CAGC,"")) Q:'CAGCI
. . . S FDA(161.917,"+"_PC_","_CARCI_",",.01)=CAGCI
. . I $D(FDA) D UPDATE^DIE("","FDA") K FDA
. ;
. S RARCLST=$P(STR,";",4) ; get the RARC list
. I RARCLST]"",$E(RARCLST)'="*" D ;update RARCs
. . S CNT=$L(RARCLST,U)-1
. . F PC=1:1:CNT D
. . . S RARC=$P(RARCLST,U,PC) Q:RARC']""
. . . I '$D(^FB(161.93,"B",RARC)) Q
. . . S RARCI=$O(^FB(161.93,"B",RARC,"")) Q:'RARCI
. . . S FDA(161.915,"+"_PC_","_CARCI_",",.01)=RARCI
. . I $D(FDA) D UPDATE^DIE("","FDA") K FDA
. E I $E(RARCLST)="*" D
. . S TAG=$P(RARCLST,"*",2)
. . F J=1:1 S RLN=$T(@(TAG)+J) Q:$P(RLN,";;",2)["THE END" D
. . . S RARCLST=$P(RLN,";;",2)
. . . I RARCLST]"" D
. . . . S CNT=$L(RARCLST,U)-1
. . . . F PC=1:1:CNT D
. . . . . S RARC=$P(RARCLST,U,PC) Q:RARC']""
. . . . . I '$D(^FB(161.93,"B",RARC)) Q
. . . . . S RARCI=$O(^FB(161.93,"B",RARC,"")) Q:'RARCI
. . . . . S FDA(161.915,"+"_PC_","_CARCI_",",.01)=RARCI
. . . . I $D(FDA) D UPDATE^DIE("","FDA") K FDA
. S I=$I(I)
D MES^XPDUTL(" done.")
Q
;
DCAGC(CI) ; delete existing CAGCs
;
N IENS,SIENS,FDA,FB
S IENS=CI_","
D GETS^DIQ(161.91,IENS,"7*","","FB")
S SIENS="" F S SIENS=$O(FB(161.917,SIENS)) Q:SIENS="" D
. S FDA(161.917,SIENS,.01)="@"
I $D(FDA) D FILE^DIE("","FDA") K FDA
Q
;
DRARC(CI) ; delete existing RARCs
;
N IENS,SIENS,FDA,FB
S IENS=CI_","
D GETS^DIQ(161.91,IENS,"5*","","FB")
S SIENS="" F S SIENS=$O(FB(161.915,SIENS)) Q:SIENS="" D
. S FDA(161.915,SIENS,.01)="@"
I $D(FDA) D FILE^DIE("","FDA") K FDA
Q
;
; CORE Version 3.3.0
CSGRTBL ;;CARC;SCENARIO;GRP1^[GRP2^...GRPn^];RARC1^[RARC2^...RARCn^]^ or *C_CARC if long list.
;;4;2;CO^PI^;N517^N519^M20^N657^M114^N56^N108^N386^N572^N644^
;;5;3;CO^PI^PR^;MA109^M77^
;;6;3;CO^PI^PR^;M37^M82^N129^N115^
;;7;3;CO^PI^PR^;N115^
;;8;3;CO^PI^PR^;MA130^N684^N95^
;;9;3;CO^PI^PR^;N517^M89^N657^
;;10;3;CO^PI^PR^;N517^N657^MA130^
;;11;3;CO^PI^PR^;N657^MA130^N386^MA63^N115^
;;12;3;CO^PI^PR^;N657^MA63^
;;13;2;CO^PI^;
;;14;2;CO^PI^;
;;15;2;CO^PI^;N517^MA130^N596^M25^M62^N752^
;;16;2;CO^PI^;*C16
;;18;2;CO^OA^;N111^N347^N522^N702^
;;19;3;CO^PI^PR^;N418^N722^N728^
;;20;3;CO^PI^PR^;MA04^N723^N725^
;;21;3;CO^PI^PR^;MA04^N728^N724^N727^
;;22;3;CO^PI^PR^;N4^N479^MA04^MA92^N36^N245^MA64^N374^MA16^N197^N376^N598^N743^N744^
;;24;4;CO^PI^PR^;M112^
;;26;3;CO^PI^PR^;N30^N216^N622^N52^N128^N650^N652^
;;27;3;CO^PI^PR^;N30^N622^N52^N650^MA47^N619^
;;29;3;CO^PI^PR^;
;;31;3;CO^PI^PR^;MA130^MA61^
;;32;3;CO^PI^PR^;N129^N52^MA47^N15^
;;33;3;PR^;N578^
;;34;3;CO^PI^PR^;
;;35;3;CO^PI^PR^;N117^N370^N587^
;;39;3;CO^PI^PR^;
;;40;3;CO^PI^PR^;N10^N409^
;;49;3;CO^PI^PR^;N130^N129^N115^M90^N390^N427^N429^N567^
;;50;3;CO^PI^PR^;M1^N45^M127^M31^M60^M135^N40^N178^N214^N455^N170^N206^M64^N227^N130^N10^M26^N163^N237^N238^N240^N242^N244^N456^N129^N386^M25^M76^M51^N229^N443^N115^M85^MA126^N124^N161^N180^N362^N372^N383^N607^N658^N661^N721^N734^
;;51;3;CO^PI^PR^;N45^N10^N204^N607^N174^
;;53;3;CO^PI^PR^;
;;54;3;CO^PI^PR^;N10^N646^N450^
;;55;3;CO^PI^PR^;M49^N111^N10^N115^N623^
;;56;3;CO^PI^PR^;N115^N623^
;;58;3;CO^PI^PR^;N386^N115^N87^N732^N760^
;;59;3;CO^PI^PR^;N10^N644^N633^N670^
;;60;3;CO^PI^PR^;N130^M114^N676^
;;61;3;CO^PI^PR^;
;;69;2;CO^PI^;
;;78;3;CO^PI^PR^;
;;89;3;CO^PI^PR^;N200^
;;95;3;CO^PI^PR^;N594^N595^N596^N182^N33^N385^N584^N593^N630^
;;96;3;CO^PI^PR^;*C96
;;97;4;CO^PI^PR^;M2^M15^M80^M144^MA109^N19^N130^N111^N122^N115^M86^N390^M112^M97^M109^N20^N67^N357^N472^N525^N626^N628^N637^N646^N666^
;;107;2;CO^PI^;M121^MA66^N122^N173^N674^
;;108;3;CO^PI^PR^;N223^M7^N130^N10^N370^N518^N372^N171^M10^M36^M94^
;;109;3;CO^PI^PR^;N36^N130^N216^M114^N418^N106^N538^N104^N448^N576^M11^N105^N127^N557^N558^N559^N747^N751^
;;110;2;CO^PI^;M52^M59^N622^
;;111;3;CO^PI^PR^;
;;114;3;CO^PI^PR^;N623^M61^M102^
;;115;3;CO^PI^PR^;
;;116;1;CO^PI^;
;;117;3;CO^PI^PR^;N115^
;;119;3;CO^PI^PR^;N45^M80^M7^N130^N111^M89^N386^N115^N117^N587^M86^M90^N357^N362^M83^M139^N435^N636^N640^
;;125;M7^N517^MA30^N519^
;;128;3;CO^PI^PR^;
;;129;2;CO^PI^;MA36^N48^MA130^
;;138;3;CO^PI^PR^;N584^
;;139;3;
;;140;2;CO^PI^;MA36^MA130^MA27^MA61^
;;146;2;CO^PI^;M64^N517^N657^M76^MA63^MA65^
;;149;3;CO^PI^PR^;N386^N117^N587^
;;150;3;CO^PI^PR^;N10^M26^N163^M25^N115^N124^N125^N640^
;;151;3;CO^PI^PR^;M3^N206^N130^N10^N386^M25^N115^M86^N362^N435^M69^
;;152;3;CO^PI^PR^;M26^N115^N640^
;;153;3;CO^PI^PR^;
;;154;3;CO^PI^PR^;
;;155;3;CO^PI^PR^;
;;157;3;CO^PI^PR^;
;;158;3;PR^;N176^
;;159;3;CO^PI^PR^;
;;160;3;CO^PI^PR^;N622^N607^N167^N356^N425^
;;163;1;CO^PI^;*C163
;;164;1;CO^PI^;N42^N764^
;;165;3;CO^PI^PR^;N45^N475^N489^N490^N285^N630^
;;166;3;CO^PI^PR^;
;;167;3;CO^PI^PR^;N386^MA63^N647^N115^N30^N607^N428^
;;168;3;CO^PI^PR^;N30^N174^
;;169;3;CO^PI^PR^;MA109^N10^
;;170;3;CO^PI^PR^;M143^M114^N95^N732^N90^N348^N665^
;;171;3;CO^PI^PR^;M97^N732^N92^N110^N121^N428^N762^
;;172;3;CO^PI^PR^;M13^
;;173;3;CO^PI^PR^;N667^N130^N668^N574^
;;174;3;CO^PI^PR^;N667^N668^N115^
;;175;2;CO^PI^;N668^N319^N378^N388^N592^
;;176;3;CO^PI^PR^;N592^
;;177;3;CO^PI^PR^;N375^N10^
;;178;3;CO^PI^PR^;
;;179;3;CO^PI^PR^;
;;180;3;CO^PI^PR^;
;;181;2;CO^PI^;N517^M20^N56^
;;182;2;CO^PI^;N517^N657^
;;183;3;CO^PI^PR^;N630^N574^N767^
;;184;3;CO^PI^PR^;N386^M115^N574^N767^
;;185;3;CO^PI^PR^;N570^N386^N684^N95^N450^N767^
;;188;3;CO^PI^PR^;N386^M61^M102^
;;189;2;CO^PI^;N657^M81^
;;190;4;CO^PI^PR^;N106^N107^N538^
;;194;3;CO^PI^PR^;M80^
;;197;3;CO^PI^PR^;N83^
;;198;3;CO^PI^PR^;N54^N10^M62^N351^N435^N758^
;;199;2;CO^PI^;N657^
;;200;3;CO^PI^PR^;N650^N619^
;;201;3;PR^;N722^N723^N724^
;;202;3;CO^PI^PR^;N658^
;;204;3;CO^PI^PR^;N157^N130^N10^N129^N386^N429^N567^N357^N666^N383^N658^N12^N158^N171^N426^N428^N441^N448^N569^N651^N751^
;;206;2;CO^PI^;N257^N286^N31^N77^N253^N262^N265^
;;207;2;CO^PI^;N257^N286^N31^N77^N253^N262^N265^
;;208;2;CO^PI^;N257^N286^N31^N77^N253^N262^N265^N516^N562^
;;210;3;CO^PI^PR^;
;;212;3;OA^PI^PR^;N658^
;;213;3;
;;222;3;CO^PI^PR^;N115^N587^N633^N640^
;;224;3;CO^;
;;228;3;CO^PI^PR^;N555^N556^
;;231;3;CO^PI^PR^;N628^
;;233;3;CO^PI^PR^;
;;234;4;CO^PI^PR^;M2^M14^M15^M80^N122^N390^N20^N67^N525^N626^N628^N83^N518^N676^
;;236;2;CO^PI^;N657^N644^
;;238;3;PR^;
;;239;3;CO^PI^PR^;
;;240;2;CO^PI^;N657^M76^MA63^N207^
;;242;3;CO^PI^PR^;N130^N95^N450^M115^N767^
;;243;3;CO^PI^PR^;N130^N95^N450^N630^M115^N767^
;;246;3;CO^PI^PR^;N572^
;;249;3;CO^;N561^
;;250;1;CO^PI^;*C250
;;251;1;CO^PI^;*C251
;;252;1;CO^PI^;*C252
;;254;3;CO^PI^PR^;N130^
;;256;3;CO^PI^PR^;M14^N130^M37^M82^M89^M81^N95^MA16^N52^N117^M90^M97^N734^N623^M61^M139^N103^N118^N428^N448^M96^N246^
;;258;3;OA^PI^PR^;N30^N103^
;;261;3;CO^PI^PR^;
;;267;2;CO^PI^;N61^N62^N63^N74^
;;268;2;CO^PI^;
;;269;3;CO^PI^PR^;N54^N130^N10^M37^M82^M89^N129^M25^N30^N124^M83^N96^
;;270;3;CO^PI^PR^;N130^N658^
;;272;3;CO^PI^PR^;N10^N386^N115^N20^N357^N584^N593^N507^N564^M40^N151^
;;273;3;CO^PI^PR^;M13^N10^N386^N115^N362^N435^
;;274;3;CO^PI^PR^;
;;276;3;CO^PI^PR^;N536^
;;A6;3;CO^PI^PR^;
;;A8;2;CO^PI^;N657^N647^
;;B1;3;CO^PI^PR^;N30^N628^N734^N113^
;;B10;4;CO^PI^PR^;M144^
;;B11;3;CO^OA^PI^PR^;N216^N418^N743^N744^N751^
;;B12;3;CO^PI^;N199^
;;B13;3;CO^PI^PR^;N10^N347^M86^M97^N472^
;;B14;3;CO^PI^PR^;M26^M25^M86^N628^N637^N666^N2^
;;B15;3;CO^PI^PR^;M80^M114^N386^M25^N122^N674^M51^N115^N20^N748^
;;B16;3;CO^PI^PR^;M13^N113^
;;B20;3;CO^PI^PR^;N10^N347^M86^N472^N538^N120^
;;B23;3;CO^PI^PR^;
;;B7;3;CO^PI^PR^;N570^M143^MA120^N115^N95^MA47^N450^N732^MA56^N425^N665^N612^
;;B8;3;CO^PI^PR^;
;;B9;3;CO^PI^PR^;M25^N90^
;;P14;4;CO^PI^PR^;M2^M15^M80^M144^N19^N111^N702^M86^N390^M97^N20^N67^N525^M75^
;;P16;3;CO^OA^;
;;P17;3;CO^PI^PR^;
;;P19;4;CO^PI^PR^;
;;P2;3;CO^PI^PR^;
;;P20;3;CO^PI^PR^;N104^
;;P21;3;CO^PI^PR^;M80^N479^MA04^N590^N667^N36^N10^N657^N668^N594^N595^N596^N622^N653^N95^N598^N650^N652^N578^N587^N409^N666^N607^N658^N661^N584^N593^N158^N576^N588^N589^N621^N651^N665^N577^N579^N580^N582^N583^N585^N586^N611^
;;P3;3;PR^;
;;P4;3;CO^PI^PR^;N612^
;;P7;2;CO^PI^;M51^M119^
;;THE END
Q
;
C16 ;;CARC 16, RARC list too long for single line
;;M24^N54^N184^N188^M60^N4^N439^N479^N685^N764^M124^MA04^MA92^N80^M64^N257^N286^
;;MA75^MA81^MA88^MA111^MA30^N519^MA36^N48^M20^M49^N243^N245^N331^N440^N657^N480^
;;M21^M125^MA27^MA64^MA76^N50^N350^N595^N596^N56^N572^M62^N752^MA66^N173^M52^M59^
;;MA61^M76^MA63^MA65^N319^N378^N388^M81^N31^N77^N253^N262^N265^N562^N207^N61^N62^
;;N63^M51^M119^M12^M22^M44^M45^M46^M47^M50^M53^M54^M56^M65^M67^N389^M73^M77^M79^M84^
;;M91^M99^M122^M123^M126^M129^M133^M136^MA21^MA31^MA32^MA33^MA34^MA35^MA37^MA39^MA40^
;;MA41^MA42^MA43^MA48^MA50^MA53^MA58^MA60^MA69^MA70^MA71^MA83^MA89^MA90^MA94^MA96^MA97^
;;MA99^MA100^MA110^MA112^MA113^MA114^MA115^MA116^MA120^MA121^MA122^MA128^MA134^N8^N27^
;;N32^N34^N37^N39^N46^N53^N57^N58^N64^N65^N75^N76^N94^N142^N147^N148^N150^N152^N153^N182^
;;N190^N203^N208^N209^N213^N229^N230^N247^N248^N249^N250^N251^N252^N254^N256^N258^N259^N260^
;;N261^N263^N264^N266^N267^N268^N269^N270^N271^N272^N273^N274^N275^N276^N277^N278^N279^N280^
;;N281^N282^N283^N284^N285^N287^N288^N289^N290^N291^N292^N293^N294^N295^N296^N297^N298^N299^
;;N300^N301^N302^N303^N304^N305^N306^N307^N308^N309^N310^N312^N313^N314^N315^N316^N317^N320^
;;N321^N322^N323^N324^N325^N326^N327^N328^N329^N330^N332^N333^N334^N335^N336^N337^N338^N339^
;;N340^N341^N342^N344^N345^N346^N349^N359^N374^N382^N407^N430^N433^N434^N443^N471^N521^N547^
;;N554^N575^N625^N653^N753^N754^N755^N756^N763^N769^
;;THE END
Q
;
C96 ;;CARC 96, RARC list too long for single line
;;M1^M2^M3^M8^M13^M41^M80^MA109^N43^N54^N157^N188^N590^N130^N216^MA67^N10^M26^N163^M37^M82^M89^N129^
;;M114^N56^N386^M25^M121^N622^N592^N61^N647^MA96^N32^N653^N115^N95^N722^N376^N52^N30^N652^MA47^N15^
;;N578^N117^N370^N587^N409^M86^M90^N427^N429^N567^M97^N20^N357^N525^N626^N628^N637^N666^N538^N83^
;;N676^MA126^N124^N161^N180^N362^N372^N383^N607^N658^N721^N734^N174^N450^N623^N87^N732^N633^N33^
;;N584^N593^N630^M18^M28^M55^M61^M83^M87^M100^M111^M115^M116^M117^M134^M138^M139^MA20^MA24^MA25^
;;MA54^MA55^MA56^MA57^MA73^MA84^MA123^MA131^N6^N12^N35^N55^N68^N81^N86^N90^N92^N96^N103^N104^N110^
;;N113^N118^N120^N121^N125^N126^N141^N143^N158^N159^N167^N171^N176^N194^N198^N348^N351^N356^N405^
;;N406^N408^N410^N424^N425^N426^N428^N431^N435^N441^N448^N507^N528^N529^N564^N569^N576^N588^N589^
;;N621^N624^N636^N640^N643^N651^N665^N726^N765^N766^
;;THE END
Q
;
C163 ;;
;;M4^M19^M127^M141^M23^M29^M30^M31^M60^M130^M135^N4^N3^N26^N40^N42^N146^N178^N186^N214^N221^N223^
;;N375^N391^N393^N395^N398^N403^N439^N445^N451^N453^N455^N457^N459^N461^N465^N467^N473^N475^N477^
;;N479^N481^N485^N487^N489^N493^N495^N497^N499^N501^N503^N555^N678^N680^N681^N682^N683^N685^N686^
;;N706^N708^N710^N712^N714^N716^N718^N729^N737^N739^N745^N749^N764^
;;THE END
Q
;
C250 ;;
;;M19^M127^M141^M23^M29^M30^M31^M60^M130^M135^N4^N3^N26^N40^N42^N146^N178^N186^N214^N221^N223^N375^
;;N391^N393^N395^N398^N403^N439^N445^N451^N453^N455^N457^N459^N461^N465^N467^N473^N475^N477^N479^
;;N481^N485^N487^N489^N493^N495^N497^N499^N501^N503^N555^N678^N680^N681^N682^N683^N686^N706^N708^
;;N710^N712^N714^N716^N718^N729^N737^N739^N745^N749^M124^M131^M132^M142^MA04^MA92^N80^N170^N175^
;;N206^N401^N463^N491^N542^N590^N667^
;;THE END
Q
;
C251 ;;
;;M135^N4^N214^N375^N680^N681^N682^N683^N686^N764^MA04^N80^N170^N491^N286^MA75^MA81^MA88^MA111^N78^
;;N205^N222^N224^N226^N227^N228^N231^N232^N233^N234^N235^N236^M42^N28^N237^N238^N239^N240^N241^N242^
;;N243^N244^N245^N331^N354^N392^N394^N396^N399^N402^N404^N440^N446^N452^N454^N456^N458^N460^N462^
;;N466^N468^N474^N476^N478^N480^N482^N486^N488^N490^N494^N496^N498^N500^N502^N504^N543^N556^N570^
;;N668^N679^N705^N707^N709^N711^N713^N715^N717^N730^N731^N736^N738^N746^N750^N768^
;;THE END
Q
;
C252 ;;
;;M1^M19^M127^M141^M23^M29^M30^M31^M60^M130^M135^N4^N3^N26^N40^N42^N146^N178^N186^N214^N221^N223^
;;N375^N391^N393^N395^N398^N403^N439^N445^N451^N453^N455^N457^N459^N461^N465^N467^N473^N475^N477^
;;N479^N481^N485^N487^N489^N493^N495^N497^N499^N501^N503^N555^N678^N680^N681^N682^N683^N685^N686^
;;N706^N708^N710^N712^N714^N716^N718^N729^N737^N739^N745^N749^N764^M131^M132^M142^MA04^MA92^N80^
;;N170^N175^N401^N491^N542^N590^N667^MA75^MA81^MA88^MA111^M42^N28^N241^N331^N668^N707^M21^M125^M143^
;;MA27^MA64^MA76^N50^N191^N204^N350^N594^N595^N596^
;;THE END
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBX2P158 13548 printed Dec 13, 2024@02:00:54 Page 2
FBX2P158 ;WCIOFO/SLT-PATCH INSTALL ROUTINE ;5/27/2006
+1 ;;3.5;FEE BASIS;**158**;JAN 30, 1995;Build 94
+2 QUIT
+3 ;
CSGR ; entry point for establishing CARC/RARC relationships
+1 DO MES^XPDUTL(" Establishing CARC/RARC Relationships...")
+2 NEW STR,I,CARC,RARC,SCNR,CAGCLST,CAGC,PC,CAGCI,CNT,FDA,RARCI,TAG,J,RLN,RARCLST,CARCI
+3 SET I=1
FOR
SET STR=$TEXT(CSGRTBL+I)
if $PIECE(STR,";;",2)["THE END"
QUIT
Begin DoDot:1
+4 SET STR=$PIECE(STR,";;",2)
+5 SET CARC=$PIECE(STR,";")
+6 IF '$DATA(^FB(161.91,"B",CARC))
QUIT
+7 SET CARCI=$ORDER(^FB(161.91,"B",CARC,""))
if 'CARCI
QUIT
+8 ;clear scenario
SET $PIECE(^FB(161.91,CARCI,0),U,3)=""
+9 ;clear CAGC and RARC codes
DO DCAGC(CARCI)
DO DRARC(CARCI)
+10 SET SCNR=+$PIECE(STR,";",2)
+11 ;set business scenario
if SCNR
SET $PIECE(^FB(161.91,CARCI,0),U,3)=SCNR
+12 ;
+13 ;get the CAGC list
SET CAGCLST=$PIECE(STR,";",3)
+14 ; update CAGCs
IF CAGCLST]""
Begin DoDot:2
+15 ; number of CAGCs
SET CNT=$LENGTH(CAGCLST,U)-1
+16 FOR PC=1:1:CNT
Begin DoDot:3
+17 SET CAGC=$PIECE(CAGCLST,U,PC)
if CAGC']""
QUIT
+18 IF '$DATA(^FB(161.92,"B",CAGC))
QUIT
+19 SET CAGCI=$ORDER(^FB(161.92,"B",CAGC,""))
if 'CAGCI
QUIT
+20 SET FDA(161.917,"+"_PC_","_CARCI_",",.01)=CAGCI
End DoDot:3
+21 IF $DATA(FDA)
DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:2
+22 ;
+23 ; get the RARC list
SET RARCLST=$PIECE(STR,";",4)
+24 ;update RARCs
IF RARCLST]""
IF $EXTRACT(RARCLST)'="*"
Begin DoDot:2
+25 SET CNT=$LENGTH(RARCLST,U)-1
+26 FOR PC=1:1:CNT
Begin DoDot:3
+27 SET RARC=$PIECE(RARCLST,U,PC)
if RARC']""
QUIT
+28 IF '$DATA(^FB(161.93,"B",RARC))
QUIT
+29 SET RARCI=$ORDER(^FB(161.93,"B",RARC,""))
if 'RARCI
QUIT
+30 SET FDA(161.915,"+"_PC_","_CARCI_",",.01)=RARCI
End DoDot:3
+31 IF $DATA(FDA)
DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:2
+32 IF '$TEST
IF $EXTRACT(RARCLST)="*"
Begin DoDot:2
+33 SET TAG=$PIECE(RARCLST,"*",2)
+34 FOR J=1:1
SET RLN=$TEXT(@(TAG)+J)
if $PIECE(RLN,";;",2)["THE END"
QUIT
Begin DoDot:3
+35 SET RARCLST=$PIECE(RLN,";;",2)
+36 IF RARCLST]""
Begin DoDot:4
+37 SET CNT=$LENGTH(RARCLST,U)-1
+38 FOR PC=1:1:CNT
Begin DoDot:5
+39 SET RARC=$PIECE(RARCLST,U,PC)
if RARC']""
QUIT
+40 IF '$DATA(^FB(161.93,"B",RARC))
QUIT
+41 SET RARCI=$ORDER(^FB(161.93,"B",RARC,""))
if 'RARCI
QUIT
+42 SET FDA(161.915,"+"_PC_","_CARCI_",",.01)=RARCI
End DoDot:5
+43 IF $DATA(FDA)
DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:4
End DoDot:3
End DoDot:2
+44
*** ERROR ***
SET I=$I(I)
End DoDot:1
+45 DO MES^XPDUTL(" done.")
+46 QUIT
+47 ;
DCAGC(CI) ; delete existing CAGCs
+1 ;
+2 NEW IENS,SIENS,FDA,FB
+3 SET IENS=CI_","
+4 DO GETS^DIQ(161.91,IENS,"7*","","FB")
+5 SET SIENS=""
FOR
SET SIENS=$ORDER(FB(161.917,SIENS))
if SIENS=""
QUIT
Begin DoDot:1
+6 SET FDA(161.917,SIENS,.01)="@"
End DoDot:1
+7 IF $DATA(FDA)
DO FILE^DIE("","FDA")
KILL FDA
+8 QUIT
+9 ;
DRARC(CI) ; delete existing RARCs
+1 ;
+2 NEW IENS,SIENS,FDA,FB
+3 SET IENS=CI_","
+4 DO GETS^DIQ(161.91,IENS,"5*","","FB")
+5 SET SIENS=""
FOR
SET SIENS=$ORDER(FB(161.915,SIENS))
if SIENS=""
QUIT
Begin DoDot:1
+6 SET FDA(161.915,SIENS,.01)="@"
End DoDot:1
+7 IF $DATA(FDA)
DO FILE^DIE("","FDA")
KILL FDA
+8 QUIT
+9 ;
+10 ; CORE Version 3.3.0
CSGRTBL ;;CARC;SCENARIO;GRP1^[GRP2^...GRPn^];RARC1^[RARC2^...RARCn^]^ or *C_CARC if long list.
+1 ;;4;2;CO^PI^;N517^N519^M20^N657^M114^N56^N108^N386^N572^N644^
+2 ;;5;3;CO^PI^PR^;MA109^M77^
+3 ;;6;3;CO^PI^PR^;M37^M82^N129^N115^
+4 ;;7;3;CO^PI^PR^;N115^
+5 ;;8;3;CO^PI^PR^;MA130^N684^N95^
+6 ;;9;3;CO^PI^PR^;N517^M89^N657^
+7 ;;10;3;CO^PI^PR^;N517^N657^MA130^
+8 ;;11;3;CO^PI^PR^;N657^MA130^N386^MA63^N115^
+9 ;;12;3;CO^PI^PR^;N657^MA63^
+10 ;;13;2;CO^PI^;
+11 ;;14;2;CO^PI^;
+12 ;;15;2;CO^PI^;N517^MA130^N596^M25^M62^N752^
+13 ;;16;2;CO^PI^;*C16
+14 ;;18;2;CO^OA^;N111^N347^N522^N702^
+15 ;;19;3;CO^PI^PR^;N418^N722^N728^
+16 ;;20;3;CO^PI^PR^;MA04^N723^N725^
+17 ;;21;3;CO^PI^PR^;MA04^N728^N724^N727^
+18 ;;22;3;CO^PI^PR^;N4^N479^MA04^MA92^N36^N245^MA64^N374^MA16^N197^N376^N598^N743^N744^
+19 ;;24;4;CO^PI^PR^;M112^
+20 ;;26;3;CO^PI^PR^;N30^N216^N622^N52^N128^N650^N652^
+21 ;;27;3;CO^PI^PR^;N30^N622^N52^N650^MA47^N619^
+22 ;;29;3;CO^PI^PR^;
+23 ;;31;3;CO^PI^PR^;MA130^MA61^
+24 ;;32;3;CO^PI^PR^;N129^N52^MA47^N15^
+25 ;;33;3;PR^;N578^
+26 ;;34;3;CO^PI^PR^;
+27 ;;35;3;CO^PI^PR^;N117^N370^N587^
+28 ;;39;3;CO^PI^PR^;
+29 ;;40;3;CO^PI^PR^;N10^N409^
+30 ;;49;3;CO^PI^PR^;N130^N129^N115^M90^N390^N427^N429^N567^
+31 ;;50;3;CO^PI^PR^;M1^N45^M127^M31^M60^M135^N40^N178^N214^N455^N170^N206^M64^N227^N130^N10^M26^N163^N237^N238^N240^N242^N244^N456^N129^N386^M25^M76^M51^N229^N443^N115^M85^MA126^N124^N161^N180^N362^N372^N383^N607^N658^N661^N721^N734^
+32 ;;51;3;CO^PI^PR^;N45^N10^N204^N607^N174^
+33 ;;53;3;CO^PI^PR^;
+34 ;;54;3;CO^PI^PR^;N10^N646^N450^
+35 ;;55;3;CO^PI^PR^;M49^N111^N10^N115^N623^
+36 ;;56;3;CO^PI^PR^;N115^N623^
+37 ;;58;3;CO^PI^PR^;N386^N115^N87^N732^N760^
+38 ;;59;3;CO^PI^PR^;N10^N644^N633^N670^
+39 ;;60;3;CO^PI^PR^;N130^M114^N676^
+40 ;;61;3;CO^PI^PR^;
+41 ;;69;2;CO^PI^;
+42 ;;78;3;CO^PI^PR^;
+43 ;;89;3;CO^PI^PR^;N200^
+44 ;;95;3;CO^PI^PR^;N594^N595^N596^N182^N33^N385^N584^N593^N630^
+45 ;;96;3;CO^PI^PR^;*C96
+46 ;;97;4;CO^PI^PR^;M2^M15^M80^M144^MA109^N19^N130^N111^N122^N115^M86^N390^M112^M97^M109^N20^N67^N357^N472^N525^N626^N628^N637^N646^N666^
+47 ;;107;2;CO^PI^;M121^MA66^N122^N173^N674^
+48 ;;108;3;CO^PI^PR^;N223^M7^N130^N10^N370^N518^N372^N171^M10^M36^M94^
+49 ;;109;3;CO^PI^PR^;N36^N130^N216^M114^N418^N106^N538^N104^N448^N576^M11^N105^N127^N557^N558^N559^N747^N751^
+50 ;;110;2;CO^PI^;M52^M59^N622^
+51 ;;111;3;CO^PI^PR^;
+52 ;;114;3;CO^PI^PR^;N623^M61^M102^
+53 ;;115;3;CO^PI^PR^;
+54 ;;116;1;CO^PI^;
+55 ;;117;3;CO^PI^PR^;N115^
+56 ;;119;3;CO^PI^PR^;N45^M80^M7^N130^N111^M89^N386^N115^N117^N587^M86^M90^N357^N362^M83^M139^N435^N636^N640^
+57 ;;125;M7^N517^MA30^N519^
+58 ;;128;3;CO^PI^PR^;
+59 ;;129;2;CO^PI^;MA36^N48^MA130^
+60 ;;138;3;CO^PI^PR^;N584^
+61 ;;139;3;
+62 ;;140;2;CO^PI^;MA36^MA130^MA27^MA61^
+63 ;;146;2;CO^PI^;M64^N517^N657^M76^MA63^MA65^
+64 ;;149;3;CO^PI^PR^;N386^N117^N587^
+65 ;;150;3;CO^PI^PR^;N10^M26^N163^M25^N115^N124^N125^N640^
+66 ;;151;3;CO^PI^PR^;M3^N206^N130^N10^N386^M25^N115^M86^N362^N435^M69^
+67 ;;152;3;CO^PI^PR^;M26^N115^N640^
+68 ;;153;3;CO^PI^PR^;
+69 ;;154;3;CO^PI^PR^;
+70 ;;155;3;CO^PI^PR^;
+71 ;;157;3;CO^PI^PR^;
+72 ;;158;3;PR^;N176^
+73 ;;159;3;CO^PI^PR^;
+74 ;;160;3;CO^PI^PR^;N622^N607^N167^N356^N425^
+75 ;;163;1;CO^PI^;*C163
+76 ;;164;1;CO^PI^;N42^N764^
+77 ;;165;3;CO^PI^PR^;N45^N475^N489^N490^N285^N630^
+78 ;;166;3;CO^PI^PR^;
+79 ;;167;3;CO^PI^PR^;N386^MA63^N647^N115^N30^N607^N428^
+80 ;;168;3;CO^PI^PR^;N30^N174^
+81 ;;169;3;CO^PI^PR^;MA109^N10^
+82 ;;170;3;CO^PI^PR^;M143^M114^N95^N732^N90^N348^N665^
+83 ;;171;3;CO^PI^PR^;M97^N732^N92^N110^N121^N428^N762^
+84 ;;172;3;CO^PI^PR^;M13^
+85 ;;173;3;CO^PI^PR^;N667^N130^N668^N574^
+86 ;;174;3;CO^PI^PR^;N667^N668^N115^
+87 ;;175;2;CO^PI^;N668^N319^N378^N388^N592^
+88 ;;176;3;CO^PI^PR^;N592^
+89 ;;177;3;CO^PI^PR^;N375^N10^
+90 ;;178;3;CO^PI^PR^;
+91 ;;179;3;CO^PI^PR^;
+92 ;;180;3;CO^PI^PR^;
+93 ;;181;2;CO^PI^;N517^M20^N56^
+94 ;;182;2;CO^PI^;N517^N657^
+95 ;;183;3;CO^PI^PR^;N630^N574^N767^
+96 ;;184;3;CO^PI^PR^;N386^M115^N574^N767^
+97 ;;185;3;CO^PI^PR^;N570^N386^N684^N95^N450^N767^
+98 ;;188;3;CO^PI^PR^;N386^M61^M102^
+99 ;;189;2;CO^PI^;N657^M81^
+100 ;;190;4;CO^PI^PR^;N106^N107^N538^
+101 ;;194;3;CO^PI^PR^;M80^
+102 ;;197;3;CO^PI^PR^;N83^
+103 ;;198;3;CO^PI^PR^;N54^N10^M62^N351^N435^N758^
+104 ;;199;2;CO^PI^;N657^
+105 ;;200;3;CO^PI^PR^;N650^N619^
+106 ;;201;3;PR^;N722^N723^N724^
+107 ;;202;3;CO^PI^PR^;N658^
+108 ;;204;3;CO^PI^PR^;N157^N130^N10^N129^N386^N429^N567^N357^N666^N383^N658^N12^N158^N171^N426^N428^N441^N448^N569^N651^N751^
+109 ;;206;2;CO^PI^;N257^N286^N31^N77^N253^N262^N265^
+110 ;;207;2;CO^PI^;N257^N286^N31^N77^N253^N262^N265^
+111 ;;208;2;CO^PI^;N257^N286^N31^N77^N253^N262^N265^N516^N562^
+112 ;;210;3;CO^PI^PR^;
+113 ;;212;3;OA^PI^PR^;N658^
+114 ;;213;3;
+115 ;;222;3;CO^PI^PR^;N115^N587^N633^N640^
+116 ;;224;3;CO^;
+117 ;;228;3;CO^PI^PR^;N555^N556^
+118 ;;231;3;CO^PI^PR^;N628^
+119 ;;233;3;CO^PI^PR^;
+120 ;;234;4;CO^PI^PR^;M2^M14^M15^M80^N122^N390^N20^N67^N525^N626^N628^N83^N518^N676^
+121 ;;236;2;CO^PI^;N657^N644^
+122 ;;238;3;PR^;
+123 ;;239;3;CO^PI^PR^;
+124 ;;240;2;CO^PI^;N657^M76^MA63^N207^
+125 ;;242;3;CO^PI^PR^;N130^N95^N450^M115^N767^
+126 ;;243;3;CO^PI^PR^;N130^N95^N450^N630^M115^N767^
+127 ;;246;3;CO^PI^PR^;N572^
+128 ;;249;3;CO^;N561^
+129 ;;250;1;CO^PI^;*C250
+130 ;;251;1;CO^PI^;*C251
+131 ;;252;1;CO^PI^;*C252
+132 ;;254;3;CO^PI^PR^;N130^
+133 ;;256;3;CO^PI^PR^;M14^N130^M37^M82^M89^M81^N95^MA16^N52^N117^M90^M97^N734^N623^M61^M139^N103^N118^N428^N448^M96^N246^
+134 ;;258;3;OA^PI^PR^;N30^N103^
+135 ;;261;3;CO^PI^PR^;
+136 ;;267;2;CO^PI^;N61^N62^N63^N74^
+137 ;;268;2;CO^PI^;
+138 ;;269;3;CO^PI^PR^;N54^N130^N10^M37^M82^M89^N129^M25^N30^N124^M83^N96^
+139 ;;270;3;CO^PI^PR^;N130^N658^
+140 ;;272;3;CO^PI^PR^;N10^N386^N115^N20^N357^N584^N593^N507^N564^M40^N151^
+141 ;;273;3;CO^PI^PR^;M13^N10^N386^N115^N362^N435^
+142 ;;274;3;CO^PI^PR^;
+143 ;;276;3;CO^PI^PR^;N536^
+144 ;;A6;3;CO^PI^PR^;
+145 ;;A8;2;CO^PI^;N657^N647^
+146 ;;B1;3;CO^PI^PR^;N30^N628^N734^N113^
+147 ;;B10;4;CO^PI^PR^;M144^
+148 ;;B11;3;CO^OA^PI^PR^;N216^N418^N743^N744^N751^
+149 ;;B12;3;CO^PI^;N199^
+150 ;;B13;3;CO^PI^PR^;N10^N347^M86^M97^N472^
+151 ;;B14;3;CO^PI^PR^;M26^M25^M86^N628^N637^N666^N2^
+152 ;;B15;3;CO^PI^PR^;M80^M114^N386^M25^N122^N674^M51^N115^N20^N748^
+153 ;;B16;3;CO^PI^PR^;M13^N113^
+154 ;;B20;3;CO^PI^PR^;N10^N347^M86^N472^N538^N120^
+155 ;;B23;3;CO^PI^PR^;
+156 ;;B7;3;CO^PI^PR^;N570^M143^MA120^N115^N95^MA47^N450^N732^MA56^N425^N665^N612^
+157 ;;B8;3;CO^PI^PR^;
+158 ;;B9;3;CO^PI^PR^;M25^N90^
+159 ;;P14;4;CO^PI^PR^;M2^M15^M80^M144^N19^N111^N702^M86^N390^M97^N20^N67^N525^M75^
+160 ;;P16;3;CO^OA^;
+161 ;;P17;3;CO^PI^PR^;
+162 ;;P19;4;CO^PI^PR^;
+163 ;;P2;3;CO^PI^PR^;
+164 ;;P20;3;CO^PI^PR^;N104^
+165 ;;P21;3;CO^PI^PR^;M80^N479^MA04^N590^N667^N36^N10^N657^N668^N594^N595^N596^N622^N653^N95^N598^N650^N652^N578^N587^N409^N666^N607^N658^N661^N584^N593^N158^N576^N588^N589^N621^N651^N665^N577^N579^N580^N582^N583^N585^N586^N611^
+166 ;;P3;3;PR^;
+167 ;;P4;3;CO^PI^PR^;N612^
+168 ;;P7;2;CO^PI^;M51^M119^
+169 ;;THE END
+170 QUIT
+171 ;
C16 ;;CARC 16, RARC list too long for single line
+1 ;;M24^N54^N184^N188^M60^N4^N439^N479^N685^N764^M124^MA04^MA92^N80^M64^N257^N286^
+2 ;;MA75^MA81^MA88^MA111^MA30^N519^MA36^N48^M20^M49^N243^N245^N331^N440^N657^N480^
+3 ;;M21^M125^MA27^MA64^MA76^N50^N350^N595^N596^N56^N572^M62^N752^MA66^N173^M52^M59^
+4 ;;MA61^M76^MA63^MA65^N319^N378^N388^M81^N31^N77^N253^N262^N265^N562^N207^N61^N62^
+5 ;;N63^M51^M119^M12^M22^M44^M45^M46^M47^M50^M53^M54^M56^M65^M67^N389^M73^M77^M79^M84^
+6 ;;M91^M99^M122^M123^M126^M129^M133^M136^MA21^MA31^MA32^MA33^MA34^MA35^MA37^MA39^MA40^
+7 ;;MA41^MA42^MA43^MA48^MA50^MA53^MA58^MA60^MA69^MA70^MA71^MA83^MA89^MA90^MA94^MA96^MA97^
+8 ;;MA99^MA100^MA110^MA112^MA113^MA114^MA115^MA116^MA120^MA121^MA122^MA128^MA134^N8^N27^
+9 ;;N32^N34^N37^N39^N46^N53^N57^N58^N64^N65^N75^N76^N94^N142^N147^N148^N150^N152^N153^N182^
+10 ;;N190^N203^N208^N209^N213^N229^N230^N247^N248^N249^N250^N251^N252^N254^N256^N258^N259^N260^
+11 ;;N261^N263^N264^N266^N267^N268^N269^N270^N271^N272^N273^N274^N275^N276^N277^N278^N279^N280^
+12 ;;N281^N282^N283^N284^N285^N287^N288^N289^N290^N291^N292^N293^N294^N295^N296^N297^N298^N299^
+13 ;;N300^N301^N302^N303^N304^N305^N306^N307^N308^N309^N310^N312^N313^N314^N315^N316^N317^N320^
+14 ;;N321^N322^N323^N324^N325^N326^N327^N328^N329^N330^N332^N333^N334^N335^N336^N337^N338^N339^
+15 ;;N340^N341^N342^N344^N345^N346^N349^N359^N374^N382^N407^N430^N433^N434^N443^N471^N521^N547^
+16 ;;N554^N575^N625^N653^N753^N754^N755^N756^N763^N769^
+17 ;;THE END
+18 QUIT
+19 ;
C96 ;;CARC 96, RARC list too long for single line
+1 ;;M1^M2^M3^M8^M13^M41^M80^MA109^N43^N54^N157^N188^N590^N130^N216^MA67^N10^M26^N163^M37^M82^M89^N129^
+2 ;;M114^N56^N386^M25^M121^N622^N592^N61^N647^MA96^N32^N653^N115^N95^N722^N376^N52^N30^N652^MA47^N15^
+3 ;;N578^N117^N370^N587^N409^M86^M90^N427^N429^N567^M97^N20^N357^N525^N626^N628^N637^N666^N538^N83^
+4 ;;N676^MA126^N124^N161^N180^N362^N372^N383^N607^N658^N721^N734^N174^N450^N623^N87^N732^N633^N33^
+5 ;;N584^N593^N630^M18^M28^M55^M61^M83^M87^M100^M111^M115^M116^M117^M134^M138^M139^MA20^MA24^MA25^
+6 ;;MA54^MA55^MA56^MA57^MA73^MA84^MA123^MA131^N6^N12^N35^N55^N68^N81^N86^N90^N92^N96^N103^N104^N110^
+7 ;;N113^N118^N120^N121^N125^N126^N141^N143^N158^N159^N167^N171^N176^N194^N198^N348^N351^N356^N405^
+8 ;;N406^N408^N410^N424^N425^N426^N428^N431^N435^N441^N448^N507^N528^N529^N564^N569^N576^N588^N589^
+9 ;;N621^N624^N636^N640^N643^N651^N665^N726^N765^N766^
+10 ;;THE END
+11 QUIT
+12 ;
C163 ;;
+1 ;;M4^M19^M127^M141^M23^M29^M30^M31^M60^M130^M135^N4^N3^N26^N40^N42^N146^N178^N186^N214^N221^N223^
+2 ;;N375^N391^N393^N395^N398^N403^N439^N445^N451^N453^N455^N457^N459^N461^N465^N467^N473^N475^N477^
+3 ;;N479^N481^N485^N487^N489^N493^N495^N497^N499^N501^N503^N555^N678^N680^N681^N682^N683^N685^N686^
+4 ;;N706^N708^N710^N712^N714^N716^N718^N729^N737^N739^N745^N749^N764^
+5 ;;THE END
+6 QUIT
+7 ;
C250 ;;
+1 ;;M19^M127^M141^M23^M29^M30^M31^M60^M130^M135^N4^N3^N26^N40^N42^N146^N178^N186^N214^N221^N223^N375^
+2 ;;N391^N393^N395^N398^N403^N439^N445^N451^N453^N455^N457^N459^N461^N465^N467^N473^N475^N477^N479^
+3 ;;N481^N485^N487^N489^N493^N495^N497^N499^N501^N503^N555^N678^N680^N681^N682^N683^N686^N706^N708^
+4 ;;N710^N712^N714^N716^N718^N729^N737^N739^N745^N749^M124^M131^M132^M142^MA04^MA92^N80^N170^N175^
+5 ;;N206^N401^N463^N491^N542^N590^N667^
+6 ;;THE END
+7 QUIT
+8 ;
C251 ;;
+1 ;;M135^N4^N214^N375^N680^N681^N682^N683^N686^N764^MA04^N80^N170^N491^N286^MA75^MA81^MA88^MA111^N78^
+2 ;;N205^N222^N224^N226^N227^N228^N231^N232^N233^N234^N235^N236^M42^N28^N237^N238^N239^N240^N241^N242^
+3 ;;N243^N244^N245^N331^N354^N392^N394^N396^N399^N402^N404^N440^N446^N452^N454^N456^N458^N460^N462^
+4 ;;N466^N468^N474^N476^N478^N480^N482^N486^N488^N490^N494^N496^N498^N500^N502^N504^N543^N556^N570^
+5 ;;N668^N679^N705^N707^N709^N711^N713^N715^N717^N730^N731^N736^N738^N746^N750^N768^
+6 ;;THE END
+7 QUIT
+8 ;
C252 ;;
+1 ;;M1^M19^M127^M141^M23^M29^M30^M31^M60^M130^M135^N4^N3^N26^N40^N42^N146^N178^N186^N214^N221^N223^
+2 ;;N375^N391^N393^N395^N398^N403^N439^N445^N451^N453^N455^N457^N459^N461^N465^N467^N473^N475^N477^
+3 ;;N479^N481^N485^N487^N489^N493^N495^N497^N499^N501^N503^N555^N678^N680^N681^N682^N683^N685^N686^
+4 ;;N706^N708^N710^N712^N714^N716^N718^N729^N737^N739^N745^N749^N764^M131^M132^M142^MA04^MA92^N80^
+5 ;;N170^N175^N401^N491^N542^N590^N667^MA75^MA81^MA88^MA111^M42^N28^N241^N331^N668^N707^M21^M125^M143^
+6 ;;MA27^MA64^MA76^N50^N191^N204^N350^N594^N595^N596^
+7 ;;THE END
+8 QUIT
