Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RACNLU

RACNLU.m

Go to the documentation of this file.
  1. RACNLU ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Case Number Lookup ;11/13/00 09:13
  1. ;;5.0;Radiology/Nuclear Medicine;**7,15,23,47**;Mar 16, 1998;Build 21
  1. CASE N RADIV,RAIMAGE,RANODE
  1. R !!,"Enter Case Number: ",X:DTIME S:'$T!(X="") X="^" G Q:X="^"
  1. I X?1A W !?3,*7,"You must enter more than one character of the name!" G CASE
  1. I X?1A.AP!(X?1A4N)!(X?9N) S RAHEAD="**** Case Lookup by Patient ****",DIC(0)="EMQ" D ^RADPA G CASE:Y<0 S RADFN=+Y G ^RAPTLU
  1. I X?16.N.E D QUES G CASE
  1. D SPACE:X=" " G Q:X="^" D QUES:'X&(X'="??") G CASE:X="^" D SEL G CASE:"^"[X!('RACNT) F I=1:1:11 S @$P("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",I)=$P(Y,"^",I)
  1. W:RACNT'=1 !!?1,"Case No.: ",RACN,?16,"Procedure: ",$E(RAPRC,1,30),?58,"Name: ",$E(RANME,1,20)
  1. I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S ^DISV($S($D(DUZ)#2:DUZ,1:0),"RA","CASE #")=RADFN_"^"_RADTI_"^"_RACNI,Y(0)=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
  1. Q K I,RACNT,RADTCN,RAEND,RAFL,RAFST,RAIX,^TMP("MAG",$J,"COL"),^TMP("MAG",$J,"ROW") Q
  1. ;
  1. SEL ;
  1. K ^TMP($J,"RAEX") S RACNT=0 G ADC:X["-" S RAFST=$S(X:X-.01,1:0),RAEND=$S(X:X,1:99999),X="",RAIX="AE"
  1. ;S RAXHOLD=X ;don't need MAG calls anymore 111300
  1. ;I $$IMAGE^RARIC1 D MED^MAGSET3,ERASE^MAGSET3
  1. ;S X=RAXHOLD K RAXHOLD
  1. F RACN=RAFST:0 Q:X="^"!(X>0) S RACN=$O(^RADPT(RAIX,RACN)) Q:RACN'>0!(RACN>RAEND) F RADFN=0:0 S RADFN=$O(^RADPT(RAIX,RACN,RADFN)) Q:RADFN'>0 S RADTI=$O(^(RADFN,0)),RACNI=$O(^(RADTI,0)) S X="" D PRT Q:X="^"!(X>0)
  1. G CHK
  1. ADC ;S RAIX="ADC",RACN=$P(X,"-",2),RADTCN=X,X=""
  1. S RAIX="ADC",RACN=$P(X,"-",$L(X,"-")),RADTCN=$S($L(X,"-")=3:$P(X,"-",2,3),1:X),X=""
  1. F RADFN=0:0 S RADFN=$O(^RADPT(RAIX,RADTCN,RADFN)) Q:RADFN'>0 S RADTI=$O(^(RADFN,0)),RACNI=$O(^(RADTI,0)) S X="" D PRT Q:X="^"!(X>0)
  1. I 'RACNT D ADC1
  1. CHK Q:X="^"!(X>0) I 'RACNT W !?3,*7,"No matches found!" Q
  1. ;Q:X="^"!(X>0) I 'RACNT W !?3,*7,"No matches found!" Q
  1. I RACNT=1 S X=1,Y=^TMP($J,"RAEX",1) D:$D(RAOPT("EDITCN")) CHECK Q
  1. CHK1 Q:'(RACNT#15) W !,"CHOOSE FROM 1-",RACNT,": " R X:DTIME S:'$T!(X="") X="^" Q:X="^" I X["?" D HLP G CHK1
  1. I '$D(^TMP($J,"RAEX",+X)) S X="^" W *7," ??" Q
  1. S Y=^TMP($J,"RAEX",+X) D:$D(RAOPT("EDITCN")) CHECK Q
  1. PRT S RAFL=0 Q:'$D(^RADPT(RADFN,0))!('$D(^DPT(RADFN,0))) S RANME=^(0),RASSN=$$SSN^RAUTL,RANME=$P(RANME,"^")
  1. K RADIV ;this var must be cleared so can detect bad ^RADPT("AE" ;111500
  1. I $D(^RADPT(RADFN,"DT",RADTI,0)) D Q:'RAFL
  1. . S RANODE=$G(^RADPT(RADFN,"DT",RADTI,0))
  1. . S RADIV=+$P(RANODE,"^",3),RAIMAGE=+$P(RANODE,"^",2),RADIVIEN=RADIV
  1. . S RADIV=+$G(^RA(79,RADIV,0)),RADIV=$P($G(^DIC(4,RADIV,0)),"^")
  1. . S:RADIV']"" RADIV="Unknown"
  1. . S RAIMAGE=$P($G(^RA(79.2,RAIMAGE,0)),"^")
  1. . S:RAIMAGE']"" RAIMAGE="Unknown"
  1. . S (Y,RADTE)=+$P(RANODE,"^") D D^RAUTL S RADATE=Y
  1. . I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RAFL=1,Y=^(0)
  1. . Q
  1. I '$D(RADIV) Q ;possible corrupted "AE" active case x-ref on ^RADPT
  1. ; pointing to a non-existent visit node
  1. ; Note: if $D(ORVP) the screen logic is to be ignored. We have entered
  1. ; through OE/RR. Even if we are not screening, the user may have
  1. ; already selected various Division(s) and Imaging type(s) which are
  1. ; in ^TMP($J,"RA D-TYPE" and ^TMP($J,"RA I-TYPE". If RANOSCRN is
  1. ; defined, it means no screening by imaging types to which the
  1. ; user has access privilege.
  1. I '$D(ORVP),($D(RANOSCRN)),('$D(RADUPSCN)) I $D(^TMP($J,"RA D-TYPE"))!($D(^TMP($J,"RA I-TYPE"))) Q:'$D(^TMP($J,"RA D-TYPE",RADIV))!('$D(^TMP($J,"RA I-TYPE",RAIMAGE)))
  1. ; If in 'Case No. Exam Edit' option, skip i-type check in the next line
  1. I '$D(ORVP),('$D(RADUPSCN)),('$D(RAOPT("EDITCN"))) Q:$$IMGTY^RAUTL12("e",RADFN,RADTI)'=RAIMGTY&('$D(RANOSCRN))
  1. S RAST=+$P(Y,"^",3),RARPT=+$P(Y,"^",17),RAPRC=$S($D(^RAMIS(71,+$P(Y,"^",2),0)):$P(^(0),"^"),1:"Unknown"),RACNT=RACNT+1
  1. S ^TMP($J,"RAEX",RACNT)=RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"_RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST
  1. ;I $$IMAGE^RARIC1 D DISPA^MAGRIC ; don't need MAG calls anymore 111300
  1. I RACNT=1,$S('$D(RAEND):1,RAEND<99999:1,1:0),$D(RAVW),$O(^RADPT(RAIX,$S(RAIX="ADC":RADTCN,1:RACN),RADFN))'>0 S X=1,Y=^TMP($J,"RAEX",1) Q
  1. N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
  1. S RACNDSP=$S((RASSAN'=""):RASSAN,1:$$LCASE(RADTE,RACN))
  1. I $$USESSAN^RAHLRU1() D HD:RACNT=1 W !?1,RACNT,?7,RACNDSP W:$O(^RARPT(RARPT,2005,0)) ?22,"i" W ?24,$E(RAPRC,1,25),?50,$E(RANME,1,22),?74,$$SSN^RAUTL(RADFN,1) Q:RACNT#15
  1. I '$$USESSAN^RAHLRU1() D HD:RACNT=1 W !?1,RACNT,?7,$$LCASE(RADTE,RACN) W:$O(^RARPT(RARPT,2005,0)) ?22,"i" W ?24,$E(RAPRC,1,25),?50,$E(RANME,1,22),?74,$$SSN^RAUTL(RADFN,1) Q:RACNT#15
  1. PRT1 W !,"Type '^' to STOP, or",!,"CHOOSE FROM 1-",RACNT,": " R X:DTIME S:'$T X="^" Q:X="^"!(X="") I X["?" D HLP G PRT1
  1. I '$D(^TMP($J,"RAEX",+X)) W *7," ??" S X="^" Q
  1. S X=+X,Y=^TMP($J,"RAEX",X) Q
  1. ;
  1. HD W !!,"Choice",?7,"Case No.",?24,"Procedure",?50,"Name",?74,"Pt ID",!,"------",?7,"---------------",?24,"---------",?50,"-----------------",?74,"------" Q
  1. ;
  1. SPACE I $D(^DISV($S($D(DUZ)#2:DUZ,1:0),"RA","CASE #")) S X=^("CASE #") I $D(^RADPT(+$P(X,"^"),"DT",+$P(X,"^",2),"P",+$P(X,"^",3),0)) S RADTX=$P($P(X,"^",2),"."),X=+^(0) S X=$$LCASE(9999999-RADTX,X) W " ",X K RADTX Q
  1. S X="^" Q
  1. ;
  1. QUES W !,"Enter an active case number in the following form '999'..."
  1. W !?10,"...or enter a completed case number as 'MMDDYY-999'"
  1. W !?10,"...or enter a patient's name"
  1. W !?10,"...or enter a patient's 9-digit SSN"
  1. W !?10,"...or enter the first character of the patient's",!?13,"last name and the last four digits of their SSN."
  1. ASKACT R !!,"Do you wish to see the entire list of active cases? NO// ",X:DTIME S X=$E(X) S:'$T!("Nn"[X) X="^" I "Yy"'[X,X'="^" W:X'="?" *7 W !!?3,"Enter 'YES' to list all active cases, or 'NO' not to." G ASKACT
  1. S:"Yy"[X X="??" Q
  1. HLP W !!?3,"Enter the number corresponding to the exam you wish to select.",! Q
  1. LCASE(RADT,RACN) ; Pass back the long case number.
  1. ; Input : RADT -> FM date (internal format)
  1. ; RACN -> Case #
  1. ; Output: long case number i.e, '010197-100'
  1. ; RTK 3/16/2009 ADDED NEXT 2 LINES FOR USE WITH SSAN P47
  1. Q $TR($TR($$FMTE^XLFDT(RADT,"2FD")," ","0"),"/","")_"-"_RACN
  1. CHECK ; Check if the exam selected is of the same imaging type as the sign-on
  1. ; location. Must be in the 'Case No. Exam Edit' option.
  1. Q:'$D(RAOPT("EDITCN")) N RAMASK,RARTRN S RAMASK=Y
  1. I $$IMGTY^RAUTL12("e",$P(Y,"^"),$P(Y,"^",2))'=RAIMGTY D
  1. . N X S RARTRN=$$SW^RAPSET1($$IMGTY^RAUTL12("e",$P(Y,"^"),$P(Y,"^",2)),RAIMGTY)
  1. . Q
  1. W:+$G(RARTRN) !!,$P(RARTRN,"^",2),$C(7)
  1. S Y=RAMASK
  1. I +$G(RARTRN) S X="^" K RADFN,RADTI,RACNI,RANME,RASSN,RADATE,RADTE,RACN,RAPRC,RARPT,RAST,RAEND,RAFST,RAIX
  1. Q
  1. ADC1 ;
  1. S RAIX="ADC1"
  1. F RADFN=0:0 S RADFN=$O(^RADPT(RAIX,RADTCN,RADFN)) Q:RADFN'>0 S RADTI=$O(^(RADFN,0)),RACNI=$O(^(RADTI,0)) S X="" D PRT Q:X="^"!(X>0)