| 1 | DGDEATH ;ALB/MRL/PJR-PROCESS DECEASED PATIENTS ; 10/27/04 9:45pm
|
|---|
| 2 | ;;5.3;Registration;**45,84,101,149,392,545,595,568,563,725**;Aug 13, 1993;Build 12
|
|---|
| 3 | ;
|
|---|
| 4 | GET N DGMTI,DATA
|
|---|
| 5 | S DGDTHEN="" W !! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S (DA,DFN)=+Y
|
|---|
| 6 | S DGDOLD=$G(^DPT(DFN,.35))
|
|---|
| 7 | I $D(^DPT(DFN,.1)) W !?3,"Patient is currently in-house. Discharge him with a discharge type of DEATH." G GET
|
|---|
| 8 | I $S($D(^DPT(DFN,.35)):^(.35),1:"") F DGY=0:0 S DGY=$O(^DGPM("ATID1",DFN,DGY)) Q:'DGY S DGDA=$O(^(DGY,0)) I $D(^DGPM(+DGDA,0)),$P(^(0),"^",17)]"" S DGXX=$P(^(0),"^",17),DGXX=^DGPM(DGXX,0) I "^12^38^"[("^"_$P(DGXX,"^",18)_"^") G DIS
|
|---|
| 9 | D NOW^%DTC S DGNOW=%
|
|---|
| 10 | S ^TMP("DEATH",$J)=1
|
|---|
| 11 | K A W ! S DIE=DIC,DR=".351" D ^DIE
|
|---|
| 12 | I '$D(^DPT(DFN,.35)) K ^TMP("DEATH",$J) G GET
|
|---|
| 13 | S DGDNEW=^DPT(DFN,.35)
|
|---|
| 14 | I $P(DGDNEW,"^",1)="",$P(DGDNEW,"^",2)'="" S DR=".352////@" D ^DIE
|
|---|
| 15 | I $P(DGDNEW,"^",1)="" K ^TMP("DEATH",$J) G GET
|
|---|
| 16 | I $P(DGDNEW,"^",1)'="" S DR=".353" D ^DIE
|
|---|
| 17 | I DGDOLD'=DGDNEW D DISCHRGE
|
|---|
| 18 | I $P(DGDOLD,"^",1)'=$P(DGDNEW,"^",1) D XFR
|
|---|
| 19 | K ^TMP("DEATH",$J) G GET
|
|---|
| 20 | ;
|
|---|
| 21 | DIS W !,"Patient has a discharge type of Death",!,"Edit the discharge",!
|
|---|
| 22 | Q K A,DA,DFN,DGDA,DIC,DIE,DR,DGXX,DGY,DGDTHEN,DGDOLD,DGDNEW,DGDONOT Q
|
|---|
| 23 | XFR ; called from set x-ref of field .351 of file 2
|
|---|
| 24 | N DGPCMM,DGFAPT,DGFAPTI,DGFAPT1
|
|---|
| 25 | Q:'$D(DFN)
|
|---|
| 26 | K DGTEXT D ^DGPATV S DGDEATH=$$GET1^DIQ(2,DFN,.351,"I"),XMSUB="PATIENT HAS EXPIRED",DGCT=0
|
|---|
| 27 | D DEMOG
|
|---|
| 28 | S DGT=X-.0001,(Y,DGDDT)=X,DG1="" D:DGT]"" ^DGPMSTAT
|
|---|
| 29 | S Y=$$FMTE^XLFDT(Y),Y=$S(Y]"":Y,1:"UNKNOWN")
|
|---|
| 30 | S DGDONOT=0 D APTT3
|
|---|
| 31 | D LINE("")
|
|---|
| 32 | D LINE(" Date/Time of Death: "_DEATHVAL_$S(DGDONOT:"",'DG1:"",$D(DGDTHEN):"",1:" (While an inpatient)"))
|
|---|
| 33 | D LINE("")
|
|---|
| 34 | I '$D(ADM),DG1,$D(^DGPM(+DGA1,0)) S ADM=+^DGPM($P(^(0),"^",14),0)
|
|---|
| 35 | S Y=$$FMTE^XLFDT($S($D(ADM):ADM,1:""))
|
|---|
| 36 | D LINE($S($D(DGDTHEN):"",DG1:" Admission Date/Time: "_Y_$S((DGDDT-ADM)<1:" (Within 24 hours of hospitalization)",1:""),1:""))
|
|---|
| 37 | D LINE("")
|
|---|
| 38 | S DGX=$P($G(^DGPM(+$G(DGA1),0)),"^",6),DGX=$P($G(^DIC(42,+DGX,0)),U,1)
|
|---|
| 39 | D LINE($S($D(DGDTHEN):"",('DG1):"",$D(DGA1):" Admitted To: "_$S(DGX]"":DGX,1:"UNKNOWN"),1:"")) K DGX
|
|---|
| 40 | D LINE("")
|
|---|
| 41 | I DG1&'$D(DGDTHEN) D
|
|---|
| 42 | . D LINE($S($D(DGXFR0):" Last Transfer: "_$S($D(^DIC(42,+$P(DGXFR0,"^",6),0)):$P(^(0),"^"),1:"UNKNOWN"),1:""))
|
|---|
| 43 | . D LINE("")
|
|---|
| 44 | F N DGARRAY,SDCNT S DGFAPT=DGDEATH,DGFAPTI=""
|
|---|
| 45 | S DGARRAY("FLDS")=3,DGARRAY(4)=DFN,DGARRAY("SORT")="P",DGARRAY(1)=DT,DGARRAY(3)="I;R"
|
|---|
| 46 | S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
|
|---|
| 47 | ;
|
|---|
| 48 | I SDCNT>0 F S DGFAPT=$O(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:'DGFAPT S DGFAPT1=$G(^TMP($J,"SDAMA301",DFN,DGFAPT)) Q:DGFAPT1']"" D Q:DGFAPTI
|
|---|
| 49 | .I $P($P(DGFAPT1,U,3),";")'["C" D LINE("NOTE: Patient has future appointments scheduled!!") S DGFAPTI=1
|
|---|
| 50 | S DGSCHAD=0 D SA I DGSCHAD D LINE("NOTE: Patient had scheduled admissions which have been cancelled!!")
|
|---|
| 51 | I 'DGVETS D LINE("Patient is a NON-VETERAN."_$S($D(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)):" ["_$P(^(0),"^",1)_"]",1:""))
|
|---|
| 52 | S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
|
|---|
| 53 | S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
|
|---|
| 54 | Q1 S DGB=1 D ^DGBUL S X=DGDEATH
|
|---|
| 55 | K DGDEATH,DGSCHAD,DGI,Y,DGDDT,^TMP($J,"SDAMA301") D KILL^DGPATV K ADM,DG1,DGA1,DGCT,DGT,DGXX,DGY,Z Q
|
|---|
| 56 | SA F DGI=0:0 S DGI=$O(^DGS(41.1,"B",DFN,DGI)) Q:'DGI I $D(^DGS(41.1,DGI,0)),($P(^(0),"^",13)']""),($P(^(0),"^",17)']"") S $P(^(0),"^",13)=DGDEATH,$P(^(0),"^",14)=+DUZ,$P(^(0),"^",15)=1,$P(^(0),"^",16)=2,DGSCHAD=1
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | DEL ; delete death bulletin
|
|---|
| 60 | N DGPCMM,DELBY,DELTM,DTHINFO
|
|---|
| 61 | S DFN=+$G(DA) I '$D(^DPT(DFN,0)) Q ; no patient node
|
|---|
| 62 | I +$G(^DPT(DFN,.35)) Q ; not deletion
|
|---|
| 63 | S DGDEATH=X,XMSUB="Patient Death has been Deleted",DGCT=0
|
|---|
| 64 | D ^DGPATV
|
|---|
| 65 | D LINE("The date of death for the following patient has been deleted.")
|
|---|
| 66 | D LINE("")
|
|---|
| 67 | D DEMOG
|
|---|
| 68 | D LINE("")
|
|---|
| 69 | S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array
|
|---|
| 70 | S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT)
|
|---|
| 71 | S DGB=1 D ^DGBUL S X=DGDEATH
|
|---|
| 72 | K DGCT,DGDEATH D KILL^DGPATV
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | DEMOG ; list main demographics
|
|---|
| 76 | D LINE(" NAME: "_DGNAME)
|
|---|
| 77 | D LINE(" SSN: "_$P(SSN,"^",2))
|
|---|
| 78 | D LINE(" DOB: "_$P(DOB,"^",2))
|
|---|
| 79 | I DGVETS D
|
|---|
| 80 | . N DGX
|
|---|
| 81 | . S DGX=$G(^DPT(DFN,.31))
|
|---|
| 82 | . S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGX,U,4)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED")
|
|---|
| 83 | . D LINE(" CLAIM FOLDER LOCATION: "_$S($D(DGLOCATN):DGLOCATN,1:"NOT LISTED"))
|
|---|
| 84 | . D LINE(" CLAIM NUMBER: "_$S($P(DGX,"^",3)]"":$P(DGX,"^",3),1:"NOT LISTED"))
|
|---|
| 85 | D LINE(" COORDINATING MASTER OF RECORD: "_DGCMOR)
|
|---|
| 86 | D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","DTHINFO")
|
|---|
| 87 | S DEATHVAL=$G(DTHINFO(2,DFN_",",.351,"E"))
|
|---|
| 88 | S DEATHVAL=$$FMTE^XLFDT(DEATHVAL),DEATHVAL=$S(DEATHVAL]"":DEATHVAL,1:"UNKNOWN")
|
|---|
| 89 | S SOURCE=$G(DTHINFO(2,DFN_",",.353,"E"))
|
|---|
| 90 | S DELTM=$G(DTHINFO(2,DFN_",",.354,"E"))
|
|---|
| 91 | S DELBY=$G(DTHINFO(2,DFN_",",.355,"E"))
|
|---|
| 92 | D LINE("")
|
|---|
| 93 | D LINE(" LAST EDITED BY: "_DELBY)
|
|---|
| 94 | D LINE(" DATE/TIME LAST MODIFIED: "_DELTM)
|
|---|
| 95 | D LINE(" SOURCE OF NOTIFICATION: "_$S(SOURCE="":"UNDEFINED",1:SOURCE))
|
|---|
| 96 | ;K DEATHVAL,SOURCE,DELTM,DELBY
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | LINE(X) ; add line contained in X to array
|
|---|
| 100 | S DGCT=DGCT+1
|
|---|
| 101 | S DGTEXT(DGCT,0)=X
|
|---|
| 102 | Q
|
|---|
| 103 | DSBULL ;
|
|---|
| 104 | ;
|
|---|
| 105 | I $G(IVMDODUP)=1 Q
|
|---|
| 106 | S DFN=DA
|
|---|
| 107 | I $D(DGPMDA) D Q
|
|---|
| 108 | .S DISTYPE=$P($G(^DGPM(DGPMDA,0)),"^",18)
|
|---|
| 109 | .I $G(^DG(405.2,DISTYPE,0))["DEATH" D
|
|---|
| 110 | ..S FDA(2,DFN_",",.353)=1 D FILE^DIE(,"FDA","BWFERR")
|
|---|
| 111 | ..D DISCHRGE,XFR
|
|---|
| 112 | I $D(^TMP("DEATH",$J)) Q
|
|---|
| 113 | D DISCHRGE,XFR
|
|---|
| 114 | Q
|
|---|
| 115 | DKBULL ;
|
|---|
| 116 | S DFN=DA
|
|---|
| 117 | S FDA(2,DFN_",",.353)="@"
|
|---|
| 118 | I $D(^TMP("DEATH",$J)) S FDA(2,DFN_",",.355)=DUZ
|
|---|
| 119 | D FILE^DIE(,"FDA",)
|
|---|
| 120 | D DEL
|
|---|
| 121 | Q
|
|---|
| 122 | DISCHRGE ;
|
|---|
| 123 | ; If the patient is being discharged, determine values needed for
|
|---|
| 124 | ; Source of Notification and Date/Time last entered.
|
|---|
| 125 | ;
|
|---|
| 126 | I '$D(DGNOW) S DGNOW=$$HTFM^XLFDT($H)
|
|---|
| 127 | I $G(DGDAUTO)'=1 S FDA(2,DFN_",",.354)=DGNOW
|
|---|
| 128 | S FDA(2,DFN_",",.355)=DUZ
|
|---|
| 129 | D FILE^DIE(,"FDA",)
|
|---|
| 130 | Q
|
|---|
| 131 | APTT3 ;Check to exclude "While an Inpatient" from DOD Bulletin
|
|---|
| 132 | ; Input: DFN Output: DGDONOT
|
|---|
| 133 | N DATE,XIEN,TYPE,XDOD,YES
|
|---|
| 134 | S DGDONOT=0
|
|---|
| 135 | S XDOD=$P($G(^DPT(DFN,.35)),"^",1) I 'XDOD Q
|
|---|
| 136 | S XDOD=$P(XDOD,".",1),YES=0,TYPE=""
|
|---|
| 137 | I '$D(^DGPM("APTT3",DFN)) Q
|
|---|
| 138 | S DATE=$O(^DGPM("APTT3",DFN,XDOD)) I 'DATE Q
|
|---|
| 139 | I $P(DATE,".",1)=XDOD S YES=1
|
|---|
| 140 | I ($P(DATE,".",1)-1)=XDOD S YES=1
|
|---|
| 141 | S XIEN=$O(^DGPM("APTT3",DFN,DATE,"")) I 'XIEN Q
|
|---|
| 142 | S TYPE=$P($G(^DGPM(XIEN,0)),"^",4)
|
|---|
| 143 | I YES,'((TYPE=27)!(TYPE=32)) S DGDONOT=1
|
|---|
| 144 | Q
|
|---|
