SRTPLSTP ;BIR/SJA - LIST ASSESSMENTS ;04/11/08
;;3.0; Surgery ;**167**;24 Jun 93;Build 27
S (SRPAGE,SRSOUT,SRDFN)=0,$P(LINE,"=",132)="",$P(LINE1,"-",132)=""
D HDR Q:SRSOUT
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 HDR I SRSOUT Q
S SRA(0)=^SRT(SRTPP,0),SRVACO=$P(^SRT(SRTPP,.01),"^",11),DFN=$P(SRA(0),"^"),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")_")",?52,SRDT,?70,$S(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),?87,$S($P(SRA(0),"^",3):$P(SRA(0),"^",3),1:"N/A")
S Y=$P(SR("RA"),"^",2) W ?107,$S(Y="LI":"LIVER",Y="LU":"LUNG",Y="K":"KIDNEY",Y="H":"HEART",1:"")
W !,LINE1
Q
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
S SRPAGE=SRPAGE+1 W:$Y @IOF W !,?53,"LIST OF TRANSPLANT ASSESSMENTS"
W ?120,"PAGE "_SRPAGE,!,?(132-$L(SRINST)\2),SRINST,!,?58,"SURGERY SERVICE",?100,"DATE REVIEWED:"
W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,"REVIEWED BY:"
W !!,"VACO ID",?16,"PATIENT",?52,"TRANSPLANT DATE",?70,"STATUS",?87,"SURGERY CASE #",?107,"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[HSRTPLSTP 1805 printed Nov 22, 2024@17:58:31 Page 2
SRTPLSTP ;BIR/SJA - LIST ASSESSMENTS ;04/11/08
+1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
+2 SET (SRPAGE,SRSOUT,SRDFN)=0
SET $PIECE(LINE,"=",132)=""
SET $PIECE(LINE1,"-",132)=""
+3 DO HDR
if SRSOUT
QUIT
+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 HDR
IF SRSOUT
QUIT
+4 SET SRA(0)=^SRT(SRTPP,0)
SET SRVACO=$PIECE(^SRT(SRTPP,.01),"^",11)
SET DFN=$PIECE(SRA(0),"^")
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")_")",?52,SRDT,?70,$SELECT(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),?87,$SELECT($PIECE(SRA(0),"^",3):$PIECE(SRA(0),"^",3),1:"N/A")
+10 SET Y=$PIECE(SR("RA"),"^",2)
WRITE ?107,$SELECT(Y="LI":"LIVER",Y="LU":"LUNG",Y="K":"KIDNEY",Y="H":"HEART",1:"")
+11 WRITE !,LINE1
+12 QUIT
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 SET SRPAGE=SRPAGE+1
if $Y
WRITE @IOF
WRITE !,?53,"LIST OF TRANSPLANT ASSESSMENTS"
+3 WRITE ?120,"PAGE "_SRPAGE,!,?(132-$LENGTH(SRINST)\2),SRINST,!,?58,"SURGERY SERVICE",?100,"DATE REVIEWED:"
+4 WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,"REVIEWED BY:"
+5 WRITE !!,"VACO ID",?16,"PATIENT",?52,"TRANSPLANT DATE",?70,"STATUS",?87,"SURGERY CASE #",?107,"ORGAN TYPE"
+6 WRITE !,LINE
+7 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
