Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAPROD2

RAPROD2.m

Go to the documentation of this file. 
  1. RAPROD2 ;HIRMFO/GJC-Display Med & Radiopharm values for exams ;12/12/96  13:35
  1.  ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
  1.  ;
  1. PHARM(RADA) ; Display Pharmaceutical default data for Exam displays
  1.  ; Input: RADA -> ien for the Examinations (50) multiple.
  1.  ;        in the following format: RACNI_","_RADTI_","_RADFN_","
  1.  ; *** Called only if $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) ***
  1.  N RA1,RACNT,RAHDR,RAPHARM,RASUB S RA1="",RASUB=70.15,RAXIT=0
  1.  D GETS^DIQ(70.03,RADA,"200*","NE","RAPHARM") Q:'$D(RAPHARM)
  1.  S RAHDR=$$CJ^XLFSTR("Medications",IOM,"-")
  1.  I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,RAHDR,!
  1.  F  S RA1=$O(RAPHARM(RASUB,RA1)) Q:RA1']""  D  Q:RAXIT
  1.  . S RACNT=0
  1.  . I $G(RAPHARM(RASUB,RA1,.01,"E"))]"" D
  1.  .. W "Med: ",$E($G(RAPHARM(RASUB,RA1,.01,"E")),1,32)
  1.  .. S RACNT=RACNT+1
  1.  .. Q
  1.  . I $G(RAPHARM(RASUB,RA1,2,"E"))]"" D
  1.  .. N RAX S RAX="""Dose Adm'd: "",$E($G(RAPHARM(RASUB,RA1,2,""E"")),1,32)"
  1.  .. S RACNT=RACNT+1 W:RACNT=1 @RAX W:RACNT=2 ?39,@RAX
  1.  .. Q
  1.  . I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D HDR
  1.  . I RACNT=2 W ! S RACNT=0
  1.  . I $G(RAPHARM(RASUB,RA1,4,"E"))]"" D
  1.  .. N RAX S RAX="""Adm'd By: "",$E($G(RAPHARM(RASUB,RA1,4,""E"")),1,28)"
  1.  .. S RACNT=RACNT+1 W:RACNT=1 @RAX W:RACNT=2 ?39,@RAX
  1.  .. Q
  1.  . I RACNT=2 W ! S RACNT=0
  1.  . I $G(RAPHARM(RASUB,RA1,3,"E"))]"" D
  1.  .. N RAX S RAX="""Date Adm'd: "",$E($G(RAPHARM(RASUB,RA1,3,""E"")),1,30)"
  1.  .. S RACNT=RACNT+1 W:RACNT=1 @RAX W:RACNT=2 ?39,@RAX
  1.  .. Q
  1.  . W:$O(RAPHARM(RASUB,RA1)) !!
  1.  . Q
  1.  Q
  1. RDIO(RADA) ; Display Radiopharmaceutical default data for Exam displays
  1.  ; Input: RADA -> ien of the Nuc Med Exam Data record (file 70.2)
  1.  ; *** Called only if $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,28)>0 ***
  1.  N RACNT,RADARY,RAFLDS,RAHDR,RAIENS,RAOPUT,X,Y
  1.  S RAIENS="",RAXIT=0 D GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
  1.  Q:'$D(RADARY)  S RAHDR=$$CJ^XLFSTR("Radiopharmaceuticals",IOM,"-")
  1.  I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,RAHDR,!
  1.  F  S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS=""  D  Q:RAXIT
  1.  . S (RACNT,RAFLDS)=0
  1.  . F  S RAFLDS=$O(RADARY(70.21,RAIENS,RAFLDS)) Q:RAFLDS'>0  D  Q:RAXIT
  1.  .. Q:$G(RADARY(70.21,RAIENS,RAFLDS,"E"))']""
  1.  .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D HDR
  1.  .. 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
  1.  .. W:RACNT=1 $E(RAOPUT,1,38) W:RACNT=2 ?39,$E(RAOPUT,1,39)
  1.  .. W:RACNT=2 ! S:RACNT=2 RACNT=0
  1.  .. Q
  1.  . W:$O(RADARY(70.21,RAIENS)) !!
  1.  . Q
  1.  Q
  1. TRN1(X) ; Translate Radiopharmaceutical field name to a shorter length.
  1.  Q:X=.01 "Rpharm: " Q:X=2 "Dose (MD Override): " Q:X=3 "Prescriber: "
  1.  Q:X=4 "Activity Drawn: " Q:X=5 "Drawn: " Q:X=6 "Measured By: "
  1.  Q:X=7 "Dose Adm'd: " Q:X=8 "Date Adm'd: " Q:X=9 "Adm'd By: "
  1.  Q:X=10 "Witness: " Q:X=11 "Route: " Q:X=12 "Site: "
  1.  Q:X=12.5 "Site Text: " Q:X=13 "Lot #: " Q:X=14 "Volume: "
  1.  Q:X=15 "Form: "
  1. HDR ; Pharmaceutical/Radiopharmaceutical Header
  1.  W @IOF,!,RAHDR,! S RACNT=0
  1.  Q
  1.  ;
  1. CMHIST(RADFN,RADTI,RACNI) ;main body
  1.  ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
  1.  ;       RADTI=exam date/time (inverse)
  1.  ;       RACNI=ien of exam record (examinations sub-file 70.03)
  1.  ;
  1.  N X S RAHD="Contrast Media Edit History"
  1.  S $P(RALINE,"-",(IOM+1))=""
  1.  S RAPG=0 W:$E(IOST,1,2)="C-" @IOF ;clear screen
  1.  D CMHDR S (RACMDT,RAXIT)=0
  1.  ;$O down 'B' xref in ascending chronological order
  1.  F  S RACMDT=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD","B",RACMDT)) Q:'RACMDT  D  Q:RAXIT
  1.  .S RAIEN=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD","B",RACMDT,0))
  1.  .;get_changed date/time, get_previous CM value, get_user
  1.  .S RAY(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD",RAIEN,0))
  1.  .S RAADT=$$FMTE^XLFDT($P(RAY(0),U),"1P"),RACMU=$P(RAY(0),U,2)
  1.  .S:+$P(RAY(0),U,3) RAAU=$$GET1^DIQ(200,$P(RAY(0),U,3)_",",.01)
  1.  .S X=$S($L(RACMU):$$CONTRAST^RACMHIS(RACMU),1:"")
  1.  .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D CMHDR
  1.  .W !,RAADT,?40,$E($G(RAAU),1,35) W:X="" !
  1.  .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D CMHDR
  1.  .I X'="" D  D ^DIWW K ^UTILITY($J,"W")
  1.  ..S DIWL=3,DIWR=70,DIWF="W" D ^DIWP
  1.  ..Q
  1.  .Q
  1. EXIT ;clean up symbol table, message to user
  1.  ;if there are no records to print, alert user
  1.  W:'$D(RAY(0))#2 !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
  1.  K RAADT,RAAU,RACH2,RACHNG2,RACMU,RAHD,RAIEN,RALINE,RAPG
  1.  K RACMDT,RAY
  1.  Q
  1.  ;
  1. CMHDR ; print header
  1.  W:RAPG @IOF S RAPG=RAPG+1
  1.  W !,$$CJ^XLFSTR(RAHD,IOM)
  1.  W !,"Date/Time Changed",?40,"User",!?2,"Contrast Media"
  1.  W !,$$CJ^XLFSTR(RALINE,IOM)
  1.  Q
  1.  ;