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