SRTPTRAN ;BIR/SJA - TRANSPLANT DATA ENTRY ;02/27/08
;;3.0; Surgery ;**167**;24 Jun 93;Build 27
N SR,SRVA,SRNOVA K SRTPP
D:'$D(SRTPP) ^SRTPSS I '$D(SRTPP)!$G(SRSOUT) Q
I $D(SRTPP) S SR("RA")=$G(^SRT(SRTPP,"RA")),SRVA=$P(SR("RA"),"^",5),SRNOVA=$S(SRVA="N":1,1:0),SRTTYPE=$P(SR("RA"),"^",2)
ENTER ; edit, delete, complete, or change indicator
I $D(SRPRINT)!'($D(SRNEW)) Q
I $P(SR("RA"),"^")="T"!($P(SR("RA"),"^")="C") D TRANS I 'SRYN K SRASS,SRTPP S SRSOUT=1 G END
S DFN=$P(^SRT(SRTPP,0),"^") D DEM^VADPT D HDR^SRTPSS S SRANM=VADM(1)_" "_VA("PID")
W @IOF,!,?1,SRANM,!! S SRSDATE=$P(^SRT(SRTPP,0),"^",2) S SRASS=SRTPP D DISP^SRTPASS
W !!,"1. Enter Transplant Assessment Information",!,"2. Delete Transplant Assessment Entry",!,"3. Update Transplant Assessment Status to 'COMPLETE'"
W !,"4. Change VA/Non-VA Transplant Indicator"
W !!,"Select Number: 1// " R X:DTIME I '$T!(X["^") K SRTN,SRASS S SRSOUT=1 G END
S:X="" X=1 I X<1!(X>4)!(X'?.N) D HELP G ENTER
I X=2 D DEL^SRTPVAN W !!,"Press <RET> to continue " R X:DTIME W @IOF K SRTN,SRTPP G END
I X=3 D ^SRTPCOM G END
I X=4 D ^SRTPVAN G END
I X=1 D @$S(SRTTYPE="K":"^SRTPKID1",SRTTYPE="LI":"^SRTPLIV1",SRTTYPE="LU":"^SRTPLUN1",1:"^SRTPHRT1")
END S:'$D(SRSOUT) SRSOUT=1 W:SRSOUT @IOF K SRTPP D ^SRSKILL
Q
HELP ;
W !!,"Enter <RET> or '1' to enter or edit information related to this ",!,"Assessment entry. If you want to delete the Assessment, enter '2'."
W !,"Enter '3' to update the status of this Assessment to 'COMPLETE'.",!,"Enter '4' to change the Assessment type from VA to Non-VA or vice versa"
W !!,"Press <RET> to continue " R X:DTIME
Q
TRANS W !!,"This assessment has a status of "_$S($P(SR("RA"),"^")="T":"TRANSMITTED.",1:"COMPLETED."),!
S SRYN=0 K DIR S DIR("A")="Do you wish to change the status of this assessment to 'INCOMPLETE'",DIR("B")="NO",DIR(0)="Y" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
S SRYN=Y I 'SRYN Q
K DA,DIE,DR S DIE=139.5,DA=SRTPP,DR="181////I;183////1" D ^DIE K DA,DIE,DR
W !!,"The Assessment Status has been changed to 'INCOMPLETE'."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPTRAN 2076 printed Sep 23, 2025@20:25:24 Page 2
SRTPTRAN ;BIR/SJA - TRANSPLANT DATA ENTRY ;02/27/08
+1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
+2 NEW SR,SRVA,SRNOVA
KILL SRTPP
+3 if '$DATA(SRTPP)
DO ^SRTPSS
IF '$DATA(SRTPP)!$GET(SRSOUT)
QUIT
+4 IF $DATA(SRTPP)
SET SR("RA")=$GET(^SRT(SRTPP,"RA"))
SET SRVA=$PIECE(SR("RA"),"^",5)
SET SRNOVA=$SELECT(SRVA="N":1,1:0)
SET SRTTYPE=$PIECE(SR("RA"),"^",2)
ENTER ; edit, delete, complete, or change indicator
+1 IF $DATA(SRPRINT)!'($DATA(SRNEW))
QUIT
+2 IF $PIECE(SR("RA"),"^")="T"!($PIECE(SR("RA"),"^")="C")
DO TRANS
IF 'SRYN
KILL SRASS,SRTPP
SET SRSOUT=1
GOTO END
+3 SET DFN=$PIECE(^SRT(SRTPP,0),"^")
DO DEM^VADPT
DO HDR^SRTPSS
SET SRANM=VADM(1)_" "_VA("PID")
+4 WRITE @IOF,!,?1,SRANM,!!
SET SRSDATE=$PIECE(^SRT(SRTPP,0),"^",2)
SET SRASS=SRTPP
DO DISP^SRTPASS
+5 WRITE !!,"1. Enter Transplant Assessment Information",!,"2. Delete Transplant Assessment Entry",!,"3. Update Transplant Assessment Status to 'COMPLETE'"
+6 WRITE !,"4. Change VA/Non-VA Transplant Indicator"
+7 WRITE !!,"Select Number: 1// "
READ X:DTIME
IF '$TEST!(X["^")
KILL SRTN,SRASS
SET SRSOUT=1
GOTO END
+8 if X=""
SET X=1
IF X<1!(X>4)!(X'?.N)
DO HELP
GOTO ENTER
+9 IF X=2
DO DEL^SRTPVAN
WRITE !!,"Press <RET> to continue "
READ X:DTIME
WRITE @IOF
KILL SRTN,SRTPP
GOTO END
+10 IF X=3
DO ^SRTPCOM
GOTO END
+11 IF X=4
DO ^SRTPVAN
GOTO END
+12 IF X=1
DO @$SELECT(SRTTYPE="K":"^SRTPKID1",SRTTYPE="LI":"^SRTPLIV1",SRTTYPE="LU":"^SRTPLUN1",1:"^SRTPHRT1")
END if '$DATA(SRSOUT)
SET SRSOUT=1
if SRSOUT
WRITE @IOF
KILL SRTPP
DO ^SRSKILL
+1 QUIT
HELP ;
+1 WRITE !!,"Enter <RET> or '1' to enter or edit information related to this ",!,"Assessment entry. If you want to delete the Assessment, enter '2'."
+2 WRITE !,"Enter '3' to update the status of this Assessment to 'COMPLETE'.",!,"Enter '4' to change the Assessment type from VA to Non-VA or vice versa"
+3 WRITE !!,"Press <RET> to continue "
READ X:DTIME
+4 QUIT
TRANS WRITE !!,"This assessment has a status of "_$SELECT($PIECE(SR("RA"),"^")="T":"TRANSMITTED.",1:"COMPLETED."),!
+1 SET SRYN=0
KILL DIR
SET DIR("A")="Do you wish to change the status of this assessment to 'INCOMPLETE'"
SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+2 SET SRYN=Y
IF 'SRYN
QUIT
+3 KILL DA,DIE,DR
SET DIE=139.5
SET DA=SRTPP
SET DR="181////I;183////1"
DO ^DIE
KILL DA,DIE,DR
+4 WRITE !!,"The Assessment Status has been changed to 'INCOMPLETE'."
+5 QUIT
