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

RADOSTIK.m

Go to the documentation of this file. 
  1. RADOSTIK ;HISC/GJC-Routine to print dosage tickets ;8/1/97  14:07
  1.  ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
  1.  ;
  1.  ;Supported IA #2056 reference to GET1^DIQ
  1.  ;Supported IA #10103 reference to NOW^XLFDT and FMTE^XLFDT
  1.  ;Supported IA #10104 reference to CJ^XLFSTR and REPEAT^XLFSTR
  1.  ;Supported IA #2053 reference to FILE^DIE
  1.  ;
  1. EN1(RADFN,RADTI,RACNI) ; the usual suspects
  1.  N I,RA1,RADTIK,RARDIO,RAY2,RAY3
  1.  S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RA1=0
  1.  S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RARDIO=+$P(RAY3,"^",28)
  1.  S RADTIK=+$P($G(^RA(79.1,+$P(RAY2,"^",4),0)),"^",23)
  1.  Q:'RADTIK  ; no dosage ticket printer defined for this imaging location
  1.  Q:'RARDIO  ; no Rpharms associated with this exam
  1.  Q:+$P(RAY3,"^",29)  ; quit if dosage ticket has already been printed
  1.  N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  S ZTDESC="Rad/Nuc Med Print dosage ticket or tickets for an Exam"
  1.  S ZTDTH=$H,ZTIO=$$GET1^DIQ(3.5,RADTIK_",",.01),ZTRTN="PRINT^RADOSTIK"
  1.  F I="RADFN","RARDIO","RAY2","RAY3" S ZTSAVE(I)=""
  1.  D ^%ZTLOAD D SETFLG^RADOSTIK(RADFN,RADTI,RACNI)
  1.  Q
  1. EN2 ; Print duplicate dosage ticket
  1.  D:'$D(RACCESS(DUZ)) SET^RAPSET1 D ^RACNLU Q:X["^"
  1.  N I,RADOSTIK,RARDIO,RAY2,RAY3
  1.  S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RADOSTIK=""
  1.  S RAY3=Y(0),RARDIO=+$P(RAY3,"^",28) ; RAY3 is the zero node of the exam
  1.  ; RADFN,RADTI & RACNI are all defined!
  1.  I 'RARDIO D  D KILL Q
  1.  . W !!?3,"Dosage ticket data does not exist!",$C(7)
  1.  . Q
  1.  N ZTDESC,ZTRTN,ZTSAVE S ZTRTN="PRINT^RADOSTIK"
  1.  F I="RADFN","RADOSTIK","RARDIO","RAY2","RAY3" S ZTSAVE(I)=""
  1.  S ZTDESC="Rad/Nuc Med Print Duplicate Dosage Ticket option."
  1.  D ZIS^RAUTL I RAPOP D KILL Q
  1.  D PRINT,KILL
  1.  Q
  1. PRINT ; Print out dosage ticket(s).  If more than one rpharm, print one
  1.  ; dosage ticket per page.
  1.  U IO S:$D(ZTQUEUED) ZTREQ="@"
  1.  W:$D(RADOSTIK)&($E(IOST,1,2)="C-") @IOF
  1.  N RA1,RA702,RA719,RACNST,RANOTE,RAPRTDT,RATTLE,RAX,RAXIT
  1.  S (RA1,RAXIT)=0
  1.  S RATTLE="Radiopharmaceutical Dose Computation and Measurement Record"
  1.  S RAPRTDT=$$NOW^XLFDT()
  1.  S:$L($P(RAPRTDT,".",2))>4 RAPRTDT=$P(RAPRTDT,".")_"."_$E($P(RAPRTDT,".",2),1,4) ; don't display seconds in printed date
  1.  S RAPRTDT="Printed: "_$$FMTE^XLFDT(RAPRTDT,"1P"),RACNST=$L(RAPRTDT)
  1.  F  S RA1=$O(^RADPTN(RARDIO,"NUC",RA1)) Q:RA1'>0  D  Q:RAXIT
  1.  . K RANOTE W !,$$CJ^XLFSTR(RATTLE,IOM),!,$$CJ^XLFSTR(RAPRTDT,IOM)
  1.  . I $D(ZTQUEUED),($D(RADOSTIK)) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
  1.  . Q:RAXIT
  1.  . W !!,"Case                    : ",$P(RAY3,"^")_"@"_$$FMTE^XLFDT($P(RAY2,"^"),"1P")
  1.  . W !!,"Patient                 : ",$$GET1^DIQ(2,RADFN_",",.01)
  1.  . W !,"Patient ID              : ",$$SSN^RAUTL()
  1.  . W !,"Study                   : ",$E($$GET1^DIQ(71,+$P(RAY3,"^",2)_",",.01),1,50)
  1.  . S RA702=$G(^RADPTN(RARDIO,"NUC",RA1,0))
  1.  . W !!,"Radiopharmaceutical     : "
  1.  . S RAX=$$EN1^RAPSAPI(+$P(RA702,"^"),.01) S:RAX="" RANOTE=""
  1.  . W $S(RAX]"":RAX,1:"*****") K RAX
  1.  . W !,"Form                    : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",15)
  1.  . D GETS^DIQ(71.9,+$P(RA702,"^",13)_",","*","","RA719")
  1.  . W !,"Lot No.                 : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",.01))
  1.  . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX
  1.  . W !,"Kit No.                 : ",$G(RA719(71.9,+$P(RA702,"^",13)_",",4))
  1.  . W !,"Lot Expiration Date     : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",3))
  1.  . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX
  1.  . W !!,"Date/Time of Measurement: " S RAX=$$GET1^DIQ(70.21,RA1_","_RARDIO_",",5)
  1.  . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX
  1.  . W !,"Dose Prescribed         : "
  1.  . I $P(RA702,"^",2)]"" W $P(RA702,"^",2)_" mCi"
  1.  . I $P(RA702,"^",2)']"",(+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0))) D
  1.  .. N RA7108 S RA7108=+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0))
  1.  .. S RA7108(0)=$G(^RAMIS(71,+$P(RAY3,"^",2),"NUC",RA7108,0))
  1.  .. W:$P(RA7108(0),"^",6)]"" "Low: "_$P(RA7108(0),"^",6)_" mCi   "
  1.  .. W:$P(RA7108(0),"^",5)]"" "High: "_$P(RA7108(0),"^",5)_" mCi"
  1.  .. Q
  1.  . W !,"Activity Drawn          : ",$S($P(RA702,"^",4)]"":$P(RA702,"^",4)_" mCi",1:"*****")
  1.  . S:$P(RA702,"^",4)="" RANOTE=""
  1.  . W !,"Dose Administered       : ",$S($P(RA702,"^",7)]"":$P(RA702,"^",7)_" mCi",1:"")
  1.  . W !,"Time of Administration  : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",8)
  1.  . W !!,"Signature of Person Measuring Dose: "
  1.  . W $$REPEAT^XLFSTR("_",((IOM-3)-$X)) K RA719
  1.  . W:$D(RANOTE) !!,"NOTE: '*****' indicates that required pieces of information are missing."
  1.  . S:'$D(ZTQUEUED)&($D(RADOSTIK))&(+$O(^RADPTN(RARDIO,"NUC",RA1))) RAXIT=$$EOS^RAUTL5()  Q:RAXIT
  1.  . W:+$O(^RADPTN(RARDIO,"NUC",RA1)) @IOF ; dosage ticket per page
  1.  . Q
  1.  D CLOSE^RAUTL,KILL^RADOSTIK
  1.  Q
  1. KILL ; Kill variables
  1.  K %,%W,%Y,%Y1,C,RACN,RACNI,RADATE,RADFN,RADTE,RADTI,RANME,RAPOP,RAPRC
  1.  K RARPT,RASSN,RAST,X,Y
  1.  K DIC,DIPGM,DISYS,DUOUT,I,RAHEAD,RAI,RAMES,RAEND,RAFL,RAFST,RAHEAD,RAIX
  1.  K ^TMP($J,"RAEX")
  1.  Q
  1. SETFLG(RADFN,RADTI,RACNI) ; Set the 'Dosage Ticket Printed?'
  1.  ; ^DD(70.03,29,0) field to 'Yes'.
  1.  ; Input: RADFN==> Patient ien     RADTI==> Inverse Date/Time of Exam
  1.  ;        RACNI==> ien of the examination
  1.  N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",29)=1
  1.  D FILE^DIE("","RAFDA")
  1.  Q