Released RA*5*193 SEQ #174 Extracted from mail message **KIDS**:RA*5.0*193^ **INSTALL NAME** RA*5.0*193 "BLD",12620,0) RA*5.0*193^RADIOLOGY/NUCLEAR MEDICINE^0^3220825^y "BLD",12620,1,0) ^^3^3^3220823^ "BLD",12620,1,1,0) Patch one hundred and ninety-three for the VistA Radiology/Nuclear "BLD",12620,1,2,0) Medicine 5.0 application. Please review FORUM's Patch Module description "BLD",12620,1,3,0) and installation instructions for RA*5.0*193 before installing this patch. "BLD",12620,4,0) ^9.64PA^^ "BLD",12620,6) 1 "BLD",12620,6.3) 1 "BLD",12620,"KRN",0) ^9.67PA^1.5^25 "BLD",12620,"KRN",.4,0) .4 "BLD",12620,"KRN",.401,0) .401 "BLD",12620,"KRN",.402,0) .402 "BLD",12620,"KRN",.403,0) .403 "BLD",12620,"KRN",.5,0) .5 "BLD",12620,"KRN",.84,0) .84 "BLD",12620,"KRN",1.5,0) 1.5 "BLD",12620,"KRN",1.6,0) 1.6 "BLD",12620,"KRN",1.61,0) 1.61 "BLD",12620,"KRN",1.62,0) 1.62 "BLD",12620,"KRN",3.6,0) 3.6 "BLD",12620,"KRN",3.8,0) 3.8 "BLD",12620,"KRN",9.2,0) 9.2 "BLD",12620,"KRN",9.8,0) 9.8 "BLD",12620,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",12620,"KRN",9.8,"NM",1,0) RAORDP^^0^B33895868 "BLD",12620,"KRN",9.8,"NM",2,0) RASYS1^^0^B41157247 "BLD",12620,"KRN",9.8,"NM","B","RAORDP",1) "BLD",12620,"KRN",9.8,"NM","B","RASYS1",2) "BLD",12620,"KRN",19,0) 19 "BLD",12620,"KRN",19.1,0) 19.1 "BLD",12620,"KRN",101,0) 101 "BLD",12620,"KRN",409.61,0) 409.61 "BLD",12620,"KRN",771,0) 771 "BLD",12620,"KRN",779.2,0) 779.2 "BLD",12620,"KRN",870,0) 870 "BLD",12620,"KRN",8989.51,0) 8989.51 "BLD",12620,"KRN",8989.52,0) 8989.52 "BLD",12620,"KRN",8993,0) 8993 "BLD",12620,"KRN",8994,0) 8994 "BLD",12620,"KRN","B",.4,.4) "BLD",12620,"KRN","B",.401,.401) "BLD",12620,"KRN","B",.402,.402) "BLD",12620,"KRN","B",.403,.403) "BLD",12620,"KRN","B",.5,.5) "BLD",12620,"KRN","B",.84,.84) "BLD",12620,"KRN","B",1.5,1.5) "BLD",12620,"KRN","B",1.6,1.6) "BLD",12620,"KRN","B",1.61,1.61) "BLD",12620,"KRN","B",1.62,1.62) "BLD",12620,"KRN","B",3.6,3.6) "BLD",12620,"KRN","B",3.8,3.8) "BLD",12620,"KRN","B",9.2,9.2) "BLD",12620,"KRN","B",9.8,9.8) "BLD",12620,"KRN","B",19,19) "BLD",12620,"KRN","B",19.1,19.1) "BLD",12620,"KRN","B",101,101) "BLD",12620,"KRN","B",409.61,409.61) "BLD",12620,"KRN","B",771,771) "BLD",12620,"KRN","B",779.2,779.2) "BLD",12620,"KRN","B",870,870) "BLD",12620,"KRN","B",8989.51,8989.51) "BLD",12620,"KRN","B",8989.52,8989.52) "BLD",12620,"KRN","B",8993,8993) "BLD",12620,"KRN","B",8994,8994) "BLD",12620,"QDEF") ^^^^^^^^^^YES "BLD",12620,"QUES",0) ^9.62^^ "BLD",12620,"REQB",0) ^9.611^2^2 "BLD",12620,"REQB",1,0) RA*5.0*182^2 "BLD",12620,"REQB",2,0) RA*5.0*184^2 "BLD",12620,"REQB","B","RA*5.0*182",1) "BLD",12620,"REQB","B","RA*5.0*184",2) "MBREQ") 0 "PKG",31,-1) 1^1 "PKG",31,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "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) 193^3220825 "PKG",31,22,1,"PAH",1,1,0) ^^3^3^3220825 "PKG",31,22,1,"PAH",1,1,1,0) Patch one hundred and ninety-three for the VistA Radiology/Nuclear "PKG",31,22,1,"PAH",1,1,2,0) Medicine 5.0 application. Please review FORUM's Patch Module description "PKG",31,22,1,"PAH",1,1,3,0) and installation instructions for RA*5.0*193 before installing this patch. "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") 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") 2 "RTN","RAORDP") 0^1^B33895868^B33978109 "RTN","RAORDP",1,0) RAORDP ;HISC/CAH,FPT AISC/DMK - Log of Pending/Hold Requests ; Aug 25, 2022@07:17:08 "RTN","RAORDP",2,0) ;;5.0;Radiology/Nuclear Medicine;**15,133,182,193**;Mar 16, 1998;Build 1 "RTN","RAORDP",3,0) ; "RTN","RAORDP",4,0) ; This report looks at all orders in file 75.1 with status=5 (pending) "RTN","RAORDP",5,0) ; or status=3 (hold) and field 21 (Desired Date) within the date range "RTN","RAORDP",6,0) ; selected. "RTN","RAORDP",7,0) ; "RTN","RAORDP",8,0) W !!,"This option will generate a list of requests for a selected date",!,"range with the status of 'PENDING' or 'HOLD'",! "RTN","RAORDP",9,0) K DIR S DIR(0)="S^H:HOLD;P:PENDING",DIR("A")="Select REQUEST STATUS",DIR("B")="P" D ^DIR K DIR "RTN","RAORDP",10,0) I $D(DIRUT) D KILL Q "RTN","RAORDP",11,0) W ! S RAREQSTA=$S(Y="P":5,1:3) "RTN","RAORDP",12,0) S RANOSCRN="" D OMA^RAUTL13 K RANOSCRN I '$L($O(RALOC(0)))!($G(RAQUIT)=1) D KILL Q "RTN","RAORDP",13,0) S RADDT=1 D DATE^RAUTL K RADDT G KILL:RAPOP S RAOBEG=BEGDATE,RAOEND=ENDDATE+.9 K BEGDATE,ENDDATE "RTN","RAORDP",14,0) S ZTRTN="START^RAORDP",ZTSAVE("RALOC(")="",ZTSAVE("RAOBEG")="",ZTSAVE("RAOEND")="",ZTSAVE("RAREQSTA")="" "RTN","RAORDP",15,0) W !!,"This report requires a 132 column output device." D ZIS^RAUTL G KILL:RAPOP "RTN","RAORDP",16,0) START ; start report processing "RTN","RAORDP",17,0) U IO S QQ="",$P(QQ,"=",132)="=",RALOCNM="",RAOLOC="",RAHDR="LOG OF "_$S(RAREQSTA=5:"PENDING",1:"HOLD")_" REQUESTS",RAHDRDSH="",$P(RAHDRDSH,"-",$L(RAHDR))="-" "RTN","RAORDP",18,0) S RAOBEG("X")=+$E(RAOBEG,4,5)_"/"_+$E(RAOBEG,6,7)_"/"_$E(RAOBEG,2,3) "RTN","RAORDP",19,0) S RAOEND("X")=+$E(RAOEND,4,5)_"/"_+$E(RAOEND,6,7)_"/"_$E(RAOEND,2,3) "RTN","RAORDP",20,0) S X="NOW",%DT="T" D ^%DT D D^RAUTL S RARUNDTE=Y K %DT "RTN","RAORDP",21,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","RAORDP",22,0) F S RALOCNM=$O(RALOC(RALOCNM)) Q:RALOCNM="" S RA791IEN="" F S RA791IEN=$O(RALOC(RALOCNM,RA791IEN)) Q:RA791IEN="" S RALOC1(RA791IEN)=0,RALOCIT(+$P(^RA(79.1,RA791IEN,0),"^",6))="" "RTN","RAORDP",23,0) K RALOCNM,RA791IEN S RADFN=0 "RTN","RAORDP",24,0) F S RADFN=$O(^RAO(75.1,"AS",RADFN)) Q:'RADFN!($D(RAEOS)) D "RTN","RAORDP",25,0) .S RAOIFN=0 F S RAOIFN=$O(^RAO(75.1,"AS",RADFN,RAREQSTA,RAOIFN)) Q:'RAOIFN!($D(RAEOS)) D "RTN","RAORDP",26,0) ..I $D(^RAO(75.1,RAOIFN,0)) S RAO(0)=^(0),RAODT=$P(RAO(0),"^",21),RAOREA=$P(RAO(0),"^",10),RAOPHY=$P(RAO(0),"^",14),RALADT=$P(RAO(0),"^",18),RAILOC=$P(RAO(0),"^",20),RAIMTYP=$P(RAO(0),"^",3) D "RTN","RAORDP",27,0) ...I $D(RALOC1(+RAILOC)) D SETTMP Q "RTN","RAORDP",28,0) ...I RAILOC="",$D(RALOCIT(+RAIMTYP)) D SETTMP "RTN","RAORDP",29,0) I $D(RAEOS) D KILL Q "RTN","RAORDP",30,0) S RAILOC="" "RTN","RAORDP",31,0) F S RAILOC=$O(RALOC1(RAILOC)) Q:RAILOC=""!($D(RAEOS)) S RACNT=0 D CONT "RTN","RAORDP",32,0) KILL W ! "RTN","RAORDP",33,0) K ^TMP($J,"RA") "RTN","RAORDP",34,0) K CNT,DIC,DIROUT,DIRUT,DTOUT,DUOUT,I,QQ,RACNT,RADFN,RADDT,RADLOCS,RADT,RAEOS,RAHDR,RAHDRDSH,RAILOC,RAIMTYP,RALOC,RALOC1,RALOCIT "RTN","RAORDP",35,0) K RALOCS,RALOCSAV,RALOCN,RAO,RAOBEG,RAODT,RAOEND,RAOIFN,RAOLOC,RAORD0,RAPOP,RAPR,RAQUIT,RARDT,RAREQSTA,BEGDATE,ENDDATE,RARUNDTE "RTN","RAORDP",36,0) K X,Y,RAMES,RALADT,RAOPHY,RAOREA,RADD,ZTDESC,ZTRTN,ZTSAVE,RALADTX "RTN","RAORDP",37,0) D CLOSE^RAUTL "RTN","RAORDP",38,0) K POP,DDH,DISYS,DFN,VAERR "RTN","RAORDP",39,0) Q "RTN","RAORDP",40,0) CONT ; "RTN","RAORDP",41,0) I $E(IOST,1,2)="C-",RAOLOC]"",RAOLOC'=RAILOC D EOS Q:$D(RAEOS) "RTN","RAORDP",42,0) D HDR Q:$D(RAEOS) "RTN","RAORDP",43,0) I +RALOC1(RAILOC)=0 W !?2,"No requests "_$S(RAREQSTA=5:"pending",1:"on hold")_" for "_RAOBEG("X")_" to "_RAOEND("X")_".",! I $E(IOST,1,2)="C-"&($O(RALOC1(RAILOC))]"") D EOS Q:$D(RAEOS) D Q "RTN","RAORDP",44,0) .S RAOLOC(0)=$O(RALOC1(RAILOC)) S:RAOLOC(0)]"" RAOLOC=RAOLOC(0) K RAOLOC(0) "RTN","RAORDP",45,0) S RADT=0 F S RADT=$O(^TMP($J,"RA",RAILOC,RADT)) Q:'RADT!($D(RAEOS)) D DATE S RADFN=0 F S RADFN=$O(^TMP($J,"RA",RAILOC,RADT,RADFN)) Q:'RADFN!($D(RAEOS)) D MORE "RTN","RAORDP",46,0) Q "RTN","RAORDP",47,0) MORE ; "RTN","RAORDP",48,0) S RARDT=0 F S RARDT=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT)) Q:'RARDT!($D(RAEOS)) S RAPR=0 F S RAPR=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR)) Q:'RAPR!($D(RAEOS)) D "RTN","RAORDP",49,0) .S RAOPHY=0 F S RAOPHY=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR,RAOPHY)) Q:'RAOPHY!($D(RAEOS)) S RALADT=0 F S RALADT=$O(^(RAOPHY,RALADT)) Q:'RALADT!($D(RAEOS)) D "RTN","RAORDP",50,0) ..;p182/KLM Moved RAO $O to new line and removed naked ref as duplicate orders were not picked up "RTN","RAORDP",51,0) ..S RAO=0 F S RAO=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR,RAOPHY,RALADT,RAO)) Q:'RAO!($D(RAEOS)) D "RTN","RAORDP",52,0) ...N RAOREA S RAOREA=$G(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR,RAOPHY,RALADT,RAO)) "RTN","RAORDP",53,0) ...S RAORD0=^RAO(75.1,+RAO,0),RACNT=RACNT+1 "RTN","RAORDP",54,0) ...K RALOCN,RARLOCN "RTN","RAORDP",55,0) ...D IPOP^RAUTL13 "RTN","RAORDP",56,0) ...D WRT "RTN","RAORDP",57,0) ...Q "RTN","RAORDP",58,0) ..Q "RTN","RAORDP",59,0) .Q "RTN","RAORDP",60,0) Q "RTN","RAORDP",61,0) WRT ; "RTN","RAORDP",62,0) S Y=RADT D DD^%DT S RADD=Y S Y=$P(RALADT,".") D DD^%DT S RALADTX=Y ;p182/KLM use diff var. "RTN","RAORDP",63,0) W !,$S($D(^DPT(RADFN,0)):$E($P(^(0),"^"),1,19),1:"Unknown"),?21,$E($P(^DPT(RADFN,0),"^",9),6,9),?27,$S($D(^RAMIS(71,RAPR,0)):$E($P(^(0),"^"),1,24),1:"Unknown"),?53,$P(RADD,"@") "RTN","RAORDP",64,0) S Y=$P(RARDT,".") D DD^%DT W ?67,Y "RTN","RAORDP",65,0) W ?81,$S(RAREQSTA=3:RALADTX,1:$E($$GET1^DIQ(200,RAOPHY,.01),1,19)) "RTN","RAORDP",66,0) I RAREQSTA=3 W ?95,$E($$GET1^DIQ(75.2,RAOREA,.01),1,28) "RTN","RAORDP",67,0) E W ?102,$E(RALOCN,1,28) "RTN","RAORDP",68,0) ;I $L($G(RARLOCN)) W !?36,"Requesting Loc: ",RARLOCN "RTN","RAORDP",69,0) S RAOLOC=RAILOC "RTN","RAORDP",70,0) I ($Y+6)>IOSL D EOS Q:$D(RAEOS) D:RACNT0 @IOF "RTN","RAORDP",74,0) W !?(80-$L(RAHDR)/2),RAHDR "RTN","RAORDP",75,0) ;p193/KLM - next line removed 'scheduled' from header. These are not scheduled requests. Updated column to re-center. "RTN","RAORDP",76,0) W !?19,"Includes requests from ",RAOBEG("X")," to ",RAOEND("X") ;W !?(80-$L(RAHDR)/2),RAHDRDSH "RTN","RAORDP",77,0) W !,"IMAGING LOCATION: ",$S('RAILOC:"Unknown",$D(^RA(79.1,RAILOC,0)):$S($D(^SC($P(^(0),"^"),0)):$P(^(0),"^"),1:"Unknown"),1:"Unknown"),?51,"Run Date: ",RARUNDTE,! "RTN","RAORDP",78,0) W !,"PATIENT NAME",?21,"SSN",?27,"PROCEDURE",?53,"DATE DESIRED",?67,"DATE ORDERED" "RTN","RAORDP",79,0) W ?81,$S(RAREQSTA=3:"HOLD DATE",1:"ORDERING PROVIDER") "RTN","RAORDP",80,0) I RAREQSTA=3 W ?95,"HOLD REASON",!,QQ,!! "RTN","RAORDP",81,0) E W ?102,"PT LOC",!,QQ,!! "RTN","RAORDP",82,0) I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS="" "RTN","RAORDP",83,0) Q "RTN","RAORDP",84,0) DATE ; Output 'Desired Date' "RTN","RAORDP",85,0) ;S Y=RADT D DD^%DT S X=$L(Y)+32 W !!?(80-X/2),"Desired Date (Time optional): ",Y,!?(80-X/2) S Y="",$P(Y,"-",X)="-" W Y,! "RTN","RAORDP",86,0) Q "RTN","RAORDP",87,0) SETTMP ; set-up ^TMP($J "RTN","RAORDP",88,0) I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS="" Q:$D(RAEOS) "RTN","RAORDP",89,0) I $S('RAODT:0,'RADFN:0,'$P(RAO(0),"^",16):0,'$P(RAO(0),"^",2):0,1:1),RAODT'RAOEND S ^TMP($J,"RA",$S(RAILOC:RAILOC,1:"UNKNOWN"),$P(RAO(0),"^",21),RADFN,$P(RAO(0),"^",16),$P(RAO(0),"^",2),RAOPHY,RALADT,RAOIFN)=RAOREA D "RTN","RAORDP",90,0) .I RAILOC="" S:'$D(RALOC1("UNKNOWN")) RALOC1("UNKNOWN")=0 S RALOC1("UNKNOWN")=RALOC1("UNKNOWN")+1 Q "RTN","RAORDP",91,0) .S:RAILOC>0 RALOC1(RAILOC)=RALOC1(RAILOC)+1 "RTN","RAORDP",92,0) Q "RTN","RAORDP",93,0) EOS ; end of screen "RTN","RAORDP",94,0) S X=$$EOS^RAUTL5 "RTN","RAORDP",95,0) S:X=1 RAEOS="" "RTN","RAORDP",96,0) Q "RTN","RASYS1") 0^2^B41157247^B40155244 "RTN","RASYS1",1,0) RASYS1 ;HISC/CAH - Utility to update I-Loc Type to Clinic ; Aug 25, 2022@07:16:49 "RTN","RASYS1",2,0) ;;5.0;Radiology/Nuclear Medicine;**184,193**;Mar 16, 1998;Build 1 "RTN","RASYS1",3,0) ;Supported IA #10040 ^SC( "RTN","RASYS1",4,0) ;Controlled IA #1623 LOC^SCDXUAPI "RTN","RASYS1",5,0) ; RAD^SCDXUAPI "RTN","RASYS1",6,0) ;Private IA #19 ^DIC(40.7 "RTN","RASYS1",7,0) EN1(RA791) ;For each imaging loc, get file 44 pointer, DSS ID, Div "RTN","RASYS1",8,0) ;and give to MAS to set/reset params on the file 44 entry "RTN","RASYS1",9,0) ; Input: -> ien of entry in the 'Imaging Locations' file (79.1) "RTN","RASYS1",10,0) N RA44,RA44NM,RA44NM2,RADSS,RADSSNM,RADIV,RAERRCNT,RA44NEW,RATRY "RTN","RASYS1",11,0) S RAERRCNT=0,RA44NM2="" "RTN","RASYS1",12,0) S RA791(0)=$G(^RA(79.1,+RA791,0)) "RTN","RASYS1",13,0) S RA44=$P(RA791(0),"^",1) I '$D(^SC(+RA44,0)) D ERR44 Q:RAXIT "RTN","RASYS1",14,0) S RA44NM=$P($G(^SC(+RA44,0)),"^",1) "RTN","RASYS1",15,0) S RADSS=$P(RA791(0),"^",22) I 'RADSS D ERRDSS Q:RAXIT "RTN","RASYS1",16,0) S RADSSNM=$P($G(^DIC(40.7,+RADSS,0)),"^",2) "RTN","RASYS1",17,0) S RADIV=$G(^RA(79.1,+RA791,"DIV")) I 'RADIV D ERRDIV Q:RAXIT "RTN","RASYS1",18,0) I RAERRCNT Q ;If this Img Loc has an error, stop here "RTN","RASYS1",19,0) ;Call MAS Sched'g routine with img loc data "RTN","RASYS1",20,0) S RA44NEW=$$RAD^SCDXUAPI(RA44,"RA") ;returns ien of same or new loc "RTN","RASYS1",21,0) I +RA44NEW=-1 D ERRMSG(RA44NEW) Q ; explain why $$RAD call failed "RTN","RASYS1",22,0) I RA44NEW'=RA44 D REPOINT "RTN","RASYS1",23,0) S RATRY=$$LOC^SCDXUAPI($S($L(RA44NM2):RA44NM2,1:RA44NM),RADIV,RADSSNM,"RA",RA44) "RTN","RASYS1",24,0) I +RATRY=-1 D ERRMSG(RATRY) "RTN","RASYS1",25,0) I +RATRY'=-1 D OK "RTN","RASYS1",26,0) Q "RTN","RASYS1",27,0) ERR44 ;bad file 44 pointer "RTN","RASYS1",28,0) S RAERRCNT=RAERRCNT+1 "RTN","RASYS1",29,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",30,0) W !,"Imaging Location file #79.1 internal entry #"_RA44 "RTN","RASYS1",31,0) W !,"is a broken pointer to Hospital Location file #44." "RTN","RASYS1",32,0) W !,"IRM must resolve this problem, then the Rad/Nuc Med ADPAC" "RTN","RASYS1",33,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",34,0) W !,"should use the Location Parameter Set-up [RA SYSLOC] option" "RTN","RASYS1",35,0) W !,"to edit this Imaging Location, and the Division Parameter" "RTN","RASYS1",36,0) W !,"Set-up [RA SYSDIV] option to assign it to a division.",!," " "RTN","RASYS1",37,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",38,0) Q "RTN","RASYS1",39,0) ERRDSS ;bad file 40.7 pointer (DSS ID/Stop Code) "RTN","RASYS1",40,0) S RAERRCNT=RAERRCNT+1 "RTN","RASYS1",41,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",42,0) W !,"Imaging Location file #79.1 entry "_$S($L(RA44NM):RA44NM,1:RA44)_" has a missing" "RTN","RASYS1",43,0) W !,"or invalid DSS ID. The Radiology/Nuclear Medicine ADPAC should" "RTN","RASYS1",44,0) W !,"use the Location Parameter Set-up [RA SYSLOC] option to enter" "RTN","RASYS1",45,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",46,0) W !,"a valid imaging DSS Code for this imaging location.",!," " "RTN","RASYS1",47,0) Q "RTN","RASYS1",48,0) ERRDIV ;bad or non-existent Division on active imaging loc "RTN","RASYS1",49,0) S RAERRCNT=RAERRCNT+1 "RTN","RASYS1",50,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",51,0) W !,"Imaging Location file #79.1 entry "_$S($L(RA44NM):RA44NM,1:RA44)_" is not assigned" "RTN","RASYS1",52,0) W !,"to a Rad/Nuc Med Division. If Imaging exams are to be registered" "RTN","RASYS1",53,0) W !,"in this imaging location, or if there are incomplete exams" "RTN","RASYS1",54,0) W !,"already registered to this location, the Radiology/Nuclear" "RTN","RASYS1",55,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",56,0) W !,"Med ADPAC should use the Division Parameter Set-up [RA SYSDIV]" "RTN","RASYS1",57,0) W !,"option to assign this imaging location to the appropriate" "RTN","RASYS1",58,0) W !,"Rad/Nuc Med Division.",!," " "RTN","RASYS1",59,0) I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",60,0) Q "RTN","RASYS1",61,0) ERRMSG(RAX) ; Explain why the $$RAD call failed. "RTN","RASYS1",62,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",63,0) W !,"Scheduling routine could not reset Hospital Location" "RTN","RASYS1",64,0) W !,"file #44 params for Imaging Location "_$S($L(RA44NM2):RA44NM2,1:RA44NM) "RTN","RASYS1",65,0) W !,"to agree with params on the Imaging Location file #79.1." "RTN","RASYS1",66,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",67,0) W !,"IRM should investigate the cause of this Scheduling error message:" "RTN","RASYS1",68,0) W !," * "_$P(RAX,"^",3)_" * ",!," " "RTN","RASYS1",69,0) Q "RTN","RASYS1",70,0) REPOINT ;current img loc points to a file 44 entry with appt patterns "RTN","RASYS1",71,0) ;must be repointed to the loc Sched'g returned to us "RTN","RASYS1",72,0) ; "RTN","RASYS1",73,0) ;call DIE or Silent FM to change .01 fld of file 79.1 to RA44NEW "RTN","RASYS1",74,0) ;use equivalent of /// stuff, and give a message about old imaging "RTN","RASYS1",75,0) ;loc name changing to new name "RTN","RASYS1",76,0) ; "RTN","RASYS1",77,0) N RAERR,RAFDA "RTN","RASYS1",78,0) S RA44=RA44NEW,RA44NM2=$P($G(^SC(+RA44NEW,0)),"^",1) "RTN","RASYS1",79,0) S RAFDA(79.1,RA791_",",.01)=+RA44NEW ;p193 always plus IENs... (invalid pointer error) "RTN","RASYS1",80,0) D FILE^DIE("K","RAFDA","RAERR") "RTN","RASYS1",81,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",82,0) W !,"Imaging Location "_RA44NM_" has appointment patterns, and" "RTN","RASYS1",83,0) W !,"cannot be 'pointed to' from a file 79.1 Imaging Location." "RTN","RASYS1",84,0) W !,"Imaging Location "_RA44NM_" has been 're-pointed' to" "RTN","RASYS1",85,0) I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",86,0) W !,"Hospital Location "_RA44NM2_".",!," " "RTN","RASYS1",87,0) Q "RTN","RASYS1",88,0) OK ;this img loc was processed ok "RTN","RASYS1",89,0) I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF "RTN","RASYS1",90,0) W !,"Imaging Location "_$S($L(RA44NM2):RA44NM2,1:RA44NM)_" is OK.",!," " "RTN","RASYS1",91,0) Q "RTN","RASYS1",92,0) INACTIV8 ;RA184/KLM Inactivate an imaging location and the associated OOC clinic "RTN","RASYS1",93,0) ;call by menu option 'RA SYSINACT' "RTN","RASYS1",94,0) N RAILOC,RA44,Y,RASUC,RAINACT,RAILS,RAIL0,RA44S,RANAME "RTN","RASYS1",95,0) W !!?5,"This option will allow you to inactivate an Imaging Location" "RTN","RASYS1",96,0) W !?5,"and the associated Occasion of Service (OOS) Hospital Location",! "RTN","RASYS1",97,0) S DIC="^RA(79.1,",DIC(0)="AEMQZ",DIC("A")="Select Location: " "RTN","RASYS1",98,0) D ^DIC I Y<0 Q "RTN","RASYS1",99,0) S RAIL0=Y(0),RAILOC=+Y,RA44=$P(Y,U,2),RANAME=Y(0,0),RAILS=$P(RAIL0,U,19) "RTN","RASYS1",100,0) S:$G(RAILS)]"" RAILS="I" "RTN","RASYS1",101,0) Q:'$G(RA44) S RA44S=$$GET1^DIQ(44,RA44,2505,"I")_"^"_$$GET1^DIQ(44,RA44,2506,"I") ;DBIA 10040 "RTN","RASYS1",102,0) I +RA44S,('$P(RA44S,"^",2)!($P(RA44S,"^",2)>DT)) S RA44S="I" "RTN","RASYS1",103,0) W !!,$J(RANAME_" STATUS: ",32)_$S(RAILS="I":"INACTIVE",1:"ACTIVE") "RTN","RASYS1",104,0) W !,$J("OOS CLINIC (IEN "_RA44_") STATUS: ",32)_$S(RA44S="I":"INACTIVE",1:"ACTIVE"),! "RTN","RASYS1",105,0) I RAILS="I"&(RA44S="I") K DIR W !!?5,"No action needed..." W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR Q "RTN","RASYS1",106,0) K DIC,Y "RTN","RASYS1",107,0) I $G(RAILS)'="I" D ;inactivate both i-loc and OOS clinic "RTN","RASYS1",108,0) .K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="INACTIVATE '"_RANAME_"' Imaging Location" D ^DIR Q:$D(DIRUT) "RTN","RASYS1",109,0) .I Y=0 K DIR W !!,"No action taken..." W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR Q "RTN","RASYS1",110,0) .S RAINACT=$P(Y(0),U,19) D INACT791 "RTN","RASYS1",111,0) .Q "RTN","RASYS1",112,0) I $G(RAILS)="I",$G(RA44S)'="I" D ;inactivate OOS clinic only "RTN","RASYS1",113,0) .K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="INACTIVATE '"_RANAME_"' associated OOS clinic" D ^DIR Q:$D(DIRUT) "RTN","RASYS1",114,0) .I Y=0 K DIR W !!,"No action taken..." W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR Q "RTN","RASYS1",115,0) .S RAINACT=$P(RAIL0,U,19) D INACT44 "RTN","RASYS1",116,0) .Q "RTN","RASYS1",117,0) Q "RTN","RASYS1",118,0) INACT791 ;inactivate the imaging location "RTN","RASYS1",119,0) K DIR S DIR(0)="79.1,19",DIR("A")="Enter the INACTIVATION date for this location" D ^DIR Q:$D(DIRUT) "RTN","RASYS1",120,0) S RAINACT=Y,RAFDA(79.1,RAILOC_",",19)=RAINACT K Y,DIRUT "RTN","RASYS1",121,0) D FILE^DIE("","RAFDA","RAERR") "RTN","RASYS1",122,0) I $D(RAERR) W !!,"There was a problem inactivating the location",!,"Contact OI&T if the problem persists" Q "RTN","RASYS1",123,0) W !!,"...Imaging Location inactivated!" "RTN","RASYS1",124,0) I $G(RA44S)'="I" D INACT44 "RTN","RASYS1",125,0) Q "RTN","RASYS1",126,0) INACT44 ;inactivate the OOS hospital location "RTN","RASYS1",127,0) I $L(RAINACT,".")>1 S RAINACT=$P(RAINACT,".") "RTN","RASYS1",128,0) S RASUC=$$LOC^SCDXUAPI(,,,"RADIOLOGY/NUCLEAR MEDICINE",RA44,RAINACT) ;DBIA 1623 "RTN","RASYS1",129,0) I +RASUC=-1 W !,"OOS Clinic not updated. Error: "_$P(RASUC,U,3) Q "RTN","RASYS1",130,0) W !!,"...OOS Clinic inactivated!" "RTN","RASYS1",131,0) Q "VER") 8.0^22.2 "BLD",12620,6) ^174 **END** **END**