- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADOSTIK.m
r613 r623 1 RADOSTIK ;HISC/GJC-Routine to print dosage tickets ;8/1/97 14:07 2 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 3 ; 4 ;Supported IA #2056 reference to GET1^DIQ 5 ;Supported IA #10103 reference to NOW^XLFDT and FMTE^XLFDT 6 ;Supported IA #10104 reference to CJ^XLFSTR and REPEAT^XLFSTR 7 ;Supported IA #2053 reference to FILE^DIE 8 ; 9 EN1(RADFN,RADTI,RACNI) ; the usual suspects 10 N I,RA1,RADTIK,RARDIO,RAY2,RAY3 11 S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RA1=0 12 S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RARDIO=+$P(RAY3,"^",28) 13 S RADTIK=+$P($G(^RA(79.1,+$P(RAY2,"^",4),0)),"^",23) 14 Q:'RADTIK ; no dosage ticket printer defined for this imaging location 15 Q:'RARDIO ; no Rpharms associated with this exam 16 Q:+$P(RAY3,"^",29) ; quit if dosage ticket has already been printed 17 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE 18 S ZTDESC="Rad/Nuc Med Print dosage ticket or tickets for an Exam" 19 S ZTDTH=$H,ZTIO=$$GET1^DIQ(3.5,RADTIK_",",.01),ZTRTN="PRINT^RADOSTIK" 20 F I="RADFN","RARDIO","RAY2","RAY3" S ZTSAVE(I)="" 21 D ^%ZTLOAD D SETFLG^RADOSTIK(RADFN,RADTI,RACNI) 22 Q 23 EN2 ; Print duplicate dosage ticket 24 D:'$D(RACCESS(DUZ)) SET^RAPSET1 D ^RACNLU Q:X["^" 25 N I,RADOSTIK,RARDIO,RAY2,RAY3 26 S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RADOSTIK="" 27 S RAY3=Y(0),RARDIO=+$P(RAY3,"^",28) ; RAY3 is the zero node of the exam 28 ; RADFN,RADTI & RACNI are all defined! 29 I 'RARDIO D D KILL Q 30 . W !!?3,"Dosage ticket data does not exist!",$C(7) 31 . Q 32 N ZTDESC,ZTRTN,ZTSAVE S ZTRTN="PRINT^RADOSTIK" 33 F I="RADFN","RADOSTIK","RARDIO","RAY2","RAY3" S ZTSAVE(I)="" 34 S ZTDESC="Rad/Nuc Med Print Duplicate Dosage Ticket option." 35 D ZIS^RAUTL I RAPOP D KILL Q 36 D PRINT,KILL 37 Q 38 PRINT ; Print out dosage ticket(s). If more than one rpharm, print one 39 ; dosage ticket per page. 40 U IO S:$D(ZTQUEUED) ZTREQ="@" 41 W:$D(RADOSTIK)&($E(IOST,1,2)="C-") @IOF 42 N RA1,RA702,RA719,RACNST,RANOTE,RAPRTDT,RATTLE,RAX,RAXIT 43 S (RA1,RAXIT)=0 44 S RATTLE="Radiopharmaceutical Dose Computation and Measurement Record" 45 S RAPRTDT=$$NOW^XLFDT() 46 S:$L($P(RAPRTDT,".",2))>4 RAPRTDT=$P(RAPRTDT,".")_"."_$E($P(RAPRTDT,".",2),1,4) ; don't display seconds in printed date 47 S RAPRTDT="Printed: "_$$FMTE^XLFDT(RAPRTDT,"1P"),RACNST=$L(RAPRTDT) 48 F S RA1=$O(^RADPTN(RARDIO,"NUC",RA1)) Q:RA1'>0 D Q:RAXIT 49 . K RANOTE W !,$$CJ^XLFSTR(RATTLE,IOM),!,$$CJ^XLFSTR(RAPRTDT,IOM) 50 . I $D(ZTQUEUED),($D(RADOSTIK)) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 51 . Q:RAXIT 52 . W !!,"Case : ",$P(RAY3,"^")_"@"_$$FMTE^XLFDT($P(RAY2,"^"),"1P") 53 . W !!,"Patient : ",$$GET1^DIQ(2,RADFN_",",.01) 54 . W !,"Patient ID : ",$$SSN^RAUTL() 55 . W !,"Study : ",$E($$GET1^DIQ(71,+$P(RAY3,"^",2)_",",.01),1,50) 56 . S RA702=$G(^RADPTN(RARDIO,"NUC",RA1,0)) 57 . W !!,"Radiopharmaceutical : " 58 . S RAX=$$EN1^RAPSAPI(+$P(RA702,"^"),.01) S:RAX="" RANOTE="" 59 . W $S(RAX]"":RAX,1:"*****") K RAX 60 . W !,"Form : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",15) 61 . D GETS^DIQ(71.9,+$P(RA702,"^",13)_",","*","","RA719") 62 . W !,"Lot No. : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",.01)) 63 . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX 64 . W !,"Kit No. : ",$G(RA719(71.9,+$P(RA702,"^",13)_",",4)) 65 . W !,"Lot Expiration Date : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",3)) 66 . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX 67 . W !!,"Date/Time of Measurement: " S RAX=$$GET1^DIQ(70.21,RA1_","_RARDIO_",",5) 68 . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX 69 . W !,"Dose Prescribed : " 70 . I $P(RA702,"^",2)]"" W $P(RA702,"^",2)_" mCi" 71 . I $P(RA702,"^",2)']"",(+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0))) D 72 .. N RA7108 S RA7108=+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0)) 73 .. S RA7108(0)=$G(^RAMIS(71,+$P(RAY3,"^",2),"NUC",RA7108,0)) 74 .. W:$P(RA7108(0),"^",6)]"" "Low: "_$P(RA7108(0),"^",6)_" mCi " 75 .. W:$P(RA7108(0),"^",5)]"" "High: "_$P(RA7108(0),"^",5)_" mCi" 76 .. Q 77 . W !,"Activity Drawn : ",$S($P(RA702,"^",4)]"":$P(RA702,"^",4)_" mCi",1:"*****") 78 . S:$P(RA702,"^",4)="" RANOTE="" 79 . W !,"Dose Administered : ",$S($P(RA702,"^",7)]"":$P(RA702,"^",7)_" mCi",1:"") 80 . W !,"Time of Administration : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",8) 81 . W !!,"Signature of Person Measuring Dose: " 82 . W $$REPEAT^XLFSTR("_",((IOM-3)-$X)) K RA719 83 . W:$D(RANOTE) !!,"NOTE: '*****' indicates that required pieces of information are missing." 84 . S:'$D(ZTQUEUED)&($D(RADOSTIK))&(+$O(^RADPTN(RARDIO,"NUC",RA1))) RAXIT=$$EOS^RAUTL5() Q:RAXIT 85 . W:+$O(^RADPTN(RARDIO,"NUC",RA1)) @IOF ; dosage ticket per page 86 . Q 87 D CLOSE^RAUTL,KILL^RADOSTIK 88 Q 89 KILL ; Kill variables 90 K %,%W,%Y,%Y1,C,RACN,RACNI,RADATE,RADFN,RADTE,RADTI,RANME,RAPOP,RAPRC 91 K RARPT,RASSN,RAST,X,Y 92 K DIC,DIPGM,DISYS,DUOUT,I,RAHEAD,RAI,RAMES,RAEND,RAFL,RAFST,RAHEAD,RAIX 93 K ^TMP($J,"RAEX") 94 Q 95 SETFLG(RADFN,RADTI,RACNI) ; Set the 'Dosage Ticket Printed?' 96 ; ^DD(70.03,29,0) field to 'Yes'. 97 ; Input: RADFN==> Patient ien RADTI==> Inverse Date/Time of Exam 98 ; RACNI==> ien of the examination 99 N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",29)=1 100 D FILE^DIE("","RAFDA") 101 Q 1 RADOSTIK ;HISC/GJC-Routine to print dosage tickets ;8/1/97 14:07 2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998 3 ; 4 EN1(RADFN,RADTI,RACNI) ; the usual suspects 5 N I,RA1,RADTIK,RARDIO,RAY2,RAY3 6 S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RA1=0 7 S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RARDIO=+$P(RAY3,"^",28) 8 S RADTIK=+$P($G(^RA(79.1,+$P(RAY2,"^",4),0)),"^",23) 9 Q:'RADTIK ; no dosage ticket printer defined for this imaging location 10 Q:'RARDIO ; no Rpharms associated with this exam 11 Q:+$P(RAY3,"^",29) ; quit if dosage ticket has already been printed 12 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE 13 S ZTDESC="Rad/Nuc Med Print dosage ticket or tickets for an Exam" 14 S ZTDTH=$H,ZTIO=$$GET1^DIQ(3.5,RADTIK_",",.01),ZTRTN="PRINT^RADOSTIK" 15 F I="RADFN","RARDIO","RAY2","RAY3" S ZTSAVE(I)="" 16 D ^%ZTLOAD D SETFLG^RADOSTIK(RADFN,RADTI,RACNI) 17 Q 18 EN2 ; Print duplicate dosage ticket 19 D:'$D(RACCESS(DUZ)) SET^RAPSET1 D ^RACNLU Q:X["^" 20 N I,RADOSTIK,RARDIO,RAY2,RAY3 21 S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RADOSTIK="" 22 S RAY3=Y(0),RARDIO=+$P(RAY3,"^",28) ; RAY3 is the zero node of the exam 23 ; RADFN,RADTI & RACNI are all defined! 24 I 'RARDIO D D KILL Q 25 . W !!?3,"Dosage ticket data does not exist!",$C(7) 26 . Q 27 N ZTDESC,ZTRTN,ZTSAVE S ZTRTN="PRINT^RADOSTIK" 28 F I="RADFN","RADOSTIK","RARDIO","RAY2","RAY3" S ZTSAVE(I)="" 29 S ZTDESC="Rad/Nuc Med Print Duplicate Dosage Ticket option." 30 D ZIS^RAUTL I RAPOP D KILL Q 31 D PRINT,KILL 32 Q 33 PRINT ; Print out dosage ticket(s). If more than one rpharm, print one 34 ; dosage ticket per page. 35 U IO S:$D(ZTQUEUED) ZTREQ="@" 36 W:$D(RADOSTIK)&($E(IOST,1,2)="C-") @IOF 37 N RA1,RA702,RA719,RACNST,RANOTE,RAPRTDT,RATTLE,RAX,RAXIT 38 S (RA1,RAXIT)=0 39 S RATTLE="Radiopharmaceutical Dose Computation and Measurement Record" 40 S RAPRTDT=$$NOW^XLFDT() 41 S:$L($P(RAPRTDT,".",2))>4 RAPRTDT=$P(RAPRTDT,".")_"."_$E($P(RAPRTDT,".",2),1,4) ; don't display seconds in printed date 42 S RAPRTDT="Printed: "_$$FMTE^XLFDT(RAPRTDT,"1P"),RACNST=$L(RAPRTDT) 43 F S RA1=$O(^RADPTN(RARDIO,"NUC",RA1)) Q:RA1'>0 D Q:RAXIT 44 . K RANOTE W !,$$CJ^XLFSTR(RATTLE,IOM),!,$$CJ^XLFSTR(RAPRTDT,IOM) 45 . I $D(ZTQUEUED),($D(RADOSTIK)) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 46 . Q:RAXIT 47 . W !!,"Case : ",$P(RAY3,"^")_"@"_$$FMTE^XLFDT($P(RAY2,"^"),"1P") 48 . W !!,"Patient : ",$$GET1^DIQ(2,RADFN_",",.01) 49 . W !,"Patient ID : ",$$SSN^RAUTL() 50 . W !,"Study : ",$E($$GET1^DIQ(71,+$P(RAY3,"^",2)_",",.01),1,50) 51 . S RA702=$G(^RADPTN(RARDIO,"NUC",RA1,0)) 52 . W !!,"Radiopharmaceutical : " 53 . S RAX=$$GET1^DIQ(50,+$P(RA702,"^")_",",.01) S:RAX="" RANOTE="" 54 . W $S(RAX]"":RAX,1:"*****") K RAX 55 . W !,"Form : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",15) 56 . D GETS^DIQ(71.9,+$P(RA702,"^",13)_",","*","","RA719") 57 . W !,"Lot No. : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",.01)) 58 . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX 59 . W !,"Kit No. : ",$G(RA719(71.9,+$P(RA702,"^",13)_",",4)) 60 . W !,"Lot Expiration Date : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",3)) 61 . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX 62 . W !!,"Date/Time of Measurement: " S RAX=$$GET1^DIQ(70.21,RA1_","_RARDIO_",",5) 63 . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX 64 . W !,"Dose Prescribed : " 65 . I $P(RA702,"^",2)]"" W $P(RA702,"^",2)_" mCi" 66 . I $P(RA702,"^",2)']"",(+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0))) D 67 .. N RA7108 S RA7108=+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0)) 68 .. S RA7108(0)=$G(^RAMIS(71,+$P(RAY3,"^",2),"NUC",RA7108,0)) 69 .. W:$P(RA7108(0),"^",6)]"" "Low: "_$P(RA7108(0),"^",6)_" mCi " 70 .. W:$P(RA7108(0),"^",5)]"" "High: "_$P(RA7108(0),"^",5)_" mCi" 71 .. Q 72 . W !,"Activity Drawn : ",$S($P(RA702,"^",4)]"":$P(RA702,"^",4)_" mCi",1:"*****") 73 . S:$P(RA702,"^",4)="" RANOTE="" 74 . W !,"Dose Administered : ",$S($P(RA702,"^",7)]"":$P(RA702,"^",7)_" mCi",1:"") 75 . W !,"Time of Administration : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",8) 76 . W !!,"Signature of Person Measuring Dose: " 77 . W $$REPEAT^XLFSTR("_",((IOM-3)-$X)) K RA719 78 . W:$D(RANOTE) !!,"NOTE: '*****' indicates that required pieces of information are missing." 79 . S:'$D(ZTQUEUED)&($D(RADOSTIK))&(+$O(^RADPTN(RARDIO,"NUC",RA1))) RAXIT=$$EOS^RAUTL5() Q:RAXIT 80 . W:+$O(^RADPTN(RARDIO,"NUC",RA1)) @IOF ; dosage ticket per page 81 . Q 82 D CLOSE^RAUTL,KILL^RADOSTIK 83 Q 84 KILL ; Kill variables 85 K %,%W,%Y,%Y1,C,RACN,RACNI,RADATE,RADFN,RADTE,RADTI,RANME,RAPOP,RAPRC 86 K RARPT,RASSN,RAST,X,Y 87 K DIC,DIPGM,DISYS,DUOUT,I,RAHEAD,RAI,RAMES,RAEND,RAFL,RAFST,RAHEAD,RAIX 88 K ^TMP($J,"RAEX") 89 Q 90 SETFLG(RADFN,RADTI,RACNI) ; Set the 'Dosage Ticket Printed?' 91 ; ^DD(70.03,29,0) field to 'Yes'. 92 ; Input: RADFN==> Patient ien RADTI==> Inverse Date/Time of Exam 93 ; RACNI==> ien of the examination 94 N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",29)=1 95 D FILE^DIE("","RAFDA") 96 Q
Note:
See TracChangeset
for help on using the changeset viewer.
