- 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
- 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