SRTPSS ;BIR/SJA - SELECT ASSESSMENT ;02/14/08
;;3.0; Surgery ;**167**;24 Jun 93;Build 27
K:$D(DUZ("SAV")) SRNEW K SRTN W !! S SRSOUT=0
N SRVA,SRTTYPE,SRTPDT S SRVA=""
W ! S SRSOUT=0 K DIC S DIC("A")="Select Patient: ",DIC=2,DIC(0)="QEAM" D ^DIC K DIC I Y<0 S SRSOUT=1 G END
S (SRDFN,DFN)=+Y D DEM^VADPT D HDR S SRANM=VADM(1)_" "_VA("PID")
START ; start display
D ^SRTPASS Q:$D(SRTPP) I SRSOUT G END
I $D(SRNEW) S CNT=CNT+1,SRCASE(CNT)="" W CNT,". ---- CREATE NEW TRANSPLANT ASSESSMENT"
I '$D(SRCASE(1)) W !!,"There are no Surgery Risk Assessments entered for "_VADM(1)_".",!! K DIR S DIR(0)="FOA",DIR("A")=" Press RETURN to continue. " D ^DIR Q
OPT W !!!,"Select Assessment: " R X:DTIME I '$T!("^"[X) S SRSOUT=1 G END
I '$D(SRCASE(X)) W !!,"Enter the number of the desired assessment." W:$D(SRNEW) " Select '"_CNT_"' to create a new",!,"transplant assessment." G OPT
I $D(SRNEW),X=CNT D ^SRTPNEW D:$D(SRTPP) K SRTPP,SRTN W @IOF G END
.S SR("RA")=$G(^SRT(SRTPP,"RA")),SRVA=$P(SR("RA"),"^",5),SRNOVA=$S(SRVA="N":1,1:0),SRTTYPE=$P(SR("RA"),"^",2)
.D @$S(SRTTYPE="K":"^SRTPKID1",SRTTYPE="LI":"^SRTPLIV1",SRTTYPE="LU":"^SRTPLUN1",1:"^SRTPHRT1")
I '$D(SRTPP) S SRTPP=+SRCASE(X)
Q
END S:'$D(SRSOUT) SRSOUT=1 W:SRSOUT @IOF D ^SRSKILL
Q
HDR ; print heading
W @IOF,!,?1,VADM(1)_" "_VA("PID") S X=$P($G(VADM(6)),"^") W:X " * DIED "_$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" *" W !
Q
SITE ; determine if transplant assessment is defined for the site
I $$TRS Q
W @IOF,!,"The SURGERY SITE PARAMETERS file indicates no transplant types defined for this",!,"site/division. Therefore, this option is not available for use.",!
S XQUIT="" W !!,"Press RETURN to continue " R X:DTIME W @IOF
Q
TRS() ; extrinsic call to determine if site is can run the transplant assessment module
N TRS S TRS=0 Q:'$G(SRSITE) TRS
I $G(^SRO(133,SRSITE,8))["Y" S TRS=1
Q TRS
PARAM ; enter/edit site parameters
N SRDIV,SRN,SRNAME,SRNUM K SRL
S (SRCNT,X)=0 F S X=$O(^SRO(133,X)) Q:'X I '$P($G(^SRO(133,X,0)),"^",21) S SRCNT=SRCNT+1,SRL(SRCNT)=X
I SRCNT=1 S SRDIV=SRL(1),SRNUM=$$GET1^DIQ(4,SRSITE("DIV"),99),Q3(1)=" "_SRSITE("SITE")_" ("_SRNUM_") " G PAR
W @IOF K DIC,DINUM S DIC=133,DIC(0)="QEAMZ",DIC("A")="Edit Parameters for which Surgery Site: " D ^DIC K DIC I Y<0 W @IOF Q
S SRDIV=+Y,SRN=+Y(0),SRNAME=Y(0,0),SRNUM=$$GET1^DIQ(4,SRN,99),Q3(1)=" "_SRNAME_" ("_SRNUM_") "
PAR K DIE,DR,DA,Y S DA=SRDIV,DR="[SR TRANSPLANT]",DIE=133 D ^SRCUSS K DR,DIE,DA,ST W @IOF I $D(SRSITE) D SET
Q
SET ; set site parameters
S S(0)=^SRO(133,SRSITE,0),SRSITE("AML")=$P(S(0),"^",4),SRSITE("REQ")=$P(S(0),"^",2) K:SRSITE("REQ")="" SRSITE("REQ")
S SRSITE("IV")=$P(S(0),"^",7) K:SRSITE("IV")="" SRSITE("IV")
S SRSITE("DIV")=$P(S(0),"^"),SRSITE("SITE")=$$GET1^DIQ(4,SRSITE("DIV"),.01)
S SRSITE("NRPT")=$P(S(0),"^",6) I SRSITE("NRPT")="" S SRSITE("NRPT")=1
I '$D(SRSITE("OPTION")),$D(XQY) S SRSITE("OPTION")=XQY
K S
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPSS 2963 printed Oct 16, 2024@18:49:33 Page 2
SRTPSS ;BIR/SJA - SELECT ASSESSMENT ;02/14/08
+1 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
+2 if $DATA(DUZ("SAV"))
KILL SRNEW
KILL SRTN
WRITE !!
SET SRSOUT=0
+3 NEW SRVA,SRTTYPE,SRTPDT
SET SRVA=""
+4 WRITE !
SET SRSOUT=0
KILL DIC
SET DIC("A")="Select Patient: "
SET DIC=2
SET DIC(0)="QEAM"
DO ^DIC
KILL DIC
IF Y<0
SET SRSOUT=1
GOTO END
+5 SET (SRDFN,DFN)=+Y
DO DEM^VADPT
DO HDR
SET SRANM=VADM(1)_" "_VA("PID")
START ; start display
+1 DO ^SRTPASS
if $DATA(SRTPP)
QUIT
IF SRSOUT
GOTO END
+2 IF $DATA(SRNEW)
SET CNT=CNT+1
SET SRCASE(CNT)=""
WRITE CNT,". ---- CREATE NEW TRANSPLANT ASSESSMENT"
+3 IF '$DATA(SRCASE(1))
WRITE !!,"There are no Surgery Risk Assessments entered for "_VADM(1)_".",!!
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")=" Press RETURN to continue. "
DO ^DIR
QUIT
OPT WRITE !!!,"Select Assessment: "
READ X:DTIME
IF '$TEST!("^"[X)
SET SRSOUT=1
GOTO END
+1 IF '$DATA(SRCASE(X))
WRITE !!,"Enter the number of the desired assessment."
if $DATA(SRNEW)
WRITE " Select '"_CNT_"' to create a new",!,"transplant assessment."
GOTO OPT
+2 IF $DATA(SRNEW)
IF X=CNT
DO ^SRTPNEW
if $DATA(SRTPP)
Begin DoDot:1
+3 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)
+4 DO @$SELECT(SRTTYPE="K":"^SRTPKID1",SRTTYPE="LI":"^SRTPLIV1",SRTTYPE="LU":"^SRTPLUN1",1:"^SRTPHRT1")
End DoDot:1
KILL SRTPP,SRTN
WRITE @IOF
GOTO END
+5 IF '$DATA(SRTPP)
SET SRTPP=+SRCASE(X)
+6 QUIT
END if '$DATA(SRSOUT)
SET SRSOUT=1
if SRSOUT
WRITE @IOF
DO ^SRSKILL
+1 QUIT
HDR ; print heading
+1 WRITE @IOF,!,?1,VADM(1)_" "_VA("PID")
SET X=$PIECE($GET(VADM(6)),"^")
if X
WRITE " * DIED "_$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_" *"
WRITE !
+2 QUIT
SITE ; determine if transplant assessment is defined for the site
+1 IF $$TRS
QUIT
+2 WRITE @IOF,!,"The SURGERY SITE PARAMETERS file indicates no transplant types defined for this",!,"site/division. Therefore, this option is not available for use.",!
+3 SET XQUIT=""
WRITE !!,"Press RETURN to continue "
READ X:DTIME
WRITE @IOF
+4 QUIT
TRS() ; extrinsic call to determine if site is can run the transplant assessment module
+1 NEW TRS
SET TRS=0
if '$GET(SRSITE)
QUIT TRS
+2 IF $GET(^SRO(133,SRSITE,8))["Y"
SET TRS=1
+3 QUIT TRS
PARAM ; enter/edit site parameters
+1 NEW SRDIV,SRN,SRNAME,SRNUM
KILL SRL
+2 SET (SRCNT,X)=0
FOR
SET X=$ORDER(^SRO(133,X))
if 'X
QUIT
IF '$PIECE($GET(^SRO(133,X,0)),"^",21)
SET SRCNT=SRCNT+1
SET SRL(SRCNT)=X
+3 IF SRCNT=1
SET SRDIV=SRL(1)
SET SRNUM=$$GET1^DIQ(4,SRSITE("DIV"),99)
SET Q3(1)=" "_SRSITE("SITE")_" ("_SRNUM_") "
GOTO PAR
+4 WRITE @IOF
KILL DIC,DINUM
SET DIC=133
SET DIC(0)="QEAMZ"
SET DIC("A")="Edit Parameters for which Surgery Site: "
DO ^DIC
KILL DIC
IF Y<0
WRITE @IOF
QUIT
+5 SET SRDIV=+Y
SET SRN=+Y(0)
SET SRNAME=Y(0,0)
SET SRNUM=$$GET1^DIQ(4,SRN,99)
SET Q3(1)=" "_SRNAME_" ("_SRNUM_") "
PAR KILL DIE,DR,DA,Y
SET DA=SRDIV
SET DR="[SR TRANSPLANT]"
SET DIE=133
DO ^SRCUSS
KILL DR,DIE,DA,ST
WRITE @IOF
IF $DATA(SRSITE)
DO SET
+1 QUIT
SET ; set site parameters
+1 SET S(0)=^SRO(133,SRSITE,0)
SET SRSITE("AML")=$PIECE(S(0),"^",4)
SET SRSITE("REQ")=$PIECE(S(0),"^",2)
if SRSITE("REQ")=""
KILL SRSITE("REQ")
+2 SET SRSITE("IV")=$PIECE(S(0),"^",7)
if SRSITE("IV")=""
KILL SRSITE("IV")
+3 SET SRSITE("DIV")=$PIECE(S(0),"^")
SET SRSITE("SITE")=$$GET1^DIQ(4,SRSITE("DIV"),.01)
+4 SET SRSITE("NRPT")=$PIECE(S(0),"^",6)
IF SRSITE("NRPT")=""
SET SRSITE("NRPT")=1
+5 IF '$DATA(SRSITE("OPTION"))
IF $DATA(XQY)
SET SRSITE("OPTION")=XQY
+6 KILL S
+7 QUIT
