Released RA*5*85 SEQ #73 Extracted from mail message **KIDS**:RA*5.0*85^ **INSTALL NAME** RA*5.0*85 "BLD",6641,0) RA*5.0*85^RADIOLOGY/NUCLEAR MEDICINE^0^3070914^y "BLD",6641,1,0) ^^1^1^3070607^ "BLD",6641,1,1,0) EXAM BACKDATING AND CANCELLING EXAMS WITH IMAGES "BLD",6641,4,0) ^9.64PA^^ "BLD",6641,6.3) 4 "BLD",6641,"KRN",0) ^9.67PA^8989.52^19 "BLD",6641,"KRN",.4,0) .4 "BLD",6641,"KRN",.401,0) .401 "BLD",6641,"KRN",.402,0) .402 "BLD",6641,"KRN",.403,0) .403 "BLD",6641,"KRN",.5,0) .5 "BLD",6641,"KRN",.84,0) .84 "BLD",6641,"KRN",3.6,0) 3.6 "BLD",6641,"KRN",3.8,0) 3.8 "BLD",6641,"KRN",9.2,0) 9.2 "BLD",6641,"KRN",9.8,0) 9.8 "BLD",6641,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",6641,"KRN",9.8,"NM",1,0) RAREG^^0^B38658501 "BLD",6641,"KRN",9.8,"NM",2,0) RAEDCN^^0^B57573116 "BLD",6641,"KRN",9.8,"NM",3,0) RASTREQ1^^0^B7300725 "BLD",6641,"KRN",9.8,"NM",4,0) RAORD6^^0^B49049103 "BLD",6641,"KRN",9.8,"NM","B","RAEDCN",2) "BLD",6641,"KRN",9.8,"NM","B","RAORD6",4) "BLD",6641,"KRN",9.8,"NM","B","RAREG",1) "BLD",6641,"KRN",9.8,"NM","B","RASTREQ1",3) "BLD",6641,"KRN",19,0) 19 "BLD",6641,"KRN",19,"NM",0) ^9.68A^^ "BLD",6641,"KRN",19.1,0) 19.1 "BLD",6641,"KRN",101,0) 101 "BLD",6641,"KRN",409.61,0) 409.61 "BLD",6641,"KRN",771,0) 771 "BLD",6641,"KRN",870,0) 870 "BLD",6641,"KRN",8989.51,0) 8989.51 "BLD",6641,"KRN",8989.52,0) 8989.52 "BLD",6641,"KRN",8994,0) 8994 "BLD",6641,"KRN","B",.4,.4) "BLD",6641,"KRN","B",.401,.401) "BLD",6641,"KRN","B",.402,.402) "BLD",6641,"KRN","B",.403,.403) "BLD",6641,"KRN","B",.5,.5) "BLD",6641,"KRN","B",.84,.84) "BLD",6641,"KRN","B",3.6,3.6) "BLD",6641,"KRN","B",3.8,3.8) "BLD",6641,"KRN","B",9.2,9.2) "BLD",6641,"KRN","B",9.8,9.8) "BLD",6641,"KRN","B",19,19) "BLD",6641,"KRN","B",19.1,19.1) "BLD",6641,"KRN","B",101,101) "BLD",6641,"KRN","B",409.61,409.61) "BLD",6641,"KRN","B",771,771) "BLD",6641,"KRN","B",870,870) "BLD",6641,"KRN","B",8989.51,8989.51) "BLD",6641,"KRN","B",8989.52,8989.52) "BLD",6641,"KRN","B",8994,8994) "BLD",6641,"QUES",0) ^9.62^^ "BLD",6641,"REQB",0) ^9.611^4^4 "BLD",6641,"REQB",1,0) RA*5.0*23^1 "BLD",6641,"REQB",2,0) RA*5.0*34^1 "BLD",6641,"REQB",3,0) RA*5.0*45^1 "BLD",6641,"REQB",4,0) RA*5.0*75^1 "BLD",6641,"REQB","B","RA*5.0*23",1) "BLD",6641,"REQB","B","RA*5.0*34",2) "BLD",6641,"REQB","B","RA*5.0*45",3) "BLD",6641,"REQB","B","RA*5.0*75",4) "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) 85^3070914 "PKG",18,22,1,"PAH",1,1,0) ^^1^1^3070914 "PKG",18,22,1,"PAH",1,1,1,0) EXAM BACKDATING AND CANCELLING EXAMS WITH IMAGES "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") 4 "RTN","RAEDCN") 0^2^B57573116^B54472977 "RTN","RAEDCN",1,0) RAEDCN ;HISC/CAH,FPT,GJC,SS AISC/MJK,RMO-Edit Exams by Case Number ;1/11/02 11:15 "RTN","RAEDCN",2,0) ;;5.0;Radiology/Nuclear Medicine;**5,13,10,18,28,31,34,45,85**;Mar 16, 1998;Build 4 "RTN","RAEDCN",3,0) ; "RTN","RAEDCN",4,0) ; 06/11/2007 KAM/BAY RA*5*85 Remedy Call 174790 Change Exam Cancel "RTN","RAEDCN",5,0) ; to allow only descendent exams with stub report "RTN","RAEDCN",6,0) ; "RTN","RAEDCN",7,0) ;last modified by SS JUNE 21,2000 for P18 "RTN","RAEDCN",8,0) START D SET^RAPSET1 I $D(XQUIT) K XQUIT,RAFLG,RADR,POP,RAQUICK Q "RTN","RAEDCN",9,0) START1 D ^RACNLU G Q:X="^" "RTN","RAEDCN",10,0) I RADR="[RA DIAGNOSTIC BY CASE]" N RAPRTSET,RAMEMARR,RA3 D EN2^RAUTL20(.RAMEMARR) S RA3=99 I RAPRTSET W ! D WHYMSG2^RASTED G Q ;skip edit because member of set =2 "RTN","RAEDCN",11,0) I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",+$G(DUZ))) W !!?3,$C(7),"You do not have the appropriate access privileges to edit completed exams." G START1 "RTN","RAEDCN",12,0) I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,$C(7),"Exam has been 'cancelled' therefore it cannot be edited." G START1 "RTN","RAEDCN",13,0) I RADR="[RA DIAGNOSTIC BY CASE]",$D(^RARPT(RARPT,0)),$P(^(0),"^",5)="V" W !!?3,$C(7),"A report has been verified for this exam, therefore it cannot be edited.",! G START "RTN","RAEDCN",14,0) S DA=RADFN,DIE("NO^")="OUTOK",DIE="^RADPT(",DR=RADR "RTN","RAEDCN",15,0) I $D(RAFLG("EDIT"))!($D(RAFLG("DIAG"))) D G:+$G(RAXIT) START1 "RTN","RAEDCN",16,0) . S RADADA=RADTI,RADIE="^RADPT("_RADFN_",""DT""," "RTN","RAEDCN",17,0) . S RAXIT=$$LOCK^RAUTL12(RADIE,RADADA) "RTN","RAEDCN",18,0) . Q "RTN","RAEDCN",19,0) I RADR="[RA EXAM EDIT]" D "RTN","RAEDCN",20,0) . N RADISPLY "RTN","RAEDCN",21,0) . S RADISPLY=$G(^RAMIS(71,+$P($G(^RADPT(+RADFN,"DT",+RADTI,"P",+RACNI,0)),U,2),0)) ; set $ZR to 71 for prccpt^radd1, not call raprod since diff col "RTN","RAEDCN",22,0) . S RADISPLY=$$PRCCPT^RADD1() "RTN","RAEDCN",23,0) . W !,?24,RADISPLY "RTN","RAEDCN",24,0) .; "RTN","RAEDCN",25,0) .;save 'before' CM data value to compare against the possible 'after' "RTN","RAEDCN",26,0) .;value "RTN","RAEDCN",27,0) .D TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB) ;RA*5*45 "RTN","RAEDCN",28,0) .; "RTN","RAEDCN",29,0) . Q "RTN","RAEDCN",30,0) D:RADR'="[RA NO PURGE SPECIFICATION]" SVBEFOR^RAO7XX(RADFN,RADTI,RACNI) ;P18 save before edit to compare it in RAUTL1 later "RTN","RAEDCN",31,0) D ^DIE K DIE("NO^"),DE,DQ,DIE,DR,RAZCM "RTN","RAEDCN",32,0) D:RADR'="[RA NO PURGE SPECIFICATION]" UP1^RAUTL1 "RTN","RAEDCN",33,0) ; "RTN","RAEDCN",34,0) ;1) check data consistency between 'CONTRAST MEDIA USED' & 'CONTRAST "RTN","RAEDCN",35,0) ;MEDIA' "RTN","RAEDCN",36,0) ;2) check 'before' CM data against 'after' CM data, file in audit log "RTN","RAEDCN",37,0) ;if necessary. Remember, contrast media asked when in input template: "RTN","RAEDCN",38,0) ;RA EXAM EDIT (RA*5*45) "RTN","RAEDCN",39,0) I RADR="[RA EXAM EDIT]" D "RTN","RAEDCN",40,0) .S RACMDA=RACNI,RACMDA(1)=RADTI,RACMDA(2)=RADFN "RTN","RAEDCN",41,0) .D XCMINTEG^RAMAINU1(.RACMDA) ;1 "RTN","RAEDCN",42,0) .D TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB) ;2 "RTN","RAEDCN",43,0) .K RACMDA Q "RTN","RAEDCN",44,0) ; "RTN","RAEDCN",45,0) I $D(RAFLG("EDIT"))!($D(RAFLG("DIAG"))) D UNLOCK^RAUTL12(RADIE,RADADA) "RTN","RAEDCN",46,0) K RATRKCMB,RADUZ,RAZZ W ! G START1:'+$G(RAXIT) "RTN","RAEDCN",47,0) ; "RTN","RAEDCN",48,0) Q K %,%DT,%W,%X,%Y,%Y1,A,C,D0,D1,D2,DA,DIC,DIE,DIV,DK,I,ORIFN,ORVP,POP,RACN,RACNI,RACS,RACT,RADADA,RADATE,RADFN,RADIE,RADIV,RADR,RADTE,RADTI,RAEXFM,RAEXLBLS,RAFIN,RAFL,RAFLG,RAFLH,RAFLHFL,RAHEAD,RAI,RAJ "RTN","RAEDCN",49,0) K RAMES,RANME,RANUM,RAOIFN,RAOR,RAORDIFN,RAOREA,RAORIFN,RAOSEL,RAOSTS,RAPOP,RAPRI,RAPRC,RAQUICK,RAPRIT,RARPT,RARPTZ,RASN,RASSN,RAST,RASTI,RAVW,X,XQUIT,VAINDT,VADMVT,Y,^TMP($J,"RAEX") "RTN","RAEDCN",50,0) K %H,%I,D,D3,DDER,DI,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,GMRAL "RTN","RAEDCN",51,0) K J,SDCLST,R1,RA,RACANC,RACN0,RACPT,RACPTNDE,RADA,RAEND,RAFELIG,RAFST "RTN","RAEDCN",52,0) K RAIX,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RAXIT,VA,VADM,VAERR,Z "RTN","RAEDCN",53,0) K DFN,DIPGM,DISYS,DQ,DR,HLN,HLRESLT,HLSAN,RAAFTER,RABEFORE,X0 "RTN","RAEDCN",54,0) K DLAYGO,DDH,RADFLTP "RTN","RAEDCN",55,0) Q "RTN","RAEDCN",56,0) ; "RTN","RAEDCN",57,0) DIAG N RADIAG,RAXIT "RTN","RAEDCN",58,0) S RAXIT=0,RAFLG("DIAG")="",RADR="[RA DIAGNOSTIC BY CASE]" G START "RTN","RAEDCN",59,0) ; "RTN","RAEDCN",60,0) SAVE S RADR="[RA NO PURGE SPECIFICATION]" G START "RTN","RAEDCN",61,0) ; "RTN","RAEDCN",62,0) EDIT ; Case No. Exam Edit "RTN","RAEDCN",63,0) N RAEDIT,RAXIT "RTN","RAEDCN",64,0) N RAREM,RANUZD1,RAPSDRUG,RA00,RADIOPH,RALOW,RAHI,RADRAWN,RAASK,RADOSE,RASKMEDS,RAWHICH ;these are used by the edit template "RTN","RAEDCN",65,0) S RAXIT=0,RAFLG("EDIT")="",RAQUICK=1,RADR="[RA EXAM EDIT]" G START "RTN","RAEDCN",66,0) ; "RTN","RAEDCN",67,0) CANCEL D SET^RAPSET1 I $D(XQUIT) K XQUIT Q "RTN","RAEDCN",68,0) S RAXIT=$$CKREASON^RAEDCN1("C") I RAXIT K RAXIT Q ;P18 "RTN","RAEDCN",69,0) D ^RACNLU G Q:X="^" I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !?3,$C(7),"This exam has already been cancelled!" G Q "RTN","RAEDCN",70,0) I $D(^RA(72,+RAST,0)),$P(^(0),"^",6)'="y" W !?3,$C(7),"This exam is in the '",$P(^(0),"^"),"' status and cannot be 'CANCELLED'." G Q "RTN","RAEDCN",71,0) ; 06/11/2007 KAM/BAY *85 Added descendent check to next line "RTN","RAEDCN",72,0) ASKIMG I RARPT,($$STUB^RAEDCN1(RARPT)),($$PSET^RAEDCN1(RADFN,RADTI,RACNI)) D G:"Nn"[$E(X) Q G:"Yy"[$E(X) ASKCAN W:X'["?" $C(7) W !!?3,"Enter 'YES' to cancel a descendent exam with images, or 'NO' not to." G ASKIMG "RTN","RAEDCN",73,0) . S X=RANME_"'s Case No. "_$E(RADTE,4,7)_$E(RADTE,1,2)_"-"_RACN "RTN","RAEDCN",74,0) . W !!?10,"----------------------------------",$C(7) "RTN","RAEDCN",75,0) . W !?10,X "RTN","RAEDCN",76,0) . W !?10,"This descendent exam has associated images.",$C(7) "RTN","RAEDCN",77,0) . W !?10,"----------------------------------",$C(7) "RTN","RAEDCN",78,0) . I '$D(^XUSEC("RA MGR",DUZ)) D S X="N" Q "RTN","RAEDCN",79,0) .. W !!?3,"** You do not have the RA MGR key to cancel an exam with images. **",$C(7) "RTN","RAEDCN",80,0) .. R !!?10,"Press RETURN to continue.",X:DTIME "RTN","RAEDCN",81,0) .. Q "RTN","RAEDCN",82,0) . R !!,"Do you really want to cancel this exam with images? NO//",X:DTIME S:'$T!(X="")!(X["^") X="N" "RTN","RAEDCN",83,0) . Q "RTN","RAEDCN",84,0) I RARPT W !?3,$C(7),"A report has been filed for this case. Therefore cancellation is not allowed!" G Q "RTN","RAEDCN",85,0) ASKCAN R !!,"Do you wish to cancel this exam now? NO// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G Q:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to cancel this exam, or 'NO' not to." G ASKCAN "RTN","RAEDCN",86,0) N REM ;used for remarks within edit template "RTN","RAEDCN",87,0) L +^RADPT(RADFN):1 I '$T W !,$C(7),"Someone else is editing the patient you selected",!,"Please try later" K RADTE,RACN,RAPOP,RADUZ G Q "RTN","RAEDCN",88,0) S DA=RADFN,DR="[RA CANCEL]",DIE="^RADPT(" D ^DIE K DE,DQ,DIE,DR "RTN","RAEDCN",89,0) K RADTE,RACN,RAPOP,RADUZ ;moved from edit template "RTN","RAEDCN",90,0) PACS I '$D(Y),$D(RAFIN) W !?10,"...cancellation complete." D DELPNT^RAUTL20(RADFN,RADTI,RACNI),^RAORDC,CANCEL^RAHLRPC "RTN","RAEDCN",91,0) L -^RADPT(RADFN) "RTN","RAEDCN",92,0) G Q "RTN","RAEDCN",93,0) ; "RTN","RAEDCN",94,0) DUP ; Option: RA FLASH "RTN","RAEDCN",95,0) N RAREGX,RAYN D SET^RAPSET1 I $D(XQUIT) K XQUIT,POP Q "RTN","RAEDCN",96,0) DUP1 D ^RACNLU G Q:X="^" "RTN","RAEDCN",97,0) G Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RAEDCN",98,0) S RAREGX(0)=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RAEDCN",99,0) S RAREGX(4)=+$P(RAREGX(0),"^",4) "RTN","RAEDCN",100,0) I +$G(RAMLC)'=RAREGX(4) D I $P(RAYN,"^",2) D Q QUIT "RTN","RAEDCN",101,0) . W !!?3,"Your sign-on location is: " "RTN","RAEDCN",102,0) . W $P($G(^SC(+$G(^RA(79.1,+$G(RAMLC),0)),0)),"^")_". The location" "RTN","RAEDCN",103,0) . W !?3,"of case ",RACN," is " "RTN","RAEDCN",104,0) . W $P($G(^SC(+$G(^RA(79.1,RAREGX(4),0)),0)),"^"),".",! "RTN","RAEDCN",105,0) . K DIR,DIROUT,DIRUT,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="Yes" "RTN","RAEDCN",106,0) . S DIR("?")="Enter 'Y'es to switch locations or 'N'o exit the option." "RTN","RAEDCN",107,0) . S DIR("A")="Do you wish to switch Imaging Locations" D ^DIR "RTN","RAEDCN",108,0) . S RAYN=+Y_"^"_$S($D(DIRUT):1,1:0) "RTN","RAEDCN",109,0) . K DIR,DIROUT,DIRUT,DTOUT,DUOUT Q:'+RAYN ; quit if no "RTN","RAEDCN",110,0) . D KILL^RAPSET1,SET^RAPSET1 ; else switch locations "RTN","RAEDCN",111,0) . I $D(XQUIT) S $P(RAYN,"^",2)=1 K XQUIT "RTN","RAEDCN",112,0) . Q "RTN","RAEDCN",113,0) S ION=$P(RAMLC,"^",3) ; imaging location flash card printer (if any) "RTN","RAEDCN",114,0) G Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S Y=^(0),Y=$S($D(^RAMIS(71,+$P(Y,"^",2),0)):$P(^(0),"^",3),1:"") "RTN","RAEDCN",115,0) ; if Y, then convert the pointer value 'Y' to the .01 value of "RTN","RAEDCN",116,0) ; the procedure flash card printer (if any) "RTN","RAEDCN",117,0) I Y]"",$D(^%ZIS(1,+Y,0)) D "RTN","RAEDCN",118,0) . S Y(0)=$$GET1^DIQ(3.5,+Y,.01) ; .01 value for proc flash card printer "RTN","RAEDCN",119,0) . S:Y(0)'=$P(RAMLC,"^",3) ION=Y(0) K Y(0) "RTN","RAEDCN",120,0) . ; if flash card printer for the imaging location differs from "RTN","RAEDCN",121,0) . ; the procedure flash card printer, default (print to) to the flash "RTN","RAEDCN",122,0) . ; card printer for the procedure. "RTN","RAEDCN",123,0) . Q "RTN","RAEDCN",124,0) S RAMES="W !!,""Duplicates queued to print on "",ION,"".""",RAFLH=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1),RAEXFM=$S($P(RAMLC,"^",9):$P(RAMLC,"^",9),1:1),RAFLHFL=RACNI "RTN","RAEDCN",125,0) FLH ; Flash Cards "RTN","RAEDCN",126,0) R !,"How many flash cards? 1// ",X:DTIME G DUP1:'$T!(X["^") S:X="" X=1 S RANUM=X I '(RANUM?.N)!(RANUM>20) W !?3,$C(7),"Must be a whole number less than 21!" G FLH "RTN","RAEDCN",127,0) EXM ; Exam Labels "RTN","RAEDCN",128,0) R !,"How many exam labels? 1// ",X:DTIME G DUP1:'$T!(X["^") S:X="" X=1 S RAEXLBLS=X I '(RAEXLBLS?.N)!(RAEXLBLS>20) W !?3,$C(7),"Must be a whole number less than 21!" G EXM "RTN","RAEDCN",129,0) S IOP="Q" S:ION]"" RADFLTP=ION "RTN","RAEDCN",130,0) K RAFL D Q^RAFLH,Q G DUP1 "RTN","RAEDCN",131,0) ; "RTN","RAEDCN",132,0) SETVARS ; Setup key Rad/Nuc Med variables "RTN","RAEDCN",133,0) I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) "RTN","RAEDCN",134,0) Q:'($D(RACCESS(DUZ))\10) ; user does not have location access "RTN","RAEDCN",135,0) I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) K:$G(RAIMGTY)="" XQUIT "RTN","RAEDCN",136,0) Q "RTN","RAORD6") 0^4^B49049103^B47839640 "RTN","RAORD6",1,0) RAORD6 ;HISC/CAH - AISC/RMO-Print A Request Cont. ;2/2/98 15:28 "RTN","RAORD6",2,0) ;;5.0;Radiology/Nuclear Medicine;**5,10,15,18,27,45,41,75,85**;Mar 16, 1998;Build 4 "RTN","RAORD6",3,0) ; 3-p75 10/12/2006 GJC RA*5*75 print Reason for Study "RTN","RAORD6",4,0) ; 4-p75 10/12/2006 KAM RA*5*75 display the request print date in the header "RTN","RAORD6",5,0) ; 5-p75 10/12/2006 KAM RA*5*75 update header "Age" to "Age at req" "RTN","RAORD6",6,0) ; 6-p85 06/20/2007 KAM RA*5*85 Reason for Study/Bar Code print issue "RTN","RAORD6",7,0) ; Remedy Call - 193859 "RTN","RAORD6",8,0) D HD Q:RAX["^" "RTN","RAORD6",9,0) I $P(RADPT0,U,2)="F" D ;display pregnancy status for females ptch 45 "RTN","RAORD6",10,0) .W !,"Pregnancy Status: ",?22,$S($P(RAORD0,"^",13)="y":"Patient is Pregnant",$P(RAORD0,"^",13)="n":"Patient not pregnant at time of order",1:"Unknown") "RTN","RAORD6",11,0) .Q "RTN","RAORD6",12,0) W:$P(RAORD0,"^",24)="y" !!?12,"*** Universal Isolation Precautions ***" "RTN","RAORD6",13,0) W:$D(RA("VDT")) !!?8,"** Note Request Associated with Visit on ",RA("VDT")," **" "RTN","RAORD6",14,0) W !!,"Requested:",?18,RA("PRC INFO") "RTN","RAORD6",15,0) I $D(^TMP($J,"RA DIFF PRC")),('$D(RAFOERR)),('$D(RAOPT("REG"))),('$D(RAOPT("ORDEREXAM"))),('$D(RAOPT("ADDEXAM"))) D Q:RAX["^" "RTN","RAORD6",16,0) . ; don't print registered procedure info (CPT, Proc Type, Imaging "RTN","RAORD6",17,0) . ; Type) if entering through 'Request An Exam', 'Register Patient "RTN","RAORD6",18,0) . ; for Exams' or 'Add Exams To Last Visit'. Don't print if ordered "RTN","RAORD6",19,0) . ; through ANY version of OE/RR. If ordered through OE/RR, RAFOERR "RTN","RAORD6",20,0) . ; will be defined. (Set in RAORD1 & RAO7RO) "RTN","RAORD6",21,0) . N RAT,RA18NLIN S RAT="",RA18NLIN=0 W !,"Registered:" "RTN","RAORD6",22,0) . F S RAT=$O(^TMP($J,"RA DIFF PRC",RAT)) Q:RAT="" D Q:RAX["^" "RTN","RAORD6",23,0) .. D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",24,0) .. W:RA18NLIN ! W ?12,RAT "RTN","RAORD6",25,0) .. S RA18NLIN=1 "RTN","RAORD6",26,0) .. Q "RTN","RAORD6",27,0) . Q "RTN","RAORD6",28,0) I $G(RACMFLG("O"))'="" W !?12,"** The requested procedure has contrast media assigned **" "RTN","RAORD6",29,0) I $G(RACMFLG("R"))'="" W !?12,"** A registered procedure uses contrast media **" "RTN","RAORD6",30,0) W:$D(RA("MOD")) !,"Procedure Modifiers:",?22,RA("MOD") "RTN","RAORD6",31,0) I RA("PRC MSG") D Q:RAX["^" "RTN","RAORD6",32,0) . N A,B,C,X S (A,C)=0 W !,"Procedure Message: ",! "RTN","RAORD6",33,0) . F S A=$O(^RAMIS(71,+$P(RAORD0,"^",2),3,A)) Q:A'>0!(RAX["^") D "RTN","RAORD6",34,0) .. S B=+$G(^RAMIS(71,+$P(RAORD0,"^",2),3,A,0)) "RTN","RAORD6",35,0) .. S X=$G(^RAMIS(71.4,B,0)) "RTN","RAORD6",36,0) .. W:'C ?3,"-" W:C !?3,"-" "RTN","RAORD6",37,0) .. D OUTTEXT^RAUTL9(X,"",5,80,4,"","!") "RTN","RAORD6",38,0) .. D HD:($Y+6)>IOSL S C=C+1 "RTN","RAORD6",39,0) .. Q "RTN","RAORD6",40,0) . Q "RTN","RAORD6",41,0) W !,"Request Status:",?22,$E(RA("OST"),1,24) "RTN","RAORD6",42,0) I $P(RAORD0,"^",5)=1!($P(RAORD0,"^",5)=3) D Q:RAX["^" "RTN","RAORD6",43,0) . W !,"Reason ",$S($P(RAORD0,"^",5)=1:"Cancelled",1:"Held"),":" "RTN","RAORD6",44,0) . W ?22,$S($D(^RA(75.2,+$P(RAORD0,"^",10),0)):$E($P(^(0),"^"),1,50),$P(RAORD0,"^",27)]"":$E($P(RAORD0,"^",27),1,50),1:"UNKNOWN") "RTN","RAORD6",45,0) . D HD:($Y+6)>IOSL Q:RAX["X" "RTN","RAORD6",46,0) . I $D(^RAO(75.1,RAOIFN,1)) D Q:RAX["^" "RTN","RAORD6",47,0) .. N X,I,RAXX "RTN","RAORD6",48,0) .. K ^UTILITY($J,"W") "RTN","RAORD6",49,0) .. W !,"Hold Description:",! "RTN","RAORD6",50,0) .. S I=0 F S I=$O(^RAO(75.1,RAOIFN,1,I)) Q:'I S (RAXX,X)=^(I,0) D HD:($Y+6)>IOSL Q:RAX["^" S X=RAXX D ^DIWP "RTN","RAORD6",51,0) .. Q:RAX["^" "RTN","RAORD6",52,0) .. D HD:($Y+6)>IOSL Q:RAX["X" "RTN","RAORD6",53,0) .. D ^DIWW:$D(RAXX) "RTN","RAORD6",54,0) .. D HD:($Y+6)>IOSL Q:RAX["X" "RTN","RAORD6",55,0) . I $P(RAORD0,"^",5)=1 D "RTN","RAORD6",56,0) .. W !!,?(IOM-(IOM/2+15)),"*********************",!,?(IOM-(IOM/2+15)),"* C A N C E L L E D *",!,?(IOM-(IOM/2+15)),"*********************" "RTN","RAORD6",57,0) W:$P(RAORD0,"^",5)=6&($D(RA("ST"))) !,"Exam Status:",?22,RA("ST") "RTN","RAORD6",58,0) W:$P(RAORD0,"^",5)=8&($D(RA("SDT"))) !,"Exam Scheduled:",?22,RA("SDT") "RTN","RAORD6",59,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",60,0) W !!,"Requester:",?22,$E(RA("PHY"),1,20) "RTN","RAORD6",61,0) W:RA("PHY")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("RPHOINFO")) "RTN","RAORD6",62,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",63,0) W !,"Attend Phy Current:",?22,$E(RA("ATTEN"),1,20) "RTN","RAORD6",64,0) W:RA("ATTEN")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("APHOINFO")) "RTN","RAORD6",65,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",66,0) W !,"Prim Phy Current:",?22,$E(RA("PRIM"),1,20) "RTN","RAORD6",67,0) W:RA("PRIM")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("PPHOINFO")) "RTN","RAORD6",68,0) K RAPASS1,RAPASS2 "RTN","RAORD6",69,0) S RAPASS1=RA("ATTEN"),RAPASS2=RA("OATTEN") "RTN","RAORD6",70,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",71,0) I $$ID^RAORD6(RAPASS1,RAPASS2) D "RTN","RAORD6",72,0) . W !,"Attend Phy At Order:",?22,$E(RA("OATTEN"),1,20) "RTN","RAORD6",73,0) . W:RA("OATTEN")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("OAPHOINFO")) "RTN","RAORD6",74,0) . Q "RTN","RAORD6",75,0) S RAPASS1=RA("PRIM"),RAPASS2=RA("OPRIM") "RTN","RAORD6",76,0) I $$ID^RAORD6(RAPASS1,RAPASS2) D "RTN","RAORD6",77,0) . W !,"Prim Phy At Order:",?22,$E(RA("OPRIM"),1,20) "RTN","RAORD6",78,0) . W:RA("OPRIM")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("OPPHOINFO")) "RTN","RAORD6",79,0) . Q "RTN","RAORD6",80,0) K RAPASS1,RAPASS2 "RTN","RAORD6",81,0) I +$P(RAORD0,"^",8) D "RTN","RAORD6",82,0) . N RAPPRAD S RAPPRAD=+$P(RAORD0,"^",8) "RTN","RAORD6",83,0) . S:$P($G(^VA(200,RAPPRAD,20)),"^",2)]"" RAPPRAD=$P(^(20),"^",2) "RTN","RAORD6",84,0) . S:RAPPRAD=+RAPPRAD RAPPRAD=$P(^VA(200,RAPPRAD,0),"^") "RTN","RAORD6",85,0) . W !,"Approved by: ",?22,RAPPRAD "RTN","RAORD6",86,0) . Q "RTN","RAORD6",87,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",88,0) W !,"Date/Time Ordered:",?22,$S($D(RA("ODT")):RA("ODT"),1:"")," by ",$E(RA("USR"),1,20) "RTN","RAORD6",89,0) W:$D(RA("RDT")) !,"Date Desired:",?22,RA("RDT") "RTN","RAORD6",90,0) D:$P(RAORD0,"^",5)=1 USERCAN^RAORD3 "RTN","RAORD6",91,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",92,0) W:$D(RA("PDT")) !,"Pre-op Date/Time:",?22,RA("PDT"),!!?26,"**** P R E - O P ****",! "RTN","RAORD6",93,0) BAR ;Print bar-coded SSN on request form if term type has bar code setup "RTN","RAORD6",94,0) I $G(RASSN)'?3N1"-"2N1"-".E G CONT "RTN","RAORD6",95,0) S X3=$E(RASSN,1,3)_$E(RASSN,5,6)_$E(RASSN,8,11) "RTN","RAORD6",96,0) ; 06/20/2007 KAM/BAY RA*5*85 Added 2 line feeds "RTN","RAORD6",97,0) D PSET^%ZISP I IOBARON]"",(IOBAROFF]"") W !!!?49,@IOBARON,X3,@IOBAROFF,! "RTN","RAORD6",98,0) D PKILL^%ZISP "RTN","RAORD6",99,0) ; "RTN","RAORD6",100,0) CONT D HD:($Y+6)>IOSL Q:RAX["^" D ODX^RABWUTL(RAOIFN) ; * Billing Aware * "RTN","RAORD6",101,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",102,0) ; 06/20/2007 KAM/BAY RA*5*85 Added line feed to the next line "RTN","RAORD6",103,0) I $L(RA("STY_REA")) W ! D DIWP^RAUTL5(1,68,"Reason for Study: "_RA("STY_REA")) ;3-p75 "RTN","RAORD6",104,0) D HD:($Y+6)>IOSL Q:RAX["^" K ^UTILITY($J,"W"),^(1) W !,"Clinical History:",! K RAXX F RAV=0:0 S RAV=$O(^RAO(75.1,RAOIFN,"H",RAV)) Q:'RAV I $D(^(RAV,0)) S RAXX=^(0) D HD:($Y+6)>IOSL Q:RAX["^" S X=RAXX D ^DIWP "RTN","RAORD6",105,0) Q:RAX["^" D HD:($Y+6)>IOSL Q:RAX["^" D ^DIWW:$D(RAXX),HD:($Y+6)>IOSL Q:RAX["^" D WORK ;always print bottom section of form 012601 "RTN","RAORD6",106,0) W ! S BOT=IOSL-($Y+4) S:($E(IOST,1,6)="P-BROW"&($D(DDBRZIS))) BOT=5 F BT=1:1:BOT W ! "RTN","RAORD6",107,0) K BOT,BT "RTN","RAORD6",108,0) W !,"VA Form 519a-ADP" "RTN","RAORD6",109,0) Q "RTN","RAORD6",110,0) ; "RTN","RAORD6",111,0) WORK W !,RALNE,!,"Date Performed: ________________________",?46 "RTN","RAORD6",112,0) I $O(^RADPT("AO",RAOIFN,0))="" W "Case No.: ______________________" "RTN","RAORD6",113,0) E W "Case No.: ______see above_______" "RTN","RAORD6",114,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",115,0) W !,"Technologist Initials: _________________" "RTN","RAORD6",116,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",117,0) W !?46,"Number/Size Films: _____________",!,"Interpreting Phys. Initials: ___________",?65,"_____________",!?65,"_____________",! "RTN","RAORD6",118,0) D HD:($Y+6)>IOSL Q:RAX["^" "RTN","RAORD6",119,0) W !,"Comments:" "RTN","RAORD6",120,0) ; "RTN","RAORD6",121,0) TC D EN30^RAO7PC1(RAOIFN),TC^RAORD61 Q:RAX["^" "RTN","RAORD6",122,0) ; "RTN","RAORD6",123,0) DASHLN W ! F I=1:1:5 D HD:($Y+6)>IOSL Q:RAX["^" W !,RALNE ;P18 "RTN","RAORD6",124,0) Q "RTN","RAORD6",125,0) ; "RTN","RAORD6",126,0) HD S:'$D(RAPGE) RAPGE=0 D CRCHK Q:$G(RAX)["^" S RATAB=$S($D(RA("ILC")):1,1:16) "RTN","RAORD6",127,0) ;10/12/2006 KAM Remedy tk 162508 Changed next line added "Printed:" "RTN","RAORD6",128,0) W:$Y @IOF W !?RATAB,">>"_$S($D(RACRHD):"Discontinued ",1:"")_"Rad/NM Consultation" W:$D(RA("ILC")) " for ",$E(RA("ILC"),1,17) W "< Attending/Primary Phy. Current "RTN","RAORD6",146,0) ; 'Y'-> Attending/Primary Phy. At Order "RTN","RAORD6",147,0) I X']""!(Y']"") Q 0 "RTN","RAORD6",148,0) I $$UP^XLFSTR(X)="UNKNOWN",($$UP^XLFSTR(Y)="UNKNOWN") Q 0 "RTN","RAORD6",149,0) N A,B,Z S A=+$O(^VA(200,"B",X,"")),B=+$O(^VA(200,"B",Y,"")) "RTN","RAORD6",150,0) I A>0,(B>0),(A=B) S Z=0 "RTN","RAORD6",151,0) E S Z=1 "RTN","RAORD6",152,0) Q Z ; $S(Z=1:"different physician",Z=0:"same physician") "RTN","RAREG") 0^1^B38658501^B33879324 "RTN","RAREG",1,0) RAREG ;HISC/GJC AISC/MJK,RMO-Register Rad/NM Patient ;8/15/97 11:04 "RTN","RAREG",2,0) ;;5.0;Radiology/Nuclear Medicine;**23,85**;Mar 16, 1998;Build 4 "RTN","RAREG",3,0) ; 06/07/2007 KAM/BAY RA*5*85 Remedy Call 185568 Exam Backdating "RTN","RAREG",4,0) K RADTE "RTN","RAREG",5,0) PAT D SET^RAPSET1 I $D(XQUIT) K XQUIT Q "RTN","RAREG",6,0) ; Is our sign-on location inactive? "RTN","RAREG",7,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RADIRYN,RAINATVE "RTN","RAREG",8,0) S RAINATVE=$$INLO^RAUTL13(+RAMLC) "RTN","RAREG",9,0) I RAINATVE D I $D(XQUIT)!(RADIRYN) K RADIRYN,RAINATVE Q "RTN","RAREG",10,0) . W !!?3,"Your current Imaging Location: '"_$P($G(RACCESS(DUZ,"LOC",+RAMLC)),U,2)_"' is inactive." "RTN","RAREG",11,0) . W !?3,"If you wish to register this patient for an exam, locations must be switched.",! "RTN","RAREG",12,0) . S DIR(0)="YA",DIR("B")="Yes" "RTN","RAREG",13,0) . S DIR("A")="Do you wish to switch locations at this time? " "RTN","RAREG",14,0) . S DIR("?")="Enter 'Y'es to switch locations, 'N'o to exit." "RTN","RAREG",15,0) . D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","RAREG",16,0) . S RADIRYN=$S('+Y:1,1:0) K X,Y Q:RADIRYN "RTN","RAREG",17,0) . W ! D KILL^RAPSET1,^RAPSET "RTN","RAREG",18,0) . I $D(XQUIT) K RACCESS Q "RTN","RAREG",19,0) . Q "RTN","RAREG",20,0) K RADIRYN,RAINATVE "RTN","RAREG",21,0) D HOME^%ZIS K X S DIC(0)="AEMQZ"_$S('$D(RAVSTFLG):"L",1:"") D ^RADPA G Q:Y<0 S RADFN=+Y,RACAT=$S($P(Y(0),"^",4)']"":"OUTPATIENT",1:$P($P(^DD(70,.04,0),$P(Y(0),"^",4)_":",2),";")) S:'$D(RAVSTFLG) RAREGFLG="" "RTN","RAREG",22,0) D ^RADEM2 G Q:RAPOP I $D(RAVSTFLG) S J=$O(^RADPT(RADFN,"DT",0)) G ADD1:$D(^(+J,0)) W !?3,*7,"A previous exam date does not exist for this patient!",! G Q "RTN","RAREG",23,0) DT K RADTEBAD N RAHRS S RAHRS=+$P($G(^RA(79,+RAMDIV,.1)),"^",24) ;How many hrs in adv? "RTN","RAREG",24,0) R !!,"Imaging Exam Date/Time: NOW// ",X:DTIME "RTN","RAREG",25,0) G Q:'$T!(X=" ")!(X="^") "RTN","RAREG",26,0) S:X="" RANOW="",X="NOW" "RTN","RAREG",27,0) S %DT(0)=-$$FMADD^XLFDT($$NOW^XLFDT,0,RAHRS,0,0),%DT="ETXR" "RTN","RAREG",28,0) D ^%DT K %DT G DT:Y<0 "RTN","RAREG",29,0) ; "RTN","RAREG",30,0) ; 06/06/2007 KAM/BAY Remedy Call 185568 Added next line "RTN","RAREG",31,0) I '$$BACKDATE(Y) G DT "RTN","RAREG",32,0) ; "RTN","RAREG",33,0) DT1 S RADTE=Y,RADTI=9999999.9999-RADTE "RTN","RAREG",34,0) I '$D(RAVSTFLG),$D(^RADPT(RADFN,"DT",RADTI,0)) D G DT "RTN","RAREG",35,0) . W !,*7,"Patient already has exams (which may have been cancelled) for this date/time." "RTN","RAREG",36,0) . W !,"....use 'Add Exams to Last Visit' option, or enter a date/time a few minutes",!," earlier or later." "RTN","RAREG",37,0) . Q "RTN","RAREG",38,0) ;Next line checks for case where exam date entered is a 'subset' of an "RTN","RAREG",39,0) ;existing exam date (i.e. 10:00 is a subset of 11:00 because DIC lookup "RTN","RAREG",40,0) ;drops trailing zeros - this was causing users to hang ;CH 4/19/94 "RTN","RAREG",41,0) S RADTEBAD=$O(^RADPT(RADFN,"DT","B",RADTE)) I RADTEBAD[RADTE W *7,!,"?? Please try a different time of day (a few minutes later)." G DT "RTN","RAREG",42,0) ;next line is a lock to prevent multiple users from adding/overwriting "RTN","RAREG",43,0) ;the same "DT" node if they begin registration of a case for the same "RTN","RAREG",44,0) ;patient during the same minute using NOW as the exam date/time. "RTN","RAREG",45,0) L +^RADPT(RADFN,"DT",RADTI):1 I '$T W !,*7,"Someone else is now editing an exam for this patient on the date/time",!,"you selected. Please try entering a date/time a few minutes earlier or later." G DT "RTN","RAREG",46,0) K RADTEBAD I $D(RANOW),$D(RAWARD) S RACAT="INPATIENT" "RTN","RAREG",47,0) I '$D(RANOW) K RAWARD,RABED,RASER D ^RASERV S:$D(RAWARD) RACAT="INPATIENT" "RTN","RAREG",48,0) G ^RAREG1 "RTN","RAREG",49,0) ; "RTN","RAREG",50,0) ADD S RAVSTFLG="" G PAT "RTN","RAREG",51,0) ADD1 S YY=^RADPT(RADFN,"DT",J,0) "RTN","RAREG",52,0) I $P(YY,"^",4)'=+RAMLC D G Q "RTN","RAREG",53,0) . W !!?3,"Last visit date is for location '",$S('$D(^RA(79.1,+$P(YY,"^",4),0)):"Unknown",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"Unknown"),"'." "RTN","RAREG",54,0) . W !?3,"Your current location is defined as: '" "RTN","RAREG",55,0) . W $P($G(^SC(+$P($G(^RA(79.1,+RAMLC,0)),"^"),0)),"^")_"'." "RTN","RAREG",56,0) . W !?3,"You must log into the '" "RTN","RAREG",57,0) . W $S('$D(^RA(79.1,+$P(YY,"^",4),0)):"Unknown",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"Unknown"),"' location" "RTN","RAREG",58,0) . W !?3,"to add exams to the last visit.",$C(7) "RTN","RAREG",59,0) . K DIR S DIR(0)="E" D ^DIR K DIR Q "RTN","RAREG",60,0) S X1=DT,X2=-1 D C^%DTC I X>+YY,'$D(^XUSEC("RA MGR",DUZ)) W !!?3,*7,"Last visit was before yesterday. No adding exams allowed!" G Q "RTN","RAREG",61,0) W !!,"Last Visit Date/Time: " S Y=$P(YY,"^") D D^RAUTL W Y,!!?1,"Case No.",?10,"Procedure",?42,"Status",!?1,"--------",?10,"---------",?42,"------" "RTN","RAREG",62,0) N RA0,RA17,RA1 S RA1=0 ;1=valid rpt, 0=stub/no rpt "RTN","RAREG",63,0) F I=0:0 S I=$O(^RADPT(RADFN,"DT",J,"P",I)) Q:I'>0 I $D(^(I,0)) S Y=^(0) D ADD2 "RTN","RAREG",64,0) I $P(YY,U,5),RA1 S Y=1 D Q "RTN","RAREG",65,0) . I $Y>(IOSL-6) N DIR S DIR(0)="E" D ^DIR Q:Y'>0 "RTN","RAREG",66,0) . W !!?2,"NOTE: Because all the cases within this exam date/time are" "RTN","RAREG",67,0) . W !?8,"part of one order set, and a valid report has been filed" "RTN","RAREG",68,0) . W !?8,"already, additional procedures may not be added to this visit." "RTN","RAREG",69,0) . W !?8,"You must register the desired exam(s) at a later date/time." "RTN","RAREG",70,0) . N Y R !!?2,"Press RETURN to continue:",Y:DTIME "RTN","RAREG",71,0) . Q "RTN","RAREG",72,0) S RARD("A")="Do you wish to add exams to this visit? ",RARD(1)="Yes^add exams to this visit",RARD(2)="No^stop",RARD("B")=2,RARD(0)="S" D SET^RARD K RARD G Q:$E(X)'="Y" "RTN","RAREG",73,0) S RAREC="",Y=$P(YY,"^") G DT1 "RTN","RAREG",74,0) ADD2 W !?3,$P(Y,"^"),?10,$E($S($D(^RAMIS(71,+$P(Y,"^",2),0)):$P(^(0),"^"),1:"Unknown"),1,30),?42,$S($D(^RA(72,+$P(Y,"^",3),0)):$P(^(0),"^"),1:"Unknown") "RTN","RAREG",75,0) K RAVLEDTI,RAVLECNI,RASHA,RARSH,RAPIFN,RARDTE,RALIFN S RAVLEDTI=J,RAVLECNI=I,RADIV=$P(YY,"^",3),RACAT=$S('$D(RAWARD):$P($P(^DD(75.1,4,0),$P(Y,"^",4)_":",2),";"),1:RACAT) "RTN","RAREG",76,0) S:"CS"[$E(RACAT)&($D(^DIC(34,+$P(Y,"^",9),0))) RASHA=$P(^(0),"^") S:"R"[$E(RACAT)&($D(^RADPT(RADFN,"DT",J,"P",I,"R"))) RARSH=^("R") "RTN","RAREG",77,0) S:$D(^VA(200,+$P(Y,"^",14),0)) RAPIFN=+$P(Y,"^",14) S:$P(Y,"^",21) RARDTE=$P(Y,"^",21) S:$D(^SC(+$P(Y,"^",22),0)) RALIFN=+$P(Y,"^",22) "RTN","RAREG",78,0) I $P(Y,"^",17)]"" D ; is this a non-stub report "RTN","RAREG",79,0) . S RA17=+$P(Y,"^",17) ;keep RA17 only if image stub rpt exists "RTN","RAREG",80,0) . I '$D(^RARPT(RA17,0))#2 K RA17 Q ; no rpt "RTN","RAREG",81,0) . Q:$$STUB^RAEDCN1(RA17) ;quit if image stub rpt "RTN","RAREG",82,0) . S RA1=1 K RA17 ; valid (non-stub record) "RTN","RAREG",83,0) Q "RTN","RAREG",84,0) ; "RTN","RAREG",85,0) Q K %,%DT,DA,DIC,GMRAL,POP,RABED,RACAT,RADFN,RADIV,RADTE,RADTI,RALIFN,RANME,RAOIFN,RAPIFN,RAPOP,RAPTFL,RARDTE,RAREGFLG,RARSH,RASER,RASEX,RASHA,RAVLECNI,RAVLEDTI,RAVSTFLG,RAWARD,X,XQUIT,Y,YY "RTN","RAREG",86,0) K %W,%X,%Y,%Y1,D,D3,DDER,DDH,DFN,DI,DIG,DIH,DIU,DIW,DIWF,DIWI,DIWL,DIWR "RTN","RAREG",87,0) K DIWT,DIWTC,DIWX,DN,I,RACANC,RACN0,RACPT,RACPTNDE,RAEXIT,RAHSMULT,RAI "RTN","RAREG",88,0) K RAN,RAOBR4,RAPARENT,RAPRCNDE,RAPROC,RAPROCI,RAPROCIT,RAPRV,RASKIPIT "RTN","RAREG",89,0) K VA,VADM,VAERR,Z "RTN","RAREG",90,0) Q "RTN","RAREG",91,0) ;06/06/2007 KAM/BAY for Remedy Call 185568 Added next 11 lines "RTN","RAREG",92,0) BACKDATE(RADT) ; "RTN","RAREG",93,0) N RACON,RAEXMDAT,RATODAY,RAANS,Y "RTN","RAREG",94,0) S RACON=1 "RTN","RAREG",95,0) S X="NOW" D ^%DT S RATODAY=Y K %DT "RTN","RAREG",96,0) I (RATODAY-RADT)>9999 D "RTN","RAREG",97,0) . W !!,"********************************************************" "RTN","RAREG",98,0) . W !,"The Exam date entered is more than one year in the past." "RTN","RAREG",99,0) . W !,"********************************************************" "RTN","RAREG",100,0) . R !!,"Are you sure you want to continue Y/N?: N// ",RAANS:DTIME "RTN","RAREG",101,0) . I "Y,y,YES,yes,Yes"'[RAANS!(RAANS="") S RACON=0 "RTN","RAREG",102,0) Q RACON "RTN","RASTREQ1") 0^3^B7300725^B6580098 "RTN","RASTREQ1",1,0) RASTREQ1 ;HISC/CAH,GJC AISC/MJK-Cont. of RASTREQ status reqmts ck ;5/29/97 12:52 "RTN","RASTREQ1",2,0) ;;5.0;Radiology/Nuclear Medicine;**34,85**;Mar 16, 1998;Build 4 "RTN","RASTREQ1",3,0) ; "RTN","RASTREQ1",4,0) ; STUFF -- Called from UP1^RAUTL1 for editing an exam "RTN","RASTREQ1",5,0) ; LOOP -- Called from RASTREQ for status tracking "RTN","RASTREQ1",6,0) ; and from RASTREQ for cancel an exam "RTN","RASTREQ1",7,0) ; "RTN","RASTREQ1",8,0) ;Determine whether exam status can be updated to next higher status "RTN","RASTREQ1",9,0) ;After this subrtn is executed, the following variables will exist: "RTN","RASTREQ1",10,0) ; RAOR= order seq no., = -1 if not eligible for an update "RTN","RASTREQ1",11,0) ; RASN= new status external format (or same status if not updateable) "RTN","RASTREQ1",12,0) ; RASTI= ien of new status if updateable "RTN","RASTREQ1",13,0) ;This subrtn does not write any data to the status field, it only "RTN","RASTREQ1",14,0) ;checks to see what the next status would be "RTN","RASTREQ1",15,0) ;RABEFORE = status level BEFORE change "RTN","RASTREQ1",16,0) ;RAAFTER = status level AFTER change "RTN","RASTREQ1",17,0) ; "RTN","RASTREQ1",18,0) ; 06/11/2007 BAY/KAM RA*5*85 Remedy Call 174790 Change exam cancel "RTN","RASTREQ1",19,0) ; to allow only descendent with stub/images "RTN","RASTREQ1",20,0) ; "RTN","RASTREQ1",21,0) STUFF ; initialize RAOR=-1 to assume NO change if early quit "RTN","RASTREQ1",22,0) S RAJ=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0)),RAOR=-1 "RTN","RASTREQ1",23,0) S RABEFORE=$P($G(^RA(72,+$P(RAJ,U,3),0)),U,3) "RTN","RASTREQ1",24,0) S RAORDIFN=+$P(RAJ,"^",11),RACS=$P(RAJ,"^",24),RAPRIT=$P(RAJ,"^",2) "RTN","RASTREQ1",25,0) I $D(^RA(72,+$P(RAJ,"^",3),0)) S RASN=$P(^(0),"^") Q:$P(^(0),"^",3)'>0 "RTN","RASTREQ1",26,0) I $P(RAJ,"^",6)]"" S RAF5=$P(RAJ,"^",6) "RTN","RASTREQ1",27,0) S RAIMGTYI=$P($G(^RADPT(DA(2),"DT",DA(1),0)),U,2),RAIMGTYJ=$P(^RA(79.2,RAIMGTYI,0),U) "RTN","RASTREQ1",28,0) ; set RAOR, RASN, RASTI to lowest level's, to allow event when "RTN","RASTREQ1",29,0) ; none of the levels meet all the requirements for that level "RTN","RASTREQ1",30,0) LOOP S RAOR=$S($O(^RA(72,"AA",RAIMGTYJ,0))>0:$O(^(0)),1:1) "RTN","RASTREQ1",31,0) S RASTI=+$O(^RA(72,"AA",RAIMGTYJ,RAOR,0)),RASN=$P($G(^RA(72,+RASTI,0)),U) "RTN","RASTREQ1",32,0) ; "RTN","RASTREQ1",33,0) N RA "RTN","RASTREQ1",34,0) F K=0:0 S K=$O(^RA(72,"AA",RAIMGTYJ,K)) Q:K'>0 D "RTN","RASTREQ1",35,0) . S X="",E=+$O(^RA(72,"AA",RAIMGTYJ,K,0)) Q:E'>0 "RTN","RASTREQ1",36,0) . I $D(^RA(72,E,0)) D "RTN","RASTREQ1",37,0) .. S RA(0)=$G(^RA(72,E,0)),N=$P(RA(0),"^"),RAS=$G(^RA(72,E,.1)) "RTN","RASTREQ1",38,0) .. I '$L(RAS) S RAS="N" "RTN","RASTREQ1",39,0) .. D HELP1^RASTREQ I $D(X),K>RAOR S RAOR=K,RASTI=E,RASN=N "RTN","RASTREQ1",40,0) .. Q "RTN","RASTREQ1",41,0) . Q "RTN","RASTREQ1",42,0) S RAAFTER=RAOR "RTN","RASTREQ1",43,0) I $D(RASTI),RASTI=$P(RAJ,"^",3) S RAOR=-1 "RTN","RASTREQ1",44,0) K RAZ,RAK,RAE,RAIMGTYI,RAIMGTYJ,E,RAS,RAJ,RAJ1,N,K,FL "RTN","RASTREQ1",45,0) Q "RTN","RASTREQ1",46,0) CANCEL ; cancel an exam "RTN","RASTREQ1",47,0) S RAOR=0,RASTI=RAXX,RASN=$P($G(^RA(72,RAXX,0)),"^") "RTN","RASTREQ1",48,0) S RAAFTER=RAOR "RTN","RASTREQ1",49,0) Q:$D(RAOPT("DELETEXAM")) ; 1st chk skip, 2nd chk done already<-- delxam "RTN","RASTREQ1",50,0) ; check again: 'allow cancelling' and if report exists "RTN","RASTREQ1",51,0) ; in case Fileman enter/edit was used directly on the EXAM STATUS field "RTN","RASTREQ1",52,0) ; if either check fails, set RAAFTER=RABEFORE so status can't change "RTN","RASTREQ1",53,0) I $D(^RA(72,+$P(RAJ,U,3),0)),$P(^(0),"^",6)'="y" W !,"This exam is in the '",$P(^(0),"^"),"' status and cannot be 'CANCELLED'" S RAAFTER=RABEFORE Q "RTN","RASTREQ1",54,0) ; ok to cancel descendent exam w images if stub rpt and user has RA MGR key "RTN","RASTREQ1",55,0) ; 06/11/2007 *85 Added descendent check to next line "RTN","RASTREQ1",56,0) I $P(RAJ,U,17)'="",$$STUB^RAEDCN1($P(RAJ,U,17)),($$PSET^RAEDCN1(RADFN,RADTI,RACNI)),$D(^XUSEC("RA MGR",+$G(DUZ))) Q "RTN","RASTREQ1",57,0) ; can't cancel exam if report isn't stub "RTN","RASTREQ1",58,0) I $P(RAJ,U,17)'="" W !,"A report has been filed for this case. Therefore cancellation is not allowed !" S RAAFTER=RABEFORE "RTN","RASTREQ1",59,0) Q "VER") 8.0^22.0 "BLD",6641,6) ^73 **END** **END**