SRTPVAN ;BIR/SJA - CHANGE ASSESSMENT TYPE ;02/29/08
;;3.0; Surgery ;**167**;24 Jun 93;Build 27
I '$D(SRTPP) Q
N SRYN,SRSTAT,SRATYPE,SRNTYPE,SRCHG,SRORG,SRVAR
S SR("RA")=$G(^SRT(SRTPP,"RA")),SRSTAT=$P(SR("RA"),"^"),SRATYPE=$P(SR("RA"),"^",5),SRORG=$P(SR("RA"),"^",2)
I SRSTAT="T" W !!,"This assessment has already been verified and transmitted. It cannot be",!,"changed. If the assessment was transmitted in error, use the option 'Update",!,"an Assessment Transmitted in Error'." D RET Q
I SRSTAT="V" W !!,"This assessment has already been verified. It cannot be changed. If the",!,"assessment was verified in error, use the option 'Update an Assessment Verified",!,"in Error'." D RET Q
CHG W !!,"This assessment has a current status of "_$S(SRSTAT="I":"'Incomplete'",1:"'Complete/Unverified'")
W !,"The Transplant Assessment Indicator is a "_$S(SRATYPE="V":"VA",SRATYPE="N":"Non-VA",1:"")_" type"
W !!,"Are you sure that you want to change the indicator to "_$S(SRATYPE="V":"Non-VA",SRATYPE="N":"VA",1:"")_"? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I "Nn"[SRYN W !!,"No action has been taken." D RET S SRSOUT=1 Q
I "Yy"'[SRYN W !!,"Enter <RET> if this assessment was selected in error and the status should not ",!,"be changed. If you want to change this assessment type, enter 'YES'." G CHG
I SRATYPE="N" S SRVA="V",SRCHG=1 D START^SRTPNEW I '$D(SRTN) W !!,"No action has been taken." D RET S SRSOUT=1 Q
I SRATYPE="N" S $P(^SRT(SRTPP,0),"^",3)=SRTN K SRCHG,SRVA
K DR,DIE,DA S DA=SRTPP,DIE=139.5,DR="185////"_$S(SRATYPE="V":"N",SRATYPE="N":"V",1:"") I SRATYPE="N" S DR=DR_";1////"_SRTPDT
I SRATYPE="V" S $P(^SRT(SRTPP,0),"^",3)=""
D ^DIE W !!,"Changing Assessment type..." D CLEAN,RET
Q
DEL ; delete assessment
S SRSTAT=$P($G(^SRT(SRTPP,"RA")),"^")
ST W !!,"Are you sure that you want to delete this assessment ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I "Nn"[SRYN W !!,"No action has been taken." S SRSOUT=1 Q
I "Yy"'[SRYN W !!,"Enter <RET> if this assessment was selected in error and should not be changed.",!,"If you want to delete this assessment, enter 'YES'." G ST
I SRSTAT="T"!(SRSTAT="C") W !!,"This case has been completed/Transmitted and must remain in the file for your records." D RET Q
K DR,DIE,DA S DA=SRTPP,DIE=139.5,DR="181///@;182///@;183///@;184///@" D ^DIE W !!,"Deleting Transplant Assessment..."
K DA,DIK S DA=SRTPP,DIK="^SRT(" D ^DIK K DA,DIK
Q
CLEAN ; clean up the database after changing the transplant type
S SRNTYPE=$P(^SRT(SRTPP,"RA"),"^",5),SRVAR=""
I SRATYPE="V",(SRNTYPE="N") D ; changed from VA to non-VA
.S SRVAR=$S(SRORG="LI":"81;82;83;109,110",SRORG="H":"108;153;75;154;115;81;82;90;83;109;110",SRORG="K":"133",1:"")
I SRATYPE="N",(SRNTYPE="V") D ; changed from non-VA to VA
.I SRORG="K" S SRVAR="4;5;147;145;132;146;131;116;117;118;119;192;121;122;123;124;125;126;127" Q
.I SRORG="LU" S SRVAR="4;5;145;132;146;131;147;116;117;118;119;192;121;122;123;124;125;126;193" Q
.I SRORG="LI" S SRVAR="4;5;147;116;117;118;119;192;121;122;123;124;125;126;193" Q
.I SRORG="H" S SRVAR="4;5;76;169;177;173;174;175;176;171;172;179;178;132;41;147;193;170;192;191;190;119;189;148;118;121;122;130;109;110;167;168"
S DR="",DIE=139.5 F I=1:1:$L(SRVAR) I $P(SRVAR,";",I)'="" S DR=$S(DR]"":DR_";"_$P(SRVAR,";",I)_"///@",1:$P(SRVAR,";",I)_"///@")
D:DR]"" ^DIE K DR,DA
Q
RET W !!,"Press <RET> to continue " R X:DTIME K SRTPP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPVAN 3475 printed Dec 13, 2024@02:49:02 Page 2
SRTPVAN ;BIR/SJA - CHANGE ASSESSMENT TYPE ;02/29/08
+1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
+2 IF '$DATA(SRTPP)
QUIT
+3 NEW SRYN,SRSTAT,SRATYPE,SRNTYPE,SRCHG,SRORG,SRVAR
+4 SET SR("RA")=$GET(^SRT(SRTPP,"RA"))
SET SRSTAT=$PIECE(SR("RA"),"^")
SET SRATYPE=$PIECE(SR("RA"),"^",5)
SET SRORG=$PIECE(SR("RA"),"^",2)
+5 IF SRSTAT="T"
WRITE !!,"This assessment has already been verified and transmitted. It cannot be",!,"changed. If the assessment was transmitted in error, use the option 'Update",!,"an Assessment Transmitted in Error'."
DO RET
QUIT
+6 IF SRSTAT="V"
WRITE !!,"This assessment has already been verified. It cannot be changed. If the",!,"assessment was verified in error, use the option 'Update an Assessment Verified",!,"in Error'."
DO RET
QUIT
CHG WRITE !!,"This assessment has a current status of "_$SELECT(SRSTAT="I":"'Incomplete'",1:"'Complete/Unverified'")
+1 WRITE !,"The Transplant Assessment Indicator is a "_$SELECT(SRATYPE="V":"VA",SRATYPE="N":"Non-VA",1:"")_" type"
+2 WRITE !!,"Are you sure that you want to change the indicator to "_$SELECT(SRATYPE="V":"Non-VA",SRATYPE="N":"VA",1:"")_"? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+3 SET SRYN=$EXTRACT(SRYN)
IF "Nn"[SRYN
WRITE !!,"No action has been taken."
DO RET
SET SRSOUT=1
QUIT
+4 IF "Yy"'[SRYN
WRITE !!,"Enter <RET> if this assessment was selected in error and the status should not ",!,"be changed. If you want to change this assessment type, enter 'YES'."
GOTO CHG
+5 IF SRATYPE="N"
SET SRVA="V"
SET SRCHG=1
DO START^SRTPNEW
IF '$DATA(SRTN)
WRITE !!,"No action has been taken."
DO RET
SET SRSOUT=1
QUIT
+6 IF SRATYPE="N"
SET $PIECE(^SRT(SRTPP,0),"^",3)=SRTN
KILL SRCHG,SRVA
+7 KILL DR,DIE,DA
SET DA=SRTPP
SET DIE=139.5
SET DR="185////"_$SELECT(SRATYPE="V":"N",SRATYPE="N":"V",1:"")
IF SRATYPE="N"
SET DR=DR_";1////"_SRTPDT
+8 IF SRATYPE="V"
SET $PIECE(^SRT(SRTPP,0),"^",3)=""
+9 DO ^DIE
WRITE !!,"Changing Assessment type..."
DO CLEAN
DO RET
+10 QUIT
DEL ; delete assessment
+1 SET SRSTAT=$PIECE($GET(^SRT(SRTPP,"RA")),"^")
ST WRITE !!,"Are you sure that you want to delete this assessment ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+1 SET SRYN=$EXTRACT(SRYN)
IF "Nn"[SRYN
WRITE !!,"No action has been taken."
SET SRSOUT=1
QUIT
+2 IF "Yy"'[SRYN
WRITE !!,"Enter <RET> if this assessment was selected in error and should not be changed.",!,"If you want to delete this assessment, enter 'YES'."
GOTO ST
+3 IF SRSTAT="T"!(SRSTAT="C")
WRITE !!,"This case has been completed/Transmitted and must remain in the file for your records."
DO RET
QUIT
+4 KILL DR,DIE,DA
SET DA=SRTPP
SET DIE=139.5
SET DR="181///@;182///@;183///@;184///@"
DO ^DIE
WRITE !!,"Deleting Transplant Assessment..."
+5 KILL DA,DIK
SET DA=SRTPP
SET DIK="^SRT("
DO ^DIK
KILL DA,DIK
+6 QUIT
CLEAN ; clean up the database after changing the transplant type
+1 SET SRNTYPE=$PIECE(^SRT(SRTPP,"RA"),"^",5)
SET SRVAR=""
+2 ; changed from VA to non-VA
IF SRATYPE="V"
IF (SRNTYPE="N")
Begin DoDot:1
+3 SET SRVAR=$SELECT(SRORG="LI":"81;82;83;109,110",SRORG="H":"108;153;75;154;115;81;82;90;83;109;110",SRORG="K":"133",1:"")
End DoDot:1
+4 ; changed from non-VA to VA
IF SRATYPE="N"
IF (SRNTYPE="V")
Begin DoDot:1
+5 IF SRORG="K"
SET SRVAR="4;5;147;145;132;146;131;116;117;118;119;192;121;122;123;124;125;126;127"
QUIT
+6 IF SRORG="LU"
SET SRVAR="4;5;145;132;146;131;147;116;117;118;119;192;121;122;123;124;125;126;193"
QUIT
+7 IF SRORG="LI"
SET SRVAR="4;5;147;116;117;118;119;192;121;122;123;124;125;126;193"
QUIT
+8 IF SRORG="H"
SET SRVAR="4;5;76;169;177;173;174;175;176;171;172;179;178;132;41;147;193;170;192;191;190;119;189;148;118;121;122;130;109;110;167;168"
End DoDot:1
+9 SET DR=""
SET DIE=139.5
FOR I=1:1:$LENGTH(SRVAR)
IF $PIECE(SRVAR,";",I)'=""
SET DR=$SELECT(DR]"":DR_";"_$PIECE(SRVAR,";",I)_"///@",1:$PIECE(SRVAR,";",I)_"///@")
+10 if DR]""
DO ^DIE
KILL DR,DA
+11 QUIT
RET WRITE !!,"Press <RET> to continue "
READ X:DTIME
KILL SRTPP
+1 QUIT