SRTPASS ;BIR/SJA - SELECT ASSESSMENT ;02/28/08
;;3.0; Surgery ;**167**;24 Jun 93;Build 27
W !! S (SRDT,CNT)=0 F I=0:0 S SRDT=$O(^SRT("ADT",DFN,SRDT)) Q:'SRDT!(SRSOUT) S SRASS=0 F I=0:0 S SRASS=$O(^SRT("ADT",DFN,SRDT,SRASS)) Q:'SRASS!($D(SRTPP))!(SRSOUT) D LIST
Q
LIST ; list assessments
I $Y+5>IOSL S SRBACK=0 D SEL Q:$D(SRTPP)!(SRSOUT) I SRBACK S CNT=0,SRASS=SRCASE(1)-1,SRDT=$P(SRCASE(1),"^",2) W @IOF,!,?1,VADM(1)_" "_VA("PID"),! Q
S CNT=CNT+1,SRSDATE=$P(^SRT(SRASS,0),"^",2)
DISP S SROPER=$$TR^SRTPUTL($P(^SRT(SRASS,"RA"),"^",2))_" TRANSPLANT"
S SR("RA")=$G(^SRT(SRASS,"RA")),Z=$P(SR("RA"),"^"),STATUS=$S(Z="I":"INCOMPLETE",Z="C":"COMPLETED",Z="T":"TRANSMITTED",1:"INCOMPLETE")
S SROPER=SROPER_$S($P(SR("RA"),"^",5)="N":" (NON-VA)",1:"")
S SROPER=SROPER_" ("_STATUS_")"
I '$D(SRTPP) W CNT_". "
CASE W $E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3),?14,SROPER
I $D(SRTPP) Q
W !! S SRCASE(CNT)=SRASS_"^"_SRDT
Q
SEL ; select case
W !!!,"Select Assessment, or enter <RET> to continue listing Assessments: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
I X="" W @IOF,!,?1,VADM(1)_" "_VA("PID"),!! Q
I '$D(SRCASE(X)) W !!,"Please enter the number corresponding to the Transplant Assessment you want",!,"to edit. If the assessment desired does not appear, enter <RET> to continue",!,"listing additional assessments."
I '$D(SRCASE(X)) W !!,"Press <RET> to continue " R X:DTIME S:'$T SRSOUT=1 S SRBACK=1 Q
S SRTPP=+SRCASE(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPASS 1471 printed Oct 16, 2024@18:48:50 Page 2
SRTPASS ;BIR/SJA - SELECT ASSESSMENT ;02/28/08
+1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
+2 WRITE !!
SET (SRDT,CNT)=0
FOR I=0:0
SET SRDT=$ORDER(^SRT("ADT",DFN,SRDT))
if 'SRDT!(SRSOUT)
QUIT
SET SRASS=0
FOR I=0:0
SET SRASS=$ORDER(^SRT("ADT",DFN,SRDT,SRASS))
if 'SRASS!($DATA(SRTPP))!(SRSOUT)
QUIT
DO LIST
+3 QUIT
LIST ; list assessments
+1 IF $Y+5>IOSL
SET SRBACK=0
DO SEL
if $DATA(SRTPP)!(SRSOUT)
QUIT
IF SRBACK
SET CNT=0
SET SRASS=SRCASE(1)-1
SET SRDT=$PIECE(SRCASE(1),"^",2)
WRITE @IOF,!,?1,VADM(1)_" "_VA("PID"),!
QUIT
+2 SET CNT=CNT+1
SET SRSDATE=$PIECE(^SRT(SRASS,0),"^",2)
DISP SET SROPER=$$TR^SRTPUTL($PIECE(^SRT(SRASS,"RA"),"^",2))_" TRANSPLANT"
+1 SET SR("RA")=$GET(^SRT(SRASS,"RA"))
SET Z=$PIECE(SR("RA"),"^")
SET STATUS=$SELECT(Z="I":"INCOMPLETE",Z="C":"COMPLETED",Z="T":"TRANSMITTED",1:"INCOMPLETE")
+2 SET SROPER=SROPER_$SELECT($PIECE(SR("RA"),"^",5)="N":" (NON-VA)",1:"")
+3 SET SROPER=SROPER_" ("_STATUS_")"
+4 IF '$DATA(SRTPP)
WRITE CNT_". "
CASE WRITE $EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_$EXTRACT(SRSDATE,2,3),?14,SROPER
+1 IF $DATA(SRTPP)
QUIT
+2 WRITE !!
SET SRCASE(CNT)=SRASS_"^"_SRDT
+3 QUIT
SEL ; select case
+1 WRITE !!!,"Select Assessment, or enter <RET> to continue listing Assessments: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+2 IF X=""
WRITE @IOF,!,?1,VADM(1)_" "_VA("PID"),!!
QUIT
+3 IF '$DATA(SRCASE(X))
WRITE !!,"Please enter the number corresponding to the Transplant Assessment you want",!,"to edit. If the assessment desired does not appear, enter <RET> to continue",!,"listing additional assessments."
+4 IF '$DATA(SRCASE(X))
WRITE !!,"Press <RET> to continue "
READ X:DTIME
if '$TEST
SET SRSOUT=1
SET SRBACK=1
QUIT
+5 SET SRTPP=+SRCASE(X)
+6 QUIT
