| 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 | 
|---|