Released RA*5*36 SEQ #34 Extracted from mail message **KIDS**:RA*5.0*36^ **INSTALL NAME** RA*5.0*36 "BLD",4139,0) RA*5.0*36^RADIOLOGY/NUCLEAR MEDICINE^0^3030122^y "BLD",4139,1,0) ^^1^1^3021213^ "BLD",4139,1,1,0) Please see patch description for this patch. "BLD",4139,4,0) ^9.64PA^^ "BLD",4139,"ABPKG") n "BLD",4139,"KRN",0) ^9.67PA^8989.52^19 "BLD",4139,"KRN",.4,0) .4 "BLD",4139,"KRN",.401,0) .401 "BLD",4139,"KRN",.402,0) .402 "BLD",4139,"KRN",.403,0) .403 "BLD",4139,"KRN",.5,0) .5 "BLD",4139,"KRN",.84,0) .84 "BLD",4139,"KRN",3.6,0) 3.6 "BLD",4139,"KRN",3.8,0) 3.8 "BLD",4139,"KRN",9.2,0) 9.2 "BLD",4139,"KRN",9.8,0) 9.8 "BLD",4139,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",4139,"KRN",9.8,"NM",1,0) RAO7PC1^^0^B25018660 "BLD",4139,"KRN",9.8,"NM",2,0) RAO7PC1A^^0^B40550808 "BLD",4139,"KRN",9.8,"NM","B","RAO7PC1",1) "BLD",4139,"KRN",9.8,"NM","B","RAO7PC1A",2) "BLD",4139,"KRN",19,0) 19 "BLD",4139,"KRN",19.1,0) 19.1 "BLD",4139,"KRN",101,0) 101 "BLD",4139,"KRN",409.61,0) 409.61 "BLD",4139,"KRN",771,0) 771 "BLD",4139,"KRN",870,0) 870 "BLD",4139,"KRN",8989.51,0) 8989.51 "BLD",4139,"KRN",8989.52,0) 8989.52 "BLD",4139,"KRN",8994,0) 8994 "BLD",4139,"KRN","B",.4,.4) "BLD",4139,"KRN","B",.401,.401) "BLD",4139,"KRN","B",.402,.402) "BLD",4139,"KRN","B",.403,.403) "BLD",4139,"KRN","B",.5,.5) "BLD",4139,"KRN","B",.84,.84) "BLD",4139,"KRN","B",3.6,3.6) "BLD",4139,"KRN","B",3.8,3.8) "BLD",4139,"KRN","B",9.2,9.2) "BLD",4139,"KRN","B",9.8,9.8) "BLD",4139,"KRN","B",19,19) "BLD",4139,"KRN","B",19.1,19.1) "BLD",4139,"KRN","B",101,101) "BLD",4139,"KRN","B",409.61,409.61) "BLD",4139,"KRN","B",771,771) "BLD",4139,"KRN","B",870,870) "BLD",4139,"KRN","B",8989.51,8989.51) "BLD",4139,"KRN","B",8989.52,8989.52) "BLD",4139,"KRN","B",8994,8994) "BLD",4139,"QUES",0) ^9.62^^ "BLD",4139,"REQB",0) ^9.611^1^1 "BLD",4139,"REQB",1,0) RA*5.0*31^2 "BLD",4139,"REQB","B","RA*5.0*31",1) "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^3011017^2980407^50 "PKG",18,22,1,"PAH",1,0) 36^3030122 "PKG",18,22,1,"PAH",1,1,0) ^^1^1^3030122 "PKG",18,22,1,"PAH",1,1,1,0) Please see patch description for 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") 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") 2 "RTN","RAO7PC1") 0^1^B25018660 "RTN","RAO7PC1",1,0) RAO7PC1 ;HISC/GJC,SS-Procedure Call utilities. ;12/9/02 08:41 "RTN","RAO7PC1",2,0) ;;5.0;Radiology/Nuclear Medicine;**1,16,18,26,36**;Mar 16, 1998 "RTN","RAO7PC1",3,0) ; "RTN","RAO7PC1",4,0) EN1(RADFN,RABDT,RAEDT,RAEXN,RACINC) ; "RTN","RAO7PC1",5,0) ; "RTN","RAO7PC1",6,0) ; DBIA#2043 - Return list of exams within date range "RTN","RAO7PC1",7,0) ; "RTN","RAO7PC1",8,0) ; ** See routines RAO7PC1A and RAO7PC2 for additional comments ** "RTN","RAO7PC1",9,0) ; ** and output node descriptions ** "RTN","RAO7PC1",10,0) ; "RTN","RAO7PC1",11,0) ; Input: RADFN-> Patient IEN RABDT-> beginning date "RTN","RAO7PC1",12,0) ; RAEDT-> ending date RAEXN-> max # of exams "RTN","RAO7PC1",13,0) ; RACINC-> include cancelled exams? (1 if yes, default no) "RTN","RAO7PC1",14,0) ; "RTN","RAO7PC1",15,0) ; Output: "RTN","RAO7PC1",16,0) ; ^TMP($J,"RAE1",Patient IEN,Exam ID)=Procedure name^Case number^ "RTN","RAO7PC1",17,0) ; Report status^Abnormal alert flag^Report ien^ "RTN","RAO7PC1",18,0) ; Exam status order #~Exam status name^ "RTN","RAO7PC1",19,0) ; Imaging location name^Imaging type abbr~ "RTN","RAO7PC1",20,0) ; Imaging type name^abnormal results flag^CPT Code "RTN","RAO7PC1",21,0) ; ^CPRS Order ien^Images exist flag "RTN","RAO7PC1",22,0) ; "RTN","RAO7PC1",23,0) ;if there are one or more CPT modifiers: "RTN","RAO7PC1",24,0) ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",n)=CPT Mod^CPT Mod Name "RTN","RAO7PC1",25,0) ; n+1)=CPT Mod^CPT Mod Name "RTN","RAO7PC1",26,0) ; "RTN","RAO7PC1",27,0) ;if CPRS asks to display parent procs, and case is descendent of parent: "RTN","RAO7PC1",28,0) ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CPRS")=memb of set^parent prc name "RTN","RAO7PC1",29,0) ; "RTN","RAO7PC1",30,0) ; Note: It is possible for the ^TMP global data returned to contain "RTN","RAO7PC1",31,0) ; 'No Report' and a Report file ien for the same exam. This is "RTN","RAO7PC1",32,0) ; because Imaging can create a report stub in the Report file, "RTN","RAO7PC1",33,0) ; but no report interpretation exists and no status is assigned "RTN","RAO7PC1",34,0) ; to the report record. "RTN","RAO7PC1",35,0) ; "RTN","RAO7PC1",36,0) ; Exam ID: exam date/time (inverse) concatenated with the case IEN "RTN","RAO7PC1",37,0) ; Abnormal alert flag: Y or blank "RTN","RAO7PC1",38,0) ; Abnormal results flag: Y or blank, may be turned on even if "RTN","RAO7PC1",39,0) ; abnormal alert flag is not "RTN","RAO7PC1",40,0) ; "RTN","RAO7PC1",41,0) Q:'RADFN!('RABDT)!('RAEDT) "RTN","RAO7PC1",42,0) N RAEXNP S RAEXNP=RAEXN ;save original value of RAEXN "RTN","RAO7PC1",43,0) ; if last char RAEXNP has "P", then count max no. by parent and "RTN","RAO7PC1",44,0) ; single, not by individual cases "RTN","RAO7PC1",45,0) S RACINC=+$G(RACINC) "RTN","RAO7PC1",46,0) Q:RABDT>RAEDT ; quit if ending date before beginning date "RTN","RAO7PC1",47,0) K ^TMP($J,"RAE1") S RAEXN=+$G(RAEXN) "RTN","RAO7PC1",48,0) S:$P(RABDT,".",2) RABDT=RABDT\1 S:$P(RAEDT,".",2) RAEDT=RAEDT\1 "RTN","RAO7PC1",49,0) N RABNOR,RACNST,RACNT,RACPT,RACSE,RADIAG,RAIBDT,RAIEDT,RAILOC,RAITY "RTN","RAO7PC1",50,0) N RANO,RAPRC,RAREX,RARPT,RARPTST "RTN","RAO7PC1",51,0) N RAXAM,RAXID,RAXIT,RAXSTAT,RABNORMR,RASHOCAN "RTN","RAO7PC1",52,0) S RACNST=9999999.9999 "RTN","RAO7PC1",53,0) S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001) "RTN","RAO7PC1",54,0) S (RACNT,RAXIT)=0 "RTN","RAO7PC1",55,0) F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D Q:RAXIT "RTN","RAO7PC1",56,0) . D SETDATA^RAO7PC1A ; obtain exam data, set ^TMP($J,"RAE1",Patient IEN,Exam ID) "RTN","RAO7PC1",57,0) . Q "RTN","RAO7PC1",58,0) Q "RTN","RAO7PC1",59,0) EN2(RADFN) ; "RTN","RAO7PC1",60,0) ; "RTN","RAO7PC1",61,0) ; DBIA#2012 - Return last 7 days of non-cancelled exames "RTN","RAO7PC1",62,0) ; "RTN","RAO7PC1",63,0) ; Input: RADFN-> Patient IEN "RTN","RAO7PC1",64,0) ; "RTN","RAO7PC1",65,0) ; Output: "RTN","RAO7PC1",66,0) ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^ "RTN","RAO7PC1",67,0) ; report status^imaging location IEN^imaging location name^ "RTN","RAO7PC1",68,0) ; m(edia) OR b(ARIUM) OR c(holecystogram) "RTN","RAO7PC1",69,0) ; "RTN","RAO7PC1",70,0) ; Exam ID: exam date/time (inverse) concatenated with the case IEN "RTN","RAO7PC1",71,0) ; "RTN","RAO7PC1",72,0) Q:'RADFN D EN2^RAO7PC1A Q "RTN","RAO7PC1",73,0) ; "RTN","RAO7PC1",74,0) EN3(X) ; Return narrative text for exam(s) "RTN","RAO7PC1",75,0) ; Input: "RTN","RAO7PC1",76,0) ; X-> Exam id in one of two forms: "RTN","RAO7PC1",77,0) ; 1) Pat. DFN^inv. exam date^Case IEN "RTN","RAO7PC1",78,0) ; Retrieves a single report for a single exam "RTN","RAO7PC1",79,0) ; 2) Pat. DFN^inv. exam date^ "RTN","RAO7PC1",80,0) ; Retrieves all reports for a set of exams ordered on one order "RTN","RAO7PC1",81,0) ; "RTN","RAO7PC1",82,0) ; Note: Input delimiter can be any of the following: ^~\&;- "RTN","RAO7PC1",83,0) ; a delimiter may be a single space i.e, " " "RTN","RAO7PC1",84,0) ; "RTN","RAO7PC1",85,0) ; Output: "RTN","RAO7PC1",86,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name)=report status^ "RTN","RAO7PC1",87,0) ; abnormal alert flag^CPRS Order ien^amended? "RTN","RAO7PC1",88,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"D",n)=diagnostic "RTN","RAO7PC1",89,0) ; code (n=1, this is the primary code) "RTN","RAO7PC1",90,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"H",n)=clin history "RTN","RAO7PC1",91,0) ; (a line of text) "RTN","RAO7PC1",92,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"I",n)=impression "RTN","RAO7PC1",93,0) ; (a line of text) "RTN","RAO7PC1",94,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"M",n)=modifier "RTN","RAO7PC1",95,0) ; (external format) "RTN","RAO7PC1",96,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"P")=primary "RTN","RAO7PC1",97,0) ; interpreting staff IEN^primary interpreting resident IEN^date "RTN","RAO7PC1",98,0) ; report entered "RTN","RAO7PC1",99,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"R",n)=report "RTN","RAO7PC1",100,0) ; (a line of text) "RTN","RAO7PC1",101,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"V",n)=verifier IEN "RTN","RAO7PC1",102,0) ; ^signature block name "RTN","RAO7PC1",103,0) ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"TCOM",1)=techno- "RTN","RAO7PC1",104,0) ; logist comment (a line of text) "RTN","RAO7PC1",105,0) ; ^TMP($J,"RAE2",Patient IEN,"PRINT_SET")=null (IFF this is a printset) "RTN","RAO7PC1",106,0) ; ^TMP($J,"RAE2",Patient IEN,"ORD")=name of ordered procedure for "RTN","RAO7PC1",107,0) ; examsets and printsets "RTN","RAO7PC1",108,0) ; ^TMP($J,"RAE2",Patient IEN,"ORD",case IEN)=name of ordered procedure "RTN","RAO7PC1",109,0) ; for that case; not part of an examset or printset "RTN","RAO7PC1",110,0) ; "RTN","RAO7PC1",111,0) K RAU,^TMP($J,"RAE2") S RAU=$$DEL(X) "RTN","RAO7PC1",112,0) I RAU="" K RAU Q "RTN","RAO7PC1",113,0) Q:'$P(X,RAU)!('$P(X,RAU,2)) ; Quit if no Pat. DFN -or- no inv. exam DT "RTN","RAO7PC1",114,0) N RACIEN,RADFN,RAINVXDT,RAPSET,Y S RAPSET=0 "RTN","RAO7PC1",115,0) S RADFN=$P(X,RAU),RAINVXDT=$P(X,RAU,2),RACIEN=+$P(X,RAU,3) "RTN","RAO7PC1",116,0) K RAU Q:'($D(^RADPT(RADFN,"DT",RAINVXDT,0))#2) "RTN","RAO7PC1",117,0) SS I RACIEN D CASE^RAO7PC2(RACIEN) D SVTCOM^RAUTL11(RADFN,RAINVXDT,RACIEN) Q ;P18 mod by SS "RTN","RAO7PC1",118,0) S Y=0 "RTN","RAO7PC1",119,0) F S Y=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y)) Q:Y'>0 D "RTN","RAO7PC1",120,0) . D CASE^RAO7PC2(Y) "RTN","RAO7PC1",121,0) . D SVTCOM^RAUTL11(RADFN,RAINVXDT,Y) ;P18 save TCOM in ^TMP "RTN","RAO7PC1",122,0) . S RAPSET=0 ;P18 modified "RTN","RAO7PC1",123,0) . Q "RTN","RAO7PC1",124,0) Q "RTN","RAO7PC1",125,0) EN30(RAOIFN) ; Return narrative text for exam(s). To be used with the EN3 "RTN","RAO7PC1",126,0) ; entry point above. "RTN","RAO7PC1",127,0) ; Input: RAOIFN -> the ien of Rad/Nuc Med Order "RTN","RAO7PC1",128,0) Q:'RAOIFN ; order passed in as 0 or null "RTN","RAO7PC1",129,0) Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order "RTN","RAO7PC1",130,0) Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order "RTN","RAO7PC1",131,0) N RADFN,RADTI,RACNI,RAXSET "RTN","RAO7PC1",132,0) S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN "RTN","RAO7PC1",133,0) S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI "RTN","RAO7PC1",134,0) S RAXSET=+$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",5) ; set if RAXSET=1 "RTN","RAO7PC1",135,0) I RAXSET D EN3(RADFN_"^"_RADTI_"^") Q ; exam set, hit EN3 code "RTN","RAO7PC1",136,0) ; the following code is executed for non-exam set examinations "RTN","RAO7PC1",137,0) S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0)) Q:'RACNI "RTN","RAO7PC1",138,0) D EN3(RADFN_"^"_RADTI_"^"_RACNI) "RTN","RAO7PC1",139,0) Q "RTN","RAO7PC1",140,0) EN4(RABBRV,RAARY) ; Return Imaging Locations "RTN","RAO7PC1",141,0) ; Input: RABBRV-> Abbreviation for I-Type RAARY-> data storage array "RTN","RAO7PC1",142,0) ; "RTN","RAO7PC1",143,0) ; Output: "RTN","RAO7PC1",144,0) ; array name(location IEN)=File 79.1 IEN^File 44 name^division IEN "RTN","RAO7PC1",145,0) ; ^division name "RTN","RAO7PC1",146,0) ; "RTN","RAO7PC1",147,0) Q:RABBRV']"" ; quit no I-Type abbreviation "RTN","RAO7PC1",148,0) Q:RAARY']"" ; quit no data storage array "RTN","RAO7PC1",149,0) N RADIV,RAITY,RALOC,RAX "RTN","RAO7PC1",150,0) S RAITY=+$O(^RA(79.2,"C",RABBRV,0)) Q:'RAITY "RTN","RAO7PC1",151,0) S RAX=0 F S RAX=$O(^RA(79.1,"BIMG",RAITY,RAX)) Q:RAX'>0 D "RTN","RAO7PC1",152,0) . S RADIV(79)=$G(^RA(79.1,RAX,"DIV")) "RTN","RAO7PC1",153,0) . S RALOC(0)=$G(^RA(79.1,RAX,0)) "RTN","RAO7PC1",154,0) . Q:$P(RALOC(0),"^",19)]"" ;inactive DT present, can't be a future DT "RTN","RAO7PC1",155,0) . S RALOC=$P($G(^SC(+RALOC(0),0)),U) "RTN","RAO7PC1",156,0) . S RALOC=$S(RALOC]"":RALOC,1:"Unknown") "RTN","RAO7PC1",157,0) . S RADIV=+$P($G(^RA(79,+RADIV(79),0)),U),RADIV(4)=$G(^DIC(4,RADIV,0)) "RTN","RAO7PC1",158,0) . S RADIV=$S($P(RADIV(4),U)]"":$P(RADIV(4),U),1:"Unknown") "RTN","RAO7PC1",159,0) . S @(RAARY_"("_RAX_")")=RAX_U_RALOC_U_+RADIV(79)_U_RADIV "RTN","RAO7PC1",160,0) . Q "RTN","RAO7PC1",161,0) Q "RTN","RAO7PC1",162,0) CASE(RAOIFN,RARRAY) ; Return the case numbers and the total number of "RTN","RAO7PC1",163,0) ; case numbers associated with a particular order. "RTN","RAO7PC1",164,0) ; Input: RAOIFN-order ien (75.1) "RTN","RAO7PC1",165,0) ; RARRAY-data storage (local array) "RTN","RAO7PC1",166,0) ; Return: RATTL-n^x where n is the number of cases in the array "RTN","RAO7PC1",167,0) ; x=PRINTSET if a single report covers many cases. "RTN","RAO7PC1",168,0) ; -1 if error (invalid order ien) "RTN","RAO7PC1",169,0) ; -2 no registered case to date -OR- case(s) cancelled "RTN","RAO7PC1",170,0) ; If -1 or -2, second piece of RATTL gives the reason "RTN","RAO7PC1",171,0) ; RARRAY-local data array, array_name(case #) "RTN","RAO7PC1",172,0) N RATTL S RATTL="" D CASE^RAO7PC1A "RTN","RAO7PC1",173,0) Q RATTL "RTN","RAO7PC1",174,0) DEL(X) ; Determine the delimiter used to seperate the data "RTN","RAO7PC1",175,0) ; Input: 'X'-> data seperated by a delimiter (first & second pieces "RTN","RAO7PC1",176,0) ; will follow null) "RTN","RAO7PC1",177,0) N Y,Z "RTN","RAO7PC1",178,0) F Y="^","~","\","&",";","-"," " S Z=$F(X,Y) I +Z Q "RTN","RAO7PC1",179,0) Q $S(+Z>0:Y,1:"") ; pass back the delimiter used, or null if not found "RTN","RAO7PC1A") 0^2^B40550808 "RTN","RAO7PC1A",1,0) RAO7PC1A ;HISC/GJC-Procedure Call utilities (cont) ;1/22/03 12:41 "RTN","RAO7PC1A",2,0) ;;5.0;Radiology/Nuclear Medicine;**1,10,26,31,36**;Mar 16, 1998 "RTN","RAO7PC1A",3,0) SETDATA ; Called from within the EN1 subroutine of RAO7PC1 "RTN","RAO7PC1A",4,0) ; Sets the ^TMP($J,"RAE1",patient ien,Exam ID) node. "RTN","RAO7PC1A",5,0) ; See EN1^RAO7PC1 for further explanation. "RTN","RAO7PC1A",6,0) ; "RTN","RAO7PC1A",7,0) ; Output (new) : "RTN","RAO7PC1A",8,0) ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",1)=cptmod^cptmodname "RTN","RAO7PC1A",9,0) ; ,2)=cptmod^cptmodname "RTN","RAO7PC1A",10,0) N RA,RA1,RA2,RA3 "RTN","RAO7PC1A",11,0) S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0)) "RTN","RAO7PC1A",12,0) S RAITY=+$P(RAREX(0),"^",2),RAILOC=+$P(RAREX(0),"^",4) "RTN","RAO7PC1A",13,0) S RAILOC=$P($G(^SC(+$P($G(^RA(79.1,RAILOC,0)),"^"),0)),"^") "RTN","RAO7PC1A",14,0) S RAITY(0)=$G(^RA(79.2,RAITY,0)) "RTN","RAO7PC1A",15,0) F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D Q:RAXIT "RTN","RAO7PC1A",16,0) . S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0)) "RTN","RAO7PC1A",17,0) . Q:RAXAM(0)="" "RTN","RAO7PC1A",18,0) . S RAORDER=+$P(RAXAM(0),"^",11) "RTN","RAO7PC1A",19,0) . ; quit if exam is WAITING and its order status isn't ACTIVE "RTN","RAO7PC1A",20,0) . ; because this means exam hasn't finished being registered "RTN","RAO7PC1A",21,0) . I $P($G(^RA(72,+$P(RAXAM(0),U,3),0)),U,3)=1,$P($G(^RAO(75.1,RAORDER,0)),U,5)'=6 Q "RTN","RAO7PC1A",22,0) . S RAORDER(7)=$P($G(^RAO(75.1,RAORDER,0)),"^",7) ; CPRS order ien "RTN","RAO7PC1A",23,0) . S RAXSTAT=+$P(RAXAM(0),"^",3),RAXSTAT(0)=$G(^RA(72,RAXSTAT,0)) "RTN","RAO7PC1A",24,0) . S RAXID=RAIBDT_"-"_RANO "RTN","RAO7PC1A",25,0) . S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown") "RTN","RAO7PC1A",26,0) . S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0)) "RTN","RAO7PC1A",27,0) . S RACPT=+$P(RAPRC,"^",9) ; pntr to 81 "RTN","RAO7PC1A",28,0) . S RACPT=$$NAMCODE^RACPTMSC(RACPT,DT) "RTN","RAO7PC1A",29,0) . S RACPT=$S($P(RACPT,"^",2)]"":$P(RACPT,"^"),1:"") "RTN","RAO7PC1A",30,0) . S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown") "RTN","RAO7PC1A",31,0) . ; quit if cancelled exam, and cancelled exams not requested "RTN","RAO7PC1A",32,0) . I ('$G(RACINC)),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) Q "RTN","RAO7PC1A",33,0) . S RADIAG=+$P(RAXAM(0),U,13),RARPT=+$P(RAXAM(0),U,17) "RTN","RAO7PC1A",34,0) .; E3R 17541, 15507 "RTN","RAO7PC1A",35,0) .; if want cancel'd cases returned, and this case is cancelled, then "RTN","RAO7PC1A",36,0) .; also require div param ALLOW RPTS ON CANCELLED CASES? = Y and "RTN","RAO7PC1A",37,0) .; presence of report, else skip this case "RTN","RAO7PC1A",38,0) . I $G(RACINC),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) D Q:RASHOCAN=0 "RTN","RAO7PC1A",39,0) .. S RASHOCAN=0 "RTN","RAO7PC1A",40,0) .. I $P($G(^RA(79,+$P(RAREX(0),"^",3),.1)),"^",22)="Y",RARPT S RASHOCAN=1 "RTN","RAO7PC1A",41,0) .. Q "RTN","RAO7PC1A",42,0) . S RABNOR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,4)) "RTN","RAO7PC1A",43,0) . S:RABNOR'="Y" RABNOR="" "RTN","RAO7PC1A",44,0) . S RABNORMR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,3)) "RTN","RAO7PC1A",45,0) . S:RABNORMR'="Y" RABNORMR="" "RTN","RAO7PC1A",46,0) . S RARPTST=$P($G(^RARPT(RARPT,0)),U,5) "RTN","RAO7PC1A",47,0) . S RARPTST=$S(RARPTST="V":"Verified",RARPTST="R":"Released/Not verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report") "RTN","RAO7PC1A",48,0) . S ^TMP($J,"RAE1",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_RABNOR_U_$S(RARPT=0:"",1:RARPT)_U_$P(RAXSTAT(0),"^",3)_"~"_$P(RAXSTAT(0),"^")_U_RAILOC_U_$P(RAITY(0),"^",3)_"~"_$P(RAITY(0),"^")_U_RABNORMR_U_RACPT_U_$G(RAORDER(7)) "RTN","RAO7PC1A",49,0) . S ^TMP($J,"RAE1",RADFN,RAXID)=^TMP($J,"RAE1",RADFN,RAXID)_U_$S($O(^RARPT(RARPT,2005,0)):"Y",1:"N") "RTN","RAO7PC1A",50,0) . D CPTMOD "RTN","RAO7PC1A",51,0) . S RACNT=RACNT+1 "RTN","RAO7PC1A",52,0) .; "RTN","RAO7PC1A",53,0) .; Condensed Radiology Display in CPRS GUI: "RTN","RAO7PC1A",54,0) .; subtract from count if counting parent; count only 1 case from printset "RTN","RAO7PC1A",55,0) .; and "RTN","RAO7PC1A",56,0) .; store values of MEMBER OF SET and ordered parent procedure name "RTN","RAO7PC1A",57,0) . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P" D "RTN","RAO7PC1A",58,0) .. I $P(RAXAM(0),U,25)="2",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO),-1) S RACNT=RACNT-1 "RTN","RAO7PC1A",59,0) .. I $P(RAXAM(0),U,25) D "RTN","RAO7PC1A",60,0) ... S RA3=$S('RAORDER:"",1:$P($G(^RAMIS(71,+$P($G(^RAO(75.1,+RAORDER,0)),U,2),0)),U)) "RTN","RAO7PC1A",61,0) ... S RA3=$S(RA3'="":RA3,1:"PARENT PROCEDURE") "RTN","RAO7PC1A",62,0) ... S ^TMP($J,"RAE1",RADFN,RAXID,"CPRS")=$P(RAXAM(0),U,25)_U_RA3 "RTN","RAO7PC1A",63,0) ... Q "RTN","RAO7PC1A",64,0) .. Q "RTN","RAO7PC1A",65,0) . S:RACNT=RAEXN RAXIT=1 "RTN","RAO7PC1A",66,0) .; Condensed Radiology Display in CPRS GUI: "RTN","RAO7PC1A",67,0) .; do not exit until all cases of printset have been stored "RTN","RAO7PC1A",68,0) . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) S RAXIT=0 "RTN","RAO7PC1A",69,0) . K RAXSTAT,RAORDER "RTN","RAO7PC1A",70,0) . Q "RTN","RAO7PC1A",71,0) K RAILOC,RAITY "RTN","RAO7PC1A",72,0) Q "RTN","RAO7PC1A",73,0) CASE ; Return the case numbers and the total number of case numbers "RTN","RAO7PC1A",74,0) ; associated with a particular order. Called from CASE^RAO7PC1. "RTN","RAO7PC1A",75,0) ; Sets RARRAY(case #)="" for all cases associated with an order. "RTN","RAO7PC1A",76,0) ; Sets first piece of RATTL to the number of cases found for an "RTN","RAO7PC1A",77,0) ; order, and the second piece is PRINTSET if the report covers "RTN","RAO7PC1A",78,0) ; multiple cases. See CASE^RAO7PC1 for more information. "RTN","RAO7PC1A",79,0) I '$D(^RAO(75.1,RAOIFN,0))#2 S RATTL="-1^invalid order ien" Q "RTN","RAO7PC1A",80,0) I '$D(^RADPT("AO",RAOIFN)) D Q ; case has yet to be registered "RTN","RAO7PC1A",81,0) . S RATTL="-2^no case registered to date" "RTN","RAO7PC1A",82,0) . Q "RTN","RAO7PC1A",83,0) N RACNI,RADFN,RADTI,RAEXAM S RADFN=0 "RTN","RAO7PC1A",84,0) F S RADFN=$O(^RADPT("AO",RAOIFN,RADFN)) Q:RADFN'>0 D "RTN","RAO7PC1A",85,0) . S RADTI=0 "RTN","RAO7PC1A",86,0) . F S RADTI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI)) Q:RADTI'>0 D "RTN","RAO7PC1A",87,0) .. S RACNI=0 "RTN","RAO7PC1A",88,0) .. F S RACNI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI)) Q:RACNI'>0 D "RTN","RAO7PC1A",89,0) ... S RAEXAM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RAO7PC1A",90,0) ... Q:$P($G(^RA(72,+$P(RAEXAM,"^",3),0)),"^",3)=0 ; xam cancelled "RTN","RAO7PC1A",91,0) ... S RATTL=+$G(RATTL)+1,@(RARRAY_"("_+RAEXAM_")")="" "RTN","RAO7PC1A",92,0) ... Q "RTN","RAO7PC1A",93,0) .. Q "RTN","RAO7PC1A",94,0) . Q "RTN","RAO7PC1A",95,0) I 'RATTL S RATTL="-2^cases cancelled" Q "RTN","RAO7PC1A",96,0) S:$P(RAEXAM,"^",25)=2 RATTL=RATTL_"^PRINTSET" ; combined reports "RTN","RAO7PC1A",97,0) Q "RTN","RAO7PC1A",98,0) EN2 ; Return last 7 days of non-cancelled exams "RTN","RAO7PC1A",99,0) ; Required: RADFN (valid patient ien) "RTN","RAO7PC1A",100,0) ; Output: "RTN","RAO7PC1A",101,0) ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^ "RTN","RAO7PC1A",102,0) ; report status^imaging location IEN^imaging location name^ "RTN","RAO7PC1A",103,0) ; m(edia) OR b(ARIUM) OR c(holecystogram) "RTN","RAO7PC1A",104,0) ; "RTN","RAO7PC1A",105,0) ; Exam ID: exam date/time (inverse) concatenated with the case IEN "RTN","RAO7PC1A",106,0) ; "RTN","RAO7PC1A",107,0) Q:'$D(RADFN) Q:'RADFN K ^TMP($J,"RAE7") "RTN","RAO7PC1A",108,0) N RABAR,RABDT,RACGRAM,RACNST,RACNTST,RACSE,RADT,RAEDT,RAIBDT "RTN","RAO7PC1A",109,0) N RAIEDT,RALOC,RAMEDIA,RANO,RAPRC,RAREX,RARPT,RARPTST,RAXAM,RAXID "RTN","RAO7PC1A",110,0) N RAXSTAT "RTN","RAO7PC1A",111,0) S RADT=$S($D(DT)#2:DT,1:$$DT^XLFDT()),RACNST=9999999.9999 "RTN","RAO7PC1A",112,0) S RABDT=$$FMADD^XLFDT(RADT,-7,0,0,0),RAEDT=RADT "RTN","RAO7PC1A",113,0) S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001) "RTN","RAO7PC1A",114,0) F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D "RTN","RAO7PC1A",115,0) . S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0)) "RTN","RAO7PC1A",116,0) . S RALOC=+$P(RAREX(0),U,4),RALOC(0)=$G(^RA(79.1,RALOC,0)) "RTN","RAO7PC1A",117,0) . S RALOC=$P($G(^SC(+RALOC(0),0)),"^") "RTN","RAO7PC1A",118,0) . F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D "RTN","RAO7PC1A",119,0) .. S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0)) "RTN","RAO7PC1A",120,0) .. S RAXID=RAIBDT_"-"_RANO "RTN","RAO7PC1A",121,0) .. S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown") "RTN","RAO7PC1A",122,0) .. S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0)) "RTN","RAO7PC1A",123,0) .. S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown") "RTN","RAO7PC1A",124,0) .. Q:$P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0 ; cancelled xam "RTN","RAO7PC1A",125,0) .. S RABAR=$$UP^XLFSTR($P(RAXAM(0),U,5)) "RTN","RAO7PC1A",126,0) .. S RABAR=$S(RABAR="Y":"b",1:"") "RTN","RAO7PC1A",127,0) .. S RACMEDIA=$$UP^XLFSTR($P(RAXAM(0),U,10)) "RTN","RAO7PC1A",128,0) .. S RACMEDIA=$S(RACMEDIA="Y":"m",1:"") "RTN","RAO7PC1A",129,0) .. S RACGRAM=$S($D(^RAMIS(71,"AC",11,+$P(RAXAM(0),U,2))):"c",1:"") "RTN","RAO7PC1A",130,0) .. S RACNTST=RABAR_RACGRAM_RACMEDIA "RTN","RAO7PC1A",131,0) .. S RARPT=+$P(RAXAM(0),U,17) "RTN","RAO7PC1A",132,0) .. S RARPTST=$P($G(^RARPT(RARPT,0)),U,5) "RTN","RAO7PC1A",133,0) .. S RARPTST=$S(RARPTST="V":"Verified",RARPTST="R":"Released/Not verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report") "RTN","RAO7PC1A",134,0) .. S ^TMP($J,"RAE7",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_+RALOC(0)_U_RALOC_U_RACNTST "RTN","RAO7PC1A",135,0) .. Q "RTN","RAO7PC1A",136,0) . Q "RTN","RAO7PC1A",137,0) Q "RTN","RAO7PC1A",138,0) CPTMOD ;extract cpt modifiers if any "RTN","RAO7PC1A",139,0) ;RA loop var, RA1 counter, RA2 intermed vars "RTN","RAO7PC1A",140,0) Q:'$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",0)) "RTN","RAO7PC1A",141,0) S RA=0,RA1=1 "RTN","RAO7PC1A",142,0) F S RA=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA)) Q:'RA I $D(^(RA,0)) D "RTN","RAO7PC1A",143,0) . S RA2=$P(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA,0),"^") "RTN","RAO7PC1A",144,0) . S RA2=$$BASICMOD^RACPTMSC(RA2,+RAREX(0)) Q:+RA2<0 "RTN","RAO7PC1A",145,0) . S ^TMP($J,"RAE1",RADFN,RAXID,"CMOD",RA1)=$P(RA2,"^",2)_"^"_$P(RA2,"^",3),RA1=RA1+1 "RTN","RAO7PC1A",146,0) Q "VER") 8.0^22 **END** **END**