RASTEXT1 ;HISC/CAH,FPT,GJC AISC/TMP,TAC-Selection of patient for status tracking ;9/4/97 15:10
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
SELECT ;
S RACONTIN=0 ;ft
I RADTI,(($O(^TMP($J,"RASTEXT",RADTI))>0)!($O(^TMP($J,"RASTEXT",RADTI,I1))>0)) S RACONTIN=1
W !!,"Enter " W:RAED "Case #, " W "Status, (N)ext status" W:RACONTIN ", (C)ontinue"
W ", '^' to Stop: "_$S(RACONTIN=1:"CONTINUE",1:"NEXT")_"// " R RAX:DTIME I '$T S RAQ=1 Q
G:RAX["?" HELP S:RAX="^" RAQ=1 Q:RAQ
I RAX="" S RAX=$S(RACONTIN=1:"C",1:"N")
G NEXT:"Nn"[$E(RAX)
G:RAX?1N.E&(RAED) CASE
S RAX=$$UP^XLFSTR(RAX)
I RAX=$E("CONTINUE",1,$L(RAX)) S RAX="C"
G:RAX?1A.E SEL1
HELP W:RAX'["?" *7
W !!,"Enter " W:RAED "a case number OR",!,"Multiple case #'s separated by commas OR",! W "The name of another status OR",!,"'N' to get the screen containing the next status"
W:RADTI " OR",!,"'C' to continue with the next screen of patients for this status"
G SELECT
;
SEL1 I "Cc"[RAX,RADTI,($O(^TMP($J,"RASTEXT",RADTI))>0!($O(^(RADTI,I1))>0)) Q
I "Cc"[RAX,'RADTI G HELP
S DIC="^RA(72,",DIC(0)="EQZF",X=RAX
S DIC("S")="S RAZ=^(0) I $P(RAZ,U,3)>0,(+$P(RAZ,U,7)=+$O(^RA(79.2,""B"",RAIMGTY,0))),($P(RAZ,U,3)'>8),($P(RAZ,U,5)=""Y"")"
D ^DIC K DIC("S"),RAZ I Y'>0 W !,"Status ",RAX," not selected." G SELECT
I $P(Y(0),"^",3)>0,$D(^RADPT("AS",+Y)) K ^TMP($J,"RASTEXT") S RASTAT=+Y,RAORD=$P(Y(0),"^",3) D START^RASTEXT S (RADTI,RACTR)=0 Q
W *7,!,"No data exists for status ",$P(Y(0),"^") G SELECT
;
CASE S X=RAX D ^RASTED Q:RAXIT K ^TMP($J,"RASTEXT") D START^RASTEXT S (RADFN,RACTR,RADTI)=0 Q
;
NEXT I $O(RASEQARR(RAORD))=""!($O(RASEQARR(RAORD))>8) W *7,!,"Last status - Do you want to start over? YES// " R RAX:DTIME S:'$T RAQ=1 S RAX=$E(RAX) D Q:RAQ G:'$D(RAX) NEXT S RAORD=""
.I RAX="?" W !!,"Answer YES or NO",! K RAX Q
.S:"Yy"'[RAX!(RAX="^") RAQ=1
K ^TMP($J,"RASTEXT") D NXTSTAT,START^RASTEXT G NEXT:'RACTR S (RACTR,RADTI)=0
Q
;
NXTSTAT ;get next status
S RAORD=$O(RASEQARR(RAORD)),RASTAT=RASEQARR(RAORD) I $D(^RA(72,+RASTAT,0)),$P(^(0),"^",5)'="Y" Q:'RAORD!(RAORD>8) G NXTSTAT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRASTEXT1 2107 printed Oct 16, 2024@18:40:28 Page 2
RASTEXT1 ;HISC/CAH,FPT,GJC AISC/TMP,TAC-Selection of patient for status tracking ;9/4/97 15:10
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
SELECT ;
+1 ;ft
SET RACONTIN=0
+2 IF RADTI
IF (($ORDER(^TMP($JOB,"RASTEXT",RADTI))>0)!($ORDER(^TMP($JOB,"RASTEXT",RADTI,I1))>0))
SET RACONTIN=1
+3 WRITE !!,"Enter "
if RAED
WRITE "Case #, "
WRITE "Status, (N)ext status"
if RACONTIN
WRITE ", (C)ontinue"
+4 WRITE ", '^' to Stop: "_$SELECT(RACONTIN=1:"CONTINUE",1:"NEXT")_"// "
READ RAX:DTIME
IF '$TEST
SET RAQ=1
QUIT
+5 if RAX["?"
GOTO HELP
if RAX="^"
SET RAQ=1
if RAQ
QUIT
+6 IF RAX=""
SET RAX=$SELECT(RACONTIN=1:"C",1:"N")
+7 if "Nn"[$EXTRACT(RAX)
GOTO NEXT
+8 if RAX?1N.E&(RAED)
GOTO CASE
+9 SET RAX=$$UP^XLFSTR(RAX)
+10 IF RAX=$EXTRACT("CONTINUE",1,$LENGTH(RAX))
SET RAX="C"
+11 if RAX?1A.E
GOTO SEL1
HELP if RAX'["?"
WRITE *7
+1 WRITE !!,"Enter "
if RAED
WRITE "a case number OR",!,"Multiple case #'s separated by commas OR",!
WRITE "The name of another status OR",!,"'N' to get the screen containing the next status"
+2 if RADTI
WRITE " OR",!,"'C' to continue with the next screen of patients for this status"
+3 GOTO SELECT
+4 ;
SEL1 IF "Cc"[RAX
IF RADTI
IF ($ORDER(^TMP($JOB,"RASTEXT",RADTI))>0!($ORDER(^(RADTI,I1))>0))
QUIT
+1 IF "Cc"[RAX
IF 'RADTI
GOTO HELP
+2 SET DIC="^RA(72,"
SET DIC(0)="EQZF"
SET X=RAX
+3 SET DIC("S")="S RAZ=^(0) I $P(RAZ,U,3)>0,(+$P(RAZ,U,7)=+$O(^RA(79.2,""B"",RAIMGTY,0))),($P(RAZ,U,3)'>8),($P(RAZ,U,5)=""Y"")"
+4 DO ^DIC
KILL DIC("S"),RAZ
IF Y'>0
WRITE !,"Status ",RAX," not selected."
GOTO SELECT
+5 IF $PIECE(Y(0),"^",3)>0
IF $DATA(^RADPT("AS",+Y))
KILL ^TMP($JOB,"RASTEXT")
SET RASTAT=+Y
SET RAORD=$PIECE(Y(0),"^",3)
DO START^RASTEXT
SET (RADTI,RACTR)=0
QUIT
+6 WRITE *7,!,"No data exists for status ",$PIECE(Y(0),"^")
GOTO SELECT
+7 ;
CASE SET X=RAX
DO ^RASTED
if RAXIT
QUIT
KILL ^TMP($JOB,"RASTEXT")
DO START^RASTEXT
SET (RADFN,RACTR,RADTI)=0
QUIT
+1 ;
NEXT IF $ORDER(RASEQARR(RAORD))=""!($ORDER(RASEQARR(RAORD))>8)
WRITE *7,!,"Last status - Do you want to start over? YES// "
READ RAX:DTIME
if '$TEST
SET RAQ=1
SET RAX=$EXTRACT(RAX)
Begin DoDot:1
+1 IF RAX="?"
WRITE !!,"Answer YES or NO",!
KILL RAX
QUIT
+2 if "Yy"'[RAX!(RAX="^")
SET RAQ=1
End DoDot:1
if RAQ
QUIT
if '$DATA(RAX)
GOTO NEXT
SET RAORD=""
+3 KILL ^TMP($JOB,"RASTEXT")
DO NXTSTAT
DO START^RASTEXT
if 'RACTR
GOTO NEXT
SET (RACTR,RADTI)=0
+4 QUIT
+5 ;
NXTSTAT ;get next status
+1 SET RAORD=$ORDER(RASEQARR(RAORD))
SET RASTAT=RASEQARR(RAORD)
IF $DATA(^RA(72,+RASTAT,0))
IF $PIECE(^(0),"^",5)'="Y"
if 'RAORD!(RAORD>8)
QUIT
GOTO NXTSTAT
+2 QUIT
