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