Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RACMP1

RACMP1.m

Go to the documentation of this file.
  1. RACMP1 ;HISC/GJC,RVD-Complication Report (Part 2 of 3) ;05/13/09 11:08
  1. ;;5.0;Radiology/Nuclear Medicine;**99**;Mar 16, 1998;Build 5
  1. ;Supported IA #10103 reference to ^XLFDT
  1. ;Supported IA #2056 reference to ^DIQ
  1. ;Supported IA #10060 reference to ^VA(200
  1. PRINT ; Output subroutine part one
  1. N I,J,RADATE,RAINVDT,RALBL,RALN1,RATECH
  1. S RA1="",RALBL="Description: ",RALN1=$TR(RALN,$E(RALN),"=")
  1. F S RA1=$O(^TMP($J,"RACMP",RA1)) Q:RA1']"" D Q:RAXIT
  1. . S RADIV=RA1,RADIV("X")=$P($G(^DIC(4,RADIV,0)),"^"),RA2=""
  1. . F S RA2=$O(^TMP($J,"RACMP",RA1,RA2)) Q:RA2']"" D Q:RAXIT
  1. .. S RAITYPE=RA2,RA3=""
  1. .. F S RA3=$O(^TMP($J,"RACMP",RA1,RA2,RA3)) Q:RA3']"" D Q:RAXIT
  1. ... S RA4=0
  1. ... F S RA4=$O(^TMP($J,"RACMP",RA1,RA2,RA3,RA4)) Q:'RA4 D Q:RAXIT
  1. .... S RA5=0
  1. .... F S RA5=$O(^TMP($J,"RACMP",RA1,RA2,RA3,RA4,RA5)) Q:'RA5 D Q:RAXIT
  1. ..... S RA0=$G(^TMP($J,"RACMP",RA1,RA2,RA3,RA4,RA5))
  1. ..... D:RA0]"" PRT1
  1. ..... Q
  1. .... Q
  1. ... Q
  1. .. D:'RAXIT IMGCHK
  1. .. Q
  1. . D:'RAXIT DIVCHK
  1. . Q
  1. Q
  1. PRT1 ; Output subroutine two
  1. F I=1:1:9 D
  1. . S @$P("RAPRC^RATME^RAPHY^RARES^RASTF^RACMPTX^RACOMP^RASSN^RADFN","^",I)=$P(RA0,"^",I)
  1. . Q
  1. S RADATE=$$FMTE^XLFDT(RA4,"2D"),RAINVDT=9999999.9999-RA4
  1. I $Y>(IOSL-4) D Q:RAXIT
  1. . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
  1. . Q
  1. I IOM=132 D
  1. . W !,RA3,?RATAB(2),RASSN,?RATAB(3),RADATE,?RATAB(4),RAPRC
  1. . W ?RATAB(5),"Physician: ",RAPHY,!?RATAB(3),RATME,?RATAB(4),RACOMP
  1. . W ?RATAB(5),"Interpreting Res. : ",RARES
  1. . W !?RATAB(5),"Staff Imaging Phys. : ",RASTF
  1. . I +$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",0)) S I=0 D Q:RAXIT
  1. .. F S I=$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I)) Q:'I D Q:RAXIT
  1. ... S J=$G(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I,0))
  1. ... S RATECH=$E($P($G(^VA(200,+J,0)),"^"),1,20)
  1. ... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
  1. ... W:'RAXIT !?RATAB(5),"Tech: ",RATECH
  1. ... Q
  1. .. Q
  1. . D PRSC
  1. . W:'RAXIT !,RALBL,RACMPTX,!,RALN1
  1. . Q
  1. E D ; Assume 80
  1. . W !,RA3,?RATAB(3),RADATE,?RATAB(4),RAPRC,!,RASSN,?RATAB(3),RATME
  1. . W ?RATAB(4),RACOMP
  1. . W !?RATAB(1),"Physician: ",RAPHY
  1. . W !?RATAB(1),"Interpreting Res. : ",RARES
  1. . W !?RATAB(1),"Staff Imaging Phys. : ",RASTF
  1. . I +$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",0)) S I=0 D
  1. .. F S I=$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I)) Q:'I S J=^(I,0) D
  1. ... S RATECH=$E($P($G(^VA(200,+J,0)),"^"),1,20)
  1. ... W !?RATAB(1),"Tech: ",RATECH
  1. ... Q
  1. .. Q
  1. . D PRSC
  1. . W !,RALBL,$E(RACMPTX,1,65)
  1. . W:$E(RALBL,66,100)]"" !?$L(RALBL),$E(RALBL,66,100) W !,RALN1
  1. . Q
  1. Q
  1. PRSC ;DISPLAY pregnancy screen and comment, patch 99
  1. I $$PTSEX^RAUTL8(RADFN)="F" D
  1. .N RAOR751 S RAOR751=$P($G(^RADPT(RADFN,"DT",$G(RAINVDT),"P",$G(RA5),0)),U,11)
  1. .W !,"Pregnant at time of order entry: ",$$GET1^DIQ(75.1,$G(RAOR751)_",",13)
  1. .N R3,RAPCOMM S R3=$G(^RADPT(RADFN,"DT",$G(RAINVDT),"P",$G(RA5),0))
  1. .S RAPCOMM=$G(^RADPT(RADFN,"DT",+$G(RAINVDT),"P",+$G(RA5),"PCOMM"))
  1. .W:$P(R3,U,32)'="" !,"Pregnancy Screen: ",$S($P(R3,"^",32)="y":"Patient answered yes",$P(R3,"^",32)="n":"Patient answered no",$P(R3,"^",32)="u":"Patient is unable to answer or is unsure",1:"")
  1. .W:$P(R3,U,32)'="n"&$L(RAPCOMM) !,"Pregnancy Screen Comment: ",RAPCOMM
  1. Q
  1. ;
  1. DIVCHK ; Output statistics within division, check for EOS on division
  1. N RA6
  1. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
  1. W !!?5,"Division: "_RADIV("X")
  1. W !,"Complications: ",+$G(^TMP($J,"RACOMP",RADIV))
  1. W " Exams: ",+$G(^TMP($J,"RAEXAM",RADIV))," % Complications: "
  1. I +$G(^TMP($J,"RAEXAM",RADIV))=0 W "0"
  1. E W $J((+$G(^TMP($J,"RACOMP",RADIV))/+$G(^TMP($J,"RAEXAM",RADIV)))*100,6,2)
  1. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
  1. W !,"Contrast Media Complications: ",+$G(^TMP($J,"RACMRE",RADIV))
  1. W " C.M. Exams: ",+$G(^TMP($J,"RACOMP",RADIV))
  1. W " % C.M. Comp.: "
  1. I +$G(^TMP($J,"RACOMP",RADIV))=0 W "0"
  1. E W $J((+$G(^TMP($J,"RACMRE",RADIV))/+$G(^TMP($J,"RACOMP",RADIV)))*100,6,2)
  1. S RA6=+$O(^TMP($J,"RACMP",RA1))
  1. I RA6 S RADIV=RA6,RADIV("X")=$P($G(^DIC(4,RADIV,0)),"^") D
  1. . N RA7 S RA7=$O(^TMP($J,"RACMP",RADIV,"")) S:RA7]"" RAITYPE=RA7
  1. . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
  1. . Q
  1. Q
  1. IMGCHK ; Check for EOS on I-Type
  1. N RA10
  1. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
  1. W !,"Complications: ",+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))
  1. W " Exams: ",+$G(^TMP($J,"RAEXAM",RADIV,RAITYPE))
  1. W " % Complications: "
  1. I +$G(^TMP($J,"RAEXAM",RADIV,RAITYPE))=0 W "0"
  1. E W $J((+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))/+$G(^TMP($J,"RAEXAM",RADIV,RAITYPE)))*100,6,2)
  1. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
  1. W !,"Contrast Media Complications: ",+$G(^TMP($J,"RACMRE",RADIV,RAITYPE))
  1. W " C.M. Exams: ",+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))
  1. W " % C.M. Comp.: "
  1. I +$G(^TMP($J,"RACOMP",RADIV,RAITYPE))=0 W "0"
  1. E W $J((+$G(^TMP($J,"RACMRE",RADIV,RAITYPE))/+$G(^TMP($J,"RACOMP",RADIV,RAITYPE)))*100,6,2)
  1. S RA10=$O(^TMP($J,"RACMP",RA1,RA2))
  1. I RA10]"" S RAITYPE=RA10 D
  1. . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
  1. . Q
  1. Q