SRTPUTLC ;BIR/SJA - UTILITY ROUTINE ;08/18/2011
;;3.0;Surgery;**167,176**;24 Jun 93;Build 8
CHK ; check for missing transplant assessment information
K SRX,SRZZ,SRMM S SRMM=0
D @SRTYPE
Q
K ; kidney data entry fields
; kidney recipient information
S DR=$S(SRNOVA:"3;1;11;187;10;12;4;5;96;26;27;95;97;33;19;98;37;42;94",1:"3;11;187;10;12;96;26;27;95;97;33;19;98;37;42;94") D DATA
; kidney transplant information
S DR="85;87;89;68;143;144;9;197;13;14;15;17;16;18" D DATA
; PREOPERATIVE RISK ASSESSMENT/RISK ASSESSMENT
S DR=$S(SRNOVA:"200;201;59;60;61;75;108;113;80;83;131;115;109;110;92;145;132;146;90",1:"59;60;61;75;108;113;80;115;90;83;109;110;92;133") D DATA
; kidney outcome data
I SRNOVA S DR="116;117;118;119;192;121;122;123;124;125;126;193;133" D DATA
; kidney donor information
S DR="44" D DATA
S DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72" D DATA
; pancreas information
S DR="134;135;136;137;138;139;140;141;142" D DATA
Q
LI ; liver data entry fields
; recipient information
S DR=$S(SRNOVA:"3;1;11;4;5;10;12;52;53;54;55;19",1:"3;11;10;12;52;53;54;55;19") D DATA
; diagnosis information
S DR="21;20;23;99;100;101;27;28;29;30;102;34;35;38;105;39;106;107;47;56;111;120;127;94" D DATA
; diagnosis information
S DR="85;87;89;68;13;14;15;17;16;18" D DATA
; risk assessment information
S DR=$S(SRNOVA:"86;84;200;201;59;60;113;108;114;90;91;78;79",1:"86;84;59;60;108;113;114;90;91;78;79;81;82;83;109;110") D DATA
; donor information for VA
I 'SRNOVA D
.S DR="44" D DATA
.S DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72" D DATA
; risk assessment information for Non-VA
I SRNOVA S DR="81;82;88;83;109;110;145;132;146;131" D DATA
; outcome information for non-VA
I SRNOVA S DR="116;117;118;119;192;121;122;123;124;125;126;193" D DATA
I SRNOVA D
.S DR="44" D DATA
.S DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72" D DATA
Q
LU ; lung data entry fields
; recipient information
S DR=$S(SRNOVA:"3;1;11;4;5;10;12;40;41;24;25;32;129;19;43;22;128;94",1:"3;11;10;12;40;41;24;25;32;43;22;128;94;129;19") D DATA
; lung transplant information
S DR="50;51;85;87;89;68;13;14;15;17;16;18" D DATA
; preoperative risk assessment
S DR=$S(SRNOVA:"200;201;59;60;71;108;61;75;113;114;131;115;90;83;109;110;145;132;146;80",1:"59;60;71;108;61;75;113;114;80;115;90;83;109;110") D DATA
; outcome information
I SRNOVA S DR="116;117;118;119;192;121;122;123;124;125;126;193" D DATA
; donor information
S DR="44" D DATA
S DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72" D DATA
Q
H ; heart data entry fields
; recipient information
S DR=$S(SRNOVA:"3;1;11;58;57;4;5;10;12;167;168;163;164;19;165;89;166;68",1:"3;11;58;57;163;164;165;89;166;68;10;12;19") D DATA
; diagnosis information
S DR="155;156;157;158;159;43;160;161;162;94;112;13;14;15;16;17;18" D DATA
; risk assessment information
S DR=$S(SRNOVA:"76;169;177;149;173;202;203;175;62;176;74;152;198;199;172;179;178;132;145;150;151;200;201;59;60",1:"62;149;150;151;59;60;152;108;153;74;115;81;82;109;110;90;83;75;154") D DATA
; risk assessment info
I SRNOVA D D DATA
.S DR="75;154;108;115;81;82;90;83;153" S DR=DR_"193;170;192;191;190;119;189;148;118;121;122;130;109;110"
; donor information
S DR="44" D DATA
S DR="45;31;36;70;46;48;49;77;69;104;64;65;66;73;67;72" D DATA
Q
DATA K DIC,DIQ,SRY,SRYY S DIC="^SRT(",DA=SRTPP,DIQ="SRY",DIQ(0)="I" D EN^DIQ1
I $P(DR,";")=44 D RACE
S XX=0 F S XX=$O(SRY(139.5,DA,XX)) Q:'XX D LOC I SRI S SRYY(139.5,DA,SRI,"I")=SRY(139.5,SRTPP,XX,"I")_"^"_XX
K DR S SRMM=SRMM+1 D ^SRTPUTL4
Q
LOC ;
S SRI=0 F I=1:1:$L(DR,";") S:$P(DR,";",I)=XX SRI=I
Q
RACE ;
K SRY1,SRY2 S DIC="^SRT(",DR=44,DA=SRTPP,DR(139.544)=".01"
S (II,JJ)=0 F S II=$O(^SRT(SRTPP,44,II)) Q:'II S SRACE=$G(^SRT(SRTPP,44,II,0)) D K SRY1
.S DA(139.544)=II,DIQ="SRY1",DIQ(0)="E" D EN^DIQ1
.S JJ=JJ+1,SRY2(139.544,JJ)=SRACE_"^"_$G(SRY1(139.544,II,.01,"E")),SRY2(139.544)=JJ
I $G(SRY2(139.544))>0 Q
S SRY(139.5,SRTPP,44,"I")=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPUTLC 4052 printed Dec 13, 2024@02:49:01 Page 2
SRTPUTLC ;BIR/SJA - UTILITY ROUTINE ;08/18/2011
+1 ;;3.0;Surgery;**167,176**;24 Jun 93;Build 8
CHK ; check for missing transplant assessment information
+1 KILL SRX,SRZZ,SRMM
SET SRMM=0
+2 DO @SRTYPE
+3 QUIT
K ; kidney data entry fields
+1 ; kidney recipient information
+2 SET DR=$SELECT(SRNOVA:"3;1;11;187;10;12;4;5;96;26;27;95;97;33;19;98;37;42;94",1:"3;11;187;10;12;96;26;27;95;97;33;19;98;37;42;94")
DO DATA
+3 ; kidney transplant information
+4 SET DR="85;87;89;68;143;144;9;197;13;14;15;17;16;18"
DO DATA
+5 ; PREOPERATIVE RISK ASSESSMENT/RISK ASSESSMENT
+6 SET DR=$SELECT(SRNOVA:"200;201;59;60;61;75;108;113;80;83;131;115;109;110;92;145;132;146;90",1:"59;60;61;75;108;113;80;115;90;83;109;110;92;133")
DO DATA
+7 ; kidney outcome data
+8 IF SRNOVA
SET DR="116;117;118;119;192;121;122;123;124;125;126;193;133"
DO DATA
+9 ; kidney donor information
+10 SET DR="44"
DO DATA
+11 SET DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72"
DO DATA
+12 ; pancreas information
+13 SET DR="134;135;136;137;138;139;140;141;142"
DO DATA
+14 QUIT
LI ; liver data entry fields
+1 ; recipient information
+2 SET DR=$SELECT(SRNOVA:"3;1;11;4;5;10;12;52;53;54;55;19",1:"3;11;10;12;52;53;54;55;19")
DO DATA
+3 ; diagnosis information
+4 SET DR="21;20;23;99;100;101;27;28;29;30;102;34;35;38;105;39;106;107;47;56;111;120;127;94"
DO DATA
+5 ; diagnosis information
+6 SET DR="85;87;89;68;13;14;15;17;16;18"
DO DATA
+7 ; risk assessment information
+8 SET DR=$SELECT(SRNOVA:"86;84;200;201;59;60;113;108;114;90;91;78;79",1:"86;84;59;60;108;113;114;90;91;78;79;81;82;83;109;110")
DO DATA
+9 ; donor information for VA
+10 IF 'SRNOVA
Begin DoDot:1
+11 SET DR="44"
DO DATA
+12 SET DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72"
DO DATA
End DoDot:1
+13 ; risk assessment information for Non-VA
+14 IF SRNOVA
SET DR="81;82;88;83;109;110;145;132;146;131"
DO DATA
+15 ; outcome information for non-VA
+16 IF SRNOVA
SET DR="116;117;118;119;192;121;122;123;124;125;126;193"
DO DATA
+17 IF SRNOVA
Begin DoDot:1
+18 SET DR="44"
DO DATA
+19 SET DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72"
DO DATA
End DoDot:1
+20 QUIT
LU ; lung data entry fields
+1 ; recipient information
+2 SET DR=$SELECT(SRNOVA:"3;1;11;4;5;10;12;40;41;24;25;32;129;19;43;22;128;94",1:"3;11;10;12;40;41;24;25;32;43;22;128;94;129;19")
DO DATA
+3 ; lung transplant information
+4 SET DR="50;51;85;87;89;68;13;14;15;17;16;18"
DO DATA
+5 ; preoperative risk assessment
+6 SET DR=$SELECT(SRNOVA:"200;201;59;60;71;108;61;75;113;114;131;115;90;83;109;110;145;132;146;80",1:"59;60;71;108;61;75;113;114;80;115;90;83;109;110")
DO DATA
+7 ; outcome information
+8 IF SRNOVA
SET DR="116;117;118;119;192;121;122;123;124;125;126;193"
DO DATA
+9 ; donor information
+10 SET DR="44"
DO DATA
+11 SET DR="45;31;36;70;46;48;49;77;69;103;104;64;65;66;73;67;72"
DO DATA
+12 QUIT
H ; heart data entry fields
+1 ; recipient information
+2 SET DR=$SELECT(SRNOVA:"3;1;11;58;57;4;5;10;12;167;168;163;164;19;165;89;166;68",1:"3;11;58;57;163;164;165;89;166;68;10;12;19")
DO DATA
+3 ; diagnosis information
+4 SET DR="155;156;157;158;159;43;160;161;162;94;112;13;14;15;16;17;18"
DO DATA
+5 ; risk assessment information
+6 SET DR=$SELECT(SRNOVA:"76;169;177;149;173;202;203;175;62;176;74;152;198;199;172;179;178;132;145;150;151;200;201;59;60",1:"62;149;150;151;59;60;152;108;153;74;115;81;82;109;110;90;83;75;154")
DO DATA
+7 ; risk assessment info
+8 IF SRNOVA
Begin DoDot:1
+9 SET DR="75;154;108;115;81;82;90;83;153"
SET DR=DR_"193;170;192;191;190;119;189;148;118;121;122;130;109;110"
End DoDot:1
DO DATA
+10 ; donor information
+11 SET DR="44"
DO DATA
+12 SET DR="45;31;36;70;46;48;49;77;69;104;64;65;66;73;67;72"
DO DATA
+13 QUIT
DATA KILL DIC,DIQ,SRY,SRYY
SET DIC="^SRT("
SET DA=SRTPP
SET DIQ="SRY"
SET DIQ(0)="I"
DO EN^DIQ1
+1 IF $PIECE(DR,";")=44
DO RACE
+2 SET XX=0
FOR
SET XX=$ORDER(SRY(139.5,DA,XX))
if 'XX
QUIT
DO LOC
IF SRI
SET SRYY(139.5,DA,SRI,"I")=SRY(139.5,SRTPP,XX,"I")_"^"_XX
+3 KILL DR
SET SRMM=SRMM+1
DO ^SRTPUTL4
+4 QUIT
LOC ;
+1 SET SRI=0
FOR I=1:1:$LENGTH(DR,";")
if $PIECE(DR,";",I)=XX
SET SRI=I
+2 QUIT
RACE ;
+1 KILL SRY1,SRY2
SET DIC="^SRT("
SET DR=44
SET DA=SRTPP
SET DR(139.544)=".01"
+2 SET (II,JJ)=0
FOR
SET II=$ORDER(^SRT(SRTPP,44,II))
if 'II
QUIT
SET SRACE=$GET(^SRT(SRTPP,44,II,0))
Begin DoDot:1
+3 SET DA(139.544)=II
SET DIQ="SRY1"
SET DIQ(0)="E"
DO EN^DIQ1
+4 SET JJ=JJ+1
SET SRY2(139.544,JJ)=SRACE_"^"_$GET(SRY1(139.544,II,.01,"E"))
SET SRY2(139.544)=JJ
End DoDot:1
KILL SRY1
+5 IF $GET(SRY2(139.544))>0
QUIT
+6 SET SRY(139.5,SRTPP,44,"I")=""
+7 QUIT
