RARTUTL1 ;HIRMFO/GJC-Utility to display Pharm & Radiopharm data ;11/18/97 13:28
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
RDIO1(RADA) ; Display Radiopharmaceutical default data for Report displays
; Input: RADA -> ien of the Nuc Med Exam Data record (file 70.2)
; Output: 'X' -> $S(X'="":'abnormal exit',1:'full display')
; *** Called only if $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,28)>0 ***
N RADARY,RAXIT,Y S RAXIT=0,X=""
D GETS^DIQ(70.2,RADA_",","**","NE","RADARY") Q:'$D(RADARY) ""
D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="T"!(X="P")!(X="^") X
I X="C" W @IOF S X=""
N RAIENS S RAIENS=""
F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D Q:RAXIT
. N RADOSE S RADOSE=$S($G(RADARY(70.21,RAIENS,7,"E"))]"":", "_$G(RADARY(70.21,RAIENS,7,"E"))_" mCi",1:"")
. D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) S:X="T"!(X="P")!(X="^") RAXIT=1
. Q:RAXIT
. I X="C" W @IOF S X=""
. W !," Radiopharmaceutical: "_$G(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
. D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) S:X="T"!(X="P")!(X="^") RAXIT=1
. Q:RAXIT
. I X="C" W @IOF S X=""
. Q:$G(RADARY(70.21,RAIENS,8,"E"))=""&($G(RADARY(70.21,RAIENS,9,"E"))="")&($G(RADARY(70.21,RAIENS,11,"E"))="")&($G(RADARY(70.21,RAIENS,12,"E"))="")
. N RACNT,RALNGTH S RACNT=0
. F RADFLDS=8,9,11,12 D
.. W:'RACNT&(RADFLDS=8) ! ; initial line feed, spacing
.. I $G(RADARY(70.21,RAIENS,RADFLDS,"E"))]"" D
... W:RACNT=2 ! S:RACNT=2 RACNT=0 ; NEW LINE
... S RACNT=RACNT+1
... W:RADFLDS=8 $S(RACNT=2:" Adm'd on ",1:" Adm'd on ")
... W:RADFLDS=9 $S(RACNT=2:" by ",1:" by ")
... W:RADFLDS=11 $S(RACNT=2:" Route ",1:" Route ")
... W:RADFLDS=12 $S(RACNT=2:" Site ",1:" Site ")
... S RALNGTH=$L($G(RADARY(70.21,RAIENS,RADFLDS,"E")))
... I RACNT=2,((RALNGTH+$X)>IOM) D
.... W $E($G(RADARY(70.21,RAIENS,RADFLDS,"E")),1,(IOM-($X-1)))
.... Q
... E W $G(RADARY(70.21,RAIENS,RADFLDS,"E"))
... Q
.. Q
. Q
Q $G(X)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTUTL1 1963 printed Oct 16, 2024@18:40:13 Page 2
RARTUTL1 ;HIRMFO/GJC-Utility to display Pharm & Radiopharm data ;11/18/97 13:28
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ;
RDIO1(RADA) ; Display Radiopharmaceutical default data for Report displays
+1 ; Input: RADA -> ien of the Nuc Med Exam Data record (file 70.2)
+2 ; Output: 'X' -> $S(X'="":'abnormal exit',1:'full display')
+3 ; *** Called only if $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,28)>0 ***
+4 NEW RADARY,RAXIT,Y
SET RAXIT=0
SET X=""
+5 DO GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
if '$DATA(RADARY)
QUIT ""
+6 if ($Y+6)>IOSL&('$DATA(RARTVERF))
DO WAIT^RART1
if X="T"!(X="P")!(X="^")
QUIT X
+7 IF X="C"
WRITE @IOF
SET X=""
+8 NEW RAIENS
SET RAIENS=""
+9 FOR
SET RAIENS=$ORDER(RADARY(70.21,RAIENS))
if RAIENS=""
QUIT
Begin DoDot:1
+10 NEW RADOSE
SET RADOSE=$SELECT($GET(RADARY(70.21,RAIENS,7,"E"))]"":", "_$GET(RADARY(70.21,RAIENS,7,"E"))_" mCi",1:"")
+11 if ($Y+6)>IOSL&('$DATA(RARTVERF))
DO WAIT^RART1
if X="T"!(X="P")!(X="^")
SET RAXIT=1
+12 if RAXIT
QUIT
+13 IF X="C"
WRITE @IOF
SET X=""
+14 WRITE !," Radiopharmaceutical: "_$GET(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
+15 if ($Y+6)>IOSL&('$DATA(RARTVERF))
DO WAIT^RART1
if X="T"!(X="P")!(X="^")
SET RAXIT=1
+16 if RAXIT
QUIT
+17 IF X="C"
WRITE @IOF
SET X=""
+18 if $GET(RADARY(70.21,RAIENS,8,"E"))=""&($GET(RADARY(70.21,RAIENS,9,"E"))="")&($GET(RADARY(70.21,RAIENS,11,"E"))="")&($GET(RADARY(70.21,RAIENS,12,"E"))="")
QUIT
+19 NEW RACNT,RALNGTH
SET RACNT=0
+20 FOR RADFLDS=8,9,11,12
Begin DoDot:2
+21 ; initial line feed, spacing
if 'RACNT&(RADFLDS=8)
WRITE !
+22 IF $GET(RADARY(70.21,RAIENS,RADFLDS,"E"))]""
Begin DoDot:3
+23 ; NEW LINE
if RACNT=2
WRITE !
if RACNT=2
SET RACNT=0
+24 SET RACNT=RACNT+1
+25 if RADFLDS=8
WRITE $SELECT(RACNT=2:" Adm'd on ",1:" Adm'd on ")
+26 if RADFLDS=9
WRITE $SELECT(RACNT=2:" by ",1:" by ")
+27 if RADFLDS=11
WRITE $SELECT(RACNT=2:" Route ",1:" Route ")
+28 if RADFLDS=12
WRITE $SELECT(RACNT=2:" Site ",1:" Site ")
+29 SET RALNGTH=$LENGTH($GET(RADARY(70.21,RAIENS,RADFLDS,"E")))
+30 IF RACNT=2
IF ((RALNGTH+$X)>IOM)
Begin DoDot:4
+31 WRITE $EXTRACT($GET(RADARY(70.21,RAIENS,RADFLDS,"E")),1,(IOM-($X-1)))
+32 QUIT
End DoDot:4
+33 IF '$TEST
WRITE $GET(RADARY(70.21,RAIENS,RADFLDS,"E"))
+34 QUIT
End DoDot:3
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
if RAXIT
QUIT
+37 QUIT $GET(X)
