SRTPLST ;BIR/SJA - LIST ASSESSMENTS ;04/11/08
;;3.0; Surgery ;**167**;24 Jun 93;Build 27
I $E(IOST)="P" D ^SRTPLSTP Q
S SRSOUT=0,$P(LINE,"=",80)="",$P(LINE1,"-",80)="" D HDR
F S SRSD=$O(^SRT("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTPP=0 F S SRTPP=$O(^SRT("AC",SRSD,SRTPP)) Q:'SRTPP!SRSOUT S SR("RA")=$G(^SRT(SRTPP,"RA")) D
.I (SRAST="ALL"!(SRAST[$P(SR("RA"),"^"))),$D(^SRT(SRTPP,0)),$$MANDIV(SRINSTP,SRTPP) D PRT
Q
PRT ; print assessments
I '$D(^SRT(SRTPP,"RA")) Q
I SRTYPE'="ALL",(SRTYPE'=$P(^SRT(SRTPP,"RA"),"^",2)) Q
I $Y+5>IOSL D PAGE I SRSOUT Q
S SRA(0)=^SRT(SRTPP,0),DFN=$P(SRA(0),"^"),SRVACO=$P(^SRT(SRTPP,.01),"^",11),SR("RA")=$G(^SRT(SRTPP,"RA"))
N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM
I $L(SRANM)>19 S SRANM=$P(SRANM,",")_","_$E($P(SRANM,",",2))_"."
S Y=$P(SRA(0),"^",2) D D^DIQ S SRDT=$P(Y,"@")
S Y=$P(SR("RA"),"^")
W !,SRVACO,?16,SRANM_" ("_VA("PID")_")",?51,SRDT,?68,$S(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),!,$S($P(SRA(0),"^",3):$P(SRA(0),"^",3),1:"N/A")
S Y=$P(SR("RA"),"^",2) W ?16,$S(Y="LI":"LIVER",Y="LU":"LUNG",Y="K":"KIDNEY",Y="H":"HEART",1:"")
W !,LINE1
Q
PAGE W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
I X["?" W !!,"If you want to continue listing incomplete assessments, enter <RET>. Enter",!,"'^' to return to the menu." G PAGE
HDR ; print heading
S $P(LINE,"=",80)="",X="LIST OF TRANSPLANT ASSESSMENTS"
W @IOF,!!,?(80-$L(X)\2),X
W !,?(80-$L(SRFRTO)\2),SRFRTO
W !!,"VACO ID",?16,"PATIENT",?51,"TRANSPLANT DATE",?68,"STATUS",!,"SURGERY CASE #",?16,"ORGAN TYPE"
W !,LINE
Q
MANDIV(SRINST,CASE) ;a boolean divisional call for managerial reports
I '$D(^SRT(CASE,0)) Q 0
I '$O(^SRO(133,1)) Q 1
I SRINST["ALL" Q 1
I +SRINST'>0 Q 0
N SRDIV,SROR
S SRDIV=$P($G(^SRT(CASE,8)),U)
Q SRDIV=SRINST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPLST 1869 printed Sep 23, 2025@20:24:59 Page 2
SRTPLST ;BIR/SJA - LIST ASSESSMENTS ;04/11/08
+1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
+2 IF $EXTRACT(IOST)="P"
DO ^SRTPLSTP
QUIT
+3 SET SRSOUT=0
SET $PIECE(LINE,"=",80)=""
SET $PIECE(LINE1,"-",80)=""
DO HDR
+4 FOR
SET SRSD=$ORDER(^SRT("AC",SRSD))
if 'SRSD!(SRSD>SRED)!SRSOUT
QUIT
SET SRTPP=0
FOR
SET SRTPP=$ORDER(^SRT("AC",SRSD,SRTPP))
if 'SRTPP!SRSOUT
QUIT
SET SR("RA")=$GET(^SRT(SRTPP,"RA"))
Begin DoDot:1
+5 IF (SRAST="ALL"!(SRAST[$PIECE(SR("RA"),"^")))
IF $DATA(^SRT(SRTPP,0))
IF $$MANDIV(SRINSTP,SRTPP)
DO PRT
End DoDot:1
+6 QUIT
PRT ; print assessments
+1 IF '$DATA(^SRT(SRTPP,"RA"))
QUIT
+2 IF SRTYPE'="ALL"
IF (SRTYPE'=$PIECE(^SRT(SRTPP,"RA"),"^",2))
QUIT
+3 IF $Y+5>IOSL
DO PAGE
IF SRSOUT
QUIT
+4 SET SRA(0)=^SRT(SRTPP,0)
SET DFN=$PIECE(SRA(0),"^")
SET SRVACO=$PIECE(^SRT(SRTPP,.01),"^",11)
SET SR("RA")=$GET(^SRT(SRTPP,"RA"))
+5 NEW I
DO DEM^VADPT
SET SRANM=VADM(1)
SET SRASSN=VA("PID")
KILL VADM
+6 IF $LENGTH(SRANM)>19
SET SRANM=$PIECE(SRANM,",")_","_$EXTRACT($PIECE(SRANM,",",2))_"."
+7 SET Y=$PIECE(SRA(0),"^",2)
DO D^DIQ
SET SRDT=$PIECE(Y,"@")
+8 SET Y=$PIECE(SR("RA"),"^")
+9 WRITE !,SRVACO,?16,SRANM_" ("_VA("PID")_")",?51,SRDT,?68,$SELECT(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),!,$SELECT($PIECE(SRA(0),"^",3):$PIECE(SRA(0),"^",3),1:"N/A")
+10 SET Y=$PIECE(SR("RA"),"^",2)
WRITE ?16,$SELECT(Y="LI":"LIVER",Y="LU":"LUNG",Y="K":"KIDNEY",Y="H":"HEART",1:"")
+11 WRITE !,LINE1
+12 QUIT
PAGE WRITE !!,"Press <RET> to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 IF X["?"
WRITE !!,"If you want to continue listing incomplete assessments, enter <RET>. Enter",!,"'^' to return to the menu."
GOTO PAGE
HDR ; print heading
+1 SET $PIECE(LINE,"=",80)=""
SET X="LIST OF TRANSPLANT ASSESSMENTS"
+2 WRITE @IOF,!!,?(80-$LENGTH(X)\2),X
+3 WRITE !,?(80-$LENGTH(SRFRTO)\2),SRFRTO
+4 WRITE !!,"VACO ID",?16,"PATIENT",?51,"TRANSPLANT DATE",?68,"STATUS",!,"SURGERY CASE #",?16,"ORGAN TYPE"
+5 WRITE !,LINE
+6 QUIT
MANDIV(SRINST,CASE) ;a boolean divisional call for managerial reports
+1 IF '$DATA(^SRT(CASE,0))
QUIT 0
+2 IF '$ORDER(^SRO(133,1))
QUIT 1
+3 IF SRINST["ALL"
QUIT 1
+4 IF +SRINST'>0
QUIT 0
+5 NEW SRDIV,SROR
+6 SET SRDIV=$PIECE($GET(^SRT(CASE,8)),U)
+7 QUIT SRDIV=SRINST
