| 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
|
|---|
