| 1 | RARTR2 ;HIRMFO/GJC-Queue/print Radiology Reports (utility) ;3/11/96
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**15,27**;Mar 16, 1998
|
|---|
| 3 | SETDIV ;get division params
|
|---|
| 4 | S RAMDV="" N RADTI,RACNI,RADTE,RACN,RADATE,Y,RADFN
|
|---|
| 5 | S Y=RARPT D RASET^RAUTL2 S LOC=$P(^RADPT(RADFN,"DT",RADTI,0),U,4)
|
|---|
| 6 | I 'LOC Q
|
|---|
| 7 | S DIV=$O(^RA(79,"AL",LOC,0)) I 'DIV Q
|
|---|
| 8 | 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)_"^"
|
|---|
| 9 | Q
|
|---|
| 10 | WRITE ; Write out Report Text, Impression Text, Clinical History and
|
|---|
| 11 | ; Additional Clinical History on report.
|
|---|
| 12 | K RAXX S RAV=0
|
|---|
| 13 | ; Get Additional Clinical History, Report Text and Impression text
|
|---|
| 14 | ; from file 74
|
|---|
| 15 | I RAP="AH"!(RAP="R")!(RAP="I") D
|
|---|
| 16 | . S ZRAP=$S(RAP="AH":"H",1:RAP)
|
|---|
| 17 | . 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
|
|---|
| 18 | ; Get Clinical History from file 70
|
|---|
| 19 | I RAP="H" D
|
|---|
| 20 | . 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
|
|---|
| 21 | D ^DIWW:$D(RAXX)
|
|---|
| 22 | Q
|
|---|
| 23 | FOOT ; footer
|
|---|
| 24 | Q:$D(RAUTOE) ; quit if e-mail
|
|---|
| 25 | I RAFOOT,(IOST'["P-MESSAGE") F I=0:0 Q:($Y+RAFOOT+5)>IOSL W !
|
|---|
| 26 | I IOST["P-MESSAGE" W !!!!!
|
|---|
| 27 | I RAFOOT S RAIOF=RAFFLF,RAFFLF="!",RAFMT=RAFTFM D PRT^RAFLH S RAFFLF=RAIOF
|
|---|
| 28 | I IOST'["P-MESSAGE" F I=0:0 Q:($Y+4)>IOSL W !
|
|---|
| 29 | W !,"VAF 10-9034 VICE SF 519B RADIOLOGY/NUCLEAR MEDICINE REPORT"
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | BANNER ;Report Batch Header/Trailer Page
|
|---|
| 33 | 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
|
|---|
| 34 | F I=1:1:10 W !,F1," ",RARTMES," ",F2
|
|---|
| 35 | W !!?((IOM-30)/2),"Printed at " S X="NOW",%DT="TX" D ^%DT,D^RAUTL W Y
|
|---|
| 36 | F I=1:1 Q:($Y+12)>IOSL W !
|
|---|
| 37 | F I=1:1 Q:($Y+2)>IOSL W !,F1," ",RARTMES," ",F2
|
|---|
| 38 | K F1,F2 Q
|
|---|
| 39 | HANG ; end-of-page prompt
|
|---|
| 40 | Q:$D(RAUTOE) ; quit if e-mail
|
|---|
| 41 | I $E(IOST,1,2)="C-" S DIR(0)="E" W ! D ^DIR K DIR S:$D(DIRUT) RAOOUT=1 W @RAFFLF
|
|---|
| 42 | Q
|
|---|
| 43 | SET ; Set up our TMP global for mailman
|
|---|
| 44 | N DIWF,DIWL,DIWR,RAX,X,RAPX S RAX=0
|
|---|
| 45 | S DIWF="",DIWL=5,DIWR=70 K ^UTILITY($J,"W")
|
|---|
| 46 | ; Get Additional Clinical History, Report Text and Impression text
|
|---|
| 47 | ; from file 74
|
|---|
| 48 | I RAP="AH"!(RAP="R")!(RAP="I") D
|
|---|
| 49 | . S RAPX=$S(RAP="AH":"H",1:RAP)
|
|---|
| 50 | . F S RAX=$O(^RARPT(RARPT,RAPX,RAX)) Q:RAX'>0 D
|
|---|
| 51 | . . S X=$G(^RARPT(RARPT,RAPX,RAX,0)) D ^DIWP
|
|---|
| 52 | . Q
|
|---|
| 53 | ; Get Clinical History from file 70
|
|---|
| 54 | I RAP="H" D
|
|---|
| 55 | . F S RAX=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX)) Q:RAX'>0 D
|
|---|
| 56 | . . S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX,0)) D ^DIWP
|
|---|
| 57 | . Q
|
|---|
| 58 | S RAX=0 F S RAX=$O(^UTILITY($J,"W",DIWL,RAX)) Q:RAX'>0 D
|
|---|
| 59 | . S X=$G(^UTILITY($J,"W",DIWL,RAX,0))
|
|---|
| 60 | . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_X
|
|---|
| 61 | . Q
|
|---|
| 62 | S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
|
|---|
| 63 | Q
|
|---|
| 64 | AMENRPT() ; Pass the text, '*** THIS IS AN AMENDED REPORT ***'.
|
|---|
| 65 | Q "*** THIS IS AN AMENDED REPORT ***"
|
|---|
