RARTUTL ;HIRMFO/GJC-Utility to display Pharm & Radiopharm data ;11/18/97 13:33
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
PHARM(RADA) ; Display Pharmaceutical default data
; Input: RADA -> ien for the Examinations (50) multiple.
; in the following format: RACNI_","_RADTI_","_RADFN_","
; *** Called only if $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) ***
N RA1,RACNT,RAPHARM,RASUB,X,Y S RA1="",RASUB=70.15
D GETS^DIQ(70.03,RADA,"200*","NE","RAPHARM") Q:'$D(RAPHARM)
I '$D(RAUTOE),($Y>(IOSL-4)) D HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR
F S RA1=$O(RAPHARM(RASUB,RA1)) Q:RA1']"" D Q:$D(RAOOUT)
. S RACNT=0
. I $G(RAPHARM(RASUB,RA1,.01,"E"))]"" D
.. N RADOSE S RADOSE=$S($G(RAPHARM(RASUB,RA1,2,"E"))]"":", "_$G(RAPHARM(RASUB,RA1,2,"E")),1:"")
.. W:'$D(RAUTOE) !," Pharmaceutical: ",$E($G(RAPHARM(RASUB,RA1,.01,"E")),1,40)_RADOSE
.. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Pharmaceutical: "_$E($G(RAPHARM(RASUB,RA1,.01,"E")),1,40)_RADOSE
.. Q
. I '$D(RAUTOE),($Y>(IOSL-4)) D HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR
. W:'$D(RAUTOE)&(($G(RAPHARM(RASUB,RA1,3,"E"))]"")!($G(RAPHARM(RASUB,RA1,4,"E"))]"")) !
. I $G(RAPHARM(RASUB,RA1,3,"E"))]"" D
.. S RACNT=RACNT+1
.. I '$D(RAUTOE) D
... W " Adm'd on "_$E($G(RAPHARM(RASUB,RA1,3,"E")),1,21)
... Q
.. E D
... S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Adm'd on "_$E($G(RAPHARM(RASUB,RA1,3,"E")),1,21)
... Q
.. Q
. I $G(RAPHARM(RASUB,RA1,4,"E"))]"" D
.. S RACNT=RACNT+1
.. I '$D(RAUTOE) D
... N RAX S RAX="""by "",$E($G(RAPHARM(RASUB,RA1,4,""E"")),1,30)"
... W:RACNT=1 " ",@RAX W:RACNT=2 " ",@RAX
... Q
.. E D
... S:RACNT=2 ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" by "_$E($G(RAPHARM(RASUB,RA1,4,"E")),1,30)
... S:RACNT=1 ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" by "_$E($G(RAPHARM(RASUB,RA1,4,"E")),1,30)
... Q
.. Q
. Q
Q
RDIO(RADA) ; Display Radiopharmaceutical default data for Report displays
; Input: RADA -> ien of the Nuc Med Exam Data record (file 70.2)
; *** Called only if $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,28)>0 ***
N RADARY,X,Y
D GETS^DIQ(70.2,RADA_",","**","NE","RADARY") Q:'$D(RADARY)
I '$D(RAUTOE),($Y>(IOSL-4)) D HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR
N RAIENS S RAIENS=""
F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D Q:$D(RAOOUT)
. N RADOSE S RADOSE=$S($G(RADARY(70.21,RAIENS,7,"E"))]"":", "_$G(RADARY(70.21,RAIENS,7,"E"))_" mCi",1:"")
. I '$D(RAUTOE),($Y>(IOSL-4)) D HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR
. I '$D(RAUTOE) D
.. W !," Radiopharmaceutical: "_$G(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
.. Q
. E D
.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Radiopharmaceutical: "_$G(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
.. Q
. 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 Q:'$D(RAUTOE)&($D(RAOOUT))
.. W:'RACNT&(RADFLDS=8)&('$D(RAUTOE)) ! ; initial line feed, spacing
.. S:'RACNT&(RADFLDS=8)&($D(RAUTOE)) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
.. I $G(RADARY(70.21,RAIENS,RADFLDS,"E"))]"" D
... W:RACNT=2 ! S:RACNT=2 RACNT=0 ; NEW LINE
... S RACNT=RACNT+1
... I '$D(RAUTOE) D
.... I $Y>(IOSL-4) D HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR W !
.... 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=$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"))
.... I $Y>(IOSL-4) D HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR W !
.... Q
... E D
.... S:RADFLDS=8 ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_$S(RACNT=2:" Adm'd on ",1:" Adm'd on ")
.... S:RADFLDS=9 ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_$S(RACNT=2:" by ",1:" by ")
.... S:RADFLDS=11 ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_$S(RACNT=2:" Route ",1:" Route ")
.... S:RADFLDS=12 ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_$S(RACNT=2:" Site ",1:" Site ")
.... S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_$G(RADARY(70.21,RAIENS,RADFLDS,"E"))
.... S:RACNT=2 ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
.... S:RACNT=2 RACNT=0
.... Q
... Q
.. Q
. Q
Q
PHARM1(RADA) ; Display Pharmaceutical default data
; Input: RADA -> ien for the Examinations (50) multiple.
; in the following format: RACNI_","_RADTI_","_RADFN_","
; Output: 'X' -> $S(X'="":'abnormal exit',1:'full display')
; *** Called only if $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) ***
N RA1,RACNT,RAPHARM,RASUB,RAXIT,Y S (RA1,X)="",RASUB=70.15,RAXIT=0
D GETS^DIQ(70.03,RADA,"200*","NE","RAPHARM") Q:'$D(RAPHARM) ""
D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="T"!(X="P")!(X="^") X
I X="C" W @IOF S X=""
F S RA1=$O(RAPHARM(RASUB,RA1)) Q:RA1']"" D Q:RAXIT
. S RACNT=0
. I $G(RAPHARM(RASUB,RA1,.01,"E"))]"" D
.. N RADOSE S RADOSE=$S($G(RAPHARM(RASUB,RA1,2,"E"))]"":", "_$G(RAPHARM(RASUB,RA1,2,"E")),1:"")
.. W !," Pharmaceutical: ",$E($G(RAPHARM(RASUB,RA1,.01,"E")),1,40)_RADOSE
.. Q
. 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:$G(RAPHARM(RASUB,RA1,3,"E"))]""!($G(RAPHARM(RASUB,RA1,4,"E"))]"") !
. I $G(RAPHARM(RASUB,RA1,3,"E"))]"" D
.. S RACNT=RACNT+1
.. W " Adm'd "_$E($G(RAPHARM(RASUB,RA1,3,"E")),1,21)
.. Q
. I $G(RAPHARM(RASUB,RA1,4,"E"))]"" D
.. S RACNT=RACNT+1
.. N RAX S RAX="""by "",$E($G(RAPHARM(RASUB,RA1,4,""E"")),1,30)"
.. W:RACNT=1 " ",@RAX W:RACNT=2 " ",@RAX
.. Q
. Q
Q $G(X)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTUTL 5941 printed Oct 16, 2024@18:40:12 Page 2
RARTUTL ;HIRMFO/GJC-Utility to display Pharm & Radiopharm data ;11/18/97 13:33
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ;
PHARM(RADA) ; Display Pharmaceutical default data
+1 ; Input: RADA -> ien for the Examinations (50) multiple.
+2 ; in the following format: RACNI_","_RADTI_","_RADFN_","
+3 ; *** Called only if $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) ***
+4 NEW RA1,RACNT,RAPHARM,RASUB,X,Y
SET RA1=""
SET RASUB=70.15
+5 DO GETS^DIQ(70.03,RADA,"200*","NE","RAPHARM")
if '$DATA(RAPHARM)
QUIT
+6 IF '$DATA(RAUTOE)
IF ($Y>(IOSL-4))
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
DO HD^RARTR
+7 FOR
SET RA1=$ORDER(RAPHARM(RASUB,RA1))
if RA1']""
QUIT
Begin DoDot:1
+8 SET RACNT=0
+9 IF $GET(RAPHARM(RASUB,RA1,.01,"E"))]""
Begin DoDot:2
+10 NEW RADOSE
SET RADOSE=$SELECT($GET(RAPHARM(RASUB,RA1,2,"E"))]"":", "_$GET(RAPHARM(RASUB,RA1,2,"E")),1:"")
+11 if '$DATA(RAUTOE)
WRITE !," Pharmaceutical: ",$EXTRACT($GET(RAPHARM(RASUB,RA1,.01,"E")),1,40)_RADOSE
+12 if $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Pharmaceutical: "_$EXTRACT($GET(RAPHARM(RASUB,RA1,.01,"E")),1,40)_RADOSE
+13 QUIT
End DoDot:2
+14 IF '$DATA(RAUTOE)
IF ($Y>(IOSL-4))
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
DO HD^RARTR
+15 if '$DATA(RAUTOE)&(($GET(RAPHARM(RASUB,RA1,3,"E"))]"")!($GET(RAPHARM(RASUB,RA1,4,"E"))]""))
WRITE !
+16 IF $GET(RAPHARM(RASUB,RA1,3,"E"))]""
Begin DoDot:2
+17 SET RACNT=RACNT+1
+18 IF '$DATA(RAUTOE)
Begin DoDot:3
+19 WRITE " Adm'd on "_$EXTRACT($GET(RAPHARM(RASUB,RA1,3,"E")),1,21)
+20 QUIT
End DoDot:3
+21 IF '$TEST
Begin DoDot:3
+22 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Adm'd on "_$EXTRACT($GET(RAPHARM(RASUB,RA1,3,"E")),1,21)
+23 QUIT
End DoDot:3
+24 QUIT
End DoDot:2
+25 IF $GET(RAPHARM(RASUB,RA1,4,"E"))]""
Begin DoDot:2
+26 SET RACNT=RACNT+1
+27 IF '$DATA(RAUTOE)
Begin DoDot:3
+28 NEW RAX
SET RAX="""by "",$E($G(RAPHARM(RASUB,RA1,4,""E"")),1,30)"
+29 if RACNT=1
WRITE " ",@RAX
if RACNT=2
WRITE " ",@RAX
+30 QUIT
End DoDot:3
+31 IF '$TEST
Begin DoDot:3
+32 if RACNT=2
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_" by "_$EXTRACT($GET(RAPHARM(RASUB,RA1,4,"E")),1,30)
+33 if RACNT=1
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" by "_$EXTRACT($GET(RAPHARM(RASUB,RA1,4,"E")),1,30)
+34 QUIT
End DoDot:3
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
if $DATA(RAOOUT)
QUIT
+37 QUIT
RDIO(RADA) ; Display Radiopharmaceutical default data for Report displays
+1 ; Input: RADA -> ien of the Nuc Med Exam Data record (file 70.2)
+2 ; *** Called only if $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,28)>0 ***
+3 NEW RADARY,X,Y
+4 DO GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
if '$DATA(RADARY)
QUIT
+5 IF '$DATA(RAUTOE)
IF ($Y>(IOSL-4))
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
DO HD^RARTR
+6 NEW RAIENS
SET RAIENS=""
+7 FOR
SET RAIENS=$ORDER(RADARY(70.21,RAIENS))
if RAIENS=""
QUIT
Begin DoDot:1
+8 NEW RADOSE
SET RADOSE=$SELECT($GET(RADARY(70.21,RAIENS,7,"E"))]"":", "_$GET(RADARY(70.21,RAIENS,7,"E"))_" mCi",1:"")
+9 IF '$DATA(RAUTOE)
IF ($Y>(IOSL-4))
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
DO HD^RARTR
+10 IF '$DATA(RAUTOE)
Begin DoDot:2
+11 WRITE !," Radiopharmaceutical: "_$GET(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
+12 QUIT
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Radiopharmaceutical: "_$GET(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
+15 QUIT
End DoDot:2
+16 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
+17 NEW RACNT,RALNGTH
SET RACNT=0
+18 FOR RADFLDS=8,9,11,12
Begin DoDot:2
+19 ; initial line feed, spacing
if 'RACNT&(RADFLDS=8)&('$DATA(RAUTOE))
WRITE !
+20 if 'RACNT&(RADFLDS=8)&($DATA(RAUTOE))
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+21 IF $GET(RADARY(70.21,RAIENS,RADFLDS,"E"))]""
Begin DoDot:3
+22 ; NEW LINE
if RACNT=2
WRITE !
if RACNT=2
SET RACNT=0
+23 SET RACNT=RACNT+1
+24 IF '$DATA(RAUTOE)
Begin DoDot:4
+25 IF $Y>(IOSL-4)
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
DO HD^RARTR
WRITE !
+26 if RADFLDS=8
WRITE $SELECT(RACNT=2:" Adm'd on ",1:" Adm'd on ")
+27 if RADFLDS=9
WRITE $SELECT(RACNT=2:" by ",1:" by ")
+28 if RADFLDS=11
WRITE $SELECT(RACNT=2:" Route ",1:" Route ")
+29 if RADFLDS=12
WRITE $SELECT(RACNT=2:" Site ",1:" Site ")
+30 SET RALNGTH=$GET(RADARY(70.21,RAIENS,RADFLDS,"E"))
+31 IF RACNT=2
IF ((RALNGTH+$X)>IOM)
Begin DoDot:5
+32 WRITE $EXTRACT($GET(RADARY(70.21,RAIENS,RADFLDS,"E")),1,(IOM-($X-1)))
+33 QUIT
End DoDot:5
+34 IF '$TEST
WRITE $GET(RADARY(70.21,RAIENS,RADFLDS,"E"))
+35 IF $Y>(IOSL-4)
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
DO HD^RARTR
WRITE !
+36 QUIT
End DoDot:4
+37 IF '$TEST
Begin DoDot:4
+38 if RADFLDS=8
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_$SELECT(RACNT=2:" Adm'd on ",1:" Adm'd on ")
+39 if RADFLDS=9
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_$SELECT(RACNT=2:" by ",1:" by ")
+40 if RADFLDS=11
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_$SELECT(RACNT=2:" Route ",1:" Route ")
+41 if RADFLDS=12
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_$SELECT(RACNT=2:" Site ",1:" Site ")
+42 SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_$GET(RADARY(70.21,RAIENS,RADFLDS,"E"))
+43 if RACNT=2
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+44 if RACNT=2
SET RACNT=0
+45 QUIT
End DoDot:4
+46 QUIT
End DoDot:3
+47 QUIT
End DoDot:2
if '$DATA(RAUTOE)&($DATA(RAOOUT))
QUIT
+48 QUIT
End DoDot:1
if $DATA(RAOOUT)
QUIT
+49 QUIT
PHARM1(RADA) ; Display Pharmaceutical default data
+1 ; Input: RADA -> ien for the Examinations (50) multiple.
+2 ; in the following format: RACNI_","_RADTI_","_RADFN_","
+3 ; Output: 'X' -> $S(X'="":'abnormal exit',1:'full display')
+4 ; *** Called only if $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) ***
+5 NEW RA1,RACNT,RAPHARM,RASUB,RAXIT,Y
SET (RA1,X)=""
SET RASUB=70.15
SET RAXIT=0
+6 DO GETS^DIQ(70.03,RADA,"200*","NE","RAPHARM")
if '$DATA(RAPHARM)
QUIT ""
+7 if ($Y+6)>IOSL&('$DATA(RARTVERF))
DO WAIT^RART1
if X="T"!(X="P")!(X="^")
QUIT X
+8 IF X="C"
WRITE @IOF
SET X=""
+9 FOR
SET RA1=$ORDER(RAPHARM(RASUB,RA1))
if RA1']""
QUIT
Begin DoDot:1
+10 SET RACNT=0
+11 IF $GET(RAPHARM(RASUB,RA1,.01,"E"))]""
Begin DoDot:2
+12 NEW RADOSE
SET RADOSE=$SELECT($GET(RAPHARM(RASUB,RA1,2,"E"))]"":", "_$GET(RAPHARM(RASUB,RA1,2,"E")),1:"")
+13 WRITE !," Pharmaceutical: ",$EXTRACT($GET(RAPHARM(RASUB,RA1,.01,"E")),1,40)_RADOSE
+14 QUIT
End DoDot:2
+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(RAPHARM(RASUB,RA1,3,"E"))]""!($GET(RAPHARM(RASUB,RA1,4,"E"))]"")
WRITE !
+19 IF $GET(RAPHARM(RASUB,RA1,3,"E"))]""
Begin DoDot:2
+20 SET RACNT=RACNT+1
+21 WRITE " Adm'd "_$EXTRACT($GET(RAPHARM(RASUB,RA1,3,"E")),1,21)
+22 QUIT
End DoDot:2
+23 IF $GET(RAPHARM(RASUB,RA1,4,"E"))]""
Begin DoDot:2
+24 SET RACNT=RACNT+1
+25 NEW RAX
SET RAX="""by "",$E($G(RAPHARM(RASUB,RA1,4,""E"")),1,30)"
+26 if RACNT=1
WRITE " ",@RAX
if RACNT=2
WRITE " ",@RAX
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
if RAXIT
QUIT
+29 QUIT $GET(X)
