RACMP2 ;HISC/GJC-Complication Report (Part 3 of 3) ;7/17/96 14:06
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
W:RAPG!($E(IOST,1,2)="C-") @IOF S RAPG=RAPG+1
W !?10,RAHDR(1)
S:'($D(RADIV("X"))#2) RADIV("X")=$S($G(^DIC(4,RADIV,0))]"":$P(^(0),"^"),1:"")
W:'$D(RAFLG) !?4,"Division: ",$S(RADIV("X")]"":RADIV("X"),1:"Unknown")
W:$D(RAFLG) !?4,"Division: "
W ?RATAB(6),"Page: ",RAPG
W:'$D(RAFLG) !,"Imaging Type: ",$S(RAITYPE]"":RAITYPE,1:"Unknown")
W:$D(RAFLG) !,"Imaging Type: "
W ?RATAB(6),"Date: ",RATDY
W !?6,RAHDR(2),!,RALN
I IOM=132 D ; If 132 column
. W !,"Name",?RATAB(2),"Pt ID",?RATAB(3),"Date/Time"
. W ?RATAB(4),"Procedure/Complication",?RATAB(5),"Personnel"
. W !,RALN
. Q
E D ; default to 80 column format
. W !,"Name/Pt-Id",?RATAB(3),"Date/Time"
. W ?RATAB(4),"Procedure/Complication"
. W !?RATAB(1),"Personnel",!,RALN
. Q
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
Q
SORT ; Obtain data
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) ; Registered Exam data missing
S RARE(0)=$G(^RADPT(RADFN,"DT",RADTI,0)),RADIV("I")=+$P(RARE(0),"^",3)
S RADIV("X")=$S($G(^DIC(4,RADIV("I"),0))]"":$P(^(0),"^"),1:"Unknown")
I RADIV("X")']""!('$D(^TMP($J,"RA D-TYPE",RADIV("X")))) Q
S RADIV=RADIV("I"),RAITYPE=+$P(RARE(0),"^",2) Q:RAITYPE'>0 ;ft 9/19/94
S RAITYPE=$P($G(^RA(79.2,RAITYPE,0)),"^")
I RAITYPE']""!('$D(^TMP($J,"RA I-TYPE",RAITYPE))) Q
S RAITYPE=$S(RAITYPE]"":RAITYPE,1:"Unknown")
S RANME=$G(^DPT(RADFN,0)),RANME=$S(RANME]"":$P(RANME,"^"),1:"Unknown")
S RANME=$E(RANME,1,23),RASSN=$$SSN^RAUTL,RACNI=0
F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D
. S RAEX(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RAEX(0)']""
. I $P(RAEX(0),"^",3)>0 D
.. ; Tab Examination data (total & site specific)
.. S ^TMP($J,"RAEXAM")=+$G(^TMP($J,"RAEXAM"))+1
.. S ^TMP($J,"RAEXAM",RADIV)=+$G(^TMP($J,"RAEXAM",RADIV))+1
.. S ^TMP($J,"RAEXAM",RADIV,RAITYPE)=+$G(^TMP($J,"RAEXAM",RADIV,RAITYPE))+1
.. I $P(RAEX(0),"^",10)]"",("Yy"[$P(RAEX(0),"^",10)) D
.. S ^TMP($J,"RACNTU")=+$G(^TMP($J,"RACNTU"))+1
.. S ^TMP($J,"RACNTU",RADIV)=+$G(^TMP($J,"RACNTU",RADIV))+1
.. S ^TMP($J,"RACNTU",RADIV,RAITYPE)=+$G(^TMP($J,"RACNTU",RADIV,RAITYPE))+1
.. Q
. I $D(^RA(78.1,+$P(RAEX(0),"^",16),0)),(RACMP'=+$P(RAEX(0),"^",16)) D
.. S RACOMP=$G(^RA(78.1,+$P(RAEX(0),"^",16),0))
.. ; Tab Complication data (total & site specific)
.. S ^TMP($J,"RACOMP")=+$G(^TMP($J,"RACOMP"))+1
.. S ^TMP($J,"RACOMP",RADIV)=+$G(^TMP($J,"RACOMP",RADIV))+1
.. S ^TMP($J,"RACOMP",RADIV,RAITYPE)=+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))+1
.. I $P(RACOMP,"^",2)]"",("Yy"[$P(RACOMP,"^",2)) D
... S ^TMP($J,"RACMRE")=+$G(^TMP($J,"RACMRE"))+1
... S ^TMP($J,"RACMRE",RADIV)=+$G(^TMP($J,"RACMRE",RADIV))+1
... S ^TMP($J,"RACMRE",RADIV,RAITYPE)=+$G(^TMP($J,"RACMRE",RADIV,RAITYPE))+1
... Q
.. D SET^RACMP
.. Q
. Q
Q
SYNOP ; Final synopsis of data presented to the user.
N A,B S A=""
F S A=$O(^TMP($J,"RACMP",A)) Q:A']"" D Q:RAXIT
. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
. W !!?10,"Division: ",$P($G(^DIC(4,A,0)),U),!?3,"Imaging Type(s): " S B=""
. F S B=$O(^TMP($J,"RACMP",A,B)) Q:B']"" D Q:RAXIT
.. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
.. W:$X>(IOM-25) !?($X+$L("Imaging Type(s): ")+3) W B,?($X+3)
.. Q
. Q
Q:RAXIT
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
W !!!?5,"Totals for all Divisions:"
W !!,"Complications: ",+$G(^TMP($J,"RACOMP"))
W " Exams: ",+$G(^TMP($J,"RAEXAM"))," % Complications: "
I +$G(^TMP($J,"RAEXAM"))=0 W "0"
E W $J((+$G(^TMP($J,"RACOMP"))/+$G(^TMP($J,"RAEXAM")))*100,6,2)
W !,"Contrast Media Comp.: ",+$G(^TMP($J,"RACMRE"))
W " C.M. Exams: ",+$G(^TMP($J,"RACOMP"))
W " % C.M. Comp.: "
I +$G(^TMP($J,"RACOMP"))=0 W "0"
E W $J((+$G(^TMP($J,"RACMRE"))/+$G(^TMP($J,"RACOMP")))*100,6,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRACMP2 4010 printed Dec 13, 2024@02:34:07 Page 2
RACMP2 ;HISC/GJC-Complication Report (Part 3 of 3) ;7/17/96 14:06
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+1 if RAPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
SET RAPG=RAPG+1
+2 WRITE !?10,RAHDR(1)
+3 if '($DATA(RADIV("X"))#2)
SET RADIV("X")=$SELECT($GET(^DIC(4,RADIV,0))]"":$PIECE(^(0),"^"),1:"")
+4 if '$DATA(RAFLG)
WRITE !?4,"Division: ",$SELECT(RADIV("X")]"":RADIV("X"),1:"Unknown")
+5 if $DATA(RAFLG)
WRITE !?4,"Division: "
+6 WRITE ?RATAB(6),"Page: ",RAPG
+7 if '$DATA(RAFLG)
WRITE !,"Imaging Type: ",$SELECT(RAITYPE]"":RAITYPE,1:"Unknown")
+8 if $DATA(RAFLG)
WRITE !,"Imaging Type: "
+9 WRITE ?RATAB(6),"Date: ",RATDY
+10 WRITE !?6,RAHDR(2),!,RALN
+11 ; If 132 column
IF IOM=132
Begin DoDot:1
+12 WRITE !,"Name",?RATAB(2),"Pt ID",?RATAB(3),"Date/Time"
+13 WRITE ?RATAB(4),"Procedure/Complication",?RATAB(5),"Personnel"
+14 WRITE !,RALN
+15 QUIT
End DoDot:1
+16 ; default to 80 column format
IF '$TEST
Begin DoDot:1
+17 WRITE !,"Name/Pt-Id",?RATAB(3),"Date/Time"
+18 WRITE ?RATAB(4),"Procedure/Complication"
+19 WRITE !?RATAB(1),"Personnel",!,RALN
+20 QUIT
End DoDot:1
+21 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
+22 QUIT
SORT ; Obtain data
+1 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
if RAXIT
QUIT
+2 ; Registered Exam data missing
if '$DATA(^RADPT(RADFN,"DT",RADTI,0))
QUIT
+3 SET RARE(0)=$GET(^RADPT(RADFN,"DT",RADTI,0))
SET RADIV("I")=+$PIECE(RARE(0),"^",3)
+4 SET RADIV("X")=$SELECT($GET(^DIC(4,RADIV("I"),0))]"":$PIECE(^(0),"^"),1:"Unknown")
+5 IF RADIV("X")']""!('$DATA(^TMP($JOB,"RA D-TYPE",RADIV("X"))))
QUIT
+6 ;ft 9/19/94
SET RADIV=RADIV("I")
SET RAITYPE=+$PIECE(RARE(0),"^",2)
if RAITYPE'>0
QUIT
+7 SET RAITYPE=$PIECE($GET(^RA(79.2,RAITYPE,0)),"^")
+8 IF RAITYPE']""!('$DATA(^TMP($JOB,"RA I-TYPE",RAITYPE)))
QUIT
+9 SET RAITYPE=$SELECT(RAITYPE]"":RAITYPE,1:"Unknown")
+10 SET RANME=$GET(^DPT(RADFN,0))
SET RANME=$SELECT(RANME]"":$PIECE(RANME,"^"),1:"Unknown")
+11 SET RANME=$EXTRACT(RANME,1,23)
SET RASSN=$$SSN^RAUTL
SET RACNI=0
+12 FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if 'RACNI
QUIT
Begin DoDot:1
+13 SET RAEX(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
if RAEX(0)']""
QUIT
+14 IF $PIECE(RAEX(0),"^",3)>0
Begin DoDot:2
+15 ; Tab Examination data (total & site specific)
+16 SET ^TMP($JOB,"RAEXAM")=+$GET(^TMP($JOB,"RAEXAM"))+1
+17 SET ^TMP($JOB,"RAEXAM",RADIV)=+$GET(^TMP($JOB,"RAEXAM",RADIV))+1
+18 SET ^TMP($JOB,"RAEXAM",RADIV,RAITYPE)=+$GET(^TMP($JOB,"RAEXAM",RADIV,RAITYPE))+1
+19 IF $PIECE(RAEX(0),"^",10)]""
IF ("Yy"[$PIECE(RAEX(0),"^",10))
Begin DoDot:3
End DoDot:3
+20 SET ^TMP($JOB,"RACNTU")=+$GET(^TMP($JOB,"RACNTU"))+1
+21 SET ^TMP($JOB,"RACNTU",RADIV)=+$GET(^TMP($JOB,"RACNTU",RADIV))+1
+22 SET ^TMP($JOB,"RACNTU",RADIV,RAITYPE)=+$GET(^TMP($JOB,"RACNTU",RADIV,RAITYPE))+1
+23 QUIT
End DoDot:2
+24 IF $DATA(^RA(78.1,+$PIECE(RAEX(0),"^",16),0))
IF (RACMP'=+$PIECE(RAEX(0),"^",16))
Begin DoDot:2
+25 SET RACOMP=$GET(^RA(78.1,+$PIECE(RAEX(0),"^",16),0))
+26 ; Tab Complication data (total & site specific)
+27 SET ^TMP($JOB,"RACOMP")=+$GET(^TMP($JOB,"RACOMP"))+1
+28 SET ^TMP($JOB,"RACOMP",RADIV)=+$GET(^TMP($JOB,"RACOMP",RADIV))+1
+29 SET ^TMP($JOB,"RACOMP",RADIV,RAITYPE)=+$GET(^TMP($JOB,"RACOMP",RADIV,RAITYPE))+1
+30 IF $PIECE(RACOMP,"^",2)]""
IF ("Yy"[$PIECE(RACOMP,"^",2))
Begin DoDot:3
+31 SET ^TMP($JOB,"RACMRE")=+$GET(^TMP($JOB,"RACMRE"))+1
+32 SET ^TMP($JOB,"RACMRE",RADIV)=+$GET(^TMP($JOB,"RACMRE",RADIV))+1
+33 SET ^TMP($JOB,"RACMRE",RADIV,RAITYPE)=+$GET(^TMP($JOB,"RACMRE",RADIV,RAITYPE))+1
+34 QUIT
End DoDot:3
+35 DO SET^RACMP
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 QUIT
SYNOP ; Final synopsis of data presented to the user.
+1 NEW A,B
SET A=""
+2 FOR
SET A=$ORDER(^TMP($JOB,"RACMP",A))
if A']""
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HEADER^RACMP2
if RAXIT
QUIT
+4 WRITE !!?10,"Division: ",$PIECE($GET(^DIC(4,A,0)),U),!?3,"Imaging Type(s): "
SET B=""
+5 FOR
SET B=$ORDER(^TMP($JOB,"RACMP",A,B))
if B']""
QUIT
Begin DoDot:2
+6 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HEADER^RACMP2
if RAXIT
QUIT
+7 if $X>(IOM-25)
WRITE !?($X+$LENGTH("Imaging Type(s): ")+3)
WRITE B,?($X+3)
+8 QUIT
End DoDot:2
if RAXIT
QUIT
+9 QUIT
End DoDot:1
if RAXIT
QUIT
+10 if RAXIT
QUIT
+11 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HEADER^RACMP2
if RAXIT
QUIT
+12 WRITE !!!?5,"Totals for all Divisions:"
+13 WRITE !!,"Complications: ",+$GET(^TMP($JOB,"RACOMP"))
+14 WRITE " Exams: ",+$GET(^TMP($JOB,"RAEXAM"))," % Complications: "
+15 IF +$GET(^TMP($JOB,"RAEXAM"))=0
WRITE "0"
+16 IF '$TEST
WRITE $JUSTIFY((+$GET(^TMP($JOB,"RACOMP"))/+$GET(^TMP($JOB,"RAEXAM")))*100,6,2)
+17 WRITE !,"Contrast Media Comp.: ",+$GET(^TMP($JOB,"RACMRE"))
+18 WRITE " C.M. Exams: ",+$GET(^TMP($JOB,"RACOMP"))
+19 WRITE " % C.M. Comp.: "
+20 IF +$GET(^TMP($JOB,"RACOMP"))=0
WRITE "0"
+21 IF '$TEST
WRITE $JUSTIFY((+$GET(^TMP($JOB,"RACMRE"))/+$GET(^TMP($JOB,"RACOMP")))*100,6,2)
+22 QUIT
