- 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 Feb 19, 2025@00:15:02 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