[613] | 1 | SRODTH ;BIR/ADM - UPDATE CASE AS UNRELATED OR RELATED TO DEATH ;01/30/01 10:06 AM
|
---|
| 2 | ;;3.0; Surgery ;**47,88,100,142**;24 Jun 93
|
---|
| 3 | PAT W @IOF,!,?15,"Update Operations as Unrelated or Related to Death",!!
|
---|
| 4 | S SRSOUT=0 K DIC S DIC("A")="Select Patient: ",DIC=2,DIC(0)="QEAM" D ^DIC K DIC I Y<0 G END
|
---|
| 5 | S DFN=+Y D DEM^VADPT S SRDEATH=$P(VADM(6),"^") I 'SRDEATH G NODIE
|
---|
| 6 | S X1=SRDEATH,X2=-90 D C^%DTC S SRDAY=X,(CNT,SRDT)=0
|
---|
| 7 | 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
|
---|
| 8 | 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
|
---|
| 9 | W !!,"Operations in 90 Days Prior to Death:",!
|
---|
| 10 | F NUM=1:1 Q:'$D(SRCASE(NUM)) S SRCASE=SRCASE(NUM) D LIST W !
|
---|
| 11 | SEL ; select operation to update
|
---|
| 12 | 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."
|
---|
| 13 | S DIR("A")="Select Number of Operation to be Updated" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G END
|
---|
| 14 | I Y S NUM=Y D RELATED G OUT
|
---|
| 15 | G PAT
|
---|
| 16 | Q
|
---|
| 17 | RELATED ; update UNRELATED/RELATED status
|
---|
| 18 | S SRCASE=SRCASE(NUM) I $$LOCK^SROUTL(SRCASE) D D UNLOCK^SROUTL(SRCASE)
|
---|
| 19 | .D HDR W ! D LIST W ! K DA,DIE,DR S DA=SRCASE,DR="903T;904T",DIE=130 D ^DIE K DA,DIE,DR
|
---|
| 20 | Q
|
---|
| 21 | SET ; set up array of cases in 90 days prior to death
|
---|
| 22 | S SRSDATE=$P(^SRF(SRCASE,0),"^",9) I SRSDATE<SRDAY!(SRSDATE>SRDEATH) Q
|
---|
| 23 | I '$P($G(^SRF(SRCASE,.2)),"^",12)!$P($G(^SRF(SRCASE,30)),"^")!($P($G(^SRF(SRCASE,"NON")),"^")="Y")!$P($G(^SRF(SRCASE,37)),"^") Q
|
---|
| 24 | S CNT=CNT+1,SRCASE(CNT)=SRCASE
|
---|
| 25 | Q
|
---|
| 26 | LIST ; display list of operations
|
---|
| 27 | S X=$P($G(^SRF(SRCASE,.4)),"^",7) I X="" S X="U",$P(^SRF(SRCASE,.4),"^",7)=X
|
---|
| 28 | S SRELATE=$S(X="U":"UNRELATED",1:"RELATED")
|
---|
| 29 | S SROPER=$P(^SRF(SRCASE,"OP"),"^")
|
---|
| 30 | S SROPER=SROPER_" - "_SRELATE
|
---|
| 31 | 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
|
---|
| 32 | 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=""
|
---|
| 33 | W !,NUM_".",?3,DATE,?15,SROPS(1) I $D(SROPS(2)) W !,?15,SROPS(2) I $D(SROPS(3)) W !,?15,SROPS(3)
|
---|
| 34 | W !,?15," >>> Died "_SRLENGTH_" day"_$S(SRLENGTH>1:"s",1:"")_" postop. <<<"
|
---|
| 35 | Q
|
---|
| 36 | LOOP ; break procedures
|
---|
| 37 | 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
|
---|
| 38 | Q
|
---|
| 39 | HDR ; print heading
|
---|
| 40 | 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)_" *"
|
---|
| 41 | Q
|
---|
| 42 | 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
|
---|
| 43 | G PAT
|
---|
| 44 | END I SRSOUT K DIR S DIR(0)="E" D ^DIR
|
---|
| 45 | D ^SRSKILL W @IOF
|
---|
| 46 | Q
|
---|