- 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 Jan 18, 2025@03:50:04 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