47 lines
2.8 KiB
Mathematica
47 lines
2.8 KiB
Mathematica
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
|