Released RA*5*77 SEQ #68 Extracted from mail message **KIDS**:RA*5.0*77^ **INSTALL NAME** RA*5.0*77 "BLD",6235,0) RA*5.0*77^RADIOLOGY/NUCLEAR MEDICINE^0^3070425^y "BLD",6235,1,0) ^^1^1^3061130^ "BLD",6235,1,1,0) SUBSCRIPT ERROR, RVU REPORTING ISSUE, SCROLLING ISSUE "BLD",6235,4,0) ^9.64PA^^ "BLD",6235,6.3) 7 "BLD",6235,"INIT") "BLD",6235,"KRN",0) ^9.67PA^8989.52^19 "BLD",6235,"KRN",.4,0) .4 "BLD",6235,"KRN",.4,"NM",0) ^9.68A^^0 "BLD",6235,"KRN",.401,0) .401 "BLD",6235,"KRN",.402,0) .402 "BLD",6235,"KRN",.403,0) .403 "BLD",6235,"KRN",.5,0) .5 "BLD",6235,"KRN",.84,0) .84 "BLD",6235,"KRN",3.6,0) 3.6 "BLD",6235,"KRN",3.8,0) 3.8 "BLD",6235,"KRN",9.2,0) 9.2 "BLD",6235,"KRN",9.8,0) 9.8 "BLD",6235,"KRN",9.8,"NM",0) ^9.68A^7^7 "BLD",6235,"KRN",9.8,"NM",1,0) RAO7PC4^^0^B40834055 "BLD",6235,"KRN",9.8,"NM",2,0) RAWKLU^^0^B49357910 "BLD",6235,"KRN",9.8,"NM",3,0) RAWKLU2^^0^B44017603 "BLD",6235,"KRN",9.8,"NM",4,0) RAWRVUP^^0^B39711179 "BLD",6235,"KRN",9.8,"NM",5,0) RAPROD1^^0^B43331509 "BLD",6235,"KRN",9.8,"NM",6,0) RAWKLU1^^0^B36246757 "BLD",6235,"KRN",9.8,"NM",7,0) RAWKLU3^^0^B15626413 "BLD",6235,"KRN",9.8,"NM","B","RAO7PC4",1) "BLD",6235,"KRN",9.8,"NM","B","RAPROD1",5) "BLD",6235,"KRN",9.8,"NM","B","RAWKLU",2) "BLD",6235,"KRN",9.8,"NM","B","RAWKLU1",6) "BLD",6235,"KRN",9.8,"NM","B","RAWKLU2",3) "BLD",6235,"KRN",9.8,"NM","B","RAWKLU3",7) "BLD",6235,"KRN",9.8,"NM","B","RAWRVUP",4) "BLD",6235,"KRN",19,0) 19 "BLD",6235,"KRN",19,"NM",0) ^9.68A^^ "BLD",6235,"KRN",19.1,0) 19.1 "BLD",6235,"KRN",19.1,"NM",0) ^9.68A^^0 "BLD",6235,"KRN",101,0) 101 "BLD",6235,"KRN",409.61,0) 409.61 "BLD",6235,"KRN",771,0) 771 "BLD",6235,"KRN",870,0) 870 "BLD",6235,"KRN",8989.51,0) 8989.51 "BLD",6235,"KRN",8989.52,0) 8989.52 "BLD",6235,"KRN",8994,0) 8994 "BLD",6235,"KRN","B",.4,.4) "BLD",6235,"KRN","B",.401,.401) "BLD",6235,"KRN","B",.402,.402) "BLD",6235,"KRN","B",.403,.403) "BLD",6235,"KRN","B",.5,.5) "BLD",6235,"KRN","B",.84,.84) "BLD",6235,"KRN","B",3.6,3.6) "BLD",6235,"KRN","B",3.8,3.8) "BLD",6235,"KRN","B",9.2,9.2) "BLD",6235,"KRN","B",9.8,9.8) "BLD",6235,"KRN","B",19,19) "BLD",6235,"KRN","B",19.1,19.1) "BLD",6235,"KRN","B",101,101) "BLD",6235,"KRN","B",409.61,409.61) "BLD",6235,"KRN","B",771,771) "BLD",6235,"KRN","B",870,870) "BLD",6235,"KRN","B",8989.51,8989.51) "BLD",6235,"KRN","B",8989.52,8989.52) "BLD",6235,"KRN","B",8994,8994) "BLD",6235,"QUES",0) ^9.62^^ "BLD",6235,"REQB",0) ^9.611^2^2 "BLD",6235,"REQB",1,0) RA*5.0*45^1 "BLD",6235,"REQB",2,0) RA*5.0*64^1 "BLD",6235,"REQB","B","RA*5.0*45",1) "BLD",6235,"REQB","B","RA*5.0*64",2) "MBREQ") 0 "PKG",18,-1) 1^1 "PKG",18,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",18,20,0) ^9.402P^^ "PKG",18,22,0) ^9.49I^1^1 "PKG",18,22,1,0) 5.0^3051109^2980407^50 "PKG",18,22,1,"PAH",1,0) 77^3070425 "PKG",18,22,1,"PAH",1,1,0) ^^1^1^3070425 "PKG",18,22,1,"PAH",1,1,1,0) SUBSCRIPT ERROR, RVU REPORTING ISSUE, SCROLLING ISSUE "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") YES "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") YES "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") YES "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") 7 "RTN","RAO7PC4") 0^1^B40834055^B39691653 "RTN","RAO7PC4",1,0) RAO7PC4 ;HISC/SWM-utilities ;11/19/01 10:23 "RTN","RAO7PC4",2,0) ;;5.0;Radiology/Nuclear Medicine;**28,32,31,45,77**;Mar 16, 1998;Build 7 "RTN","RAO7PC4",3,0) ;08/10/2006 BAY/KAM Remedy Call 134839 Subscript Error "RTN","RAO7PC4",4,0) Q "RTN","RAO7PC4",5,0) EN1 ; api for CPRS notification alert #67 "RTN","RAO7PC4",6,0) Q:'$D(XQADATA) "RTN","RAO7PC4",7,0) D SET1 ; set up ^TMP nodes "RTN","RAO7PC4",8,0) D DISP1 ; convert and display ^TMP nodes "RTN","RAO7PC4",9,0) D KIL1 ; kill ^TMP nodes "RTN","RAO7PC4",10,0) Q "RTN","RAO7PC4",11,0) SET1 N RADFN,RADTI,RACNI,RAPROC1,RAPROC2,RAPHY1,RAPHY2,RAPMOD1,RAPMOD2,RAACNT "RTN","RAO7PC4",12,0) N RAPATNAM,RASSN,RASTR,I,J,RACMU "RTN","RAO7PC4",13,0) ; 08/10/2006 BAY/KAM Remedy Call 134839/RA*5*77 - Added next line "RTN","RAO7PC4",14,0) Q:$G(XQADATA)="" "RTN","RAO7PC4",15,0) S RADFN=$P(XQADATA,"/") ; ien patient "RTN","RAO7PC4",16,0) S RAACNT=0 ; counter "RTN","RAO7PC4",17,0) S RADTI=$P(XQADATA,"/",2) ; inverse date of exam "RTN","RAO7PC4",18,0) S RACNI=$P(XQADATA,"/",3) ; ien case "RTN","RAO7PC4",19,0) S RAPROC1=$P(XQADATA,"/",4) ; ien 71, before "RTN","RAO7PC4",20,0) S RAPROC2=$P(XQADATA,"/",5) ; ien 71, after "RTN","RAO7PC4",21,0) S RAPHY1=$P(XQADATA,"/",6) ; ien 200 requesting physician, before "RTN","RAO7PC4",22,0) S RAPHY2=$P(XQADATA,"/",7) ; ien 200 requesting physician, after "RTN","RAO7PC4",23,0) S RAPMOD1=$P(XQADATA,"/",8) ;string of proc mod iens, before "RTN","RAO7PC4",24,0) S RAPMOD2=$P(XQADATA,"/",9) ;string of proc mod iens, after "RTN","RAO7PC4",25,0) K ^TMP($J,"RAE4") "RTN","RAO7PC4",26,0) Q:'$D(^DPT(RADFN,0)) "RTN","RAO7PC4",27,0) S RAPATNAM=$P(^DPT(RADFN,0),"^") S RASSN=$$SSN^RAUTL() S:RASSN="" RASSN="Unkn" "RTN","RAO7PC4",28,0) S RACMU=$S(+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0))>0:" (CM w/exam)",1:"") "RTN","RAO7PC4",29,0) S ^TMP($J,"RAE4",1)="Imaging Exam for "_RAPATNAM_" ("_RASSN_") changed:" "RTN","RAO7PC4",30,0) I 'RAPROC2,RAPROC1 D "RTN","RAO7PC4",31,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" " "RTN","RAO7PC4",32,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))="For procedure "_$E($P(^RAMIS(71,RAPROC1,0),"^"),1,53)_RACMU "RTN","RAO7PC4",33,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" " "RTN","RAO7PC4",34,0) I RAPROC2 D "RTN","RAO7PC4",35,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" Procedure changed" "RTN","RAO7PC4",36,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_$E($P(^RAMIS(71,RAPROC1,0),"^"),1,53) "RTN","RAO7PC4",37,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_$E($P(^RAMIS(71,RAPROC2,0),"^"),1,53)_RACMU "RTN","RAO7PC4",38,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))="" "RTN","RAO7PC4",39,0) I RAPHY2 D "RTN","RAO7PC4",40,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" Requesting Physician changed" "RTN","RAO7PC4",41,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_$$GET1^DIQ(200,RAPHY1,.01) "RTN","RAO7PC4",42,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_$$GET1^DIQ(200,RAPHY2,.01) "RTN","RAO7PC4",43,0) I RAPMOD2!(('RAPMOD2)&(RAPMOD1)) D "RTN","RAO7PC4",44,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" Procedure Modifier changed" "RTN","RAO7PC4",45,0) .S RASTR="" "RTN","RAO7PC4",46,0) .F I=1:1:($L(RAPMOD1)/2) S J=$P(RAPMOD1,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240 "RTN","RAO7PC4",47,0) .S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma and blank "RTN","RAO7PC4",48,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_RASTR "RTN","RAO7PC4",49,0) .S RASTR="" "RTN","RAO7PC4",50,0) .F I=1:1:($L(RAPMOD2)/2) S J=$P(RAPMOD2,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240 "RTN","RAO7PC4",51,0) .S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma "RTN","RAO7PC4",52,0) .S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_RASTR "RTN","RAO7PC4",53,0) Q "RTN","RAO7PC4",54,0) DISP1 N RARRAY "RTN","RAO7PC4",55,0) MERGE RARRAY=^TMP($J,"RAE4") "RTN","RAO7PC4",56,0) D EN^DDIOL(.RARRAY) "RTN","RAO7PC4",57,0) Q "RTN","RAO7PC4",58,0) KIL1 K ^TMP($J,"RAE4") "RTN","RAO7PC4",59,0) Q "RTN","RAO7PC4",60,0) ; "RTN","RAO7PC4",61,0) SETALERT ; "RTN","RAO7PC4",62,0) Q:'$D(RASTRING) "RTN","RAO7PC4",63,0) N RAPHY1,RAPHY2,RAPNAM,RAPSSN "RTN","RAO7PC4",64,0) S RADFN=$P(RASTRING,"/") ; ien patient "RTN","RAO7PC4",65,0) S RAPNAM=$$GET1^DIQ(70,+RADFN,.01) S:RAPNAM="" RAPNAM="UNKNOWN" "RTN","RAO7PC4",66,0) S RAPSSN=$$GET1^DIQ(70,+RADFN,.09) S:RAPSSN="" RAPSSN="UNKNOWN" "RTN","RAO7PC4",67,0) S RAPHY1=$P(RASTRING,"/",6) ; ien 200 requesting physician, before "RTN","RAO7PC4",68,0) S RAPHY2=$P(RASTRING,"/",7) ; ien 200 requesting physician, after "RTN","RAO7PC4",69,0) ; "RTN","RAO7PC4",70,0) S XQA(RAPHY1)="",XQAID=$J_","_$H S:$G(RAPHY2)]"" XQA(RAPHY2)="" "RTN","RAO7PC4",71,0) S XQAMSG=$E(RAPNAM,1,9)_" ("_$E(RAPNAM,1)_$E(RAPSSN,6,9)_"): Imaging Exam Changed: "_$S($P(RASTRING,"/",5):"Proc., ",1:"")_$S($P(RASTRING,"/",7):"Rqstr, ",1:"")_$S($P(RASTRING,"/",9):"Proc Mod",1:"") "RTN","RAO7PC4",72,0) S:$E(XQAMSG,($L(XQAMSG)-1))="," XQAMSG=$E(XQAMSG,1,($L(XQAMSG)-2)) "RTN","RAO7PC4",73,0) S XQADATA=RASTRING "RTN","RAO7PC4",74,0) S XQAROU="ZZ^RAO7PC4(XQADATA)" "RTN","RAO7PC4",75,0) D SETUP^XQALERT "RTN","RAO7PC4",76,0) Q "RTN","RAO7PC4",77,0) ; "RTN","RAO7PC4",78,0) ZZ(RASTRING) ; Additional text for display when processing alert. "RTN","RAO7PC4",79,0) ; "RTN","RAO7PC4",80,0) N RADFN,RADTI,RACMU,RACNI,RAPROC1,RAPROC2,RAPHY1,RAPHY2,RAPMOD1,RAPMOD2 "RTN","RAO7PC4",81,0) N RAPNAM,RAPSSN,I,RAPRFR,RAPRTO,RAPHYFR,RAPHYTO,RASTR "RTN","RAO7PC4",82,0) S RADFN=$P(RASTRING,"/") ; ien patient "RTN","RAO7PC4",83,0) S RADTI=$P(RASTRING,"/",2) ; inverse date of exam "RTN","RAO7PC4",84,0) S RACNI=$P(RASTRING,"/",3) ; ien case "RTN","RAO7PC4",85,0) S RAPROC1=$P(RASTRING,"/",4) ; ien 71, before "RTN","RAO7PC4",86,0) S RAPROC2=$P(RASTRING,"/",5) ; ien 71, after "RTN","RAO7PC4",87,0) S RAPHY1=$P(RASTRING,"/",6) ; ien 200 requesting physician, before "RTN","RAO7PC4",88,0) S RAPHY2=$P(RASTRING,"/",7) ; ien 200 requesting physician, after "RTN","RAO7PC4",89,0) S RAPMOD1=$P(RASTRING,"/",8) ;string of proc mod iens, before "RTN","RAO7PC4",90,0) S RAPMOD2=$P(RASTRING,"/",9) ;string of proc mod iens, after "RTN","RAO7PC4",91,0) ; "RTN","RAO7PC4",92,0) S RAPNAM=$$GET1^DIQ(70,+RADFN,.01) S:RAPNAM="" RAPNAM="UNKNOWN" "RTN","RAO7PC4",93,0) S RAPSSN=$$GET1^DIQ(70,+RADFN,.09) S:RAPSSN="" RAPSSN="UNKNOWN" "RTN","RAO7PC4",94,0) D EN^DDIOL("Imaging Exam For "_$E(RAPNAM,1,30)_" ("_RAPSSN_") Changed:",,"!!?4") "RTN","RAO7PC4",95,0) ; "RTN","RAO7PC4",96,0) S RACMU=$S(+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0))>0:" (CM w/exam)",1:"") "RTN","RAO7PC4",97,0) I 'RAPROC2,RAPROC1 D "RTN","RAO7PC4",98,0) .S RAPRFR=$E($$GET1^DIQ(71,+RAPROC1,.01),1,50) S:RAPRFR="" RAPRFR="UNKNOWN" "RTN","RAO7PC4",99,0) .S RAPRFR=RAPRFR_RACMU D EN^DDIOL("For procedure "_RAPRFR_RACMU,,"!?4") "RTN","RAO7PC4",100,0) .D EN^DDIOL(" ",,"!") "RTN","RAO7PC4",101,0) .Q "RTN","RAO7PC4",102,0) I RAPROC2 D "RTN","RAO7PC4",103,0) .S RAPRFR=$E($$GET1^DIQ(71,+RAPROC1,.01),1,53) S:RAPRFR="" RAPRFR="UNKNOWN" "RTN","RAO7PC4",104,0) .S RAPRTO=$E($$GET1^DIQ(71,+RAPROC2,.01),1,53) S:RAPRTO="" RAPRTO="UNKNOWN" "RTN","RAO7PC4",105,0) .D EN^DDIOL("Procedure changed",,"!?4") "RTN","RAO7PC4",106,0) .D EN^DDIOL("From: "_RAPRFR,,"!?8") "RTN","RAO7PC4",107,0) .D EN^DDIOL("To: "_RAPRTO_RACMU,,"!?8") "RTN","RAO7PC4",108,0) .Q "RTN","RAO7PC4",109,0) I RAPHY2 D "RTN","RAO7PC4",110,0) .S RAPHYFR=$$GET1^DIQ(200,RAPHY1,.01) S:RAPHYFR="" RAPHYFR="UNKNOWN" "RTN","RAO7PC4",111,0) .S RAPHYTO=$$GET1^DIQ(200,RAPHY2,.01) S:RAPHYTO="" RAPHYTO="UNKNOWN" "RTN","RAO7PC4",112,0) .D EN^DDIOL("Requesting Physician changed",,"!?4") "RTN","RAO7PC4",113,0) .D EN^DDIOL("From: "_RAPHYFR,,"!?8") "RTN","RAO7PC4",114,0) .D EN^DDIOL("To: "_RAPHYTO,,"!?8") "RTN","RAO7PC4",115,0) .Q "RTN","RAO7PC4",116,0) I RAPMOD2!('(RAPMOD2)&(RAPMOD1)) D "RTN","RAO7PC4",117,0) .D EN^DDIOL("Procedure Modifier changed",,"!?4") "RTN","RAO7PC4",118,0) .S RASTR="" "RTN","RAO7PC4",119,0) .F I=1:1:($L(RAPMOD1)/2) S J=$P(RAPMOD1,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240 "RTN","RAO7PC4",120,0) .S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma "RTN","RAO7PC4",121,0) .D EN^DDIOL("From: "_RASTR,,"!?8") "RTN","RAO7PC4",122,0) .S RASTR="" "RTN","RAO7PC4",123,0) .F I=1:1:($L(RAPMOD2)/2) S J=$P(RAPMOD2,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240 "RTN","RAO7PC4",124,0) .S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma "RTN","RAO7PC4",125,0) .D EN^DDIOL("To: "_RASTR,,"!?8") "RTN","RAO7PC4",126,0) .Q "RTN","RAO7PC4",127,0) Q "RTN","RAO7PC4",128,0) ; "RTN","RAO7PC4",129,0) SETNOTIF(RAIEN751) ; called by RAO7XX if patch OR*3.0*112 is installed "RTN","RAO7PC4",130,0) ;so that the CPRS notification system can be used to set the alert "RTN","RAO7PC4",131,0) Q:'$D(RASTRING) "RTN","RAO7PC4",132,0) ;RASTRING is : dfn^invdt^caseien^befproc^aftproc^befphy^aftphy "RTN","RAO7PC4",133,0) ; ^befpmodA,pmodF,etc^aftpmodF,pmodH,etc "RTN","RAO7PC4",134,0) N RAREQPHY "RTN","RAO7PC4",135,0) S:+$P(RASTRING,"/",6) RAREQPHY(+$P(RASTRING,"/",6))="" "RTN","RAO7PC4",136,0) S:+$P(RASTRING,"/",7) RAREQPHY(+$P(RASTRING,"/",7))="" "RTN","RAO7PC4",137,0) S RAMSG="Imaging Exam Changed: "_$S($P(RASTRING,"/",5):"Proc., ",1:"")_$S($P(RASTRING,"/",7):"Rqstr, ",1:"")_$S($L($P(RASTRING,"/",8,9))>1:"Proc Mod",1:"") "RTN","RAO7PC4",138,0) S:$E(RAMSG,$L(RAMSG)-1)="," RAMSG=$E(RAMSG,1,($L(RAMSG)-2)) "RTN","RAO7PC4",139,0) D EN^ORB3(67,+RASTRING,RAIEN751,.RAREQPHY,RAMSG,RASTRING) "RTN","RAO7PC4",140,0) ;ORN mustbe 67,dfn,ienfile75.1,reqphys,messagetitle,string for api "RTN","RAO7PC4",141,0) Q "RTN","RAPROD1") 0^5^B43331509^B41351989 "RTN","RAPROD1",1,0) RAPROD1 ;HISC/FPT,GJC AISC/MJK,RMO-Detailed Exam View ;11/26/96 08:24 "RTN","RAPROD1",2,0) ;;5.0;Radiology/Nuclear Medicine;**15,18,45,77**;Mar 16, 1998;Build 7 "RTN","RAPROD1",3,0) ;last mof by SS for P18 JUN 29 ,00 "RTN","RAPROD1",4,0) ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - correct paging issue "RTN","RAPROD1",5,0) PER ; Display personnel information. "RTN","RAPROD1",6,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT N Y "RTN","RAPROD1",7,0) S DIR(0)="Y",DIR("B")="No" "RTN","RAPROD1",8,0) S DIR("A")="Do you wish to display all personnel involved" "RTN","RAPROD1",9,0) D ^DIR S:$D(DIRUT) X="^" "RTN","RAPROD1",10,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT I X="^" D Q QUIT "RTN","RAPROD1",11,0) G:+Y=0 ACT ; (Y=1:Yes,Y=0:No) "RTN","RAPROD1",12,0) S RAXIT=0 D PERHDR "RTN","RAPROD1",13,0) S RAXIT=$$PERINFO(RADFN,RADTI,RACNI) "RTN","RAPROD1",14,0) I RAXIT D Q QUIT "RTN","RAPROD1",15,0) I $D(RACM) D CMHIST^RAPROD2(RADFN,RADTI,RACNI) "RTN","RAPROD1",16,0) I RAXIT D Q QUIT "RTN","RAPROD1",17,0) ACT R !!,"Do you wish to display activity log? No// ",X:DTIME S X=$E(X) S:'$T X="^" G Q:X="^" S:X="" X="N" G STAT:"Nn"[X I "Yy"'[X W:X'="?" $C(7) W !!?3,"Enter 'YES' if activity log should be displayed, or 'NO' if not." G ACT "RTN","RAPROD1",18,0) W !!?23,"*** Exam Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?3,"Technologist comment",!?2,"---------------------",?25,"------",?60,"-------------" "RTN","RAPROD1",19,0) N RA18RET S RADD=70.07 F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",I)) Q:I'>0 I $D(^(I,0)) S RAY=^(0),Y=+RAY D ACT1 S RA18RET=$$PUTTCOM3^RAUTL11(RADFN,RADTI,RACNI,I,"",3,78,7,0,1,6,0) S:RA18RET=-1 RAXIT=1 Q:RA18RET=-1 ;P18 "RTN","RAPROD1",20,0) I $D(RAXIT) I RAXIT D Q QUIT ;P18 "RTN","RAPROD1",21,0) ; "RTN","RAPROD1",22,0) G STAT:'RARPT W !!?22,"*** Report Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?2,"---------",?25,"------",?60,"-------------" "RTN","RAPROD1",23,0) ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - added screen length check to next line "RTN","RAPROD1",24,0) S RADD=74.01 F I=0:0 S I=$O(^RARPT(RARPT,"L",I)) Q:I'>0 I $D(^(I,0)) S RAY=^(0),Y=+RAY D ACT1 I $$CONTIN^RAUTL11(7)=-1 S RAXIT=1 Q "RTN","RAPROD1",25,0) ;10/25/2006 BAY/KAM Remedy Call 161846, *77 Added next line "RTN","RAPROD1",26,0) I $G(RAXIT) D Q QUIT "RTN","RAPROD1",27,0) W ! S X="",$P(X,"=",80)="" W X K X "RTN","RAPROD1",28,0) G STAT "RTN","RAPROD1",29,0) ACT1 D D^RAUTL W !?2,Y,?25,$E($P($P(^DD(RADD,2,0),$P(RAY,"^",2)_":",2),";"),1,33),?60,$E($S($D(^VA(200,+$P(RAY,"^",3),0)):$P(^(0),"^"),1:"Unknown"),1,18) Q "RTN","RAPROD1",30,0) ; "RTN","RAPROD1",31,0) STAT G TEXT:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T")) "RTN","RAPROD1",32,0) ASKSTA R !!,"Do you wish to display exam status tracking log? No// ",X:DTIME S X=$E(X) S:'$T X="^" G Q:X="^" S:X="" X="N" G TEXT:"Nn"[X I "Yy"'[X W:X'="?" $C(7) D G ASKSTA "RTN","RAPROD1",33,0) . W !!?3,"Enter 'YES' if exam status tracking log should be displayed, or 'NO' if not." "RTN","RAPROD1",34,0) . Q "RTN","RAPROD1",35,0) S RAXIT=0 D STATHDR ; print header "RTN","RAPROD1",36,0) K RAX2 S RACUM="" "RTN","RAPROD1",37,0) F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T",I)) Q:I'>0 I $D(^(I,0)) S RA=^(0),RAX1=+RA D STAT1 Q:$D(RAX2)&('$D(RAMTIME)) Q:RAXIT S RAX2=RAX1 "RTN","RAPROD1",38,0) Q:RAXIT W ! S X="",$P(X,"=",80)="" W X K X "RTN","RAPROD1",39,0) TEXT S X=$E(RA("RST")) G Q:X="P"!(X="N")!(X="D") "RTN","RAPROD1",40,0) ASKTXT R !!,"Do you wish to display exam report text? No// ",X:DTIME S X=$E(X) S:'$T!(X="")!(X="^") X="N" G Q:"Nn"[X I "Yy"'[X W:X'="?" $C(7) W !!?3,"Enter 'YES' if report text should be displayed, or 'NO' if not." G ASKTXT "RTN","RAPROD1",41,0) D DISP^RART1 "RTN","RAPROD1",42,0) Q ; kill and quit "RTN","RAPROD1",43,0) K I,J,POP,RAMTIME,RAPRC,RAPRT,RADFN,RADTI,RACNI,RARPT,RANME,RASSN,RADATE,RADTE,RAST,RACN,RA,RAY,RACI,RADD,RADI,RAMOD,RAX,RAX1,RAX2,RAELAP,RACUM,Z "RTN","RAPROD1",44,0) K RAXIT,RACM "RTN","RAPROD1",45,0) Q "RTN","RAPROD1",46,0) STAT1 ; display status tracking info "RTN","RAPROD1",47,0) K RAELAP I $D(RAX2) S X1=RAX1,X=RAX2 D ELAPSED^RAUTL1 Q:'$D(RAMTIME) S RAELAP=Y D CUMUL "RTN","RAPROD1",48,0) S Y=RAX1 D D^RAUTL "RTN","RAPROD1",49,0) W:$D(RAELAP) ?49,RAELAP,?65,RACUM "RTN","RAPROD1",50,0) I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D STATHDR "RTN","RAPROD1",51,0) W !?2,$S($D(^RA(72,+$P(RA,"^",2),0)):$E($P(^(0),"^"),1,20),1:"Unknown"),?25,Y "RTN","RAPROD1",52,0) Q "RTN","RAPROD1",53,0) CUMUL ; calculate time frame "RTN","RAPROD1",54,0) Q:$E(Y)="N" F RAI=1:1:3 S RA(RAI)=+$P(RACUM,":",RAI)+$P(Y,":",RAI) "RTN","RAPROD1",55,0) F RAI=3:-1:2 S:RA(RAI)>59 RA(RAI-1)=RA(RAI-1)+1,RA(RAI)=RA(RAI)-60 "RTN","RAPROD1",56,0) S RACUM=$E(RA(1)+100,2,3)_":"_$E(RA(2)+100,2,3)_":"_$E(RA(3)+100,2,3) K RAI,RA(1),RA(2),RA(3) "RTN","RAPROD1",57,0) Q "RTN","RAPROD1",58,0) STATHDR ; Print status tracking header "RTN","RAPROD1",59,0) D:'$D(IOF) HOME^%ZIS W @IOF "RTN","RAPROD1",60,0) W !!,?23,"*** Exam Status Tracking Log ***",!,?47,"Elapsed Time",?61,"Cumulative Time",!,?2,"Status",?25,"Date/Time",?48,"(DD:HH:MM)",?64,"(DD:HH:MM)",!,?2,"------",?25,"---------",?47,"------------",?61,"---------------" "RTN","RAPROD1",61,0) Q "RTN","RAPROD1",62,0) PERHDR ; Print personnel header "RTN","RAPROD1",63,0) D:'$D(IOF) HOME^%ZIS W @IOF "RTN","RAPROD1",64,0) N X,Y S X="*** Imaging Personnel ***" "RTN","RAPROD1",65,0) S $P(Y,"-",(IOM+1))="" W !?(IOM-$L(X)\2),X,!,Y "RTN","RAPROD1",66,0) Q "RTN","RAPROD1",67,0) PERINFO(RADFN,RADTI,RACNI) ; Personnel information "RTN","RAPROD1",68,0) ; Pass back 0 if ok, 1 if interrupt "RTN","RAPROD1",69,0) Q:'$L(RADFN)!('$L(RADTI))!('$L(RACNI)) 1 "RTN","RAPROD1",70,0) N RA70,RAHD1,RAHD2,RAHD3,RAPIR,RAPIS,RAPRE,RARP,RARPT,RASIR,RASIS "RTN","RAPROD1",71,0) N RATECH,RATRAN,RAVER "RTN","RAPROD1",72,0) S RA70=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RAPROD1",73,0) S RARPT=+$P(RA70,"^",17) S:'RARPT RATRAN="No Report" "RTN","RAPROD1",74,0) S:'RARPT (RAPRE,RAVER,RAPRE("DT"),RAVER("DT"))="" "RTN","RAPROD1",75,0) I RARPT D "RTN","RAPROD1",76,0) . S RARPT(0)=$G(^RARPT(RARPT,0)) "RTN","RAPROD1",77,0) . S RARPT("T")=$G(^RARPT(RARPT,"T")) "RTN","RAPROD1",78,0) . S RATRAN=$S($D(^VA(200,+RARPT("T"),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",79,0) . S RAPRE=$S($D(^VA(200,+$P(RARPT(0),"^",13),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",80,0) . S RAVER=$S($D(^VA(200,+$P(RARPT(0),"^",9),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",81,0) . S RAPRE("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",12),"2F")," /","0") "RTN","RAPROD1",82,0) . S RAVER("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",7),"2F")," /","0") "RTN","RAPROD1",83,0) . Q "RTN","RAPROD1",84,0) S RAPIR=$S($D(^VA(200,+$P(RA70,"^",12),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",85,0) S RAPIS=$S($D(^VA(200,+$P(RA70,"^",15),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",86,0) S RASIR=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0)) "RTN","RAPROD1",87,0) S RASIS=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0)) "RTN","RAPROD1",88,0) S RATECH=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) "RTN","RAPROD1",89,0) W !,"Primary Int'g Resident: ",RAPIR "RTN","RAPROD1",90,0) W !,"Primary Int'g Staff : ",RAPIS "RTN","RAPROD1",91,0) W !,"Pre-Verifier: ",RAPRE," ",RAPRE("DT") "RTN","RAPROD1",92,0) W !,"Verifier : ",RAVER," ",RAVER("DT"),! "RTN","RAPROD1",93,0) S RAHD1="W !,""Secondary Interpreting Resident"",?40,""Secondary Interpreting Staff""" "RTN","RAPROD1",94,0) S RAHD2="W !,""-------------------------------"",?40,""----------------------------""" "RTN","RAPROD1",95,0) X RAHD1,RAHD2 "RTN","RAPROD1",96,0) I 'RASIR,('RASIS) W !,"None",?40,"None" "RTN","RAPROD1",97,0) E D Q:RAXIT 1 "RTN","RAPROD1",98,0) . S (RASIR,RASIS)=.001 "RTN","RAPROD1",99,0) . F D Q:(('RASIR)&('RASIS))!(RAXIT) "RTN","RAPROD1",100,0) .. I $Y>(IOSL-4) D Q:RAXIT "RTN","RAPROD1",101,0) ... S RAXIT=$$EOS^RAUTL5() "RTN","RAPROD1",102,0) ... I 'RAXIT D PERHDR X RAHD1,RAHD2 "RTN","RAPROD1",103,0) ... Q "RTN","RAPROD1",104,0) .. W ! D SECRES:RASIR,SECSTF:RASIS "RTN","RAPROD1",105,0) .. Q "RTN","RAPROD1",106,0) . Q "RTN","RAPROD1",107,0) I $Y>(IOSL-4) D Q:RAXIT 1 "RTN","RAPROD1",108,0) . S RAXIT=$$EOS^RAUTL5() "RTN","RAPROD1",109,0) . D:'RAXIT PERHDR "RTN","RAPROD1",110,0) . Q "RTN","RAPROD1",111,0) W ! S RAHD3="W !,""Technologist(s) Transcriptionist"",!,""--------------- ----------------""" X RAHD3 "RTN","RAPROD1",112,0) I 'RATECH W !,"None",?40,RATRAN "RTN","RAPROD1",113,0) E D Q:RAXIT 1 "RTN","RAPROD1",114,0) . N RA S RA=0 "RTN","RAPROD1",115,0) . F S RA=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA)) Q:RA'>0 D Q:RAXIT "RTN","RAPROD1",116,0) .. S RATECH(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA,0)) "RTN","RAPROD1",117,0) .. S RATECH=$S($D(^VA(200,+RATECH(0),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",118,0) .. I $Y>(IOSL-4) D Q:RAXIT "RTN","RAPROD1",119,0) ... S RAXIT=$$EOS^RAUTL5() "RTN","RAPROD1",120,0) ... I 'RAXIT D PERHDR X RAHD3 "RTN","RAPROD1",121,0) ... Q "RTN","RAPROD1",122,0) .. W !,RATECH W:RATRAN'=99 ?40,RATRAN S RATRAN=99 "RTN","RAPROD1",123,0) .. Q "RTN","RAPROD1",124,0) . Q "RTN","RAPROD1",125,0) Q 0 "RTN","RAPROD1",126,0) SECRES ; Secondary Resident data "RTN","RAPROD1",127,0) S:RASIR=.001 RATXT="None" "RTN","RAPROD1",128,0) S RASIR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR)) "RTN","RAPROD1",129,0) I $D(RATXT),('+RASIR) W RATXT "RTN","RAPROD1",130,0) E D "RTN","RAPROD1",131,0) . S RASIR(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR,0)) "RTN","RAPROD1",132,0) . W $S($D(^VA(200,+RASIR(0),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",133,0) . Q "RTN","RAPROD1",134,0) K RATXT "RTN","RAPROD1",135,0) Q "RTN","RAPROD1",136,0) SECSTF ; Secondary Staff data "RTN","RAPROD1",137,0) S:RASIS=.001 RATXT="None" "RTN","RAPROD1",138,0) S RASIS=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS)) "RTN","RAPROD1",139,0) I $D(RATXT),('+RASIS) W ?40,RATXT "RTN","RAPROD1",140,0) E D "RTN","RAPROD1",141,0) . S RASIS(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS,0)) "RTN","RAPROD1",142,0) . W ?40,$S($D(^VA(200,+RASIS(0),0)):$P(^(0),"^"),1:"") "RTN","RAPROD1",143,0) . Q "RTN","RAPROD1",144,0) K RATXT "RTN","RAPROD1",145,0) Q "RTN","RAWKLU") 0^2^B49357910^B43942290 "RTN","RAWKLU",1,0) RAWKLU ;HISC/GJC-physician workload statistics by wRVU or CPT ;10/26/05 14:57 "RTN","RAWKLU",2,0) ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7 "RTN","RAWKLU",3,0) ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value "RTN","RAWKLU",4,0) ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC "RTN","RAWKLU",5,0) ; eliminating the need for IA's 1995 amd 1996 "RTN","RAWKLU",6,0) ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77 "RTN","RAWKLU",7,0) ; Add check to see if current RVU data is available and if "RTN","RAWKLU",8,0) ; not use previous year RVU data "RTN","RAWKLU",9,0) ; "RTN","RAWKLU",10,0) ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam "RTN","RAWKLU",11,0) ; date/time "RTN","RAWKLU",12,0) ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW "RTN","RAWKLU",13,0) ; PERSON (#200) file "RTN","RAWKLU",14,0) ;DBIA#:10063 ($$S^%ZTLOAD) "RTN","RAWKLU",15,0) ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT) "RTN","RAWKLU",16,0) ;DBIA#:10104 ($$CJ^XLFSTR) "RTN","RAWKLU",17,0) ;DBIA#:1519 ($$EN^XUTMDEVQ) "RTN","RAWKLU",18,0) ; "RTN","RAWKLU",19,0) EN(RARPTYP,RASCLD) ;Identifies the option that the user wishes to execute. "RTN","RAWKLU",20,0) ;input: RARPTYP="CPT" for the CPT workload report -or- "RVU" for "RTN","RAWKLU",21,0) ; wRVU workload report. Exit if the value is neither 'CPT' "RTN","RAWKLU",22,0) ; or 'RVU'. "RTN","RAWKLU",23,0) ; RASCLD=null for the CPT report, zero for non-scaled wRVU, & one "RTN","RAWKLU",24,0) ; for the scaled wRVU report. "RTN","RAWKLU",25,0) ; "RTN","RAWKLU",26,0) I RARPTYP'="CPT",(RARPTYP'="RVU") Q "RTN","RAWKLU",27,0) I RARPTYP="CPT",(RASCLD'="") Q "RTN","RAWKLU",28,0) K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J) "RTN","RAWKLU",29,0) I RARPTYP="RVU" W !!,"Please note that this report is best suited for display on a 132 column device." "RTN","RAWKLU",30,0) ; "RTN","RAWKLU",31,0) PHYST ;allow the user to select one/many/all physicians "RTN","RAWKLU",32,0) ;(w/ staff classification) ;DBIA#: 10060 "RTN","RAWKLU",33,0) S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS" "RTN","RAWKLU",34,0) S RADIC("A")="Select Physician: ",RADIC("B")="All" "RTN","RAWKLU",35,0) S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10" "RTN","RAWKLU",36,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y "RTN","RAWKLU",37,0) ;did the user select physicians to compile data on? if not, quit "RTN","RAWKLU",38,0) I $O(^TMP($J,"RA STFPHYS",""))="" D Q "RTN","RAWKLU",39,0) .W !!?3,$C(7),"Staff Physician data was not selected." "RTN","RAWKLU",40,0) .Q "RTN","RAWKLU",41,0) ; "RTN","RAWKLU",42,0) ;build a new staff physician array (the other array is subscripted by "RTN","RAWKLU",43,0) ;physician name then IEN) subscripting by staff physician IEN this "RTN","RAWKLU",44,0) ;allows us to check the IEN of the staff physician selected by the "RTN","RAWKLU",45,0) ;user against the IEN of the staff physician on the exam record "RTN","RAWKLU",46,0) S X="" F S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X="" D "RTN","RAWKLU",47,0) .S Y=0 "RTN","RAWKLU",48,0) .F S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y S ^TMP("RA STFPHYS-IEN",$J,Y)="" "RTN","RAWKLU",49,0) .Q "RTN","RAWKLU",50,0) ; "RTN","RAWKLU",51,0) K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1) "RTN","RAWKLU",52,0) ; "RTN","RAWKLU",53,0) STRTDT ;Prompt the user for a starting date (VERIFIED DATE) "RTN","RAWKLU",54,0) S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101) "RTN","RAWKLU",55,0) I RASTART=-1 D XIT Q "RTN","RAWKLU",56,0) S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001 "RTN","RAWKLU",57,0) ;need inv. verified date to search ^RARPT("AA", "RTN","RAWKLU",58,0) S RAMBGDT=9999999.9999-RAMBGDT "RTN","RAWKLU",59,0) K RASTART "RTN","RAWKLU",60,0) ; "RTN","RAWKLU",61,0) ENDDT ;Prompt the user for an ending date (VERIFIED DATE) "RTN","RAWKLU",62,0) S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX) "RTN","RAWKLU",63,0) I RAEND=-1 D XIT Q "RTN","RAWKLU",64,0) S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999 "RTN","RAWKLU",65,0) ;need inv. verified date to search ^RARPT("AA", "RTN","RAWKLU",66,0) S RAMENDT=9999999.9999-RAMENDT "RTN","RAWKLU",67,0) K RAEND "RTN","RAWKLU",68,0) ; "RTN","RAWKLU",69,0) F I="RARPTYP","^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)="" "RTN","RAWKLU",70,0) S I="RA print "_$S(RARPTYP="CPT":"CPTs",1:"wRVUs")_" totals for physicians within imaging type" "RTN","RAWKLU",71,0) D EN^XUTMDEVQ("START^RAWKLU",I,.ZTSAVE,,1) "RTN","RAWKLU",72,0) I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,! "RTN","RAWKLU",73,0) K I,ZTSAVE,ZTSK "RTN","RAWKLU",74,0) Q "RTN","RAWKLU",75,0) ; "RTN","RAWKLU",76,0) START ;check exams based on criteria input by user; physician & exam D/T "RTN","RAWKLU",77,0) ;eliminate the exam record is one of the following conditions is true: "RTN","RAWKLU",78,0) ;1-the status of the exam is 'Cancelled' "RTN","RAWKLU",79,0) ;2-the physician(s) selected are not the primary staff for the exam "RTN","RAWKLU",80,0) ; "RTN","RAWKLU",81,0) ;03/28/07 KAM/BAY Remedy Call 179232 Added next line "RTN","RAWKLU",82,0) S RACYFLG=0 "RTN","RAWKLU",83,0) ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check "RTN","RAWKLU",84,0) D CHKCY^RAWKLU2 "RTN","RAWKLU",85,0) S:$D(ZTQUEUED)#2 ZTREQ="@" "RTN","RAWKLU",86,0) K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE") "RTN","RAWKLU",87,0) S ^TMP($J,"RA BY I-TYPE")="0^0^0^0^0^0^0^0^0",CNT=0 "RTN","RAWKLU",88,0) ;define where the totals for imaging type will reside on the globals "RTN","RAWKLU",89,0) F RAI="RAD","MRI","CT","US","NM","VAS","ANI","CARD","MAM" S CNT=CNT+1,RAIAB(RAI)=CNT "RTN","RAWKLU",90,0) K RAI,CNT S RARPTVDT=RAMBGDT,(RACNT,RAXIT)=0 "RTN","RAWKLU",91,0) F S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT0 S RAI=0 D "RTN","RAWKLU",159,0) .F S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI D "RTN","RAWKLU",160,0) ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0)) "RTN","RAWKLU",161,0) ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC "RTN","RAWKLU",162,0) ..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT) "RTN","RAWKLU",163,0) ..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2 "RTN","RAWKLU",164,0) ..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_"," "RTN","RAWKLU",165,0) ..Q "RTN","RAWKLU",166,0) .Q "RTN","RAWKLU",167,0) ;get wRVU value from FEE BASIS; returns a string: status^value^message "RTN","RAWKLU",168,0) ;where status'=1 means "in error". All exams prior to 1/1/1999 will "RTN","RAWKLU",169,0) ;use 1999 wRVU values for their calculations. "RTN","RAWKLU",170,0) ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line "RTN","RAWKLU",171,0) S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT)) "RTN","RAWKLU",172,0) ; 09/25/2006 KAM/BAY Remedy Call 154793 Correct 0 RVUs "RTN","RAWKLU",173,0) I $P(RAWRVU,U,2)=0,RACPTMOD="" D "RTN","RAWKLU",174,0) . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT)) "RTN","RAWKLU",175,0) ; "RTN","RAWKLU",176,0) I $P(RAWRVU,U)=1 D "RTN","RAWKLU",177,0) .;apply bilateral multiplier if appropriate "RTN","RAWKLU",178,0) .S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2 "RTN","RAWKLU",179,0) .;or not... "RTN","RAWKLU",180,0) .S:'RABILAT RAWRVU=$P(RAWRVU,U,2) "RTN","RAWKLU",181,0) .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT) "RTN","RAWKLU",182,0) .Q "RTN","RAWKLU",183,0) ; "RTN","RAWKLU",184,0) E S RAWRVU=0 ;status some other value than 1; "in error" "RTN","RAWKLU",185,0) S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value... "RTN","RAWKLU",186,0) D ARY(RAWRVU) "RTN","RAWKLU",187,0) K RA813,RABILAT,RACPT,RACPTMOD,RAI,RAWRVU "RTN","RAWKLU",188,0) Q "RTN","RAWKLU",189,0) ; "RTN","RAWKLU",190,0) XIT ;kill variables and exit "RTN","RAWKLU",191,0) W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM) "RTN","RAWKLU",192,0) K DIRUT,DTOUT,DUOUT,RA7002,RA7003,RABGDTI,RABGDTX,RACNI,RADATE "RTN","RAWKLU",193,0) K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAIAB,RAITYP,RAMBGDT,RAMENDT "RTN","RAWKLU",194,0) K RARPT,RARPTIEN,RARPTVDT,RASTAFF,RAXIT,X,Y,^TMP("RA STFPHYS-IEN",$J) "RTN","RAWKLU",195,0) K ^TMP($J,"RA BY STFPHYS"),^TMP($J,"RA BY I-TYPE"),RACYFLG "RTN","RAWKLU",196,0) Q "RTN","RAWKLU1") 0^6^B36246757^B32092526 "RTN","RAWKLU1",1,0) RAWKLU1 ;HISC/GJC-physician workload statistics by wRVU or CPT ;10/26/05 14:57 "RTN","RAWKLU1",2,0) ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7 "RTN","RAWKLU1",3,0) ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77 "RTN","RAWKLU1",4,0) ; Add note to header if current calendar year data was "RTN","RAWKLU1",5,0) ; not used used in the report creation and add default "RTN","RAWKLU1",6,0) ; scaling factors to print "RTN","RAWKLU1",7,0) ; "RTN","RAWKLU1",8,0) ;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217) "RTN","RAWKLU1",9,0) ; from the KERNEL SYSTEM PARAMETERS (#8989.3) file. "RTN","RAWKLU1",10,0) ;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into "RTN","RAWKLU1",11,0) ; the name of the facility "RTN","RAWKLU1",12,0) ;DBIA#:10063 ($$S^%ZTLOAD) "RTN","RAWKLU1",13,0) ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT) "RTN","RAWKLU1",14,0) ; "RTN","RAWKLU1",15,0) EN ;entry point; called from RAWKLU... "RTN","RAWKLU1",16,0) S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST")) "RTN","RAWKLU1",17,0) S:RAFAC="" RAFAC="***undefined facility name***" "RTN","RAWKLU1",18,0) S $P(RALN,"-",IOM+1)="",(RACNT,RAPG)=0 "RTN","RAWKLU1",19,0) S RAHDR="IMAGING PHYSICIAN WORKLOAD SUMMARY BY " "RTN","RAWKLU1",20,0) I RARPTYP="CPT" S RAHDR=RAHDR_"NUMBER OF CPT CODES" "RTN","RAWKLU1",21,0) I RARPTYP="RVU" S RAHDR=RAHDR_$S(RASCLD=1:"SCALED ",1:"")_"PROFESSIONAL COMPONENT CMS RVU" "RTN","RAWKLU1",22,0) S RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D") "RTN","RAWKLU1",23,0) ; "RTN","RAWKLU1",24,0) ;$O through physician names; print totals... "RTN","RAWKLU1",25,0) I RARPTYP="RVU" S RATMP="("_$S(RASCLD'=1:"un-s",1:"S")_"caled wRVU)" "RTN","RAWKLU1",26,0) S RAPCE=$S(RARPTYP="CPT":3,RARPTYP="RVU"&(IOM=132):5,1:7) "RTN","RAWKLU1",27,0) S RATRUNC=$S(RARPTYP="CPT":20,RARPTYP="RVU"&(IOM=80):23,1:27) "RTN","RAWKLU1",28,0) S RAWDTH=$S(RARPTYP="CPT":5,1:8),RADEC=$S(RARPTYP="RVU":2,1:0) "RTN","RAWKLU1",29,0) D HDR S RAX="" "RTN","RAWKLU1",30,0) F S RAX=$O(^TMP($J,"RA BY STFPHYS",RAX)) Q:RAX="" D Q:RAXIT "RTN","RAWKLU1",31,0) .S RACNT=RACNT+1,RAY=$G(^TMP($J,"RA BY STFPHYS",RAX)),RATOT=0 "RTN","RAWKLU1",32,0) .;did the user stop the task? Check every five hundred records... "RTN","RAWKLU1",33,0) .S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT "RTN","RAWKLU1",34,0) .W !,$E(RAX,1,RATRUNC) ;physician name "RTN","RAWKLU1",35,0) .D WRITE(RAPCE,0,RAY,RAWDTH,RADEC) "RTN","RAWKLU1",36,0) .S RAFMAT=$P($T(CFMAT+10),";;",2,99) "RTN","RAWKLU1",37,0) .;single physician total for all i-types - adj RAWDTH for totals "RTN","RAWKLU1",38,0) .W ?$P(RAFMAT,U,RAPCE),$J(RATOT,$S(RAWDTH=8:10,1:6),RADEC) "RTN","RAWKLU1",39,0) .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU1",40,0) .Q "RTN","RAWKLU1",41,0) ;print the imaging type and physician totals... "RTN","RAWKLU1",42,0) I RAXIT D XIT Q "RTN","RAWKLU1",43,0) I 'RACNT W !,$$CJ^XLFSTR("No data found for this report",IOM) D XIT Q "RTN","RAWKLU1",44,0) I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU1",45,0) S RAY=$G(^TMP($J,"RA BY I-TYPE")),RATOT=0 "RTN","RAWKLU1",46,0) W !!,"Physician Total" "RTN","RAWKLU1",47,0) D WRITE(RAPCE,0,RAY,RAWDTH,RADEC) "RTN","RAWKLU1",48,0) S RAFMAT=$P($T(CFMAT+10),";;",2,99) "RTN","RAWKLU1",49,0) ;total for all physicians for all i-types - adj RAWDTH for totals "RTN","RAWKLU1",50,0) W ?$P(RAFMAT,U,RAPCE),$J(RATOT,$S(RAWDTH=8:10,1:6),RADEC) ;physician total for all i-types "RTN","RAWKLU1",51,0) I RASCLD=1 S RASFACTR="" D "RTN","RAWKLU1",52,0) .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU1",53,0) .W !!,"For calendar year "_($E(DT,1,3)+1700)_" the following scaling factors apply:" "RTN","RAWKLU1",54,0) .S I=0 "RTN","RAWKLU1",55,0) . ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types "RTN","RAWKLU1",56,0) .F S I=$O(^RA(79.2,I)) Q:'I D Q:RAXIT "RTN","RAWKLU1",57,0) ..S I(0)=$G(^RA(79.2,I,0)) "RTN","RAWKLU1",58,0) ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU1",59,0) .. ;04/13/07 KAM/BAY Added $S to next line for default "RTN","RAWKLU1",60,0) .. W !,$P(I(0),U),?34,$P(I(0),U,3),?49,$S($O(^RA(79.2,I,"CY",0))>0:$$SFCTR^RAWRVUP(I,DT),1:"1.00 (default)") "RTN","RAWKLU1",61,0) ..Q "RTN","RAWKLU1",62,0) .Q "RTN","RAWKLU1",63,0) XIT ;exit and kill variables "RTN","RAWKLU1",64,0) K I,RACNT,RADEC,RAFAC,RAFMAT,RAHDR,RAI,RALN,RAPCE,RAPG,RARDATE,RASFACTR,RATAB,RATMP,RATOT "RTN","RAWKLU1",65,0) K RATRUNC,RAWDTH,RAX,RAY "RTN","RAWKLU1",66,0) Q "RTN","RAWKLU1",67,0) ; "RTN","RAWKLU1",68,0) HDR ; Header for our report "RTN","RAWKLU1",69,0) W:RAPG!($E(IOST,1,2)="C-") @IOF "RTN","RAWKLU1",70,0) S RAPG=RAPG+1 "RTN","RAWKLU1",71,0) W !?(IOM-$L(RAHDR)\2),RAHDR "RTN","RAWKLU1",72,0) W !,"Run Date: ",RARDATE,?68,"Page: ",RAPG "RTN","RAWKLU1",73,0) W !,"Facility: ",$E(RAFAC,1,40),?41,"Date Range: ",RABGDTX_" - "_RAENDTX "RTN","RAWKLU1",74,0) ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines "RTN","RAWKLU1",75,0) I $G(RACYFLG) D "RTN","RAWKLU1",76,0) . W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***" "RTN","RAWKLU1",77,0) ;header formatting logic for CPT & RVU reports "RTN","RAWKLU1",78,0) W:RARPTYP="RVU" !,$$CJ^XLFSTR(RATMP,IOM) "RTN","RAWKLU1",79,0) W:RARPTYP="CPT" ! ;CPT report "RTN","RAWKLU1",80,0) N RAPCE S RAPCE=$S(RARPTYP="CPT":2,RARPTYP="RVU"&(IOM=132):4,1:6) "RTN","RAWKLU1",81,0) I '$D(RASFACTR)#2 D "RTN","RAWKLU1",82,0) .W !,"Physician" D WRITE(RAPCE,1) "RTN","RAWKLU1",83,0) W:$D(RASFACTR)#2 !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor" "RTN","RAWKLU1",84,0) W !,RALN "RTN","RAWKLU1",85,0) Q "RTN","RAWKLU1",86,0) ; "RTN","RAWKLU1",87,0) STRTDT(RADATE,RAEARLY) ;Prompt the user for the starting date report verified "RTN","RAWKLU1",88,0) ;RADATE-Today's date; DT-implicitly defined as today's date(internal format) "RTN","RAWKLU1",89,0) ;RAEARLY-Earliest conceivable starting date "RTN","RAWKLU1",90,0) W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y N RARSLT "RTN","RAWKLU1",91,0) S DIR(0)="DA^"_RAEARLY_":"_"DT:PEX" "RTN","RAWKLU1",92,0) S DIR("A",1)="Calculate physician workload over a date range; enter a start date" "RTN","RAWKLU1",93,0) S DIR("A")="of: " "RTN","RAWKLU1",94,0) S DIR("?",1)="Workload is assigned on the date the report is verified, not the date" "RTN","RAWKLU1",95,0) S DIR("?",2)="the report is dictated.",DIR("?",3)="" "RTN","RAWKLU1",96,0) S DIR("?",4)="This is the date from which our search will begin. The starting" "RTN","RAWKLU1",97,0) S DIR("?",5)="date must not precede: "_$$FMTE^XLFDT(RAEARLY,"1D")_" and must not come after: "_RADATE_"." "RTN","RAWKLU1",98,0) S DIR("?")="Dates associated with a time will not be accepted." "RTN","RAWKLU1",99,0) S DIR("B")=RADATE D ^DIR "RTN","RAWKLU1",100,0) S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=Y_U_Y(0) "RTN","RAWKLU1",101,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RAWKLU1",102,0) Q RARSLT "RTN","RAWKLU1",103,0) ; "RTN","RAWKLU1",104,0) ENDDT(RABGDTI,RABGDTX) ;Prompt the user for the ending date report verified (no greater than a "RTN","RAWKLU1",105,0) ;year after the start date input by the user) "RTN","RAWKLU1",106,0) ;DT-implicitly defined as today's date(internal format) "RTN","RAWKLU1",107,0) ;RABGDTI-The search start date (selected by the user; internal format) "RTN","RAWKLU1",108,0) ;RABGDTX-The search start date (selected by the user; external format) "RTN","RAWKLU1",109,0) W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y N RAEND,RARSLT "RTN","RAWKLU1",110,0) ;is today's date 365 days or more past the start date? If yes, calculate end date "RTN","RAWKLU1",111,0) ;by adding a year to the start date selected by the user "RTN","RAWKLU1",112,0) I $$FMDIFF^XLFDT(DT,RABGDTI,1)'<365 S RAEND=$$FMADD^XLFDT(RABGDTI,365,0,0,0) "RTN","RAWKLU1",113,0) ;if not, default using DT (today's date) "RTN","RAWKLU1",114,0) S:'$D(RAEND)#2 RAEND=DT "RTN","RAWKLU1",115,0) S DIR(0)="DA^"_RABGDTI_":"_RAEND_":PEX" "RTN","RAWKLU1",116,0) S DIR("A")="Enter an end date of: " "RTN","RAWKLU1",117,0) S DIR("?",1)="Workload is assigned on the date the report is verified, not the date" "RTN","RAWKLU1",118,0) S DIR("?",2)="the report is dictated.",DIR("?",3)="" "RTN","RAWKLU1",119,0) S DIR("?",4)="This is the date in which our search will end. The ending date" "RTN","RAWKLU1",120,0) S DIR("?",5)="must not precede: "_RABGDTX_" and must not exceed: "_$$FMTE^XLFDT(RAEND,"1D")_"." "RTN","RAWKLU1",121,0) S DIR("?")="Dates associated with a time will not be accepted." "RTN","RAWKLU1",122,0) S DIR("B")=$$FMTE^XLFDT(RAEND,"1D") D ^DIR K DIR "RTN","RAWKLU1",123,0) S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=Y_U_Y(0) "RTN","RAWKLU1",124,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RAWKLU1",125,0) Q RARSLT "RTN","RAWKLU1",126,0) ; "RTN","RAWKLU1",127,0) WRITE(RAPCE,HDR,RAY,RAWDTH,RADEC) ;Write out the column headers and the data for our reports. "RTN","RAWKLU1",128,0) ;input: RAPCE=the piece of data referenced from the format string defined in CFMAT (req'd) "RTN","RAWKLU1",129,0) ; HDR=1 if called from the HDR subroutine, else HDR is 0 (req'd) "RTN","RAWKLU1",130,0) ; RAY=data to be printed; not a label (optional) "RTN","RAWKLU1",131,0) ; RAWDTH=field width; right justified (optional) "RTN","RAWKLU1",132,0) ; RADEC=number of decimal places; either zero or two (optional) "RTN","RAWKLU1",133,0) S RANGE=$S(HDR=1:10,1:9) "RTN","RAWKLU1",134,0) F RAI=1:1:RANGE S RAFMAT=$P($T(CFMAT+RAI),";;",2,99) D "RTN","RAWKLU1",135,0) .S RATAB=$P(RAFMAT,U,RAPCE) S:HDR=0 RATOT=RATOT+$P(RAY,U,RAI) "RTN","RAWKLU1",136,0) .I $P(RAFMAT,U)="NUC",((RAPCE=6)!(RAPCE=7)) W ! ;RVU on 80 "RTN","RAWKLU1",137,0) .W ?RATAB,$S(HDR=1:$P(RAFMAT,U),1:$J(+$P(RAY,U,RAI),RAWDTH,RADEC)) "RTN","RAWKLU1",138,0) .Q "RTN","RAWKLU1",139,0) K RANGE "RTN","RAWKLU1",140,0) Q "RTN","RAWKLU1",141,0) ; "RTN","RAWKLU1",142,0) CFMAT ;ImgTyp Abbr^colabbr-cpt80^col-data80^colabbr-rvu132^col-data132^colabbr-rvu80^col-data80 "RTN","RAWKLU1",143,0) ;;RAD^23^21^34^29^30^25 "RTN","RAWKLU1",144,0) ;;MRI^29^27^45^40^40^35 "RTN","RAWKLU1",145,0) ;;CT^36^33^56^50^51^45 "RTN","RAWKLU1",146,0) ;;US^42^39^66^60^61^55 "RTN","RAWKLU1",147,0) ;;NUC^47^45^75^70^14^9 "RTN","RAWKLU1",148,0) ;;VAS^53^51^85^80^25^20 "RTN","RAWKLU1",149,0) ;;ANI^59^57^95^91^36^31 "RTN","RAWKLU1",150,0) ;;CARD^64^63^104^100^46^42 "RTN","RAWKLU1",151,0) ;;MAM^70^67^115^110^58^53 "RTN","RAWKLU1",152,0) ;;Total^75^74^125^120^70^65 "RTN","RAWKLU1",153,0) ;; "RTN","RAWKLU2") 0^3^B44017603^B37550729 "RTN","RAWKLU2",1,0) RAWKLU2 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 "RTN","RAWKLU2",2,0) ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7 "RTN","RAWKLU2",3,0) ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value "RTN","RAWKLU2",4,0) ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC "RTN","RAWKLU2",5,0) ; eliminating the need for IA's 1995 amd 1996 "RTN","RAWKLU2",6,0) ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77 "RTN","RAWKLU2",7,0) ; Add check to see if current RVU data is available and if "RTN","RAWKLU2",8,0) ; not use previous year RVU data "RTN","RAWKLU2",9,0) ; "RTN","RAWKLU2",10,0) ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam "RTN","RAWKLU2",11,0) ; date/time "RTN","RAWKLU2",12,0) ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW "RTN","RAWKLU2",13,0) ; PERSON (#200) file "RTN","RAWKLU2",14,0) ;DBIA#:10063 ($$S^%ZTLOAD) "RTN","RAWKLU2",15,0) ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT) "RTN","RAWKLU2",16,0) ;DBIA#:10104 ($$CJ^XLFSTR) "RTN","RAWKLU2",17,0) ;DBIA#:1519 ($$EN^XUTMDEVQ) "RTN","RAWKLU2",18,0) ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file "RTN","RAWKLU2",19,0) ; 162.99 was updated "RTN","RAWKLU2",20,0) ; "RTN","RAWKLU2",21,0) EN(RASCLD) ;Identifies the option that the user wishes to execute. "RTN","RAWKLU2",22,0) ;input: RASCLD=zero for non-scaled wRVU, & one for the scaled wRVU "RTN","RAWKLU2",23,0) ; report. "RTN","RAWKLU2",24,0) ; "RTN","RAWKLU2",25,0) K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYS-IEN",$J) "RTN","RAWKLU2",26,0) ; "RTN","RAWKLU2",27,0) PHYST ;allow the user to select one/many/all physicians "RTN","RAWKLU2",28,0) ;(w/ staff classification) ;DBIA#: 10060 "RTN","RAWKLU2",29,0) S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS" "RTN","RAWKLU2",30,0) S RADIC("A")="Select Physician: ",RADIC("B")="All" "RTN","RAWKLU2",31,0) S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10" "RTN","RAWKLU2",32,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y "RTN","RAWKLU2",33,0) ;did the user select physicians to compile data on? if not, quit "RTN","RAWKLU2",34,0) I $O(^TMP($J,"RA STFPHYS",""))="" D Q "RTN","RAWKLU2",35,0) .W !!?3,$C(7),"Staff Physician data was not selected." "RTN","RAWKLU2",36,0) .Q "RTN","RAWKLU2",37,0) ; "RTN","RAWKLU2",38,0) ;build a new staff physician array (the other array is subscripted by "RTN","RAWKLU2",39,0) ;physician name then IEN) subscripting by staff physician IEN this "RTN","RAWKLU2",40,0) ;allows us to check the IEN of the staff physician selected by the "RTN","RAWKLU2",41,0) ;user against the IEN of the staff physician on the exam record "RTN","RAWKLU2",42,0) S X="" F S X=$O(^TMP($J,"RA STFPHYS",X)) Q:X="" D "RTN","RAWKLU2",43,0) .S Y=0 "RTN","RAWKLU2",44,0) .F S Y=$O(^TMP($J,"RA STFPHYS",X,Y)) Q:'Y S ^TMP("RA STFPHYS-IEN",$J,Y)="" "RTN","RAWKLU2",45,0) .Q "RTN","RAWKLU2",46,0) ; "RTN","RAWKLU2",47,0) K ^TMP($J,"RA STFPHYS") S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1) "RTN","RAWKLU2",48,0) ; "RTN","RAWKLU2",49,0) STRTDT ;Prompt the user for the starting verified date "RTN","RAWKLU2",50,0) S RASTART=$$STRTDT^RAWKLU1(RADATE,2110101) "RTN","RAWKLU2",51,0) I RASTART=-1 D XIT Q "RTN","RAWKLU2",52,0) S RABGDTI=$P(RASTART,U),RABGDTX=$P(RASTART,U,2),RAMBGDT=RABGDTI-.0001 "RTN","RAWKLU2",53,0) ;need inv. verified date to search ^RARPT("AA", "RTN","RAWKLU2",54,0) S RAMBGDT=9999999.9999-RABGDTI "RTN","RAWKLU2",55,0) K RASTART "RTN","RAWKLU2",56,0) ; "RTN","RAWKLU2",57,0) ENDDT ;Prompt the user for the ending verified date "RTN","RAWKLU2",58,0) S RAEND=$$ENDDT^RAWKLU1(RABGDTI,RABGDTX) "RTN","RAWKLU2",59,0) I RAEND=-1 D XIT Q "RTN","RAWKLU2",60,0) S RAENDTI=$P(RAEND,U),RAENDTX=$P(RAEND,U,2),RAMENDT=RAENDTI+.9999 "RTN","RAWKLU2",61,0) ;need inv. verified date to search ^RARPT("AA", "RTN","RAWKLU2",62,0) S RAMENDT=9999999.9999-RAMENDT "RTN","RAWKLU2",63,0) K RAEND "RTN","RAWKLU2",64,0) ; "RTN","RAWKLU2",65,0) F I="^TMP(""RA STFPHYS-IEN"",$J,","RADATE","RAB*","RAM*","RAE*","RASCLD" S ZTSAVE(I)="" "RTN","RAWKLU2",66,0) S I="RA print procedures, wRVUs, and their totals for a physician" "RTN","RAWKLU2",67,0) D EN^XUTMDEVQ("START^RAWKLU2",I,.ZTSAVE,,1) "RTN","RAWKLU2",68,0) I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,! "RTN","RAWKLU2",69,0) K I,ZTSAVE,ZTSK "RTN","RAWKLU2",70,0) Q "RTN","RAWKLU2",71,0) ; "RTN","RAWKLU2",72,0) START ;check exams based on criteria input by user; physician & exam D/T "RTN","RAWKLU2",73,0) ;eliminate the exam record is one of the following conditions is true: "RTN","RAWKLU2",74,0) ;1-the status of the exam is 'Cancelled' "RTN","RAWKLU2",75,0) ;2-the physician(s) selected are not the primary staff for the exam "RTN","RAWKLU2",76,0) ; "RTN","RAWKLU2",77,0) S:$D(ZTQUEUED)#2 ZTREQ="@" "RTN","RAWKLU2",78,0) K ^TMP($J,"RA BY STFPHYS") "RTN","RAWKLU2",79,0) ;03/28/07 KAM/BAY Remedy Call 179232 Added RACYFLG to next line "RTN","RAWKLU2",80,0) S RARPTVDT=RAMBGDT,(RACNT,RAXIT,RACYFLG)=0 "RTN","RAWKLU2",81,0) ;03/28/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check "RTN","RAWKLU2",82,0) D CHKCY "RTN","RAWKLU2",83,0) F S RARPTVDT=$O(^RARPT("AA",RARPTVDT),-1) Q:'RARPTVDT!(RARPTVDT0 S RAI=0 D "RTN","RAWKLU2",132,0) .F S RAI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI)) Q:'RAI D "RTN","RAWKLU2",133,0) ..S RACPTMOD(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RAI,0)) "RTN","RAWKLU2",134,0) ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC "RTN","RAWKLU2",135,0) ..S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),RAXAMDT) "RTN","RAWKLU2",136,0) ..I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2 "RTN","RAWKLU2",137,0) ..S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_"," "RTN","RAWKLU2",138,0) ..Q "RTN","RAWKLU2",139,0) .Q "RTN","RAWKLU2",140,0) ;get wRVU value from FEE BASIS; returns a string: status^value^message "RTN","RAWKLU2",141,0) ;where status'=1 means "in error". All exams prior to 1/1/1999 will use "RTN","RAWKLU2",142,0) ;1999 wRVU values for their calculations. "RTN","RAWKLU2",143,0) ;03/28/2007 KAM/BAY Rem Call 179232 Added RACYFLG to $S in next line "RTN","RAWKLU2",144,0) S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT)) "RTN","RAWKLU2",145,0) ;09/27/2006 KAM/BAY RA*5*77 Remedy Call 154793 "RTN","RAWKLU2",146,0) I $P(RAWRVU,U,2)=0,RACPTMOD="" D "RTN","RAWKLU2",147,0) . S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RAXAMDT<2990101:2990101,RACYFLG:RAXAMDT-10000,1:RAXAMDT)) "RTN","RAWKLU2",148,0) I $P(RAWRVU,U)=1 D "RTN","RAWKLU2",149,0) .;apply bilateral multiplier if appropriate "RTN","RAWKLU2",150,0) .S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2 "RTN","RAWKLU2",151,0) .;or not... "RTN","RAWKLU2",152,0) .S:'RABILAT RAWRVU=$P(RAWRVU,U,2) "RTN","RAWKLU2",153,0) .I RASCLD S RAWRVU=RAWRVU*$$SFCTR^RAWRVUP($P(RA7002,U,2),RAXAMDT) "RTN","RAWKLU2",154,0) .Q "RTN","RAWKLU2",155,0) ; "RTN","RAWKLU2",156,0) E S RAWRVU=0 ;status some other value than 1; "in error" "RTN","RAWKLU2",157,0) S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) ;do not round the value... "RTN","RAWKLU2",158,0) ; "RTN","RAWKLU2",159,0) ;^TMP($J,"RA BY STFPHYS",RASTF)=total # procedures^wRVU total(all proc) "RTN","RAWKLU2",160,0) ;^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))=^total # RACPT^ "RTN","RAWKLU2",161,0) ; total # RAWRVU "RTN","RAWKLU2",162,0) ; "RTN","RAWKLU2",163,0) S:'$D(^TMP($J,"RA BY STFPHYS",RASTF))#2 ^(RASTF)="0^0" "RTN","RAWKLU2",164,0) S $P(^TMP($J,"RA BY STFPHYS",RASTF),U)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U)+1 "RTN","RAWKLU2",165,0) S $P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)=$P(^TMP($J,"RA BY STFPHYS",RASTF),U,2)+RAWRVU "RTN","RAWKLU2",166,0) S:'$D(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)))#2 ^(RAPRCIEN(0))="^0^0" "RTN","RAWKLU2",167,0) S $P(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,2)=+$P($G(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0))),U,2)+1 "RTN","RAWKLU2",168,0) S $P(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,3)=RAWRVU*(+$P(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRCIEN(0)),U,2)) "RTN","RAWKLU2",169,0) ; "RTN","RAWKLU2",170,0) K RA813,RABILAT,RACPTMOD,RAI,RAWRVU "RTN","RAWKLU2",171,0) Q "RTN","RAWKLU2",172,0) ; "RTN","RAWKLU2",173,0) XIT ;kill variables and exit "RTN","RAWKLU2",174,0) W:$G(ZTSTOP)=1 !,$$CJ^XLFSTR("USER STOPPED PROCESS THROUGH TASKMAN",IOM) "RTN","RAWKLU2",175,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RA7002,RABGDTI,RABGDTX,RACNI,RACNT,RADATE "RTN","RAWKLU2",176,0) K RADFN,RADTE,RADTI,RAENDTI,RAENDTX,RAMBGDT,RAMENDT,RAQUIT,RARPT,RARPTIEN "RTN","RAWKLU2",177,0) K RARPTVDT,RAXAMDT,RAXIT,X,Y,RACYFLG "RTN","RAWKLU2",178,0) K ^TMP("RA STFPHYS-IEN",$J),^TMP($J,"RA BY STFPHYS") "RTN","RAWKLU2",179,0) Q "RTN","RAWKLU2",180,0) ; "RTN","RAWKLU2",181,0) CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU "RTN","RAWKLU2",182,0) ;data from Fee Basis "RTN","RAWKLU2",183,0) ; "RTN","RAWKLU2",184,0) S RACYFLG=0,Y=$G(DT) D DD^%DT "RTN","RAWKLU2",185,0) I $$LASTCY^FBAAFSR()<$P(Y," ",3) S RACYFLG=1 "RTN","RAWKLU2",186,0) Q "RTN","RAWKLU3") 0^7^B15626413^B12473282 "RTN","RAWKLU3",1,0) RAWKLU3 ;HISC/GJC-physician wRVU (scaled too) by procedure ;10/26/05 14:57 [3/15/06 12:30pm] "RTN","RAWKLU3",2,0) ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7 "RTN","RAWKLU3",3,0) ; "RTN","RAWKLU3",4,0) ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77 "RTN","RAWKLU3",5,0) ; Add note to header if current calendar year data was "RTN","RAWKLU3",6,0) ; not used in the report creation and added default "RTN","RAWKLU3",7,0) ; scaling factors "RTN","RAWKLU3",8,0) ; "RTN","RAWKLU3",9,0) ;DBIA#:2541 ($$KSP^XUPARAM) returns the DEFAULT INSTITUTION (#217) "RTN","RAWKLU3",10,0) ; from the KERNEL SYSTEM PARAMETERS (#8989.3) file. "RTN","RAWKLU3",11,0) ;DBIA#:2171 ($$NAME^XUAF4) resolves the DEFAULT INSTITUTION value into "RTN","RAWKLU3",12,0) ; the name of the facility "RTN","RAWKLU3",13,0) ;DBIA#:10063 ($$S^%ZTLOAD) "RTN","RAWKLU3",14,0) ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT) "RTN","RAWKLU3",15,0) ;DBIA#:10104 ($$CJ^XLFSTR) "RTN","RAWKLU3",16,0) ; "RTN","RAWKLU3",17,0) EN ;entry point; called from RAWKLU2... "RTN","RAWKLU3",18,0) S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST")) "RTN","RAWKLU3",19,0) S:RAFAC="" RAFAC="***undefined facility name***" "RTN","RAWKLU3",20,0) S $P(RALN,"-",IOM+1)="",(RACNT,RAPG,RAXIT)=0 "RTN","RAWKLU3",21,0) S RAHDR="IMAGING PHYSICIAN "_$S(RASCLD=1:"SCALED",1:"UN-SCALED")_" wRVU SUMMARY BY CPT" "RTN","RAWKLU3",22,0) S RARDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D") "RTN","RAWKLU3",23,0) ; "RTN","RAWKLU3",24,0) ;get the data from the global array and print it... "RTN","RAWKLU3",25,0) D HDR S RASTF="" "RTN","RAWKLU3",26,0) F S RASTF=$O(^TMP($J,"RA BY STFPHYS",RASTF)) Q:RASTF="" D Q:RAXIT D PHYTTL "RTN","RAWKLU3",27,0) .S RADAT(0)=$G(^TMP($J,"RA BY STFPHYS",RASTF)) "RTN","RAWKLU3",28,0) .S RATTLXP=$P(RADAT(0),U),RATLRVUP=$P(RADAT(0),U,2) "RTN","RAWKLU3",29,0) .W !,RASTF S RACPT="" "RTN","RAWKLU3",30,0) .F S RACPT=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT)) Q:RACPT="" D Q:RAXIT "RTN","RAWKLU3",31,0) ..S RAWRVU="" "RTN","RAWKLU3",32,0) ..F S RAWRVU=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU)) Q:RAWRVU="" D Q:RAXIT "RTN","RAWKLU3",33,0) ...S RAPRC="" "RTN","RAWKLU3",34,0) ...F S RAPRC=$O(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC)) Q:RAPRC="" D Q:RAXIT "RTN","RAWKLU3",35,0) ....S RADAT(1)=$G(^TMP($J,"RA BY STFPHYS",RASTF,RACPT,RAWRVU,RAPRC)) "RTN","RAWKLU3",36,0) ....S RATTLX=$P(RADAT(1),U,2) ;total # of exams "RTN","RAWKLU3",37,0) ....S RATTLRVU=$P(RADAT(1),U,3) ;total wRVU for a multiple occurances of the same CPT "RTN","RAWKLU3",38,0) ....S RACNT=RACNT+1 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT "RTN","RAWKLU3",39,0) ....I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU3",40,0) ....W !?2,RACPT,?12,$E(RAPRC,1,35),?50,$J(RAWRVU,6,2),?58,$J(RATTLX,8,0),?70,$J(RATTLRVU,8,2) "RTN","RAWKLU3",41,0) ....Q "RTN","RAWKLU3",42,0) ...Q "RTN","RAWKLU3",43,0) ..Q "RTN","RAWKLU3",44,0) .Q "RTN","RAWKLU3",45,0) ; "RTN","RAWKLU3",46,0) I RAXIT D XIT Q "RTN","RAWKLU3",47,0) I 'RACNT W !,$$CJ^XLFSTR("No data found for this report",IOM) D XIT Q "RTN","RAWKLU3",48,0) ; "RTN","RAWKLU3",49,0) DSPSFTR ;display CY i-type scaling factors if appropriate "RTN","RAWKLU3",50,0) ;04/13/2007 KAM/BAY RA*5*77 added default scaling factors "RTN","RAWKLU3",51,0) I RASCLD=1 S RASFACTR="" D "RTN","RAWKLU3",52,0) .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU3",53,0) .W !!,"For calendar year "_($E(DT,1,3)+1700)_" the following scaling factors apply:" "RTN","RAWKLU3",54,0) .S I=0 "RTN","RAWKLU3",55,0) . ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types "RTN","RAWKLU3",56,0) .F S I=$O(^RA(79.2,I)) Q:'I D Q:RAXIT "RTN","RAWKLU3",57,0) ..S I(0)=$G(^RA(79.2,I,0)) "RTN","RAWKLU3",58,0) ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU3",59,0) .. ;04/13/07 KAM/BAY Added $S to next line "RTN","RAWKLU3",60,0) .. W !,$P(I(0),U),?34,$P(I(0),U,3),?49,$S($O(^RA(79.2,I,"CY",0))>0:$$SFCTR^RAWRVUP(I,DT),1:"1.00 (default)") "RTN","RAWKLU3",61,0) ..Q "RTN","RAWKLU3",62,0) .Q "RTN","RAWKLU3",63,0) XIT ;exit and kill variables "RTN","RAWKLU3",64,0) K I,RACNT,RACPT,RADAT,RAFAC,RAHDR,RAI,RALN,RAPG,RAPRC,RARDATE,RASFACTR "RTN","RAWKLU3",65,0) K RASTF,RATLRVUP,RATTLRVU,RATTLX,RATTLXP,RAWRVU "RTN","RAWKLU3",66,0) Q "RTN","RAWKLU3",67,0) ; "RTN","RAWKLU3",68,0) HDR ; Header for our report "RTN","RAWKLU3",69,0) W:RAPG!($E(IOST,1,2)="C-") @IOF "RTN","RAWKLU3",70,0) S RAPG=RAPG+1 "RTN","RAWKLU3",71,0) W !?(IOM-$L(RAHDR)\2),RAHDR "RTN","RAWKLU3",72,0) W !,"Run Date: ",RARDATE,?68,"Page: ",RAPG "RTN","RAWKLU3",73,0) W !,"Facility: ",RAFAC,?41,"Date Range: ",RABGDTX_" - "_RAENDTX "RTN","RAWKLU3",74,0) ;header formatting logic for CPT scaled/un-scaled wRVU reports "RTN","RAWKLU3",75,0) ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines "RTN","RAWKLU3",76,0) I $G(RACYFLG) D "RTN","RAWKLU3",77,0) . W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***" "RTN","RAWKLU3",78,0) W:'$D(RASFACTR)#2 !!,"Staff Physician",?58,"Total #",?73,"Total",!?2,"CPT Code",?12,"Procedure",?51,$S(RASCLD=1:"SwRVU",1:" wRVU"),?58,"of exams",?73,$S(RASCLD=1:"SwRVU",1:" wRVU") "RTN","RAWKLU3",79,0) W:$D(RASFACTR)#2 !,"Imaging Type",?34,"Abbreviation",?49,"wRVU scaling factor" "RTN","RAWKLU3",80,0) W !,RALN "RTN","RAWKLU3",81,0) Q "RTN","RAWKLU3",82,0) ; "RTN","RAWKLU3",83,0) PHYTTL ;print the procedure & wRVU totals for the staff physician "RTN","RAWKLU3",84,0) I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWKLU3",85,0) W !?59,"-------",?71,"-------",!?58,$J(RATTLXP,8,0),?70,$J(RATLRVUP,8,2) "RTN","RAWKLU3",86,0) Q "RTN","RAWKLU3",87,0) ; "RTN","RAWRVUP") 0^4^B39711179^B28533070 "RTN","RAWRVUP",1,0) RAWRVUP ;HISC/GJC-Display procedures with their wRVU values ;10/26/05 14:57 "RTN","RAWRVUP",2,0) ;;5.0;Radiology/Nuclear Medicine;**64,77**;Mar 16, 1998;Build 7 "RTN","RAWRVUP",3,0) ;09/25/06 KAM/BAY Remedy Call 154793 PATCH *77 RVU with 0 value "RTN","RAWRVUP",4,0) ; and changed CPT calls from ^ICPTCOD to ^RACPTMSC "RTN","RAWRVUP",5,0) ; eliminating the need for IA's 1995 amd 1996 "RTN","RAWRVUP",6,0) ;03/28/07 KAM/BAY Remedy Call 179232 Patch RA*5*77 "RTN","RAWRVUP",7,0) ; Add check to see if current RVU data is available and if "RTN","RAWRVUP",8,0) ; not use previous year RVU data and added default scaling "RTN","RAWRVUP",9,0) ; factors "RTN","RAWRVUP",10,0) ; "RTN","RAWRVUP",11,0) ;DBIA#:4799 ($$RVU^FBRVU) return wRVU value for CPT, CPT Mod, & exam "RTN","RAWRVUP",12,0) ; date/time "RTN","RAWRVUP",13,0) ;DBIA#:10060 EN1^RASELCT enacts 10060 which allows lookups on the NEW "RTN","RAWRVUP",14,0) ; PERSON (#200) file "RTN","RAWRVUP",15,0) ;DBIA#:10063 ($$S^%ZTLOAD) "RTN","RAWRVUP",16,0) ;DBIA#:10103 ($$FMTE^XLFDT) & ($$NOW^XLFDT) "RTN","RAWRVUP",17,0) ;DBIA#:10104 ($$CJ^XLFSTR) "RTN","RAWRVUP",18,0) ;DBIA#:1519 ($$EN^XUTMDEVQ) "RTN","RAWRVUP",19,0) ;DBIA#:4432 (LASTCY^FBAAFSR) return last calendar year file "RTN","RAWRVUP",20,0) ; 162.99 was updated "RTN","RAWRVUP",21,0) ; "RTN","RAWRVUP",22,0) EN(RASCLD) ;entry point "RTN","RAWRVUP",23,0) ;input: RASCLD=one if scaled, 0 if un-scaled "RTN","RAWRVUP",24,0) K ^TMP($J,"RA PROCEDURES") "RTN","RAWRVUP",25,0) ; "RTN","RAWRVUP",26,0) PROC ;allow the user to select one/many/all Rad/Nuc Med procedures "RTN","RAWRVUP",27,0) S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ",RAUTIL="RA PROCEDURES" "RTN","RAWRVUP",28,0) S RADIC("A")="Select Procedures: ",RADIC("B")="All",RAXIT=0 "RTN","RAWRVUP",29,0) ;screen: based on user selection of procedure activity and that the "RTN","RAWRVUP",30,0) ;procedure must have a CPT code (only detailed and series procedures) "RTN","RAWRVUP",31,0) S RADIC("S")="I $P(^(0),U,9)" ;must have a CPT code (detailed/series) "RTN","RAWRVUP",32,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) "RTN","RAWRVUP",33,0) S RAXIT=RAQUIT K %W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y "RTN","RAWRVUP",34,0) ;did the user select physicians to compile data on? if not, quit "RTN","RAWRVUP",35,0) I $O(^TMP($J,"RA PROCEDURES",""))="" D D XIT Q "RTN","RAWRVUP",36,0) .W !!?3,$C(7),"Rad/Nuc Med Procedures were not selected." "RTN","RAWRVUP",37,0) .Q "RTN","RAWRVUP",38,0) ; "RTN","RAWRVUP",39,0) F I="RASCLD","^TMP($J,""RA PROCEDURES""," S ZTSAVE(I)="" "RTN","RAWRVUP",40,0) S I="RA print wRVUs for Rad/Nuc Med procedures" "RTN","RAWRVUP",41,0) D EN^XUTMDEVQ("START^RAWRVUP",I,.ZTSAVE,,1) "RTN","RAWRVUP",42,0) I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,! "RTN","RAWRVUP",43,0) K I,ZTSAVE,ZTSK "RTN","RAWRVUP",44,0) Q "RTN","RAWRVUP",45,0) ; "RTN","RAWRVUP",46,0) START ; "RTN","RAWRVUP",47,0) S:$D(ZTQUEUED)#2 ZTREQ="@" "RTN","RAWRVUP",48,0) ; 03/29/07 KAM/BAY Patch RA*5*77/179232 Added RACYFLG to next line "RTN","RAWRVUP",49,0) S $P(RALN,"-",IOM+1)="",(RACNT,RAPG,RAXIT,RACYFLG)=0 "RTN","RAWRVUP",50,0) ;03/29/07 KAM/BAY RA*5*77/179232 Added Fee Basis Data Check "RTN","RAWRVUP",51,0) D CHKCY "RTN","RAWRVUP",52,0) S RARUNDT=$$FMTE^XLFDT(DT,"1P") "RTN","RAWRVUP",53,0) S RAHDR="PROCEDURE CPT CODE AND"_$S(RASCLD=1:" SCALED",1:"")_" WORK RELATIVE VALUE UNITS (wRVU)" "RTN","RAWRVUP",54,0) S RAX="" D HDR "RTN","RAWRVUP",55,0) F S RAX=$O(^TMP($J,"RA PROCEDURES",RAX)) Q:RAX="" D Q:RAXIT "RTN","RAWRVUP",56,0) .S RAY=0 "RTN","RAWRVUP",57,0) .F S RAY=$O(^TMP($J,"RA PROCEDURES",RAX,RAY)) Q:'RAY D Q:RAXIT "RTN","RAWRVUP",58,0) ..S RACNT=RACNT+1 S:RACNT#500=0 (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT "RTN","RAWRVUP",59,0) ..S RAMIS(0)=$G(^RAMIS(71,RAY,0)) "RTN","RAWRVUP",60,0) ..S RAPROC=$E($P(RAMIS(0),U),1,35) ;truncate to thirty-five chars "RTN","RAWRVUP",61,0) ..S RAPTYPE=$S($P(RAMIS(0),U,6)="D":"Detailed",1:"Series") "RTN","RAWRVUP",62,0) ..S RAITYPE=$P($G(^RA(79.2,+$P(RAMIS(0),U,12),0)),U,3) "RTN","RAWRVUP",63,0) ..;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC "RTN","RAWRVUP",64,0) ..S RACPT=$P(RAMIS(0),U,9),RACPT=$P($$NAMCODE^RACPTMSC(RACPT,DT),U,1) "RTN","RAWRVUP",65,0) ..;determine if there are default CPT modifiers for this procedure; if "RTN","RAWRVUP",66,0) ..;so, does one indicate 'bilateral'? If bilateral multiply wRVU by two. "RTN","RAWRVUP",67,0) ..S RACPTMOD="",RABILAT=0 "RTN","RAWRVUP",68,0) ..I $O(^RAMIS(71,RAY,"DCM",0))>0 S RAI=0 D "RTN","RAWRVUP",69,0) ...F S RAI=$O(^RAMIS(71,RAY,"DCM",RAI)) Q:'RAI D "RTN","RAWRVUP",70,0) ....S RACPTMOD(0)=+$G(^RAMIS(71,RAY,"DCM",RAI,0)) "RTN","RAWRVUP",71,0) ....;09/27/2006 KAM/BAY RA*5*77 Changed next line to use ^RACPTMSC "RTN","RAWRVUP",72,0) ....S RA813(0)=$$BASICMOD^RACPTMSC(RACPTMOD(0),DT) "RTN","RAWRVUP",73,0) ....I 'RABILAT,$P(RA813(0),U,2)=50 S RABILAT=1 ;bilateral multiplier=2 "RTN","RAWRVUP",74,0) ....S RACPTMOD=RACPTMOD_$P(RA813(0),U,2)_"," "RTN","RAWRVUP",75,0) ....Q "RTN","RAWRVUP",76,0) ...Q "RTN","RAWRVUP",77,0) ..;get wRVU value from FEE BASIS; returns a string: status^value^message "RTN","RAWRVUP",78,0) ..;where status'=1 means "in error" "RTN","RAWRVUP",79,0) .. ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line "RTN","RAWRVUP",80,0) ..S RAWRVU=$$RVU^FBRVU(RACPT,RACPTMOD,$S(RACYFLG:DT-10000,1:DT)) "RTN","RAWRVUP",81,0) .. ; 09/25/2006 Remedy call 154793 Correct 0 RVUs "RTN","RAWRVUP",82,0) .. I $P(RAWRVU,U,2)=0,RACPTMOD="" D "RTN","RAWRVUP",83,0) ... ;03/29/07 KAM/BAY RA*5*77/179232 Added $S to next line "RTN","RAWRVUP",84,0) ... S RAWRVU=$$RVU^FBRVU(RACPT,26,$S(RACYFLG:DT-10000,1:DT)) "RTN","RAWRVUP",85,0) .. ; "RTN","RAWRVUP",86,0) ..I $P(RAWRVU,U)=1 D "RTN","RAWRVUP",87,0) ...;apply bilateral multiplier if appropriate "RTN","RAWRVUP",88,0) ...S:RABILAT RAWRVU=$P(RAWRVU,U,2)*2 "RTN","RAWRVUP",89,0) ...;or not... "RTN","RAWRVUP",90,0) ...S:'RABILAT RAWRVU=$P(RAWRVU,U,2) "RTN","RAWRVUP",91,0) ...Q "RTN","RAWRVUP",92,0) ..E S RAWRVU=0 ;status some other value than 1; "in error" "RTN","RAWRVUP",93,0) ..; "RTN","RAWRVUP",94,0) ..S:RAWRVU>0 RAWRVU=$J(RAWRVU,1,2) "RTN","RAWRVUP",95,0) ..; "RTN","RAWRVUP",96,0) SCALED ..;when scaled find scaled wRVU value "RTN","RAWRVUP",97,0) ..I RASCLD=1,(RAWRVU>0) D "RTN","RAWRVUP",98,0) ...S RASFACTR=$$SFCTR(+$P(RAMIS(0),U,12)) ;pass i-type ptr "RTN","RAWRVUP",99,0) ...S RASWRVU=$J((RAWRVU*RASFACTR),1,2) "RTN","RAWRVUP",100,0) ...Q "RTN","RAWRVUP",101,0) ..E S RASWRVU=0 ;mult by zero "RTN","RAWRVUP",102,0) ..; "RTN","RAWRVUP",103,0) ..W !,RAPROC,?37,RAPTYPE,?48,RAITYPE,?58,RACPT,?68,$S(RASCLD=1:$J(RASWRVU,7,2),1:$J(RAWRVU,7,2)) "RTN","RAWRVUP",104,0) ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR "RTN","RAWRVUP",105,0) ..Q "RTN","RAWRVUP",106,0) .Q "RTN","RAWRVUP",107,0) I 'RAXIT,(RASCLD) S RASFACTR(0)="" D "RTN","RAWRVUP",108,0) .I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWRVUP",109,0) .W !!,"For calendar year "_($E(DT,1,3)+1700)_" the following scaling factors apply:" "RTN","RAWRVUP",110,0) .S I=0 "RTN","RAWRVUP",111,0) . ;04/13/07 KAM/BAY RA*5*77 Modified next line to loop thru all imaging types "RTN","RAWRVUP",112,0) .F S I=$O(^RA(79.2,I)) Q:'I D Q:RAXIT "RTN","RAWRVUP",113,0) ..S I(0)=$G(^RA(79.2,I,0)) "RTN","RAWRVUP",114,0) ..I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR "RTN","RAWRVUP",115,0) ..; 04/13/07 KAM/BAY RA*5*77 Added $S to next line "RTN","RAWRVUP",116,0) .. W !,$P(I(0),U),?34,$P(I(0),U,3),?49,$S($O(^RA(79.2,I,"CY",0))>0:$$SFCTR^RAWRVUP(I,DT),1:"1.00 (default)") "RTN","RAWRVUP",117,0) ..Q "RTN","RAWRVUP",118,0) .S RAXIT=$$EOS^RAUTL5() "RTN","RAWRVUP",119,0) .Q "RTN","RAWRVUP",120,0) D XIT "RTN","RAWRVUP",121,0) Q "RTN","RAWRVUP",122,0) ; "RTN","RAWRVUP",123,0) HDR ; Header for our report "RTN","RAWRVUP",124,0) W:RAPG!($E(IOST,1,2)="C-") @IOF "RTN","RAWRVUP",125,0) S RAPG=RAPG+1 W !?(IOM-$L(RAHDR)\2),RAHDR "RTN","RAWRVUP",126,0) W !,"Run Date: ",RARUNDT,?68,"Page: ",RAPG "RTN","RAWRVUP",127,0) ;03/28/07 KAM/BAY RA*5*77/179232 Added next 2 lines "RTN","RAWRVUP",128,0) I $G(RACYFLG) D "RTN","RAWRVUP",129,0) . W !,?7,"***This report was prepared with "_$$LASTCY^FBAAFSR()_" Calendar Year RVU Data***" "RTN","RAWRVUP",130,0) W:'$D(RASFACTR(0))#2 !!,"Procedure",?37,"Proc Type",?48,"Img Type",?58,"CPT Code",?68,$S(RASCLD=1:" S",1:" ")_"wRVU" "RTN","RAWRVUP",131,0) W:$D(RASFACTR(0))#2 !!,"Imaging Type",?34,"Abbreviation",?51,"wRVU scaling factor" "RTN","RAWRVUP",132,0) W !,RALN "RTN","RAWRVUP",133,0) Q "RTN","RAWRVUP",134,0) ; "RTN","RAWRVUP",135,0) XIT ;kill variables and exit "RTN","RAWRVUP",136,0) I 'RAXIT W:'RACNT !,$$CJ^XLFSTR("No data found for this report",IOM) "RTN","RAWRVUP",137,0) K DILN,DTOUT,DUOUT,I,POP,RA813,RABILAT,RACNT,RACPT,RACPTMOD,RAHDR,RAI "RTN","RAWRVUP",138,0) K RAITYPE,RALN,RAMIS,RAPTYPE,RAPG,RAPROC,RARUNDT,RASCLD,RASFACTR "RTN","RAWRVUP",139,0) K RASWRVU,RAWRVU,RAX,RAXIT,RAY,RAYEAR,X,Y,RACYFLG "RTN","RAWRVUP",140,0) K ^TMP($J,"RA PROCEDURES") "RTN","RAWRVUP",141,0) Q "RTN","RAWRVUP",142,0) ; "RTN","RAWRVUP",143,0) SFCTR(RAITYP,RAYEAR) ;return the calendar year specific scaling factor for a "RTN","RAWRVUP",144,0) ;specific imaging type "RTN","RAWRVUP",145,0) ;input: RAITYP=imaging type "RTN","RAWRVUP",146,0) ; RAYEAR=internal FM date/time format; resolves to current year "RTN","RAWRVUP",147,0) ;return: calendar year specific scaling factor "RTN","RAWRVUP",148,0) N RASF,RAYR S RAYEAR=$G(RAYEAR,DT) ;default to DT (current year) "RTN","RAWRVUP",149,0) S (RAYEAR,RAYR)=$E(RAYEAR,1,3)+1700 "RTN","RAWRVUP",150,0) S RASF=+$O(^RA(79.2,RAITYP,"CY","B",RAYEAR,0)) "RTN","RAWRVUP",151,0) ;if RASF=0 for the current year, check for the most recent year "RTN","RAWRVUP",152,0) I RASF=0 D "RTN","RAWRVUP",153,0) .S RAYEAR=+$O(^RA(79.2,1,"CY","B",RAYEAR),-1) "RTN","RAWRVUP",154,0) .S RASF=+$O(^RA(79.2,RAITYP,"CY","B",RAYEAR,0)) "RTN","RAWRVUP",155,0) .Q "RTN","RAWRVUP",156,0) S RASF=+$P($G(^RA(79.2,RAITYP,"CY",RASF,0)),U,2) "RTN","RAWRVUP",157,0) S:RASF=0 RASF=1 ;defaults to one "RTN","RAWRVUP",158,0) Q $J(RASF,$L(RASF),2)_$S(RAYEAR:" ("_RAYR_")",1:"") "RTN","RAWRVUP",159,0) ; "RTN","RAWRVUP",160,0) CHKCY ;03/28/2007 KAM/BAY RA*5*77 Remedy Call 179232 Check for latest RVU "RTN","RAWRVUP",161,0) ;data from Fee Basis "RTN","RAWRVUP",162,0) S RACYFLG=0,Y=$G(DT) D DD^%DT "RTN","RAWRVUP",163,0) I $$LASTCY^FBAAFSR()<$P(Y," ",3) S RACYFLG=1 "RTN","RAWRVUP",164,0) Q "VER") 8.0^22.0 "BLD",6235,6) ^68 **END** **END**