SRODTH ;BIR/ADM - UPDATE CASE AS UNRELATED OR RELATED TO DEATH ;01/30/01 10:06 AM
;;3.0; Surgery ;**47,88,100,142**;24 Jun 93
PAT W @IOF,!,?15,"Update Operations as Unrelated or Related to Death",!!
S SRSOUT=0 K DIC S DIC("A")="Select Patient: ",DIC=2,DIC(0)="QEAM" D ^DIC K DIC I Y<0 G END
S DFN=+Y D DEM^VADPT S SRDEATH=$P(VADM(6),"^") I 'SRDEATH G NODIE
S X1=SRDEATH,X2=-90 D C^%DTC S SRDAY=X,(CNT,SRDT)=0
K SRCASE F S SRDT=$O(^SRF("ADT",DFN,SRDT)) Q:'SRDT S SRCASE=0 F S SRCASE=$O(^SRF("ADT",DFN,SRDT,SRCASE)) Q:'SRCASE D SET
OUT D HDR I 'CNT W !!,"This patient had no operations in 90 days prior to death.",!! K DIR S DIR(0)="E" D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT) END G PAT
W !!,"Operations in 90 Days Prior to Death:",!
F NUM=1:1 Q:'$D(SRCASE(NUM)) S SRCASE=SRCASE(NUM) D LIST W !
SEL ; select operation to update
K DIR S DIR(0)="NO^1:"_CNT_":0",DIR("?",1)="Enter the number corresponding to the operation to be updated or",DIR("?")="press RETURN to quit this patient."
S DIR("A")="Select Number of Operation to be Updated" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G END
I Y S NUM=Y D RELATED G OUT
G PAT
Q
RELATED ; update UNRELATED/RELATED status
S SRCASE=SRCASE(NUM) I $$LOCK^SROUTL(SRCASE) D D UNLOCK^SROUTL(SRCASE)
.D HDR W ! D LIST W ! K DA,DIE,DR S DA=SRCASE,DR="903T;904T",DIE=130 D ^DIE K DA,DIE,DR
Q
SET ; set up array of cases in 90 days prior to death
S SRSDATE=$P(^SRF(SRCASE,0),"^",9) I SRSDATE<SRDAY!(SRSDATE>SRDEATH) Q
I '$P($G(^SRF(SRCASE,.2)),"^",12)!$P($G(^SRF(SRCASE,30)),"^")!($P($G(^SRF(SRCASE,"NON")),"^")="Y")!$P($G(^SRF(SRCASE,37)),"^") Q
S CNT=CNT+1,SRCASE(CNT)=SRCASE
Q
LIST ; display list of operations
S X=$P($G(^SRF(SRCASE,.4)),"^",7) I X="" S X="U",$P(^SRF(SRCASE,.4),"^",7)=X
S SRELATE=$S(X="U":"UNRELATED",1:"RELATED")
S SROPER=$P(^SRF(SRCASE,"OP"),"^")
S SROPER=SROPER_" - "_SRELATE
S X1=SRDEATH,(DATE,X2)=$P(^SRF(SRCASE,0),"^",9),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3) D ^%DTC S SRLENGTH=X
K SROPS,MM,MMM S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
W !,NUM_".",?3,DATE,?15,SROPS(1) I $D(SROPS(2)) W !,?15,SROPS(2) I $D(SROPS(3)) W !,?15,SROPS(3)
W !,?15," >>> Died "_SRLENGTH_" day"_$S(SRLENGTH>1:"s",1:"")_" postop. <<<"
Q
LOOP ; break procedures
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<65 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
HDR ; print heading
W @IOF,!,?15,"Update Operations as Unrelated or Related to Death",!!,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)_" *"
Q
NODIE D HDR W !!!,"No death is recorded for this patient.",!!! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G END
G PAT
END I SRSOUT K DIR S DIR(0)="E" D ^DIR
D ^SRSKILL W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRODTH 2872 printed Apr 09, 2024@21:43:56 Page 2
SRODTH ;BIR/ADM - UPDATE CASE AS UNRELATED OR RELATED TO DEATH ;01/30/01 10:06 AM
+1 ;;3.0; Surgery ;**47,88,100,142**;24 Jun 93
PAT WRITE @IOF,!,?15,"Update Operations as Unrelated or Related to Death",!!
+1 SET SRSOUT=0
KILL DIC
SET DIC("A")="Select Patient: "
SET DIC=2
SET DIC(0)="QEAM"
DO ^DIC
KILL DIC
IF Y<0
GOTO END
+2 SET DFN=+Y
DO DEM^VADPT
SET SRDEATH=$PIECE(VADM(6),"^")
IF 'SRDEATH
GOTO NODIE
+3 SET X1=SRDEATH
SET X2=-90
DO C^%DTC
SET SRDAY=X
SET (CNT,SRDT)=0
+4 KILL SRCASE
FOR
SET SRDT=$ORDER(^SRF("ADT",DFN,SRDT))
if 'SRDT
QUIT
SET SRCASE=0
FOR
SET SRCASE=$ORDER(^SRF("ADT",DFN,SRDT,SRCASE))
if 'SRCASE
QUIT
DO SET
OUT DO HDR
IF 'CNT
WRITE !!,"This patient had no operations in 90 days prior to death.",!!
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO END
GOTO PAT
+1 WRITE !!,"Operations in 90 Days Prior to Death:",!
+2 FOR NUM=1:1
if '$DATA(SRCASE(NUM))
QUIT
SET SRCASE=SRCASE(NUM)
DO LIST
WRITE !
SEL ; select operation to update
+1 KILL DIR
SET DIR(0)="NO^1:"_CNT_":0"
SET DIR("?",1)="Enter the number corresponding to the operation to be updated or"
SET DIR("?")="press RETURN to quit this patient."
+2 SET DIR("A")="Select Number of Operation to be Updated"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO END
+3 IF Y
SET NUM=Y
DO RELATED
GOTO OUT
+4 GOTO PAT
+5 QUIT
RELATED ; update UNRELATED/RELATED status
+1 SET SRCASE=SRCASE(NUM)
IF $$LOCK^SROUTL(SRCASE)
Begin DoDot:1
+2 DO HDR
WRITE !
DO LIST
WRITE !
KILL DA,DIE,DR
SET DA=SRCASE
SET DR="903T;904T"
SET DIE=130
DO ^DIE
KILL DA,DIE,DR
End DoDot:1
DO UNLOCK^SROUTL(SRCASE)
+3 QUIT
SET ; set up array of cases in 90 days prior to death
+1 SET SRSDATE=$PIECE(^SRF(SRCASE,0),"^",9)
IF SRSDATE<SRDAY!(SRSDATE>SRDEATH)
QUIT
+2 IF '$PIECE($GET(^SRF(SRCASE,.2)),"^",12)!$PIECE($GET(^SRF(SRCASE,30)),"^")!($PIECE($GET(^SRF(SRCASE,"NON")),"^")="Y")!$PIECE($GET(^SRF(SRCASE,37)),"^")
QUIT
+3 SET CNT=CNT+1
SET SRCASE(CNT)=SRCASE
+4 QUIT
LIST ; display list of operations
+1 SET X=$PIECE($GET(^SRF(SRCASE,.4)),"^",7)
IF X=""
SET X="U"
SET $PIECE(^SRF(SRCASE,.4),"^",7)=X
+2 SET SRELATE=$SELECT(X="U":"UNRELATED",1:"RELATED")
+3 SET SROPER=$PIECE(^SRF(SRCASE,"OP"),"^")
+4 SET SROPER=SROPER_" - "_SRELATE
+5 SET X1=SRDEATH
SET (DATE,X2)=$PIECE(^SRF(SRCASE,0),"^",9)
SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
DO ^%DTC
SET SRLENGTH=X
+6 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<65
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>64
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+7 WRITE !,NUM_".",?3,DATE,?15,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?15,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?15,SROPS(3)
+8 WRITE !,?15," >>> Died "_SRLENGTH_" day"_$SELECT(SRLENGTH>1:"s",1:"")_" postop. <<<"
+9 QUIT
LOOP ; break procedures
+1 SET SROPS(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROPS(M))+$LENGTH(MM)'<65
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
HDR ; print heading
+1 WRITE @IOF,!,?15,"Update Operations as Unrelated or Related to Death",!!,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)_" *"
+2 QUIT
NODIE DO HDR
WRITE !!!,"No death is recorded for this patient.",!!!
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO END
+1 GOTO PAT
END IF SRSOUT
KILL DIR
SET DIR(0)="E"
DO ^DIR
+1 DO ^SRSKILL
WRITE @IOF
+2 QUIT
