source: WorldVistAEHR/trunk/r/SURGERY-SR/SRODTH.m@ 1764

Last change on this file since 1764 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1SRODTH ;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
3PAT 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
8OUT 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 !
11SEL ; 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
17RELATED ; 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
21SET ; 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
26LIST ; 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
36LOOP ; 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
39HDR ; 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
42NODIE 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
44END I SRSOUT K DIR S DIR(0)="E" D ^DIR
45 D ^SRSKILL W @IOF
46 Q
Note: See TracBrowser for help on using the repository browser.