RAPROD2 ;HIRMFO/GJC-Display Med & Radiopharm values for exams ;12/12/96 13:35
;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
;
PHARM(RADA) ; Display Pharmaceutical default data for Exam displays
; 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,RAHDR,RAPHARM,RASUB S RA1="",RASUB=70.15,RAXIT=0
D GETS^DIQ(70.03,RADA,"200*","NE","RAPHARM") Q:'$D(RAPHARM)
S RAHDR=$$CJ^XLFSTR("Medications",IOM,"-")
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF
W !,RAHDR,!
F S RA1=$O(RAPHARM(RASUB,RA1)) Q:RA1']"" D Q:RAXIT
. S RACNT=0
. I $G(RAPHARM(RASUB,RA1,.01,"E"))]"" D
.. W "Med: ",$E($G(RAPHARM(RASUB,RA1,.01,"E")),1,32)
.. S RACNT=RACNT+1
.. Q
. I $G(RAPHARM(RASUB,RA1,2,"E"))]"" D
.. N RAX S RAX="""Dose Adm'd: "",$E($G(RAPHARM(RASUB,RA1,2,""E"")),1,32)"
.. S RACNT=RACNT+1 W:RACNT=1 @RAX W:RACNT=2 ?39,@RAX
.. Q
. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
. I RACNT=2 W ! S RACNT=0
. I $G(RAPHARM(RASUB,RA1,4,"E"))]"" D
.. N RAX S RAX="""Adm'd By: "",$E($G(RAPHARM(RASUB,RA1,4,""E"")),1,28)"
.. S RACNT=RACNT+1 W:RACNT=1 @RAX W:RACNT=2 ?39,@RAX
.. Q
. I RACNT=2 W ! S RACNT=0
. I $G(RAPHARM(RASUB,RA1,3,"E"))]"" D
.. N RAX S RAX="""Date Adm'd: "",$E($G(RAPHARM(RASUB,RA1,3,""E"")),1,30)"
.. S RACNT=RACNT+1 W:RACNT=1 @RAX W:RACNT=2 ?39,@RAX
.. Q
. W:$O(RAPHARM(RASUB,RA1)) !!
. Q
Q
RDIO(RADA) ; Display Radiopharmaceutical default data for Exam 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 RACNT,RADARY,RAFLDS,RAHDR,RAIENS,RAOPUT,X,Y
S RAIENS="",RAXIT=0 D GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
Q:'$D(RADARY) S RAHDR=$$CJ^XLFSTR("Radiopharmaceuticals",IOM,"-")
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF
W !,RAHDR,!
F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D Q:RAXIT
. S (RACNT,RAFLDS)=0
. F S RAFLDS=$O(RADARY(70.21,RAIENS,RAFLDS)) Q:RAFLDS'>0 D Q:RAXIT
.. Q:$G(RADARY(70.21,RAIENS,RAFLDS,"E"))']""
.. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
.. S RAOPUT=$$TRN1(RAFLDS)_$G(RADARY(70.21,RAIENS,RAFLDS,"E"))_$S(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:""),RACNT=RACNT+1
.. W:RACNT=1 $E(RAOPUT,1,38) W:RACNT=2 ?39,$E(RAOPUT,1,39)
.. W:RACNT=2 ! S:RACNT=2 RACNT=0
.. Q
. W:$O(RADARY(70.21,RAIENS)) !!
. Q
Q
TRN1(X) ; Translate Radiopharmaceutical field name to a shorter length.
Q:X=.01 "Rpharm: " Q:X=2 "Dose (MD Override): " Q:X=3 "Prescriber: "
Q:X=4 "Activity Drawn: " Q:X=5 "Drawn: " Q:X=6 "Measured By: "
Q:X=7 "Dose Adm'd: " Q:X=8 "Date Adm'd: " Q:X=9 "Adm'd By: "
Q:X=10 "Witness: " Q:X=11 "Route: " Q:X=12 "Site: "
Q:X=12.5 "Site Text: " Q:X=13 "Lot #: " Q:X=14 "Volume: "
Q:X=15 "Form: "
HDR ; Pharmaceutical/Radiopharmaceutical Header
W @IOF,!,RAHDR,! S RACNT=0
Q
;
CMHIST(RADFN,RADTI,RACNI) ;main body
;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
; RADTI=exam date/time (inverse)
; RACNI=ien of exam record (examinations sub-file 70.03)
;
N X S RAHD="Contrast Media Edit History"
S $P(RALINE,"-",(IOM+1))=""
S RAPG=0 W:$E(IOST,1,2)="C-" @IOF ;clear screen
D CMHDR S (RACMDT,RAXIT)=0
;$O down 'B' xref in ascending chronological order
F S RACMDT=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD","B",RACMDT)) Q:'RACMDT D Q:RAXIT
.S RAIEN=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD","B",RACMDT,0))
.;get_changed date/time, get_previous CM value, get_user
.S RAY(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD",RAIEN,0))
.S RAADT=$$FMTE^XLFDT($P(RAY(0),U),"1P"),RACMU=$P(RAY(0),U,2)
.S:+$P(RAY(0),U,3) RAAU=$$GET1^DIQ(200,$P(RAY(0),U,3)_",",.01)
.S X=$S($L(RACMU):$$CONTRAST^RACMHIS(RACMU),1:"")
.I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D CMHDR
.W !,RAADT,?40,$E($G(RAAU),1,35) W:X="" !
.I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D CMHDR
.I X'="" D D ^DIWW K ^UTILITY($J,"W")
..S DIWL=3,DIWR=70,DIWF="W" D ^DIWP
..Q
.Q
EXIT ;clean up symbol table, message to user
;if there are no records to print, alert user
W:'$D(RAY(0))#2 !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
K RAADT,RAAU,RACH2,RACHNG2,RACMU,RAHD,RAIEN,RALINE,RAPG
K RACMDT,RAY
Q
;
CMHDR ; print header
W:RAPG @IOF S RAPG=RAPG+1
W !,$$CJ^XLFSTR(RAHD,IOM)
W !,"Date/Time Changed",?40,"User",!?2,"Contrast Media"
W !,$$CJ^XLFSTR(RALINE,IOM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPROD2 4569 printed Apr 09, 2024@21:42:43 Page 2
RAPROD2 ;HIRMFO/GJC-Display Med & Radiopharm values for exams ;12/12/96 13:35
+1 ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
+2 ;
PHARM(RADA) ; Display Pharmaceutical default data for Exam displays
+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,RAHDR,RAPHARM,RASUB
SET RA1=""
SET RASUB=70.15
SET RAXIT=0
+5 DO GETS^DIQ(70.03,RADA,"200*","NE","RAPHARM")
if '$DATA(RAPHARM)
QUIT
+6 SET RAHDR=$$CJ^XLFSTR("Medications",IOM,"-")
+7 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
WRITE @IOF
+8 WRITE !,RAHDR,!
+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 WRITE "Med: ",$EXTRACT($GET(RAPHARM(RASUB,RA1,.01,"E")),1,32)
+13 SET RACNT=RACNT+1
+14 QUIT
End DoDot:2
+15 IF $GET(RAPHARM(RASUB,RA1,2,"E"))]""
Begin DoDot:2
+16 NEW RAX
SET RAX="""Dose Adm'd: "",$E($G(RAPHARM(RASUB,RA1,2,""E"")),1,32)"
+17 SET RACNT=RACNT+1
if RACNT=1
WRITE @RAX
if RACNT=2
WRITE ?39,@RAX
+18 QUIT
End DoDot:2
+19 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+20 IF RACNT=2
WRITE !
SET RACNT=0
+21 IF $GET(RAPHARM(RASUB,RA1,4,"E"))]""
Begin DoDot:2
+22 NEW RAX
SET RAX="""Adm'd By: "",$E($G(RAPHARM(RASUB,RA1,4,""E"")),1,28)"
+23 SET RACNT=RACNT+1
if RACNT=1
WRITE @RAX
if RACNT=2
WRITE ?39,@RAX
+24 QUIT
End DoDot:2
+25 IF RACNT=2
WRITE !
SET RACNT=0
+26 IF $GET(RAPHARM(RASUB,RA1,3,"E"))]""
Begin DoDot:2
+27 NEW RAX
SET RAX="""Date Adm'd: "",$E($G(RAPHARM(RASUB,RA1,3,""E"")),1,30)"
+28 SET RACNT=RACNT+1
if RACNT=1
WRITE @RAX
if RACNT=2
WRITE ?39,@RAX
+29 QUIT
End DoDot:2
+30 if $ORDER(RAPHARM(RASUB,RA1))
WRITE !!
+31 QUIT
End DoDot:1
if RAXIT
QUIT
+32 QUIT
RDIO(RADA) ; Display Radiopharmaceutical default data for Exam 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 RACNT,RADARY,RAFLDS,RAHDR,RAIENS,RAOPUT,X,Y
+4 SET RAIENS=""
SET RAXIT=0
DO GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
+5 if '$DATA(RADARY)
QUIT
SET RAHDR=$$CJ^XLFSTR("Radiopharmaceuticals",IOM,"-")
+6 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
WRITE @IOF
+7 WRITE !,RAHDR,!
+8 FOR
SET RAIENS=$ORDER(RADARY(70.21,RAIENS))
if RAIENS=""
QUIT
Begin DoDot:1
+9 SET (RACNT,RAFLDS)=0
+10 FOR
SET RAFLDS=$ORDER(RADARY(70.21,RAIENS,RAFLDS))
if RAFLDS'>0
QUIT
Begin DoDot:2
+11 if $GET(RADARY(70.21,RAIENS,RAFLDS,"E"))']""
QUIT
+12 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+13 SET RAOPUT=$$TRN1(RAFLDS)_$GET(RADARY(70.21,RAIENS,RAFLDS,"E"))_$SELECT(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:"")
SET RACNT=RACNT+1
+14 if RACNT=1
WRITE $EXTRACT(RAOPUT,1,38)
if RACNT=2
WRITE ?39,$EXTRACT(RAOPUT,1,39)
+15 if RACNT=2
WRITE !
if RACNT=2
SET RACNT=0
+16 QUIT
End DoDot:2
if RAXIT
QUIT
+17 if $ORDER(RADARY(70.21,RAIENS))
WRITE !!
+18 QUIT
End DoDot:1
if RAXIT
QUIT
+19 QUIT
TRN1(X) ; Translate Radiopharmaceutical field name to a shorter length.
+1 if X=.01
QUIT "Rpharm: "
if X=2
QUIT "Dose (MD Override): "
if X=3
QUIT "Prescriber: "
+2 if X=4
QUIT "Activity Drawn: "
if X=5
QUIT "Drawn: "
if X=6
QUIT "Measured By: "
+3 if X=7
QUIT "Dose Adm'd: "
if X=8
QUIT "Date Adm'd: "
if X=9
QUIT "Adm'd By: "
+4 if X=10
QUIT "Witness: "
if X=11
QUIT "Route: "
if X=12
QUIT "Site: "
+5 if X=12.5
QUIT "Site Text: "
if X=13
QUIT "Lot #: "
if X=14
QUIT "Volume: "
+6 if X=15
QUIT "Form: "
HDR ; Pharmaceutical/Radiopharmaceutical Header
+1 WRITE @IOF,!,RAHDR,!
SET RACNT=0
+2 QUIT
+3 ;
CMHIST(RADFN,RADTI,RACNI) ;main body
+1 ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
+2 ; RADTI=exam date/time (inverse)
+3 ; RACNI=ien of exam record (examinations sub-file 70.03)
+4 ;
+5 NEW X
SET RAHD="Contrast Media Edit History"
+6 SET $PIECE(RALINE,"-",(IOM+1))=""
+7 ;clear screen
SET RAPG=0
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+8 DO CMHDR
SET (RACMDT,RAXIT)=0
+9 ;$O down 'B' xref in ascending chronological order
+10 FOR
SET RACMDT=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD","B",RACMDT))
if 'RACMDT
QUIT
Begin DoDot:1
+11 SET RAIEN=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD","B",RACMDT,0))
+12 ;get_changed date/time, get_previous CM value, get_user
+13 SET RAY(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD",RAIEN,0))
+14 SET RAADT=$$FMTE^XLFDT($PIECE(RAY(0),U),"1P")
SET RACMU=$PIECE(RAY(0),U,2)
+15 if +$PIECE(RAY(0),U,3)
SET RAAU=$$GET1^DIQ(200,$PIECE(RAY(0),U,3)_",",.01)
+16 SET X=$SELECT($LENGTH(RACMU):$$CONTRAST^RACMHIS(RACMU),1:"")
+17 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO CMHDR
+18 WRITE !,RAADT,?40,$EXTRACT($GET(RAAU),1,35)
if X=""
WRITE !
+19 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO CMHDR
+20 IF X'=""
Begin DoDot:2
+21 SET DIWL=3
SET DIWR=70
SET DIWF="W"
DO ^DIWP
+22 QUIT
End DoDot:2
DO ^DIWW
KILL ^UTILITY($JOB,"W")
+23 QUIT
End DoDot:1
if RAXIT
QUIT
EXIT ;clean up symbol table, message to user
+1 ;if there are no records to print, alert user
+2 if '$DATA(RAY(0))#2
WRITE !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
+3 KILL RAADT,RAAU,RACH2,RACHNG2,RACMU,RAHD,RAIEN,RALINE,RAPG
+4 KILL RACMDT,RAY
+5 QUIT
+6 ;
CMHDR ; print header
+1 if RAPG
WRITE @IOF
SET RAPG=RAPG+1
+2 WRITE !,$$CJ^XLFSTR(RAHD,IOM)
+3 WRITE !,"Date/Time Changed",?40,"User",!?2,"Contrast Media"
+4 WRITE !,$$CJ^XLFSTR(RALINE,IOM)
+5 QUIT
+6 ;
