Released DG*5.3*595 SEQ #513 Extracted from mail message **KIDS**:DG*5.3*595^ **INSTALL NAME** DG*5.3*595 "BLD",4818,0) DG*5.3*595^REGISTRATION^0^3040407^y "BLD",4818,1,0) ^^1^1^3040406^ "BLD",4818,1,1,0) CORRECT FUTURE APPOINTMENTS ON DEATH BULLETIN "BLD",4818,4,0) ^9.64PA^^ "BLD",4818,"ABPKG") n "BLD",4818,"KRN",0) ^9.67PA^8989.52^19 "BLD",4818,"KRN",.4,0) .4 "BLD",4818,"KRN",.401,0) .401 "BLD",4818,"KRN",.402,0) .402 "BLD",4818,"KRN",.403,0) .403 "BLD",4818,"KRN",.5,0) .5 "BLD",4818,"KRN",.84,0) .84 "BLD",4818,"KRN",3.6,0) 3.6 "BLD",4818,"KRN",3.8,0) 3.8 "BLD",4818,"KRN",9.2,0) 9.2 "BLD",4818,"KRN",9.8,0) 9.8 "BLD",4818,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",4818,"KRN",9.8,"NM",1,0) DGDEATH^^0^B25935205 "BLD",4818,"KRN",9.8,"NM","B","DGDEATH",1) "BLD",4818,"KRN",19,0) 19 "BLD",4818,"KRN",19.1,0) 19.1 "BLD",4818,"KRN",101,0) 101 "BLD",4818,"KRN",409.61,0) 409.61 "BLD",4818,"KRN",771,0) 771 "BLD",4818,"KRN",870,0) 870 "BLD",4818,"KRN",8989.51,0) 8989.51 "BLD",4818,"KRN",8989.52,0) 8989.52 "BLD",4818,"KRN",8994,0) 8994 "BLD",4818,"KRN","B",.4,.4) "BLD",4818,"KRN","B",.401,.401) "BLD",4818,"KRN","B",.402,.402) "BLD",4818,"KRN","B",.403,.403) "BLD",4818,"KRN","B",.5,.5) "BLD",4818,"KRN","B",.84,.84) "BLD",4818,"KRN","B",3.6,3.6) "BLD",4818,"KRN","B",3.8,3.8) "BLD",4818,"KRN","B",9.2,9.2) "BLD",4818,"KRN","B",9.8,9.8) "BLD",4818,"KRN","B",19,19) "BLD",4818,"KRN","B",19.1,19.1) "BLD",4818,"KRN","B",101,101) "BLD",4818,"KRN","B",409.61,409.61) "BLD",4818,"KRN","B",771,771) "BLD",4818,"KRN","B",870,870) "BLD",4818,"KRN","B",8989.51,8989.51) "BLD",4818,"KRN","B",8989.52,8989.52) "BLD",4818,"KRN","B",8994,8994) "BLD",4818,"QUES",0) ^9.62^^ "BLD",4818,"REQB",0) ^9.611^1^1 "BLD",4818,"REQB",1,0) DG*5.3*545^2 "BLD",4818,"REQB","B","DG*5.3*545",1) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 595^3040407 "PKG",5,22,1,"PAH",1,1,0) ^^1^1^3040407 "PKG",5,22,1,"PAH",1,1,1,0) CORRECT FUTURE APPOINTMENTS ON DEATH BULLETIN "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","DGDEATH") 0^1^B25935205 "RTN","DGDEATH",1,0) DGDEATH ;ALB/MRL-PROCESS DECEASED PATIENTS ;19 JUN 87 "RTN","DGDEATH",2,0) ;;5.3;Registration;**45,84,101,149,392,545,595**;Aug 13, 1993 "RTN","DGDEATH",3,0) ; "RTN","DGDEATH",4,0) GET S DGDTHEN="" W !! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S (DA,DFN)=+Y "RTN","DGDEATH",5,0) I $D(^DPT(DFN,.1)) W !?3,"Patient is currently in-house. Discharge him with a discharge type of DEATH." G GET "RTN","DGDEATH",6,0) 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 "RTN","DGDEATH",7,0) D NOW^%DTC S DGNOW=% "RTN","DGDEATH",8,0) S ^TMP("DEATH",$J)=1 "RTN","DGDEATH",9,0) K A W ! S DIE=DIC,DR=".351" D ^DIE "RTN","DGDEATH",10,0) I '$D(^DPT(DFN,.35)) G GET "RTN","DGDEATH",11,0) I $P(^DPT(DFN,.35),"^",1)="" K ^TMP("DEATH",$J) G GET "RTN","DGDEATH",12,0) I $P(^DPT(DFN,.35),"^",1)'="" S DR=".353" D ^DIE "RTN","DGDEATH",13,0) D DISCHRGE,XFR "RTN","DGDEATH",14,0) K ^TMP("DEATH",$J) G GET "RTN","DGDEATH",15,0) ; "RTN","DGDEATH",16,0) DIS W !,"Patient has a discharge type of Death",!,"Edit the discharge",! "RTN","DGDEATH",17,0) Q K A,DA,DFN,DGDA,DIC,DIE,DR,DGXX,DGY,DGDTHEN Q "RTN","DGDEATH",18,0) XFR ; called from set x-ref of field .351 of file 2 "RTN","DGDEATH",19,0) N DGPCMM,DGFAPT,DGFAPTI,DGFAPT1 "RTN","DGDEATH",20,0) Q:'$D(DFN) "RTN","DGDEATH",21,0) K DGTEXT D ^DGPATV S DGDEATH=$$GET1^DIQ(2,DFN,.351,"I"),XMSUB="PATIENT HAS EXPIRED",DGCT=0 "RTN","DGDEATH",22,0) D DEMOG "RTN","DGDEATH",23,0) S DGT=X-.0001,(Y,DGDDT)=X,DG1="" D:DGT]"" ^DGINPW "RTN","DGDEATH",24,0) S Y=$$FMTE^XLFDT(Y),Y=$S(Y]"":Y,1:"UNKNOWN") "RTN","DGDEATH",25,0) D LINE("") "RTN","DGDEATH",26,0) D LINE(" Date/Time of Death: "_DEATHVAL_$S('DG1:"",$D(DGDTHEN):"",1:" (While an inpatient)")) "RTN","DGDEATH",27,0) D LINE("") "RTN","DGDEATH",28,0) I '$D(ADM),DG1,$D(^DGPM(+DGA1,0)) S ADM=+^DGPM($P(^(0),"^",14),0) "RTN","DGDEATH",29,0) S Y=$$FMTE^XLFDT($S($D(ADM):ADM,1:"")) "RTN","DGDEATH",30,0) D LINE($S($D(DGDTHEN):"",DG1:" Admission Date/Time: "_Y_$S((DGDDT-ADM)<1:" (Within 24 hours of hospitalization)",1:""),1:"")) "RTN","DGDEATH",31,0) D LINE("") "RTN","DGDEATH",32,0) S DGX=$P($G(^DGPM(+$G(DGA1),0)),"^",6),DGX=$P($G(^DIC(42,+DGX,0)),U,1) "RTN","DGDEATH",33,0) D LINE($S($D(DGDTHEN):"",('DG1):"",$D(DGA1):" Admitted To: "_$S(DGX]"":DGX,1:"UNKNOWN"),1:"")) K DGX "RTN","DGDEATH",34,0) D LINE("") "RTN","DGDEATH",35,0) I DG1&'$D(DGDTHEN) D "RTN","DGDEATH",36,0) . D LINE($S($D(DGXFR0):" Last Transfer: "_$S($D(^DIC(42,+$P(DGXFR0,"^",6),0)):$P(^(0),"^"),1:"UNKNOWN"),1:"")) "RTN","DGDEATH",37,0) . D LINE("") "RTN","DGDEATH",38,0) F S DGFAPT=DGDEATH,DGFAPTI="" "RTN","DGDEATH",39,0) F S DGFAPT=$O(^DPT(DFN,"S",DGFAPT)) Q:'DGFAPT S DGFAPT1=$G(^(DGFAPT,0)) Q:'DGFAPT1 D Q:DGFAPTI "RTN","DGDEATH",40,0) .I $P(DGFAPT1,"^",2)'["C" D LINE("NOTE: Patient has future appointments scheduled!!") S DGFAPTI=1 "RTN","DGDEATH",41,0) S DGSCHAD=0 D SA I DGSCHAD D LINE("NOTE: Patient had scheduled admissions which have been cancelled!!") "RTN","DGDEATH",42,0) I 'DGVETS D LINE("Patient is a NON-VETERAN."_$S($D(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)):" ["_$P(^(0),"^",1)_"]",1:"")) "RTN","DGDEATH",43,0) S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array "RTN","DGDEATH",44,0) S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT) "RTN","DGDEATH",45,0) Q1 S DGB=1 D ^DGBUL S X=DGDEATH "RTN","DGDEATH",46,0) K DGDEATH,DGSCHAD,DGI,Y,DGDDT D KILL^DGPATV K ADM,DG1,DGA1,DGCT,DGT,DGXX,DGY,Z Q "RTN","DGDEATH",47,0) 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 "RTN","DGDEATH",48,0) Q "RTN","DGDEATH",49,0) ; "RTN","DGDEATH",50,0) DEL ; delete death bulletin "RTN","DGDEATH",51,0) N DGPCMM,DELBY,DELTM,DTHINFO "RTN","DGDEATH",52,0) S DFN=+$G(DA) I '$D(^DPT(DFN,0)) Q ; no patient node "RTN","DGDEATH",53,0) I +$G(^DPT(DFN,.35)) Q ; not deletion "RTN","DGDEATH",54,0) S DGDEATH=X,XMSUB="Patient Death has been Deleted",DGCT=0 "RTN","DGDEATH",55,0) D ^DGPATV "RTN","DGDEATH",56,0) D LINE("The date of death for the following patient has been deleted.") "RTN","DGDEATH",57,0) D LINE("") "RTN","DGDEATH",58,0) D DEMOG "RTN","DGDEATH",59,0) D LINE("") "RTN","DGDEATH",60,0) S DGPCMM=$$PCMMXMY^SCAPMC25(1,DFN,,,0) ;creates xmy array "RTN","DGDEATH",61,0) S DGCT=$$PCMAIL^SCMCMM(DFN,"DGTEXT",DT) "RTN","DGDEATH",62,0) S DGB=1 D ^DGBUL S X=DGDEATH "RTN","DGDEATH",63,0) K DGCT,DGDEATH D KILL^DGPATV "RTN","DGDEATH",64,0) Q "RTN","DGDEATH",65,0) ; "RTN","DGDEATH",66,0) DEMOG ; list main demographics "RTN","DGDEATH",67,0) D LINE(" NAME: "_DGNAME) "RTN","DGDEATH",68,0) D LINE(" SSN: "_$P(SSN,"^",2)) "RTN","DGDEATH",69,0) D LINE(" DOB: "_$P(DOB,"^",2)) "RTN","DGDEATH",70,0) I DGVETS D "RTN","DGDEATH",71,0) . N DGX "RTN","DGDEATH",72,0) . S DGX=$G(^DPT(DFN,.31)) "RTN","DGDEATH",73,0) . S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGX,U,4)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED") "RTN","DGDEATH",74,0) . D LINE(" CLAIM FOLDER LOCATION: "_$S($D(DGLOCATN):DGLOCATN,1:"NOT LISTED")) "RTN","DGDEATH",75,0) . D LINE(" CLAIM NUMBER: "_$S($P(DGX,"^",3)]"":$P(DGX,"^",3),1:"NOT LISTED")) "RTN","DGDEATH",76,0) D LINE(" COORDINATING MASTER OF RECORD: "_DGCMOR) "RTN","DGDEATH",77,0) D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","DTHINFO") "RTN","DGDEATH",78,0) S DEATHVAL=$G(DTHINFO(2,DFN_",",.351,"E")) "RTN","DGDEATH",79,0) S DEATHVAL=$$FMTE^XLFDT(DEATHVAL),DEATHVAL=$S(DEATHVAL]"":DEATHVAL,1:"UNKNOWN") "RTN","DGDEATH",80,0) S SOURCE=$G(DTHINFO(2,DFN_",",.353,"E")) "RTN","DGDEATH",81,0) S DELTM=$G(DTHINFO(2,DFN_",",.354,"E")) "RTN","DGDEATH",82,0) S DELBY=$G(DTHINFO(2,DFN_",",.355,"E")) "RTN","DGDEATH",83,0) D LINE("") "RTN","DGDEATH",84,0) D LINE(" LAST EDITED BY: "_DELBY) "RTN","DGDEATH",85,0) D LINE(" DATE/TIME LAST MODIFIED: "_DELTM) "RTN","DGDEATH",86,0) D LINE(" SOURCE OF NOTIFICATION: "_$S(SOURCE="":"UNDEFINED",1:SOURCE)) "RTN","DGDEATH",87,0) ;K DEATHVAL,SOURCE,DELTM,DELBY "RTN","DGDEATH",88,0) Q "RTN","DGDEATH",89,0) ; "RTN","DGDEATH",90,0) LINE(X) ; add line contained in X to array "RTN","DGDEATH",91,0) S DGCT=DGCT+1 "RTN","DGDEATH",92,0) S DGTEXT(DGCT,0)=X "RTN","DGDEATH",93,0) Q "RTN","DGDEATH",94,0) DSBULL ; "RTN","DGDEATH",95,0) ; "RTN","DGDEATH",96,0) S DFN=DA "RTN","DGDEATH",97,0) I $D(DGPMDA) D Q "RTN","DGDEATH",98,0) .S DISTYPE=$P($G(^DGPM(DGPMDA,0)),"^",18) "RTN","DGDEATH",99,0) .I $G(^DG(405.2,DISTYPE,0))["DEATH" D "RTN","DGDEATH",100,0) ..S FDA(2,DFN_",",.353)=1 D FILE^DIE(,"FDA","BWFERR") "RTN","DGDEATH",101,0) ..D DISCHRGE,XFR "RTN","DGDEATH",102,0) I $D(^TMP("DEATH",$J)) Q "RTN","DGDEATH",103,0) D DISCHRGE,XFR "RTN","DGDEATH",104,0) Q "RTN","DGDEATH",105,0) DKBULL ; "RTN","DGDEATH",106,0) S DFN=DA "RTN","DGDEATH",107,0) S FDA(2,DFN_",",.353)="@" D FILE^DIE(,"FDA",) "RTN","DGDEATH",108,0) D DISCHRGE,DEL "RTN","DGDEATH",109,0) Q "RTN","DGDEATH",110,0) DISCHRGE ; "RTN","DGDEATH",111,0) ; If the patient is being discharged, determine values needed for "RTN","DGDEATH",112,0) ; Source of Notification and Date/Time last entered. "RTN","DGDEATH",113,0) ; "RTN","DGDEATH",114,0) I '$D(DGNOW) S DGNOW=$$HTFM^XLFDT($H) "RTN","DGDEATH",115,0) S FDA(2,DFN_",",.354)=DGNOW "RTN","DGDEATH",116,0) S FDA(2,DFN_",",.355)=DUZ "RTN","DGDEATH",117,0) D FILE^DIE(,"FDA",) "RTN","DGDEATH",118,0) Q "VER") 8.0^22.0 **END** **END**