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

RARTR2.m

Go to the documentation of this file.
  1. RARTR2 ;HIRMFO/GJC-Queue/print Radiology Reports (utility) ;3/11/96
  1. ;;5.0;Radiology/Nuclear Medicine;**15,27**;Mar 16, 1998
  1. SETDIV ;get division params
  1. S RAMDV="" N RADTI,RACNI,RADTE,RACN,RADATE,Y,RADFN
  1. S Y=RARPT D RASET^RAUTL2 S LOC=$P(^RADPT(RADFN,"DT",RADTI,0),U,4)
  1. I 'LOC Q
  1. S DIV=$O(^RA(79,"AL",LOC,0)) I 'DIV Q
  1. S RAMDIV=DIV,Y=$S($D(^RA(79,DIV,.1)):^(.1),1:""),RAMDV="" F I=1:1 Q:$P(Y,"^",I,99)']"" S RAMDV=RAMDV_$S($P(Y,"^",I)="Y"!($P(Y,"^",I)="y"):1,1:0)_"^"
  1. Q
  1. WRITE ; Write out Report Text, Impression Text, Clinical History and
  1. ; Additional Clinical History on report.
  1. K RAXX S RAV=0
  1. ; Get Additional Clinical History, Report Text and Impression text
  1. ; from file 74
  1. I RAP="AH"!(RAP="R")!(RAP="I") D
  1. . S ZRAP=$S(RAP="AH":"H",1:RAP)
  1. . F S RAV=$O(^RARPT(RARPT,ZRAP,RAV)) Q:RAV'>0!($D(RAOOUT)) S RAXX=^(RAV,0) D HANG:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL S X=RAXX D ^DIWP
  1. ; Get Clinical History from file 70
  1. I RAP="H" D
  1. . F S RAV=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV)) Q:RAV'>0!($D(RAOOUT)) S RAXX=^(RAV,0) D HANG:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL S X=RAXX D ^DIWP
  1. D ^DIWW:$D(RAXX)
  1. Q
  1. Q:$D(RAUTOE) ; quit if e-mail
  1. I RAFOOT,(IOST'["P-MESSAGE") F I=0:0 Q:($Y+RAFOOT+5)>IOSL W !
  1. I IOST["P-MESSAGE" W !!!!!
  1. I RAFOOT S RAIOF=RAFFLF,RAFFLF="!",RAFMT=RAFTFM D PRT^RAFLH S RAFFLF=RAIOF
  1. I IOST'["P-MESSAGE" F I=0:0 Q:($Y+4)>IOSL W !
  1. W !,"VAF 10-9034 VICE SF 519B RADIOLOGY/NUCLEAR MEDICINE REPORT"
  1. Q
  1. ;
  1. Q:'$D(RARTMES)!($D(RAUTOE)) S $P(F1,">",((IOM-$L(RARTMES))/2))="",$P(F2,"<",((IOM-$L(RARTMES))/2))="" U IO S RAFFLF=$S($D(RAFFLF):RAFFLF,1:"#") W @RAFFLF
  1. F I=1:1:10 W !,F1," ",RARTMES," ",F2
  1. W !!?((IOM-30)/2),"Printed at " S X="NOW",%DT="TX" D ^%DT,D^RAUTL W Y
  1. F I=1:1 Q:($Y+12)>IOSL W !
  1. F I=1:1 Q:($Y+2)>IOSL W !,F1," ",RARTMES," ",F2
  1. K F1,F2 Q
  1. HANG ; end-of-page prompt
  1. Q:$D(RAUTOE) ; quit if e-mail
  1. I $E(IOST,1,2)="C-" S DIR(0)="E" W ! D ^DIR K DIR S:$D(DIRUT) RAOOUT=1 W @RAFFLF
  1. Q
  1. SET ; Set up our TMP global for mailman
  1. N DIWF,DIWL,DIWR,RAX,X,RAPX S RAX=0
  1. S DIWF="",DIWL=5,DIWR=70 K ^UTILITY($J,"W")
  1. ; Get Additional Clinical History, Report Text and Impression text
  1. ; from file 74
  1. I RAP="AH"!(RAP="R")!(RAP="I") D
  1. . S RAPX=$S(RAP="AH":"H",1:RAP)
  1. . F S RAX=$O(^RARPT(RARPT,RAPX,RAX)) Q:RAX'>0 D
  1. . . S X=$G(^RARPT(RARPT,RAPX,RAX,0)) D ^DIWP
  1. . Q
  1. ; Get Clinical History from file 70
  1. I RAP="H" D
  1. . F S RAX=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX)) Q:RAX'>0 D
  1. . . S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX,0)) D ^DIWP
  1. . Q
  1. S RAX=0 F S RAX=$O(^UTILITY($J,"W",DIWL,RAX)) Q:RAX'>0 D
  1. . S X=$G(^UTILITY($J,"W",DIWL,RAX,0))
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_X
  1. . Q
  1. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. Q
  1. AMENRPT() ; Pass the text, '*** THIS IS AN AMENDED REPORT ***'.
  1. Q "*** THIS IS AN AMENDED REPORT ***"