source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR2.m@ 1763

Last change on this file since 1763 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1RARTR2 ;HIRMFO/GJC-Queue/print Radiology Reports (utility) ;3/11/96
2 ;;5.0;Radiology/Nuclear Medicine;**15,27**;Mar 16, 1998
3SETDIV ;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
10WRITE ; 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
23FOOT ; 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 ;
32BANNER ;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
39HANG ; 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
43SET ; 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
64AMENRPT() ; Pass the text, '*** THIS IS AN AMENDED REPORT ***'.
65 Q "*** THIS IS AN AMENDED REPORT ***"
Note: See TracBrowser for help on using the repository browser.