Index: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR.m
===================================================================
--- WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR.m	(revision 613)
+++ WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR.m	(revision 623)
@@ -1,174 +1,169 @@
-RARTR	;HISC/CAH COLUMBIA/REB AISC/MJK,RMO-Queue/print Reports ;11/27/98  09:05
-	;;5.0;Radiology/Nuclear Medicine;**5,13,16,27,43,55,75,92**;Mar 16, 1998;Build 4
-PRT	; Begin print/build of e-mail message
-	;
-	; ** NOTE: If the layout of this output is changed  **
-	; **       please check that routine RAO7PC3 is     **
-	; **       not affected. It assumes fixed format of **
-	; **       the following headings:                  **
-	; **            Clinical History:                   **
-	; **            Report:                             **
-	; **            Impression:                         **
-	; **            Primary Diagnostic Code:            **
-	; **            Secondary Diagnostic Codes:         **
-	; **            Primary Interpreting Staff:         **
-	;
-	Q:'$D(^RARPT(+$G(RARPT),0))
-	; Use and Set if running in the foreground and Writing to the device
-	I '$D(RAUTOE) D
-	. U IO
-	. S RAFFLF=IOF
-	. S RAORIOF=RAFFLF
-	;
-	W:$Y>0&('$D(RAUTOE)) @RAFFLF   ; If RAUTOE defined build mail msg
-	S X=$G(^RARPT(+$G(RARPT),0))   ;  RAORIOF=RAFFLF
-	;
-	;S RAFFLF=$S('$D(ORACTION):RAFFLF,ORACTION'=8:RAFFLF,1:"!")
-	D INIT ; setup exam/report variables
-	I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q  ; data nodes missing
-	;
-PRT1	I $D(RAUTOE) D
-	. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "
-	. I $D(RADDEN) D
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Unverified by: "_$P($G(^VA(200,$S($G(RADUZ):RADUZ,1:DUZ),0)),"^")
-	.. Q
-	. Q
-	I +$O(^RARPT(RARPT,"ERR",0)) D
-	. S RAERRFLG="" ; set for future reference (display AMENRPT^RARTR text)
-	. W:'$D(RAUTOE) !!?10,$$AMENRPT^RARTR2(),!
-	. I $D(RAUTOE) D
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="         "_$$AMENRPT^RARTR2()
-	.. Q
-	. Q
-	I $P(RAY3,"^",25)<2 D  G END:$D(RAOOUT)
-	. D MODS^RAUTL2,OUT1^RARTR3
-	. D:+$P(RAY3,"^",28) RDIO^RARTUTL(+$P(RAY3,"^",28))  Q:$D(RAOOUT)
-	. D:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) PHARM^RARTUTL(RACNI_","_RADTI_","_RADFN_",")
-	. ;W:'$D(RAUTOE) !
-	. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	. Q
-	I $P(RAY3,"^",25)>1 D
-	. D MEMS1^RARTR3
-	. W:'$D(RAUTOE) !
-	. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	. Q
-	G END:$D(RAOOUT)
-	; Check for duplicate history in file 70 and 74.
-	D CHKDUPHX^RART1  ; Sets RADUPHX to 1 for duplicate or 0 if different.
-	F RAP="H","AH","R","I" K ^UTILITY($J,"W"),^(1) D  G END:$D(RAOOUT)
-	. S RAP("P")=$S(RAP="H":"Clinical History:",RAP="AH":"Additional Clinical History:",RAP="R":"Report:",1:"Impression:")
-	. ; Don't continue if printing Additional Clinical History and it is a
-	. ; duplicate of Clinical History.
-	. Q:RAP="AH"&(RADUPHX>0)
-	. W:'$D(RAUTOE) !?RATAB,RAP("P")
-	. I $D(RAUTOE),($D(RADDEN)),(RAP="R") D
-	.. N RABAN1,RABAN2,RASPCE S $P(RASPCE," ",46)=""
-	.. S RABAN1="*** Uncorrected Version   ***"
-	.. S RABAN2="*** Refer to final report ***"
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN1
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN2
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	.. Q
-	. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="    "_RAP("P")
-	. W:$D(RASTFL)&(RAP="R")&('$D(RAUTOE)) ?45,"Status: ",$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2))
-	. I RAP="R",($D(RAUTOE)) D
-	.. S $P(RAP("S")," ",(46-$L(^TMP($J,"RA AUTOE",RAACNT))))=""
-	.. I '$D(RADDEN) S ^TMP($J,"RA AUTOE",RAACNT)=^(RAACNT)_RAP("S")_"Status: "_$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2))
-	.. Q
-	. D:$D(RAUTOE) SET^RARTR2
-	. D:'$D(RAUTOE) WRITE^RARTR2 Q:$D(RAOOUT)
-	. K ^UTILITY($J,"W")
-	. Q
-	I $D(RADDEN),($G(^RARPT(RARPT,"PURGE"))) D
-	. ; when the report is unverified and purge data exists (rpt adden)
-	. N RAPRGE S RAPRGE=+$G(^RARPT(RARPT,"PURGE"))
-	. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Purged: "_$$FMTE^XLFDT(RAPRGE,"1P")
-	. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	. Q
-	I $P($G(^RA(79.1,+$P(RAY2,U,4),0)),U,18)="Y" D PRTDX^RARTR1 G:$D(RAOOUT) END ;print dx codes
-	D EN1^RARTR0 G:$D(RAOOUT) END
-	I '$D(RAVERFND) D  G END:$D(RAOOUT)
-	. I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)  D HD:($Y+RAFOOT+4)>IOSL
-	. N RADFTSBN,RADFTSBT S:$D(RADDEN) RAVERF=+$P(RA74B4,"^",9)
-	. S RADFTSBN=$E($P($G(^VA(200,RAVERF,20)),"^",2),1,25)
-	. S:RADFTSBN']"" RADFTSBN=$E($P($G(^VA(200,RAVERF,0)),"^"),1,25)
-	. S RADFTSBT=$E($P($G(^VA(200,RAVERF,20)),"^",3),1,30)
-	. I RADFTSBT']"" S RADFTSBT=$$TITLE^RARTR0(RAVERF)
-	. W:'$D(RAUTOE) !!,"VERIFIED BY:",!?2,$S(RADFTSBN]"":RADFTSBN,1:"")
-	. W:RADFTSBT]""&('$D(RAUTOE)) ", "_RADFTSBT
-	. I $D(RAUTOE) D
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="VERIFIED BY:"
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RADFTSBN]"":RADFTSBN,1:"")_$S(RADFTSBT]"":", "_RADFTSBT,1:"")
-	.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	.. Q
-	. Q
-	K RASBPN,RASBT,RASECIEN,RASECOND,RASECSS
-	I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 G END:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL
-	W:'$D(RAUTOE) !!,$S($D(^RABTCH(74.2,+RABTCH,0)):$P(^(0),"^"),1:""),"/" I +$G(^RARPT(RARPT,"T")),$D(^VA(200,+$P(^RARPT(RARPT,"T"),"^"),0)) W:'$D(RAUTOE) $P(^(0),"^",2)
-	S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$P($G(^RABTCH(74.2,+RABTCH,0)),"^")_"/"_$S(+$G(^RARPT(RARPT,"T"))&($D(^VA(200,+$P($G(^RARPT(RARPT,"T")),"^"),0))):$P(^(0),"^",2),1:"")
-	S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	D HANG^RARTR2 G END:$D(RAOOUT)
-	I RAST'="V" D:'$D(RAMDV) SETDIV^RARTR2 I $P(RAMDV,U,25) D WARNING^RARTR1
-	G PEND:RAST'="PD"
-	S $P(RASTRSK,"*",80)=""
-	I '$D(RAUTOE) D
-	. D HD:($Y+RAFOOT+9)>IOSL
-	. W !,$E(RASTRSK,1,22)," P R O B L E M   S T A T E M E N T ",$E(RASTRSK,1,22)
-	. W !!,$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.") W !!,RASTRSK
-	. Q
-	E  D
-	. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$E(RASTRSK,1,22)_" P R O B L E M   S T A T E M E N T "_$E(RASTRSK,1,22)
-	. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.")
-	. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
-	. Q
-PEND	D FOOT^RARTR2,HANG^RARTR2 D:'$D(RAMIE)&('$D(RAUTOE)) Q^RAFLH1
-END	K:$D(RAOOUT) XQAID,XQAKILL
-	K %I,%W,%Y1,C,DN,I,RADXCODE,RARTMES,RAVERF,RAVERFND,RAPVERF
-	K RAVERS,RAFOOT,RAY0,RAY1,RAY2,RAY3,RALOC,RAFMT,RAMOD,RASTFL,RALB,RALBR
-	K RALBRT,RALBS,RALBST,RAV,RAP,RATAB,RAXX,VAL,VAR,RADFN,RADTI,RACN,RADTE
-	K RARPT,RAHDFM,RAFTFM,RAV,RAIOF,RABTCH,RAOOUT,RAPIR,RAPIS,VAERR,Z
-	; K RASTRSK S RAFFLF=RAORIOF K RAORIOF,RAFFLF,RAERRFLG
-	; 05/15/08 BAY/KAM Patch RA*5*92 Added Conditional Kill to next line
-	; to support an AMIE interface (IA 708)
-	K RASTRSK,RAORIOF,RAFFLF,RAERRFLG K:'($D(RAMIE)#2) DFN
-	;the next kill line corrects the CPRS V27 report display issue when repeated
-	;on same patient P92
-	K %,DIW,DIWF,DIWI,DIWL,DIWT,DIWTC,DIWX,RAACNT,RADUPHX,RANUM,RAREZON,RAST
-	Q
-Q	; Queue the report
-	S ZTDTH=$H,ZTRTN="DQ^RARTR",ZTSAVE("RARPT")="" S:$D(RARTMES) ZTSAVE("RARTMES")=""
-	D ZIS^RAUTL Q:RAPOP
-	;
-DQ	S U="^",X="T",%DT="" D ^%DT K %DT S DT=Y G PRT
-	;
-INIT	; initialize exam/report variables
-	; main variables set:
-	; RAY0: zero node data from the Patient File (2)
-	; RAY1: zero node data from the Rad/Nuc Med Patient File (70)
-	; RAY2: Registered Exams (70.02) zero node data
-	; RAY3: Examinations     (70.03) zero node data
-	S (RAY0,RAY1,RAY2,RAY3)=-1 ; error condition, if no data nodes
-	S RADFN=+$P(X,"^",2),RADTE=+$P(X,"^",3),RADTI=(9999999.9999-RADTE)
-	S RACN=+$P(X,"^",4),RAST=$P(X,"^",5),RATAB=5
-	S:'$D(RABTCH) RABTCH=0 S (DIWL,DIWF)=0
-	Q:'$D(^RADPT(RADFN,0))  S RANUM=1,RAY1=^(0)
-	Q:'$D(^DPT(RADFN,0))  S RAY0=^(0)
-	Q:'$D(^RADPT(RADFN,"DT",RADTI,0))  S RAY2=^(0)
-	S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
-	S (RAY3,RALB)=$S($D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0)):^(0),1:-1)
-	Q:RAY3<0  ; examinations data missing
-	;
-	S (RAHDFM,RAFTFM)=1 S:$D(^RA(79.1,+$P(RAY2,"^",4),0)) RAHDFM=^(0),RAFTFM=+$P(RAHDFM,"^",13),DIWL=$P(RAHDFM,"^",14),DIWF=$P(RAHDFM,"^",15),RAHDFM=+$P(RAHDFM,"^",12) S RAFOOT=$S($D(^RA(78.2,RAFTFM,0)):+$P(^(0),"^",2),1:0)
-	S:'DIWL DIWL=5 S:'DIWF DIWF=70 S DIWF="WC"_(DIWF-DIWL)
-	G @$S($D(RAUTOE):"HEAD^RARTR0",1:"HD1")
-	Q
-	;
-HD	D FOOT^RARTR2:$E(IOST,1,2)'="C-"
-HD1	S RAFMT=RAHDFM I $D(RARTMES) W:$Y>0 @RAFFLF W !,?((80-$L(RARTMES))/2),RARTMES,! S RAIOF=RAFFLF,RAFFLF="!"
-	I '$D(RARTMES) W:$Y>0 @RAFFLF
-	D PRT^RAFLH S:$D(RARTMES) RAFFLF=RAIOF
-	W:$D(RAERRFLG) !!?10,$$AMENRPT^RARTR2(),!!
-	Q
+RARTR ;HISC/CAH COLUMBIA/REB AISC/MJK,RMO-Queue/print Reports ;11/27/98  09:05
+ ;;5.0;Radiology/Nuclear Medicine;**5,13,16,27,43,55,75**;Mar 16, 1998;Build 4
+PRT ; Begin print/build of e-mail message
+ ;
+ ; ** NOTE: If the layout of this output is changed  **
+ ; **       please check that routine RAO7PC3 is     **
+ ; **       not affected. It assumes fixed format of **
+ ; **       the following headings:                  **
+ ; **            Clinical History:                   **
+ ; **            Report:                             **
+ ; **            Impression:                         **
+ ; **            Primary Diagnostic Code:            **
+ ; **            Secondary Diagnostic Codes:         **
+ ; **            Primary Interpreting Staff:         **
+ ;
+ Q:'$D(^RARPT(+$G(RARPT),0))
+ ; Use and Set if running in the foreground and Writing to the device
+ I '$D(RAUTOE) D
+ . U IO
+ . S RAFFLF=IOF
+ . S RAORIOF=RAFFLF
+ ;
+ W:$Y>0&('$D(RAUTOE)) @RAFFLF   ; If RAUTOE defined build mail msg
+ S X=$G(^RARPT(+$G(RARPT),0))   ;  RAORIOF=RAFFLF
+ ;
+ ;S RAFFLF=$S('$D(ORACTION):RAFFLF,ORACTION'=8:RAFFLF,1:"!")
+ D INIT ; setup exam/report variables
+ I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q  ; data nodes missing
+ ;
+PRT1 I $D(RAUTOE) D
+ . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "
+ . I $D(RADDEN) D
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Unverified by: "_$P($G(^VA(200,$S($G(RADUZ):RADUZ,1:DUZ),0)),"^")
+ .. Q
+ . Q
+ I +$O(^RARPT(RARPT,"ERR",0)) D
+ . S RAERRFLG="" ; set for future reference (display AMENRPT^RARTR text)
+ . W:'$D(RAUTOE) !!?10,$$AMENRPT^RARTR2(),!
+ . I $D(RAUTOE) D
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="         "_$$AMENRPT^RARTR2()
+ .. Q
+ . Q
+ I $P(RAY3,"^",25)<2 D  G END:$D(RAOOUT)
+ . D MODS^RAUTL2,OUT1^RARTR3
+ . D:+$P(RAY3,"^",28) RDIO^RARTUTL(+$P(RAY3,"^",28))  Q:$D(RAOOUT)
+ . D:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) PHARM^RARTUTL(RACNI_","_RADTI_","_RADFN_",")
+ . ;W:'$D(RAUTOE) !
+ . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ . Q
+ I $P(RAY3,"^",25)>1 D
+ . D MEMS1^RARTR3
+ . W:'$D(RAUTOE) !
+ . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ . Q
+ G END:$D(RAOOUT)
+ ; Check for duplicate history in file 70 and 74.
+ D CHKDUPHX^RART1  ; Sets RADUPHX to 1 for duplicate or 0 if different.
+ F RAP="H","AH","R","I" K ^UTILITY($J,"W"),^(1) D  G END:$D(RAOOUT)
+ . S RAP("P")=$S(RAP="H":"Clinical History:",RAP="AH":"Additional Clinical History:",RAP="R":"Report:",1:"Impression:")
+ . ; Don't continue if printing Additional Clinical History and it is a
+ . ; duplicate of Clinical History.
+ . Q:RAP="AH"&(RADUPHX>0)
+ . W:'$D(RAUTOE) !?RATAB,RAP("P")
+ . I $D(RAUTOE),($D(RADDEN)),(RAP="R") D
+ .. N RABAN1,RABAN2,RASPCE S $P(RASPCE," ",46)=""
+ .. S RABAN1="*** Uncorrected Version   ***"
+ .. S RABAN2="*** Refer to final report ***"
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN1
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN2
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ .. Q
+ . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="    "_RAP("P")
+ . W:$D(RASTFL)&(RAP="R")&('$D(RAUTOE)) ?45,"Status: ",$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2))
+ . I RAP="R",($D(RAUTOE)) D
+ .. S $P(RAP("S")," ",(46-$L(^TMP($J,"RA AUTOE",RAACNT))))=""
+ .. I '$D(RADDEN) S ^TMP($J,"RA AUTOE",RAACNT)=^(RAACNT)_RAP("S")_"Status: "_$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2))
+ .. Q
+ . D:$D(RAUTOE) SET^RARTR2
+ . D:'$D(RAUTOE) WRITE^RARTR2 Q:$D(RAOOUT)
+ . K ^UTILITY($J,"W")
+ . Q
+ I $D(RADDEN),($G(^RARPT(RARPT,"PURGE"))) D
+ . ; when the report is unverified and purge data exists (rpt adden)
+ . N RAPRGE S RAPRGE=+$G(^RARPT(RARPT,"PURGE"))
+ . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Purged: "_$$FMTE^XLFDT(RAPRGE,"1P")
+ . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ . Q
+ I $P($G(^RA(79.1,+$P(RAY2,U,4),0)),U,18)="Y" D PRTDX^RARTR1 G:$D(RAOOUT) END ;print dx codes
+ D EN1^RARTR0 G:$D(RAOOUT) END
+ I '$D(RAVERFND) D  G END:$D(RAOOUT)
+ . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)  D HD:($Y+RAFOOT+4)>IOSL
+ . N RADFTSBN,RADFTSBT S:$D(RADDEN) RAVERF=+$P(RA74B4,"^",9)
+ . S RADFTSBN=$E($P($G(^VA(200,RAVERF,20)),"^",2),1,25)
+ . S:RADFTSBN']"" RADFTSBN=$E($P($G(^VA(200,RAVERF,0)),"^"),1,25)
+ . S RADFTSBT=$E($P($G(^VA(200,RAVERF,20)),"^",3),1,30)
+ . I RADFTSBT']"" S RADFTSBT=$$TITLE^RARTR0(RAVERF)
+ . W:'$D(RAUTOE) !!,"VERIFIED BY:",!?2,$S(RADFTSBN]"":RADFTSBN,1:"")
+ . W:RADFTSBT]""&('$D(RAUTOE)) ", "_RADFTSBT
+ . I $D(RAUTOE) D
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="VERIFIED BY:"
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RADFTSBN]"":RADFTSBN,1:"")_$S(RADFTSBT]"":", "_RADFTSBT,1:"")
+ .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ .. Q
+ . Q
+ K RASBPN,RASBT,RASECIEN,RASECOND,RASECSS
+ I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 G END:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL
+ W:'$D(RAUTOE) !!,$S($D(^RABTCH(74.2,+RABTCH,0)):$P(^(0),"^"),1:""),"/" I +$G(^RARPT(RARPT,"T")),$D(^VA(200,+$P(^RARPT(RARPT,"T"),"^"),0)) W:'$D(RAUTOE) $P(^(0),"^",2)
+ S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$P($G(^RABTCH(74.2,+RABTCH,0)),"^")_"/"_$S(+$G(^RARPT(RARPT,"T"))&($D(^VA(200,+$P($G(^RARPT(RARPT,"T")),"^"),0))):$P(^(0),"^",2),1:"")
+ S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ D HANG^RARTR2 G END:$D(RAOOUT)
+ I RAST'="V" D:'$D(RAMDV) SETDIV^RARTR2 I $P(RAMDV,U,25) D WARNING^RARTR1
+ G PEND:RAST'="PD"
+ S $P(RASTRSK,"*",80)=""
+ I '$D(RAUTOE) D
+ . D HD:($Y+RAFOOT+9)>IOSL
+ . W !,$E(RASTRSK,1,22)," P R O B L E M   S T A T E M E N T ",$E(RASTRSK,1,22)
+ . W !!,$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.") W !!,RASTRSK
+ . Q
+ E  D
+ . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$E(RASTRSK,1,22)_" P R O B L E M   S T A T E M E N T "_$E(RASTRSK,1,22)
+ . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.")
+ . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+ . Q
+PEND D FOOT^RARTR2,HANG^RARTR2 D:'$D(RAMIE)&('$D(RAUTOE)) Q^RAFLH1
+END K:$D(RAOOUT) XQAID,XQAKILL
+ K %I,%W,%Y1,C,DN,I,RADXCODE,RARTMES,RAVERF,RAVERFND,RAPVERF
+ K RAVERS,RAFOOT,RAY0,RAY1,RAY2,RAY3,RALOC,RAFMT,RAMOD,RASTFL,RALB,RALBR
+ K RALBRT,RALBS,RALBST,RAV,RAP,RATAB,RAXX,VAL,VAR,RADFN,RADTI,RACN,RADTE
+ K RARPT,RAHDFM,RAFTFM,RAV,RAIOF,RABTCH,RAOOUT,RAPIR,RAPIS,VAERR,Z
+ ; K RASTRSK S RAFFLF=RAORIOF K RAORIOF,RAFFLF,RAERRFLG
+ K RASTRSK,RAORIOF,RAFFLF,RAERRFLG
+ Q
+Q ; Queue the report
+ S ZTDTH=$H,ZTRTN="DQ^RARTR",ZTSAVE("RARPT")="" S:$D(RARTMES) ZTSAVE("RARTMES")=""
+ D ZIS^RAUTL Q:RAPOP
+ ;
+DQ S U="^",X="T",%DT="" D ^%DT K %DT S DT=Y G PRT
+ ;
+INIT ; initialize exam/report variables
+ ; main variables set:
+ ; RAY0: zero node data from the Patient File (2)
+ ; RAY1: zero node data from the Rad/Nuc Med Patient File (70)
+ ; RAY2: Registered Exams (70.02) zero node data
+ ; RAY3: Examinations     (70.03) zero node data
+ S (RAY0,RAY1,RAY2,RAY3)=-1 ; error condition, if no data nodes
+ S RADFN=+$P(X,"^",2),RADTE=+$P(X,"^",3),RADTI=(9999999.9999-RADTE)
+ S RACN=+$P(X,"^",4),RAST=$P(X,"^",5),RATAB=5
+ S:'$D(RABTCH) RABTCH=0 S (DIWL,DIWF)=0
+ Q:'$D(^RADPT(RADFN,0))  S RANUM=1,RAY1=^(0)
+ Q:'$D(^DPT(RADFN,0))  S RAY0=^(0)
+ Q:'$D(^RADPT(RADFN,"DT",RADTI,0))  S RAY2=^(0)
+ S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
+ S (RAY3,RALB)=$S($D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0)):^(0),1:-1)
+ Q:RAY3<0  ; examinations data missing
+ ;
+ S (RAHDFM,RAFTFM)=1 S:$D(^RA(79.1,+$P(RAY2,"^",4),0)) RAHDFM=^(0),RAFTFM=+$P(RAHDFM,"^",13),DIWL=$P(RAHDFM,"^",14),DIWF=$P(RAHDFM,"^",15),RAHDFM=+$P(RAHDFM,"^",12) S RAFOOT=$S($D(^RA(78.2,RAFTFM,0)):+$P(^(0),"^",2),1:0)
+ S:'DIWL DIWL=5 S:'DIWF DIWF=70 S DIWF="WC"_(DIWF-DIWL)
+ G @$S($D(RAUTOE):"HEAD^RARTR0",1:"HD1")
+ Q
+ ;
+HD D FOOT^RARTR2:$E(IOST,1,2)'="C-"
+HD1 S RAFMT=RAHDFM I $D(RARTMES) W:$Y>0 @RAFFLF W !,?((80-$L(RARTMES))/2),RARTMES,! S RAIOF=RAFFLF,RAFFLF="!"
+ I '$D(RARTMES) W:$Y>0 @RAFFLF
+ D PRT^RAFLH S:$D(RARTMES) RAFFLF=RAIOF
+ W:$D(RAERRFLG) !!?10,$$AMENRPT^RARTR2(),!!
+ Q
