- 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 Feb 19, 2025@00:00:23 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