Released RA*5*151 SEQ #133 Extracted from mail message **KIDS**:RA*5.0*151^ **INSTALL NAME** RA*5.0*151 "BLD",11240,0) RA*5.0*151^RADIOLOGY/NUCLEAR MEDICINE^0^3181002^y "BLD",11240,1,0) ^^2^2^3181002^ "BLD",11240,1,1,0) Radiopharmaceutical Usage Report is not displaying correct "BLD",11240,1,2,0) Long-Case@Time values after turning on Site Specific Accession Numbers "BLD",11240,4,0) ^9.64PA^^ "BLD",11240,6.3) 1 "BLD",11240,"ABPKG") n "BLD",11240,"KRN",0) ^9.67PA^779.2^20 "BLD",11240,"KRN",.4,0) .4 "BLD",11240,"KRN",.401,0) .401 "BLD",11240,"KRN",.402,0) .402 "BLD",11240,"KRN",.403,0) .403 "BLD",11240,"KRN",.5,0) .5 "BLD",11240,"KRN",.84,0) .84 "BLD",11240,"KRN",3.6,0) 3.6 "BLD",11240,"KRN",3.8,0) 3.8 "BLD",11240,"KRN",9.2,0) 9.2 "BLD",11240,"KRN",9.8,0) 9.8 "BLD",11240,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",11240,"KRN",9.8,"NM",1,0) RANMUSE2^^0^B44664263 "BLD",11240,"KRN",9.8,"NM","B","RANMUSE2",1) "BLD",11240,"KRN",19,0) 19 "BLD",11240,"KRN",19.1,0) 19.1 "BLD",11240,"KRN",101,0) 101 "BLD",11240,"KRN",409.61,0) 409.61 "BLD",11240,"KRN",771,0) 771 "BLD",11240,"KRN",779.2,0) 779.2 "BLD",11240,"KRN",870,0) 870 "BLD",11240,"KRN",8989.51,0) 8989.51 "BLD",11240,"KRN",8989.52,0) 8989.52 "BLD",11240,"KRN",8994,0) 8994 "BLD",11240,"KRN","B",.4,.4) "BLD",11240,"KRN","B",.401,.401) "BLD",11240,"KRN","B",.402,.402) "BLD",11240,"KRN","B",.403,.403) "BLD",11240,"KRN","B",.5,.5) "BLD",11240,"KRN","B",.84,.84) "BLD",11240,"KRN","B",3.6,3.6) "BLD",11240,"KRN","B",3.8,3.8) "BLD",11240,"KRN","B",9.2,9.2) "BLD",11240,"KRN","B",9.8,9.8) "BLD",11240,"KRN","B",19,19) "BLD",11240,"KRN","B",19.1,19.1) "BLD",11240,"KRN","B",101,101) "BLD",11240,"KRN","B",409.61,409.61) "BLD",11240,"KRN","B",771,771) "BLD",11240,"KRN","B",779.2,779.2) "BLD",11240,"KRN","B",870,870) "BLD",11240,"KRN","B",8989.51,8989.51) "BLD",11240,"KRN","B",8989.52,8989.52) "BLD",11240,"KRN","B",8994,8994) "BLD",11240,"QDEF") ^^^^NO^^^^NO^^NO "BLD",11240,"QUES",0) ^9.62^^ "BLD",11240,"REQB",0) ^9.611^1^1 "BLD",11240,"REQB",1,0) RA*5.0*47^2 "BLD",11240,"REQB","B","RA*5.0*47",1) "MBREQ") 0 "PKG",31,-1) 1^1 "PKG",31,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",31,20,0) ^9.402P^^ "PKG",31,22,0) ^9.49I^1^1 "PKG",31,22,1,0) 5.0^2980317^2981117^66481 "PKG",31,22,1,"PAH",1,0) 151^3181002 "PKG",31,22,1,"PAH",1,1,0) ^^2^2^3181002 "PKG",31,22,1,"PAH",1,1,1,0) Radiopharmaceutical Usage Report is not displaying correct "PKG",31,22,1,"PAH",1,1,2,0) Long-Case@Time values after turning on Site Specific Accession Numbers "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","RANMUSE2") 0^1^B44664263^B42611600 "RTN","RANMUSE2",1,0) RANMUSE2 ;HISC/SWM-Nuclear Medicine Usage reports ;9/3/97 14:37 "RTN","RANMUSE2",2,0) ;;5.0;Radiology/Nuclear Medicine;**65,47,151**;Mar 16, 1998;Build 1 "RTN","RANMUSE2",3,0) ;;Per VA Directive 6402, this routine should not be modified "RTN","RANMUSE2",4,0) ; "RTN","RANMUSE2",5,0) ;Supported IA #10061 reference to DEM^VADPT "RTN","RANMUSE2",6,0) ; "RTN","RANMUSE2",7,0) SET ; There are 2 parts: set local arrays and ^tmp() "RTN","RANMUSE2",8,0) ; "RTN","RANMUSE2",9,0) ; part 1 -- raseqd(),raseqi(),ranumd(),ranumi() so to reduce "RTN","RANMUSE2",10,0) ; div and img-typ names to a single number, and so to reduce "RTN","RANMUSE2",11,0) ; the length of the ^tmp() string "RTN","RANMUSE2",12,0) ; raseqd("division name")=sequence number for alpha sort order "RTN","RANMUSE2",13,0) ; raseqi("imaging type name")=sequence number for alpha sort order "RTN","RANMUSE2",14,0) ; ranumd(sequence number for alpha sort order)="division name" "RTN","RANMUSE2",15,0) ; ranumi(sequence number for alpha sort order)="imaging type name" "RTN","RANMUSE2",16,0) ; "RTN","RANMUSE2",17,0) 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))="" "RTN","RANMUSE2",18,0) S RA1="",RA2=1 F S RA1=$O(RASEQD(RA1)) Q:RA1="" S RASEQD(RA1)=RA2,RANUMD(RA2)=RA1,RA2=RA2+1 "RTN","RANMUSE2",19,0) ; "RTN","RANMUSE2",20,0) S RA1=0 F S RA1=$O(^RA(79.2,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2]"" RASEQI(RA2)="" "RTN","RANMUSE2",21,0) S RA1="",RA2=1 F S RA1=$O(RASEQI(RA1)) Q:RA1="" S RASEQI(RA1)=RA2,RANUMI(RA2)=RA1,RA2=RA2+1 "RTN","RANMUSE2",22,0) ; "RTN","RANMUSE2",23,0) ; part 2 -- ^TMP($J,"RA",div,imgtyp,S3,S4,patnam,caseno) "RTN","RANMUSE2",24,0) ; S3 = sort field 3, either radiopharm/whoadmin or examdttm "RTN","RANMUSE2",25,0) ; S4 = sort field 4, either examdttm or radiopharm/whoadmin "RTN","RANMUSE2",26,0) ; "RTN","RANMUSE2",27,0) ; Loop thru ^RADPTN("AB" to select recs within requested date range "RTN","RANMUSE2",28,0) ; "RTN","RANMUSE2",29,0) S RA0=RADTBEG-.0001 "RTN","RANMUSE2",30,0) S1 S RA0=$O(^RADPTN("AB",RA0)) Q:RA0="" Q:RA0>RADTEND S RA1=0 "RTN","RANMUSE2",31,0) S2 S RA1=$O(^RADPTN("AB",RA0,RA1)) G:RA1="" S1 "RTN","RANMUSE2",32,0) S RAN0=$G(^RADPTN(RA1,0)) G:RAN0="" S2 "RTN","RANMUSE2",33,0) S RADFN=$P(RAN0,U) G:RADFN="" S2 "RTN","RANMUSE2",34,0) S RADTI=9999999.9999-$P(RAN0,U,2) G:RADTI="" S2 "RTN","RANMUSE2",35,0) S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",$P(RAN0,U,3),0)) G:RACNI="" S2 "RTN","RANMUSE2",36,0) D EXTRACT "RTN","RANMUSE2",37,0) G S2 "RTN","RANMUSE2",38,0) EXTRACT ; "RTN","RANMUSE2",39,0) S P02=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:P02="" "RTN","RANMUSE2",40,0) S P03=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:P03="" "RTN","RANMUSE2",41,0) S RADIVNAM=$P($G(^DIC(4,+$P(P02,U,3),0)),U) "RTN","RANMUSE2",42,0) Q:'$D(^TMP($J,"RA D-TYPE",RADIVNAM)) ; div not selected "RTN","RANMUSE2",43,0) S RAIMGNAM=$P($G(^RA(79.2,+$P(P02,U,2),0)),U) "RTN","RANMUSE2",44,0) Q:'$D(^TMP($J,"RA I-TYPE",RAIMGNAM)) ; img typ not selected "RTN","RANMUSE2",45,0) S RA2=0 "RTN","RANMUSE2",46,0) F1 S RA2=$O(^RADPTN(RA1,"NUC",RA2)) Q:RA2'=+RA2 "RTN","RANMUSE2",47,0) S RANUC=^RADPTN(RA1,"NUC",RA2,0) "RTN","RANMUSE2",48,0) S RACN=$P(RAN0,U,3) "RTN","RANMUSE2",49,0) S RADIOPH=$$EN1^RAPSAPI(+$P(RANUC,U),.01) ; Radiopharm Name "RTN","RANMUSE2",50,0) I 'RAINPUT,RATITLE["Usage",'$D(^TMP($J,"RA EITHER",RADIOPH)) G F1 ;radioph not selectd "RTN","RANMUSE2",51,0) S RAWHO=$P($G(^VA(200,+$P(RANUC,U,9),0)),U) ; who administered dose "RTN","RANMUSE2",52,0) I RATITLE["Admin",RAWHO="" G F1 ;who admin dose is unknown "RTN","RANMUSE2",53,0) I 'RAINPUT,RATITLE["Admin",'$D(^TMP($J,"RA EITHER",RAWHO)) G F1 ;who not selectd "RTN","RANMUSE2",54,0) S RAXMDTM=$P(RAN0,U,2) ; exam date/time "RTN","RANMUSE2",55,0) S RAPRC0=$G(^RAMIS(71,+$P(P03,U,2),0)) ; procedure 0-node "RTN","RANMUSE2",56,0) S RAPRCNAM=$P(RAPRC0,U) ; procedure name "RTN","RANMUSE2",57,0) S DFN=RADFN D DEM^VADPT "RTN","RANMUSE2",58,0) S RAPATNAM=$P(VADM(1),U) ; patient name "RTN","RANMUSE2",59,0) S RASSN=$P(VADM(2),U,2) ; ssn "RTN","RANMUSE2",60,0) K VADM "RTN","RANMUSE2",61,0) S RADOSE=$P(RANUC,U,7) ; dose administered "RTN","RANMUSE2",62,0) S RADRAWN=$P(RANUC,U,4) ; activity drawn "RTN","RANMUSE2",63,0) I 'RADOSE,'RADRAWN G F1 ; dose admin and drawn both null/zero "RTN","RANMUSE2",64,0) ; ien of procedure sub-record with matching radiopharm "RTN","RANMUSE2",65,0) ; if user changes default radiopharm entry, or "RTN","RANMUSE2",66,0) ; adds a radiopharm that's not defined in file 71 default radiopharm, "RTN","RANMUSE2",67,0) ; the high and low values would be unknown "RTN","RANMUSE2",68,0) S RANUC1=$O(^RAMIS(71,+$P(P03,U,2),"NUC","B",+$P(RANUC,U),0)) "RTN","RANMUSE2",69,0) ; 0-node of procedure sub-record with matching radiopharm "RTN","RANMUSE2",70,0) S:RANUC1 RANUC1=^RAMIS(71,+$P(P03,U,2),"NUC",+RANUC1,0) "RTN","RANMUSE2",71,0) S RAHIGH=$P(RANUC1,U,5) ; high adult dose "RTN","RANMUSE2",72,0) S RALOW=$P(RANUC1,U,6) ; low adult dose "RTN","RANMUSE2",73,0) S RASTERSK="" "RTN","RANMUSE2",74,0) I RADOSE>0,RALOW>0,RADOSE0,RAHIGH>0,RADOSE>RAHIGH S RASTERSK="*" "RTN","RANMUSE2",76,0) D S3S4 "RTN","RANMUSE2",77,0) 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 "RTN","RANMUSE2",78,0) 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 "RTN","RANMUSE2",79,0) S RAEITHER=$S(RATITLE["Usage":RADIOPH,1:RAWHO) "RTN","RANMUSE2",80,0) 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 "RTN","RANMUSE2",81,0) S ^(RASSN)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN))+1 "RTN","RANMUSE2",82,0) S ^(RAEITHER)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER))+1 "RTN","RANMUSE2",83,0) ; img typ totals "RTN","RANMUSE2",84,0) S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 "RTN","RANMUSE2",85,0) S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADRAWN "RTN","RANMUSE2",86,0) S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADOSE "RTN","RANMUSE2",87,0) ; "ratradio" is used for either radiopharm or who-admin-dose "RTN","RANMUSE2",88,0) S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 "RTN","RANMUSE2",89,0) ; division totals "RTN","RANMUSE2",90,0) S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RAEITHER))+1 "RTN","RANMUSE2",91,0) S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RAEITHER))+RADRAWN "RTN","RANMUSE2",92,0) S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RAEITHER))+RADOSE "RTN","RANMUSE2",93,0) S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RAEITHER))+1 "RTN","RANMUSE2",94,0) G F1 "RTN","RANMUSE2",95,0) WRT S RASEQD="" "RTN","RANMUSE2",96,0) W1 S RASEQD=$O(^TMP($J,"RA",RASEQD)) Q:RASEQD="" S RASEQI="" "RTN","RANMUSE2",97,0) W2 S RASEQI=$O(^TMP($J,"RA",RASEQD,RASEQI)) G:RASEQI="" W1 S S3="" "RTN","RANMUSE2",98,0) S:RAPG>0 RAXIT=$$EOS^RAUTL5 Q:$G(RAXIT) D PGHD^RANMUSE3,COLHD^RANMUSE3 "RTN","RANMUSE2",99,0) W3 S S3=$O(^TMP($J,"RA",RASEQD,RASEQI,S3)) G:S3="" W2 S S4="" "RTN","RANMUSE2",100,0) W4 S S4=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4)) G:S4="" W3 S RAPATNAM="" "RTN","RANMUSE2",101,0) W5 S RAPATNAM=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM)) G:RAPATNAM="" W4 S RACN="" "RTN","RANMUSE2",102,0) W6 S RACN=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN)) G:RACN="" W5 S RADIOPH="" "RTN","RANMUSE2",103,0) W7 S RADIOPH=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN,RADIOPH)) G:RADIOPH="" W6 S RA1=^(RADIOPH) "RTN","RANMUSE2",104,0) S RALONGCN=$S(RASORT:S3,1:S4),RALONGCN=$E(RALONGCN,4,7)_$E(RALONGCN,2,3)_"-"_RACN_"@"_$E($P(RALONGCN,".",2)_"000",1,4) "RTN","RANMUSE2",105,0) ; "RTN","RANMUSE2",106,0) ; RA*5*151 - must reset RADFN,RADTI,RACNI before calling SSANVAL^RAHLRU1 "RTN","RANMUSE2",107,0) S RADFN=$O(^RADPT("ADC",$P(RALONGCN,"@"),0)) "RTN","RANMUSE2",108,0) S RADTI=$O(^RADPT("ADC",$P(RALONGCN,"@"),RADFN,0)) "RTN","RANMUSE2",109,0) S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) "RTN","RANMUSE2",110,0) N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI) "RTN","RANMUSE2",111,0) S RACNDSP=$S((RASSAN'=""):RASSAN_"@"_$P(RALONGCN,"@",2),1:RALONGCN) "RTN","RANMUSE2",112,0) 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) "RTN","RANMUSE2",113,0) S RAPRCNAM=$P(RA1,U,8) "RTN","RANMUSE2",114,0) I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD^RANMUSE3,COLHD^RANMUSE3 "RTN","RANMUSE2",115,0) I $$USESSAN^RAHLRU1() W !,RACNDSP,?22,$E(RAPATNAM,1,15),?38,RASSN,?50,$E(RADIOPH,1,14),?56,$J(RADRAWN,10,4),?69,$J(RADOSE,10,4),?79,$J(RALOW,10,4),?89,$J(RAHIGH,10,4),?105,$E(RAPRCNAM,1,15),?121,$E(RAWHO,1,10),?131,RASTERSK "RTN","RANMUSE2",116,0) I '$$USESSAN^RAHLRU1() 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 "RTN","RANMUSE2",117,0) G W7 "RTN","RANMUSE2",118,0) S3S4 ; set subscripts 3 and 4 "RTN","RANMUSE2",119,0) I RATITLE["Usage" D Q "RTN","RANMUSE2",120,0) . I RASORT S S4=$E(RADIOPH,1,15),S3=RAXMDTM "RTN","RANMUSE2",121,0) . I 'RASORT S S3=$E(RADIOPH,1,15),S4=RAXMDTM "RTN","RANMUSE2",122,0) . Q "RTN","RANMUSE2",123,0) I RATITLE["Admin" D Q "RTN","RANMUSE2",124,0) . I RASORT S S4=$E(RAWHO,1,15),S3=RAXMDTM "RTN","RANMUSE2",125,0) . I 'RASORT S S3=$E(RAWHO,1,15),S4=RAXMDTM "RTN","RANMUSE2",126,0) . Q "RTN","RANMUSE2",127,0) Q "VER") 8.0^22.2 "BLD",11240,6) ^133 **END** **END**