- 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/RANMUSE2.m
r613 r623 1 RANMUSE2 ;HISC/SWM-Nuclear Medicine Usage reports ;9/3/97 14:37 2 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 3 ; 4 ;Supported IA #10061 reference to DEM^VADPT 5 ; 6 SET ; There are 2 parts: set local arrays and ^tmp() 7 ; 8 ; part 1 -- raseqd(),raseqi(),ranumd(),ranumi() so to reduce 9 ; div and img-typ names to a single number, and so to reduce 10 ; the length of the ^tmp() string 11 ; raseqd("division name")=sequence number for alpha sort order 12 ; raseqi("imaging type name")=sequence number for alpha sort order 13 ; ranumd(sequence number for alpha sort order)="division name" 14 ; ranumi(sequence number for alpha sort order)="imaging type name" 15 ; 16 S RA1=0 F S RA1=$O(^RA(79,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2 RASEQD($P($G(^DIC(4,+RA2,0)),U))="" 17 S RA1="",RA2=1 F S RA1=$O(RASEQD(RA1)) Q:RA1="" S RASEQD(RA1)=RA2,RANUMD(RA2)=RA1,RA2=RA2+1 18 ; 19 S RA1=0 F S RA1=$O(^RA(79.2,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2]"" RASEQI(RA2)="" 20 S RA1="",RA2=1 F S RA1=$O(RASEQI(RA1)) Q:RA1="" S RASEQI(RA1)=RA2,RANUMI(RA2)=RA1,RA2=RA2+1 21 ; 22 ; part 2 -- ^TMP($J,"RA",div,imgtyp,S3,S4,patnam,caseno) 23 ; S3 = sort field 3, either radiopharm/whoadmin or examdttm 24 ; S4 = sort field 4, either examdttm or radiopharm/whoadmin 25 ; 26 ; Loop thru ^RADPTN("AB" to select recs within requested date range 27 ; 28 S RA0=RADTBEG-.0001 29 S1 S RA0=$O(^RADPTN("AB",RA0)) Q:RA0="" Q:RA0>RADTEND S RA1=0 30 S2 S RA1=$O(^RADPTN("AB",RA0,RA1)) G:RA1="" S1 31 S RAN0=$G(^RADPTN(RA1,0)) G:RAN0="" S2 32 S RADFN=$P(RAN0,U) G:RADFN="" S2 33 S RADTI=9999999.9999-$P(RAN0,U,2) G:RADTI="" S2 34 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",$P(RAN0,U,3),0)) G:RACNI="" S2 35 D EXTRACT 36 G S2 37 EXTRACT ; 38 S P02=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:P02="" 39 S P03=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:P03="" 40 S RADIVNAM=$P($G(^DIC(4,+$P(P02,U,3),0)),U) 41 Q:'$D(^TMP($J,"RA D-TYPE",RADIVNAM)) ; div not selected 42 S RAIMGNAM=$P($G(^RA(79.2,+$P(P02,U,2),0)),U) 43 Q:'$D(^TMP($J,"RA I-TYPE",RAIMGNAM)) ; img typ not selected 44 S RA2=0 45 F1 S RA2=$O(^RADPTN(RA1,"NUC",RA2)) Q:RA2'=+RA2 46 S RANUC=^RADPTN(RA1,"NUC",RA2,0) 47 S RACN=$P(RAN0,U,3) 48 S RADIOPH=$$EN1^RAPSAPI(+$P(RANUC,U),.01) ; Radiopharm Name 49 I 'RAINPUT,RATITLE["Usage",'$D(^TMP($J,"RA EITHER",RADIOPH)) G F1 ;radioph not selectd 50 S RAWHO=$P($G(^VA(200,+$P(RANUC,U,9),0)),U) ; who administered dose 51 I RATITLE["Admin",RAWHO="" G F1 ;who admin dose is unknown 52 I 'RAINPUT,RATITLE["Admin",'$D(^TMP($J,"RA EITHER",RAWHO)) G F1 ;who not selectd 53 S RAXMDTM=$P(RAN0,U,2) ; exam date/time 54 S RAPRC0=$G(^RAMIS(71,+$P(P03,U,2),0)) ; procedure 0-node 55 S RAPRCNAM=$P(RAPRC0,U) ; procedure name 56 S DFN=RADFN D DEM^VADPT 57 S RAPATNAM=$P(VADM(1),U) ; patient name 58 S RASSN=$P(VADM(2),U,2) ; ssn 59 K VADM 60 S RADOSE=$P(RANUC,U,7) ; dose administered 61 S RADRAWN=$P(RANUC,U,4) ; activity drawn 62 I 'RADOSE,'RADRAWN G F1 ; dose admin and drawn both null/zero 63 ; ien of procedure sub-record with matching radiopharm 64 ; if user changes default radiopharm entry, or 65 ; adds a radiopharm that's not defined in file 71 default radiopharm, 66 ; the high and low values would be unknown 67 S RANUC1=$O(^RAMIS(71,+$P(P03,U,2),"NUC","B",+$P(RANUC,U),0)) 68 ; 0-node of procedure sub-record with matching radiopharm 69 S:RANUC1 RANUC1=^RAMIS(71,+$P(P03,U,2),"NUC",+RANUC1,0) 70 S RAHIGH=$P(RANUC1,U,5) ; high adult dose 71 S RALOW=$P(RANUC1,U,6) ; low adult dose 72 S RASTERSK="" 73 I RADOSE>0,RALOW>0,RADOSE<RALOW S RASTERSK="*" 74 I RADOSE>0,RAHIGH>0,RADOSE>RAHIGH S RASTERSK="*" 75 D S3S4 76 S ^TMP($J,"RA",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),S3,S4,$E(RAPATNAM,1,15),RACN,RADIOPH)=RASSN_U_RADRAWN_U_RADOSE_U_RAHIGH_U_RALOW_U_RAWHO_U_RASTERSK_U_RAPRCNAM 77 I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN)) S ^(RASEQI(RAIMGNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM)))+1,^(RASEQD(RADIVNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM)))+1 78 S RAEITHER=$S(RATITLE["Usage":RADIOPH,1:RAWHO) 79 I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER)) S ^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1,^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RAEITHER))+1 80 S ^(RASSN)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN))+1 81 S ^(RAEITHER)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER))+1 82 ; img typ totals 83 S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 84 S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADRAWN 85 S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADOSE 86 ; "ratradio" is used for either radiopharm or who-admin-dose 87 S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 88 ; division totals 89 S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RAEITHER))+1 90 S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RAEITHER))+RADRAWN 91 S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RAEITHER))+RADOSE 92 S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RAEITHER))+1 93 G F1 94 WRT S RASEQD="" 95 W1 S RASEQD=$O(^TMP($J,"RA",RASEQD)) Q:RASEQD="" S RASEQI="" 96 W2 S RASEQI=$O(^TMP($J,"RA",RASEQD,RASEQI)) G:RASEQI="" W1 S S3="" 97 S:RAPG>0 RAXIT=$$EOS^RAUTL5 Q:$G(RAXIT) D PGHD^RANMUSE3,COLHD^RANMUSE3 98 W3 S S3=$O(^TMP($J,"RA",RASEQD,RASEQI,S3)) G:S3="" W2 S S4="" 99 W4 S S4=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4)) G:S4="" W3 S RAPATNAM="" 100 W5 S RAPATNAM=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM)) G:RAPATNAM="" W4 S RACN="" 101 W6 S RACN=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN)) G:RACN="" W5 S RADIOPH="" 102 W7 S RADIOPH=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN,RADIOPH)) G:RADIOPH="" W6 S RA1=^(RADIOPH) 103 S RALONGCN=$S(RASORT:S3,1:S4),RALONGCN=$E(RALONGCN,4,7)_$E(RALONGCN,2,3)_"-"_RACN_"@"_$E($P(RALONGCN,".",2)_"000",1,4) 104 S RASSN=$P(RA1,U),RADRAWN=$P(RA1,U,2),RADOSE=$P(RA1,U,3),RAHIGH=$P(RA1,U,4),RALOW=$P(RA1,U,5),RAWHO=$P(RA1,U,6),RASTERSK=$P(RA1,U,7) 105 S RAPRCNAM=$P(RA1,U,8) 106 I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD^RANMUSE3,COLHD^RANMUSE3 107 W !,RALONGCN,?16,$E(RAPATNAM,1,15),?32,RASSN,?44,$E(RADIOPH,1,15),?59,$J(RADRAWN,10,4),?69,$J(RADOSE,10,4),?79,$J(RALOW,10,4),?89,$J(RAHIGH,10,4),?100,$E(RAPRCNAM,1,15),?116,$E(RAWHO,1,15),?131,RASTERSK 108 G W7 109 S3S4 ; set subscripts 3 and 4 110 I RATITLE["Usage" D Q 111 . I RASORT S S4=$E(RADIOPH,1,15),S3=RAXMDTM 112 . I 'RASORT S S3=$E(RADIOPH,1,15),S4=RAXMDTM 113 . Q 114 I RATITLE["Admin" D Q 115 . I RASORT S S4=$E(RAWHO,1,15),S3=RAXMDTM 116 . I 'RASORT S S3=$E(RAWHO,1,15),S4=RAXMDTM 117 . Q 118 Q 1 RANMUSE2 ;HISC/SWM-Nuclear Medicine Usage reports ;9/3/97 14:37 2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998 3 SET ; There are 2 parts: set local arrays and ^tmp() 4 ; 5 ; part 1 -- raseqd(),raseqi(),ranumd(),ranumi() so to reduce 6 ; div and img-typ names to a single number, and so to reduce 7 ; the length of the ^tmp() string 8 ; raseqd("division name")=sequence number for alpha sort order 9 ; raseqi("imaging type name")=sequence number for alpha sort order 10 ; ranumd(sequence number for alpha sort order)="division name" 11 ; ranumi(sequence number for alpha sort order)="imaging type name" 12 ; 13 S RA1=0 F S RA1=$O(^RA(79,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2 RASEQD($P($G(^DIC(4,+RA2,0)),U))="" 14 S RA1="",RA2=1 F S RA1=$O(RASEQD(RA1)) Q:RA1="" S RASEQD(RA1)=RA2,RANUMD(RA2)=RA1,RA2=RA2+1 15 ; 16 S RA1=0 F S RA1=$O(^RA(79.2,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2]"" RASEQI(RA2)="" 17 S RA1="",RA2=1 F S RA1=$O(RASEQI(RA1)) Q:RA1="" S RASEQI(RA1)=RA2,RANUMI(RA2)=RA1,RA2=RA2+1 18 ; 19 ; part 2 -- ^TMP($J,"RA",div,imgtyp,S3,S4,patnam,caseno) 20 ; S3 = sort field 3, either radiopharm/whoadmin or examdttm 21 ; S4 = sort field 4, either examdttm or radiopharm/whoadmin 22 ; 23 ; Loop thru ^RADPTN("AB" to select recs within requested date range 24 ; 25 S RA0=RADTBEG-.0001 26 S1 S RA0=$O(^RADPTN("AB",RA0)) Q:RA0="" Q:RA0>RADTEND S RA1=0 27 S2 S RA1=$O(^RADPTN("AB",RA0,RA1)) G:RA1="" S1 28 S RAN0=$G(^RADPTN(RA1,0)) G:RAN0="" S2 29 S RADFN=$P(RAN0,U) G:RADFN="" S2 30 S RADTI=9999999.9999-$P(RAN0,U,2) G:RADTI="" S2 31 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",$P(RAN0,U,3),0)) G:RACNI="" S2 32 D EXTRACT 33 G S2 34 EXTRACT ; 35 S P02=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:P02="" 36 S P03=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:P03="" 37 S RADIVNAM=$P($G(^DIC(4,+$P(P02,U,3),0)),U) 38 Q:'$D(^TMP($J,"RA D-TYPE",RADIVNAM)) ; div not selected 39 S RAIMGNAM=$P($G(^RA(79.2,+$P(P02,U,2),0)),U) 40 Q:'$D(^TMP($J,"RA I-TYPE",RAIMGNAM)) ; img typ not selected 41 S RA2=0 42 F1 S RA2=$O(^RADPTN(RA1,"NUC",RA2)) Q:RA2'=+RA2 43 S RANUC=^RADPTN(RA1,"NUC",RA2,0) 44 S RACN=$P(RAN0,U,3) 45 S RADIOPH=$P($G(^PSDRUG(+$P(RANUC,U),0)),U) ; Radiopharm Name 46 I 'RAINPUT,RATITLE["Usage",'$D(^TMP($J,"RA EITHER",RADIOPH)) G F1 ;radioph not selectd 47 S RAWHO=$P($G(^VA(200,+$P(RANUC,U,9),0)),U) ; who administered dose 48 I RATITLE["Admin",RAWHO="" G F1 ;who admin dose is unknown 49 I 'RAINPUT,RATITLE["Admin",'$D(^TMP($J,"RA EITHER",RAWHO)) G F1 ;who not selectd 50 S RAXMDTM=$P(RAN0,U,2) ; exam date/time 51 S RAPRC0=$G(^RAMIS(71,+$P(P03,U,2),0)) ; procedure 0-node 52 S RAPRCNAM=$P(RAPRC0,U) ; procedure name 53 S DFN=RADFN D DEM^VADPT 54 S RAPATNAM=$P(VADM(1),U) ; patient name 55 S RASSN=$P(VADM(2),U,2) ; ssn 56 K VADM 57 S RADOSE=$P(RANUC,U,7) ; dose administered 58 S RADRAWN=$P(RANUC,U,4) ; activity drawn 59 I 'RADOSE,'RADRAWN G F1 ; dose admin and drawn both null/zero 60 ; ien of procedure sub-record with matching radiopharm 61 ; if user changes default radiopharm entry, or 62 ; adds a radiopharm that's not defined in file 71 default radiopharm, 63 ; the high and low values would be unknown 64 S RANUC1=$O(^RAMIS(71,+$P(P03,U,2),"NUC","B",+$P(RANUC,U),0)) 65 ; 0-node of procedure sub-record with matching radiopharm 66 S:RANUC1 RANUC1=^RAMIS(71,+$P(P03,U,2),"NUC",+RANUC1,0) 67 S RAHIGH=$P(RANUC1,U,5) ; high adult dose 68 S RALOW=$P(RANUC1,U,6) ; low adult dose 69 S RASTERSK="" 70 I RADOSE>0,RALOW>0,RADOSE<RALOW S RASTERSK="*" 71 I RADOSE>0,RAHIGH>0,RADOSE>RAHIGH S RASTERSK="*" 72 D S3S4 73 S ^TMP($J,"RA",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),S3,S4,$E(RAPATNAM,1,15),RACN,RADIOPH)=RASSN_U_RADRAWN_U_RADOSE_U_RAHIGH_U_RALOW_U_RAWHO_U_RASTERSK_U_RAPRCNAM 74 I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN)) S ^(RASEQI(RAIMGNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM)))+1,^(RASEQD(RADIVNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM)))+1 75 S RAEITHER=$S(RATITLE["Usage":RADIOPH,1:RAWHO) 76 I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER)) S ^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1,^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RAEITHER))+1 77 S ^(RASSN)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN))+1 78 S ^(RAEITHER)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER))+1 79 ; img typ totals 80 S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 81 S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADRAWN 82 S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADOSE 83 ; "ratradio" is used for either radiopharm or who-admin-dose 84 S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 85 ; division totals 86 S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RAEITHER))+1 87 S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RAEITHER))+RADRAWN 88 S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RAEITHER))+RADOSE 89 S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RAEITHER))+1 90 G F1 91 WRT S RASEQD="" 92 W1 S RASEQD=$O(^TMP($J,"RA",RASEQD)) Q:RASEQD="" S RASEQI="" 93 W2 S RASEQI=$O(^TMP($J,"RA",RASEQD,RASEQI)) G:RASEQI="" W1 S S3="" 94 S:RAPG>0 RAXIT=$$EOS^RAUTL5 Q:$G(RAXIT) D PGHD^RANMUSE3,COLHD^RANMUSE3 95 W3 S S3=$O(^TMP($J,"RA",RASEQD,RASEQI,S3)) G:S3="" W2 S S4="" 96 W4 S S4=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4)) G:S4="" W3 S RAPATNAM="" 97 W5 S RAPATNAM=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM)) G:RAPATNAM="" W4 S RACN="" 98 W6 S RACN=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN)) G:RACN="" W5 S RADIOPH="" 99 W7 S RADIOPH=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN,RADIOPH)) G:RADIOPH="" W6 S RA1=^(RADIOPH) 100 S RALONGCN=$S(RASORT:S3,1:S4),RALONGCN=$E(RALONGCN,4,7)_$E(RALONGCN,2,3)_"-"_RACN_"@"_$E($P(RALONGCN,".",2)_"000",1,4) 101 S RASSN=$P(RA1,U),RADRAWN=$P(RA1,U,2),RADOSE=$P(RA1,U,3),RAHIGH=$P(RA1,U,4),RALOW=$P(RA1,U,5),RAWHO=$P(RA1,U,6),RASTERSK=$P(RA1,U,7) 102 S RAPRCNAM=$P(RA1,U,8) 103 I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD^RANMUSE3,COLHD^RANMUSE3 104 W !,RALONGCN,?16,$E(RAPATNAM,1,15),?32,RASSN,?44,$E(RADIOPH,1,15),?59,$J(RADRAWN,10,4),?69,$J(RADOSE,10,4),?79,$J(RALOW,10,4),?89,$J(RAHIGH,10,4),?100,$E(RAPRCNAM,1,15),?116,$E(RAWHO,1,15),?131,RASTERSK 105 G W7 106 S3S4 ; set subscripts 3 and 4 107 I RATITLE["Usage" D Q 108 . I RASORT S S4=$E(RADIOPH,1,15),S3=RAXMDTM 109 . I 'RASORT S S3=$E(RADIOPH,1,15),S4=RAXMDTM 110 . Q 111 I RATITLE["Admin" D Q 112 . I RASORT S S4=$E(RAWHO,1,15),S3=RAXMDTM 113 . I 'RASORT S S3=$E(RAWHO,1,15),S4=RAXMDTM 114 . Q 115 Q
Note:
See TracChangeset
for help on using the changeset viewer.
