source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACMP1.m@ 1769

RACMP1 ;HISC/GJC-Complication Report (Part 2 of 3) ;4/16/96  10:50

 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

PRINT ; Output subroutine part one

 N I,J,RADATE,RAINVDT,RALBL,RALN1,RATECH

 S RA1="",RALBL="Description: ",RALN1=$TR(RALN,$E(RALN),"=")

 F  S RA1=$O(^TMP($J,"RACMP",RA1)) Q:RA1']""  D  Q:RAXIT

 . S RADIV=RA1,RADIV("X")=$P($G(^DIC(4,RADIV,0)),"^"),RA2=""

 . F  S RA2=$O(^TMP($J,"RACMP",RA1,RA2)) Q:RA2']""  D  Q:RAXIT

 .. S RAITYPE=RA2,RA3=""

 .. F  S RA3=$O(^TMP($J,"RACMP",RA1,RA2,RA3)) Q:RA3']""  D  Q:RAXIT

 ... S RA4=0

 ... F  S RA4=$O(^TMP($J,"RACMP",RA1,RA2,RA3,RA4)) Q:'RA4  D  Q:RAXIT

 .... S RA5=0

 .... F  S RA5=$O(^TMP($J,"RACMP",RA1,RA2,RA3,RA4,RA5)) Q:'RA5  D  Q:RAXIT

 ..... S RA0=$G(^TMP($J,"RACMP",RA1,RA2,RA3,RA4,RA5))

 ..... D:RA0]"" PRT1

 ..... Q

 .... Q

 ... Q

 .. D:'RAXIT IMGCHK

 .. Q

 . D:'RAXIT DIVCHK

 . Q

 Q

PRT1 ; Output subroutine two

 F I=1:1:9 D

 . S @$P("RAPRC^RATME^RAPHY^RARES^RASTF^RACMPTX^RACOMP^RASSN^RADFN","^",I)=$P(RA0,"^",I)

 . Q

 S RADATE=$$FMTE^XLFDT(RA4,"2D"),RAINVDT=9999999.9999-RADATE

 I $Y>(IOSL-4) D  Q:RAXIT

 . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2

 . Q

 I IOM=132 D

 . W !,RA3,?RATAB(2),RASSN,?RATAB(3),RADATE,?RATAB(4),RAPRC

 . W ?RATAB(5),"Physician: ",RAPHY,!?RATAB(3),RATME,?RATAB(4),RACOMP

 . W ?RATAB(5),"Interpreting Res. : ",RARES

 . W !?RATAB(5),"Interpreting Stf. : ",RASTF

 . I +$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",0)) S I=0 D  Q:RAXIT

 .. F  S I=$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I)) Q:'I  D  Q:RAXIT

 ... S J=$G(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I,0))

 ... S RATECH=$E($P($G(^VA(200,+J,0)),"^"),1,20)

 ... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2

 ... W:'RAXIT !?RATAB(5),"Tech: ",RATECH

 ... Q

 .. Q

 . W:'RAXIT !,RALBL,RACMPTX,!,RALN1

 . Q

 E  D  ; Assume 80

 . W !,RA3,?RATAB(3),RADATE,?RATAB(4),RAPRC,!,RASSN,?RATAB(3),RATME

 . W ?RATAB(4),RACOMP

 . W !?RATAB(1),"Physician: ",RAPHY

 . W !?RATAB(1),"Interpreting Res. : ",RARES

 . W !?RATAB(1),"Interpreting Stf. : ",RASTF

 . I +$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",0)) S I=0 D

 .. F  S I=$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I)) Q:'I  S J=^(0) D

 ... S RATECH=$E($P($G(^VA(200,+J,0)),"^"),1,20)

 ... W !?RATAB(1),"Tech: ",RATECH

 ... Q

 .. Q

 . W !,RALBL,$E(RACMPTX,1,65)

 . W:$E(RALBL,66,100)]"" !?$L(RALBL),$E(RALBL,66,100) W !,RALN1

 . Q

 Q

DIVCHK ; Output statistics within division, check for EOS on division

 N RA6

 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT

 W !!?5,"Division: "_RADIV("X")

 W !,"Complications: ",+$G(^TMP($J,"RACOMP",RADIV))

 W "   Exams: ",+$G(^TMP($J,"RAEXAM",RADIV)),"   % Complications: "

 I +$G(^TMP($J,"RAEXAM",RADIV))=0 W "0"

 E  W $J((+$G(^TMP($J,"RACOMP",RADIV))/+$G(^TMP($J,"RAEXAM",RADIV)))*100,6,2)

 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT

 W !,"Contrast Media Complications: ",+$G(^TMP($J,"RACMRE",RADIV))

 W "   C.M. Exams: ",+$G(^TMP($J,"RACOMP",RADIV))

 W "   % C.M. Comp.: "

 I +$G(^TMP($J,"RACOMP",RADIV))=0 W "0"

 E  W $J((+$G(^TMP($J,"RACMRE",RADIV))/+$G(^TMP($J,"RACOMP",RADIV)))*100,6,2)

 S RA6=+$O(^TMP($J,"RACMP",RA1))

 I RA6 S RADIV=RA6,RADIV("X")=$P($G(^DIC(4,RADIV,0)),"^") D

 . N RA7 S RA7=$O(^TMP($J,"RACMP",RADIV,"")) S:RA7]"" RAITYPE=RA7

 . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2

 . Q

 Q

IMGCHK ; Check for EOS on I-Type

 N RA10

 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT

 W !,"Complications: ",+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))

 W "   Exams: ",+$G(^TMP($J,"RAEXAM",RADIV,RAITYPE))

 W "   % Complications: "

 I +$G(^TMP($J,"RAEXAM",RADIV,RAITYPE))=0 W "0"

 E  W $J((+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))/+$G(^TMP($J,"RAEXAM",RADIV,RAITYPE)))*100,6,2)

 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT

 W !,"Contrast Media Complications: ",+$G(^TMP($J,"RACMRE",RADIV,RAITYPE))

 W "   C.M. Exams: ",+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))

 W "   % C.M. Comp.: "

 I +$G(^TMP($J,"RACOMP",RADIV,RAITYPE))=0 W "0"

 E  W $J((+$G(^TMP($J,"RACMRE",RADIV,RAITYPE))/+$G(^TMP($J,"RACOMP",RADIV,RAITYPE)))*100,6,2)

 S RA10=$O(^TMP($J,"RACMP",RA1,RA2))

 I RA10]"" S RAITYPE=RA10 D

 . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2

 . Q

 Q