- RARTR2 ;HIRMFO/GJC-Queue/print Radiology Reports (utility) ;3/11/96
- ;;5.0;Radiology/Nuclear Medicine;**15,27**;Mar 16, 1998
- SETDIV ;get division params
- S RAMDV="" N RADTI,RACNI,RADTE,RACN,RADATE,Y,RADFN
- S Y=RARPT D RASET^RAUTL2 S LOC=$P(^RADPT(RADFN,"DT",RADTI,0),U,4)
- I 'LOC Q
- S DIV=$O(^RA(79,"AL",LOC,0)) I 'DIV Q
- 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)_"^"
- Q
- WRITE ; Write out Report Text, Impression Text, Clinical History and
- ; Additional Clinical History on report.
- K RAXX S RAV=0
- ; Get Additional Clinical History, Report Text and Impression text
- ; from file 74
- I RAP="AH"!(RAP="R")!(RAP="I") D
- . S ZRAP=$S(RAP="AH":"H",1:RAP)
- . 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
- ; Get Clinical History from file 70
- I RAP="H" D
- . 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
- D ^DIWW:$D(RAXX)
- Q
- Q:$D(RAUTOE) ; quit if e-mail
- I RAFOOT,(IOST'["P-MESSAGE") F I=0:0 Q:($Y+RAFOOT+5)>IOSL W !
- I IOST["P-MESSAGE" W !!!!!
- I RAFOOT S RAIOF=RAFFLF,RAFFLF="!",RAFMT=RAFTFM D PRT^RAFLH S RAFFLF=RAIOF
- I IOST'["P-MESSAGE" F I=0:0 Q:($Y+4)>IOSL W !
- W !,"VAF 10-9034 VICE SF 519B RADIOLOGY/NUCLEAR MEDICINE REPORT"
- Q
- ;
- BANNER ;Report Batch Header/Trailer Page
- 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
- F I=1:1:10 W !,F1," ",RARTMES," ",F2
- W !!?((IOM-30)/2),"Printed at " S X="NOW",%DT="TX" D ^%DT,D^RAUTL W Y
- F I=1:1 Q:($Y+12)>IOSL W !
- F I=1:1 Q:($Y+2)>IOSL W !,F1," ",RARTMES," ",F2
- K F1,F2 Q
- HANG ; end-of-page prompt
- Q:$D(RAUTOE) ; quit if e-mail
- I $E(IOST,1,2)="C-" S DIR(0)="E" W ! D ^DIR K DIR S:$D(DIRUT) RAOOUT=1 W @RAFFLF
- Q
- SET ; Set up our TMP global for mailman
- N DIWF,DIWL,DIWR,RAX,X,RAPX S RAX=0
- S DIWF="",DIWL=5,DIWR=70 K ^UTILITY($J,"W")
- ; Get Additional Clinical History, Report Text and Impression text
- ; from file 74
- I RAP="AH"!(RAP="R")!(RAP="I") D
- . S RAPX=$S(RAP="AH":"H",1:RAP)
- . F S RAX=$O(^RARPT(RARPT,RAPX,RAX)) Q:RAX'>0 D
- . . S X=$G(^RARPT(RARPT,RAPX,RAX,0)) D ^DIWP
- . Q
- ; Get Clinical History from file 70
- I RAP="H" D
- . F S RAX=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX)) Q:RAX'>0 D
- . . S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX,0)) D ^DIWP
- . Q
- S RAX=0 F S RAX=$O(^UTILITY($J,"W",DIWL,RAX)) Q:RAX'>0 D
- . S X=$G(^UTILITY($J,"W",DIWL,RAX,0))
- . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_X
- . Q
- S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
- Q
- AMENRPT() ; Pass the text, '*** THIS IS AN AMENDED REPORT ***'.
- Q "*** THIS IS AN AMENDED REPORT ***"
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTR2 2995 printed Jan 18, 2025@03:40:28 Page 2
- RARTR2 ;HIRMFO/GJC-Queue/print Radiology Reports (utility) ;3/11/96
- +1 ;;5.0;Radiology/Nuclear Medicine;**15,27**;Mar 16, 1998
- SETDIV ;get division params
- +1 SET RAMDV=""
- NEW RADTI,RACNI,RADTE,RACN,RADATE,Y,RADFN
- +2 SET Y=RARPT
- DO RASET^RAUTL2
- SET LOC=$PIECE(^RADPT(RADFN,"DT",RADTI,0),U,4)
- +3 IF 'LOC
- QUIT
- +4 SET DIV=$ORDER(^RA(79,"AL",LOC,0))
- IF 'DIV
- QUIT
- +5 SET RAMDIV=DIV
- SET Y=$SELECT($DATA(^RA(79,DIV,.1)):^(.1),1:"")
- SET RAMDV=""
- FOR I=1:1
- if $PIECE(Y,"^",I,99)']""
- QUIT
- SET RAMDV=RAMDV_$SELECT($PIECE(Y,"^",I)="Y"!($PIECE(Y,"^",I)="y"):1,1:0)_"^"
- +6 QUIT
- WRITE ; Write out Report Text, Impression Text, Clinical History and
- +1 ; Additional Clinical History on report.
- +2 KILL RAXX
- SET RAV=0
- +3 ; Get Additional Clinical History, Report Text and Impression text
- +4 ; from file 74
- +5 IF RAP="AH"!(RAP="R")!(RAP="I")
- Begin DoDot:1
- +6 SET ZRAP=$SELECT(RAP="AH":"H",1:RAP)
- +7 FOR
- SET RAV=$ORDER(^RARPT(RARPT,ZRAP,RAV))
- if RAV'>0!($DATA(RAOOUT))
- QUIT
- SET RAXX=^(RAV,0)
- if ($Y+RAFOOT+4)>IOSL
- DO HANG
- if $DATA(RAOOUT)
- QUIT
- if ($Y+RAFOOT+4)>IOSL
- DO HD^RARTR
- SET X=RAXX
- DO ^DIWP
- End DoDot:1
- +8 ; Get Clinical History from file 70
- +9 IF RAP="H"
- Begin DoDot:1
- +10 FOR
- SET RAV=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV))
- if RAV'>0!($DATA(RAOOUT))
- QUIT
- SET RAXX=^(RAV,0)
- if ($Y+RAFOOT+4)>IOSL
- DO HANG
- if $DATA(RAOOUT)
- QUIT
- if ($Y+RAFOOT+4)>IOSL
- DO HD^RARTR
- SET X=RAXX
- DO ^DIWP
- End DoDot:1
- +11 if $DATA(RAXX)
- DO ^DIWW
- +12 QUIT
- +1 ; quit if e-mail
- if $DATA(RAUTOE)
- QUIT
- +2 IF RAFOOT
- IF (IOST'["P-MESSAGE")
- FOR I=0:0
- if ($Y+RAFOOT+5)>IOSL
- QUIT
- WRITE !
- +3 IF IOST["P-MESSAGE"
- WRITE !!!!!
- +4 IF RAFOOT
- SET RAIOF=RAFFLF
- SET RAFFLF="!"
- SET RAFMT=RAFTFM
- DO PRT^RAFLH
- SET RAFFLF=RAIOF
- +5 IF IOST'["P-MESSAGE"
- FOR I=0:0
- if ($Y+4)>IOSL
- QUIT
- WRITE !
- +6 WRITE !,"VAF 10-9034 VICE SF 519B RADIOLOGY/NUCLEAR MEDICINE REPORT"
- +7 QUIT
- +8 ;
- BANNER ;Report Batch Header/Trailer Page
- +1 if '$DATA(RARTMES)!($DATA(RAUTOE))
- QUIT
- SET $PIECE(F1,">",((IOM-$LENGTH(RARTMES))/2))=""
- SET $PIECE(F2,"<",((IOM-$LENGTH(RARTMES))/2))=""
- USE IO
- SET RAFFLF=$SELECT($DATA(RAFFLF):RAFFLF,1:"#")
- WRITE @RAFFLF
- +2 FOR I=1:1:10
- WRITE !,F1," ",RARTMES," ",F2
- +3 WRITE !!?((IOM-30)/2),"Printed at "
- SET X="NOW"
- SET %DT="TX"
- DO ^%DT
- DO D^RAUTL
- WRITE Y
- +4 FOR I=1:1
- if ($Y+12)>IOSL
- QUIT
- WRITE !
- +5 FOR I=1:1
- if ($Y+2)>IOSL
- QUIT
- WRITE !,F1," ",RARTMES," ",F2
- +6 KILL F1,F2
- QUIT
- HANG ; end-of-page prompt
- +1 ; quit if e-mail
- if $DATA(RAUTOE)
- QUIT
- +2 IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- SET RAOOUT=1
- WRITE @RAFFLF
- +3 QUIT
- SET ; Set up our TMP global for mailman
- +1 NEW DIWF,DIWL,DIWR,RAX,X,RAPX
- SET RAX=0
- +2 SET DIWF=""
- SET DIWL=5
- SET DIWR=70
- KILL ^UTILITY($JOB,"W")
- +3 ; Get Additional Clinical History, Report Text and Impression text
- +4 ; from file 74
- +5 IF RAP="AH"!(RAP="R")!(RAP="I")
- Begin DoDot:1
- +6 SET RAPX=$SELECT(RAP="AH":"H",1:RAP)
- +7 FOR
- SET RAX=$ORDER(^RARPT(RARPT,RAPX,RAX))
- if RAX'>0
- QUIT
- Begin DoDot:2
- +8 SET X=$GET(^RARPT(RARPT,RAPX,RAX,0))
- DO ^DIWP
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 ; Get Clinical History from file 70
- +11 IF RAP="H"
- Begin DoDot:1
- +12 FOR
- SET RAX=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX))
- if RAX'>0
- QUIT
- Begin DoDot:2
- +13 SET X=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX,0))
- DO ^DIWP
- End DoDot:2
- +14 QUIT
- End DoDot:1
- +15 SET RAX=0
- FOR
- SET RAX=$ORDER(^UTILITY($JOB,"W",DIWL,RAX))
- if RAX'>0
- QUIT
- Begin DoDot:1
- +16 SET X=$GET(^UTILITY($JOB,"W",DIWL,RAX,0))
- +17 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_X
- +18 QUIT
- End DoDot:1
- +19 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
- +20 QUIT
- AMENRPT() ; Pass the text, '*** THIS IS AN AMENDED REPORT ***'.
- +1 QUIT "*** THIS IS AN AMENDED REPORT ***"