Released DG*5.3*687 SEQ #603 Extracted from mail message **KIDS**:DG*5.3*687^ **INSTALL NAME** DG*5.3*687 "BLD",6543,0) DG*5.3*687^REGISTRATION^0^3060206^y "BLD",6543,1,0) ^^2^2^3051219^ "BLD",6543,1,1,0) This patch corrects problems caused when Patient Treatment file (#45) "BLD",6543,1,2,0) records are deleted. "BLD",6543,4,0) ^9.64PA^^ "BLD",6543,6) 2^ "BLD",6543,"INI") DG687PRE "BLD",6543,"INIT") DG687PST "BLD",6543,"KRN",0) ^9.67PA^8989.52^19 "BLD",6543,"KRN",.4,0) .4 "BLD",6543,"KRN",.401,0) .401 "BLD",6543,"KRN",.402,0) .402 "BLD",6543,"KRN",.403,0) .403 "BLD",6543,"KRN",.5,0) .5 "BLD",6543,"KRN",.84,0) .84 "BLD",6543,"KRN",3.6,0) 3.6 "BLD",6543,"KRN",3.8,0) 3.8 "BLD",6543,"KRN",9.2,0) 9.2 "BLD",6543,"KRN",9.8,0) 9.8 "BLD",6543,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",6543,"KRN",9.8,"NM",1,0) DG687PRE^^0^B3068531 "BLD",6543,"KRN",9.8,"NM",2,0) DG687PST^^0^B700925 "BLD",6543,"KRN",9.8,"NM","B","DG687PRE",1) "BLD",6543,"KRN",9.8,"NM","B","DG687PST",2) "BLD",6543,"KRN",19,0) 19 "BLD",6543,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",6543,"KRN",19,"NM",1,0) DGPT ARCHIVE/PURGE^^1^ "BLD",6543,"KRN",19,"NM","B","DGPT ARCHIVE/PURGE",1) "BLD",6543,"KRN",19.1,0) 19.1 "BLD",6543,"KRN",101,0) 101 "BLD",6543,"KRN",409.61,0) 409.61 "BLD",6543,"KRN",771,0) 771 "BLD",6543,"KRN",870,0) 870 "BLD",6543,"KRN",8989.51,0) 8989.51 "BLD",6543,"KRN",8989.52,0) 8989.52 "BLD",6543,"KRN",8994,0) 8994 "BLD",6543,"KRN","B",.4,.4) "BLD",6543,"KRN","B",.401,.401) "BLD",6543,"KRN","B",.402,.402) "BLD",6543,"KRN","B",.403,.403) "BLD",6543,"KRN","B",.5,.5) "BLD",6543,"KRN","B",.84,.84) "BLD",6543,"KRN","B",3.6,3.6) "BLD",6543,"KRN","B",3.8,3.8) "BLD",6543,"KRN","B",9.2,9.2) "BLD",6543,"KRN","B",9.8,9.8) "BLD",6543,"KRN","B",19,19) "BLD",6543,"KRN","B",19.1,19.1) "BLD",6543,"KRN","B",101,101) "BLD",6543,"KRN","B",409.61,409.61) "BLD",6543,"KRN","B",771,771) "BLD",6543,"KRN","B",870,870) "BLD",6543,"KRN","B",8989.51,8989.51) "BLD",6543,"KRN","B",8989.52,8989.52) "BLD",6543,"KRN","B",8994,8994) "BLD",6543,"QUES",0) ^9.62^^ "BLD",6543,"REQB",0) ^9.611^1^1 "BLD",6543,"REQB",1,0) DG*5.3*478^1 "BLD",6543,"REQB","B","DG*5.3*478",1) "INI") DG687PRE "INIT") DG687PST "KRN",19,12849,-1) 1^1 "KRN",19,12849,0) DGPT ARCHIVE/PURGE "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "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) 687^3060206^100850 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3060206 "PKG",5,22,1,"PAH",1,1,1,0) This patch corrects problems caused when Patient Treatment file (#45) "PKG",5,22,1,"PAH",1,1,2,0) records are deleted. "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") 2 "RTN","DG687PRE") 0^1^B3068531 "RTN","DG687PRE",1,0) DG687PRE ;BAY/JAT;reset kill nodes of "AC" and "AADA1" on file 45 "RTN","DG687PRE",2,0) ;;5.3;Registration;**687*;Aug 13,1993 "RTN","DG687PRE",3,0) ; "RTN","DG687PRE",4,0) ; This is a pre-init routine for DG*5.3*687 "RTN","DG687PRE",5,0) ; The purpose is to reset kill nodes on the "AC" and "AADA1" "RTN","DG687PRE",6,0) ; crossreferences of the discharge date (field #70) on "RTN","DG687PRE",7,0) ; the Patient Treatment file (#45) "RTN","DG687PRE",8,0) ; "RTN","DG687PRE",9,0) EN ; "RTN","DG687PRE",10,0) N DGI "RTN","DG687PRE",11,0) D BMES^XPDUTL("Updating the ""AC"" cross reference...") "RTN","DG687PRE",12,0) S DGI=0 F S DGI=$O(^DD(45,70,1,DGI)) Q:'DGI D "RTN","DG687PRE",13,0) .Q:$P($G(^DD(45,70,1,DGI,0)),U,2)'="AC" "RTN","DG687PRE",14,0) .S ^DD(45,70,1,DGI,2)="S %=$S($D(^DGPT(DA,""M"",1,0)):^(0),1:""""),%D=+$P(%,U,10),^(0)=$P(%_""^^^^^^^^^^"",U,1,9)_U_X_U_$P(%,U,11,99) K ^DGPT(DA,""M"",""AM"",%D,1),%,%D" "RTN","DG687PRE",15,0) D BMES^XPDUTL("Updating the ""AADA1"" cross reference...") "RTN","DG687PRE",16,0) S DGI=0 F S DGI=$O(^DD(45,70,1,DGI)) Q:'DGI D "RTN","DG687PRE",17,0) .Q:$P($G(^DD(45,70,1,DGI,0)),U,2)'="AADA1" "RTN","DG687PRE",18,0) .S ^DD(45,70,1,DGI,2)="S L=$P(^DGPT(DA,0),""^"",2) I L?7N.E,$G(DIK)'=""^DGPT("" S ^DGPT(""AADA"",L,DA)=""""" "RTN","DG687PRE",19,0) I $D(^DD(45,0,"DIK")) N X,Y,DMAX S X=^DD(45,0,"DIK"),Y=45,DMAX=$$ROUSIZE^DILF D EN^DIKZ Q ;Trigger xref re-compile if already compiled "RTN","DG687PRE",20,0) Q "RTN","DG687PST") 0^2^B700925 "RTN","DG687PST",1,0) DG687PST ;BAY/JAT;cleanup of "AADA" crossref on file 45 "RTN","DG687PST",2,0) ;;5.3;Registration;**687*;Aug 13,1993 "RTN","DG687PST",3,0) ; "RTN","DG687PST",4,0) ; This is a post-init routine for DG*5.3*687 "RTN","DG687PST",5,0) ; The purpose is to cleanup the "AADA" crossreference on field #70 "RTN","DG687PST",6,0) ; of the Patient Treatment file (#45). Any entries for which "RTN","DG687PST",7,0) ; there is no PTF zero node is to be deleted. "RTN","DG687PST",8,0) ; "RTN","DG687PST",9,0) EN ; "RTN","DG687PST",10,0) D BMES^XPDUTL("Deleting bogus ""AADA"" cross references") "RTN","DG687PST",11,0) N DGDTE,DGPTIEN,CNT "RTN","DG687PST",12,0) S DGDTE=0 "RTN","DG687PST",13,0) S CNT=0 "RTN","DG687PST",14,0) F S DGDTE=$O(^DGPT("AADA",DGDTE)) Q:'DGDTE D "RTN","DG687PST",15,0) .S DGPTIEN=0 "RTN","DG687PST",16,0) .F S DGPTIEN=$O(^DGPT("AADA",DGDTE,DGPTIEN)) Q:'DGPTIEN D "RTN","DG687PST",17,0) ..I '$D(^DGPT(DGPTIEN,0)) D "RTN","DG687PST",18,0) ...S CNT=CNT+1 "RTN","DG687PST",19,0) ...K ^DGPT("AADA",DGDTE,DGPTIEN) "RTN","DG687PST",20,0) Q "VER") 8.0^22.0 "BLD",6543,6) ^603 **END** **END**