Released DG*5.3*558 SEQ #488 Extracted from mail message **KIDS**:DG*5.3*558^ **INSTALL NAME** DG*5.3*558 "BLD",5175,0) DG*5.3*558^REGISTRATION^0^3040103^y "BLD",5175,1,0) ^^2^2^3031029^ "BLD",5175,1,1,0) This patch contains a couple of cleanup routines to remove duplicate and "BLD",5175,1,2,0) bad Means Tests from the ANNUAL MEANS TEST file #408.31. "BLD",5175,4,0) ^9.64PA^^ "BLD",5175,"KRN",0) ^9.67PA^8989.52^19 "BLD",5175,"KRN",.4,0) .4 "BLD",5175,"KRN",.401,0) .401 "BLD",5175,"KRN",.402,0) .402 "BLD",5175,"KRN",.403,0) .403 "BLD",5175,"KRN",.5,0) .5 "BLD",5175,"KRN",.84,0) .84 "BLD",5175,"KRN",3.6,0) 3.6 "BLD",5175,"KRN",3.8,0) 3.8 "BLD",5175,"KRN",9.2,0) 9.2 "BLD",5175,"KRN",9.8,0) 9.8 "BLD",5175,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",5175,"KRN",9.8,"NM",1,0) DG53358D^^0^B28560677 "BLD",5175,"KRN",9.8,"NM",2,0) DG53558^^0^B46602062 "BLD",5175,"KRN",9.8,"NM",3,0) DG53358C^^0^B1030394 "BLD",5175,"KRN",9.8,"NM",4,0) DG53558M^^0^B31371417 "BLD",5175,"KRN",9.8,"NM","B","DG53358C",3) "BLD",5175,"KRN",9.8,"NM","B","DG53358D",1) "BLD",5175,"KRN",9.8,"NM","B","DG53558",2) "BLD",5175,"KRN",9.8,"NM","B","DG53558M",4) "BLD",5175,"KRN",19,0) 19 "BLD",5175,"KRN",19,"NM",0) ^9.68A^3^3 "BLD",5175,"KRN",19,"NM",1,0) DG CLEANUP INCOME TEST DUPES^^0^ "BLD",5175,"KRN",19,"NM",2,0) DG CLEANUP INCOME TEST MONITOR^^0^ "BLD",5175,"KRN",19,"NM",3,0) DG MEANS TEST SUPERVISOR MENU^^3 "BLD",5175,"KRN",19,"NM","B","DG CLEANUP INCOME TEST DUPES",1) "BLD",5175,"KRN",19,"NM","B","DG CLEANUP INCOME TEST MONITOR",2) "BLD",5175,"KRN",19,"NM","B","DG MEANS TEST SUPERVISOR MENU",3) "BLD",5175,"KRN",19.1,0) 19.1 "BLD",5175,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",5175,"KRN",101,0) 101 "BLD",5175,"KRN",409.61,0) 409.61 "BLD",5175,"KRN",771,0) 771 "BLD",5175,"KRN",870,0) 870 "BLD",5175,"KRN",8989.51,0) 8989.51 "BLD",5175,"KRN",8989.52,0) 8989.52 "BLD",5175,"KRN",8994,0) 8994 "BLD",5175,"KRN","B",.4,.4) "BLD",5175,"KRN","B",.401,.401) "BLD",5175,"KRN","B",.402,.402) "BLD",5175,"KRN","B",.403,.403) "BLD",5175,"KRN","B",.5,.5) "BLD",5175,"KRN","B",.84,.84) "BLD",5175,"KRN","B",3.6,3.6) "BLD",5175,"KRN","B",3.8,3.8) "BLD",5175,"KRN","B",9.2,9.2) "BLD",5175,"KRN","B",9.8,9.8) "BLD",5175,"KRN","B",19,19) "BLD",5175,"KRN","B",19.1,19.1) "BLD",5175,"KRN","B",101,101) "BLD",5175,"KRN","B",409.61,409.61) "BLD",5175,"KRN","B",771,771) "BLD",5175,"KRN","B",870,870) "BLD",5175,"KRN","B",8989.51,8989.51) "BLD",5175,"KRN","B",8989.52,8989.52) "BLD",5175,"KRN","B",8994,8994) "BLD",5175,"QUES",0) ^9.62^^ "KRN",19,869,-1) 3^3 "KRN",19,869,0) DG MEANS TEST SUPERVISOR MENU^Means Test Supervisor Menu^^M^^DG MEANSTEST^^^^^^REGISTRATION^y "KRN",19,869,1,0) ^19.06^1^1^3011207^^^^ "KRN",19,869,1,1,0) Means test supervisor menu. "KRN",19,869,10,0) ^19.01IP^11^11 "KRN",19,869,10,10,0) 11922 "KRN",19,869,10,10,"^") DG CLEANUP INCOME TEST DUPES "KRN",19,869,10,11,0) 11923 "KRN",19,869,10,11,"^") DG CLEANUP INCOME TEST MONITOR "KRN",19,869,99) 59487,35259 "KRN",19,869,99.1) 59527,27251 "KRN",19,869,"U") MEANS TEST SUPERVISOR MENU "KRN",19,11922,-1) 0^1 "KRN",19,11922,0) DG CLEANUP INCOME TEST DUPES^Purge Duplicate Income Tests^^R^^^^^^^^ "KRN",19,11922,1,0) ^19.06^4^4^3031103^^ "KRN",19,11922,1,1,0) This option will allow the authorized user to run the cleanup utility. "KRN",19,11922,1,2,0) This utility purges duplicate tests that appear on the same day. It will "KRN",19,11922,1,3,0) leave one valid test per day. This utility will also delete "BAD" "KRN",19,11922,1,4,0) tests. Theses "BAD" tests are defined as ones that have a null status. "KRN",19,11922,25) EN^DG53558 "KRN",19,11922,"U") PURGE DUPLICATE INCOME TESTS "KRN",19,11923,-1) 0^2 "KRN",19,11923,0) DG CLEANUP INCOME TEST MONITOR^Purge Income Test Monitor^^R^^^^^^^^ "KRN",19,11923,1,0) ^^4^4^3031103^ "KRN",19,11923,1,1,0) This option will monitor the cleanup process previously selected. If "KRN",19,11923,1,2,0) the process has been stopped, then it may be resumed where it left off. "KRN",19,11923,1,3,0) If the process has run to Completion, then re-running the Purge option, "KRN",19,11923,1,4,0) will kill the XTMP work file, and start over. "KRN",19,11923,25) MONITOR^DG53558M "KRN",19,11923,"U") PURGE INCOME TEST MONITOR "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) 558^3040103^100835 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3040103 "PKG",5,22,1,"PAH",1,1,1,0) This patch contains a couple of cleanup routines to remove duplicate and "PKG",5,22,1,"PAH",1,1,2,0) bad Means Tests from the ANNUAL MEANS TEST file #408.31. "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") 4 "RTN","DG53358C") 0^3^B1030394 "RTN","DG53358C",1,0) DG53358C ;ALB/AEG,GN DG*5.3*296 DELETE INC TEST CON'T;01 JUNE 2000 ; 10/29/03 2:41pm "RTN","DG53358C",2,0) ;;5.3;REGISTRATION;**358,558**;JUNE 1 2000 "RTN","DG53358C",3,0) ; "RTN","DG53358C",4,0) ;This is a modified version for IVMCMD1. It deletes records "RTN","DG53358C",5,0) ;from the Annual Means Test(#408.31) file. It does not open "RTN","DG53358C",6,0) ;a case record in the IVM Patient (#301.5)file, does not send 'delete' "RTN","DG53358C",7,0) ;bulletin/notification to local mail group, does not call the means "RTN","DG53358C",8,0) ;test event driver and does not call DGMTR. "RTN","DG53358C",9,0) ; "RTN","DG53358C",10,0) ;DG*53*558 - re-deploy with this patch "RTN","DG53358C",11,0) ; "RTN","DG53358C",12,0) EN ;This entry point is called from the routine (DG53358D) and "RTN","DG53358C",13,0) ;contains calls that are responsible for completing the "RTN","DG53358C",14,0) ;deletion of an income test. "RTN","DG53358C",15,0) ; "RTN","DG53358C",16,0) ; Delete record from Annual Means Test (#408.31) file "RTN","DG53358C",17,0) D DEL31(IVMMTIEN) "RTN","DG53358C",18,0) S IVMDONE=1 "RTN","DG53358C",19,0) ; "RTN","DG53358C",20,0) ; Cleanup variables "RTN","DG53358C",21,0) D CLEAN "RTN","DG53358C",22,0) ; "RTN","DG53358C",23,0) ENQ Q "RTN","DG53358C",24,0) ; "RTN","DG53358C",25,0) ; "RTN","DG53358C",26,0) DEL31(IVMDIEN) ; Delete record from Annual Means Test (#408.31) file. "RTN","DG53358C",27,0) ; "RTN","DG53358C",28,0) ; Input(s): "RTN","DG53358C",29,0) ; IVMDIEN - as IEN of the Annual Means Test (#408.31) file "RTN","DG53358C",30,0) ; "RTN","DG53358C",31,0) ; Output(s): None "RTN","DG53358C",32,0) ; "RTN","DG53358C",33,0) N DA,DIK "RTN","DG53358C",34,0) S DA=IVMDIEN,DIK="^DGMT(408.31," "RTN","DG53358C",35,0) D ^DIK "RTN","DG53358C",36,0) Q "RTN","DG53358C",37,0) ; "RTN","DG53358C",38,0) ; "RTN","DG53358C",39,0) ; "RTN","DG53358C",40,0) CLEAN ; Cleanup variables used for deletion. "RTN","DG53358C",41,0) K DA,DFN,DGINC,DGINR,DGMTA,DGMTACT,DGMTI,DGMTP "RTN","DG53358C",42,0) K DGMTYPT,DIE,DIK,DR,IVM12,IVM121,IVM13,IVM41,IVM411 "RTN","DG53358C",43,0) K IVMAR1,IVMDEP,IVMFILE,IVMNOD,IVMOLD "RTN","DG53358C",44,0) K IVMPAT,IVMTEXT,IVMVAMCA,XMSUB,Y "RTN","DG53358C",45,0) Q "RTN","DG53358D") 0^1^B28560677 "RTN","DG53358D",1,0) DG53358D ;ALB/AEG,GN DG*5.3*358 DELETE INCOME TESTS ; 12/17/03 3:06pm "RTN","DG53358D",2,0) ;;5.3;REGISTRATION;**358,558**;5-1-2001 "RTN","DG53358D",3,0) ; "RTN","DG53358D",4,0) ;This is a modified version of IVMCMD in that it calls a modified "RTN","DG53358D",5,0) ;version of IVMCMD1 called DG53358C which only deletes the "RTN","DG53358D",6,0) ;records from the Annual Means Test(#408.31) file. It does not open "RTN","DG53358D",7,0) ;a case record in the IVM Patient (#301.5)file, does not send 'delete' "RTN","DG53358D",8,0) ;bulletin/notification to local mail group, does not call the means "RTN","DG53358D",9,0) ;test event driver and does not call DGMTR. "RTN","DG53358D",10,0) ; "RTN","DG53358D",11,0) ;DG*53*558 - re-deploy with this patch "RTN","DG53358D",12,0) ; "RTN","DG53358D",13,0) EN(IVMMTIEN) ; -- "RTN","DG53358D",14,0) ; This routine will process income test deletion requests received "RTN","DG53358D",15,0) ; from the IVM Center. "RTN","DG53358D",16,0) ; "RTN","DG53358D",17,0) ; Input(s): "RTN","DG53358D",18,0) ; IVMMTIEN - pointer to test to be deleted in file 408.31 "RTN","DG53358D",19,0) ; "RTN","DG53358D",20,0) ; Output(s): "RTN","DG53358D",21,0) ; Function Value - 1 test deleted "RTN","DG53358D",22,0) ; 0 test not deleted "RTN","DG53358D",23,0) ; "RTN","DG53358D",24,0) ; "RTN","DG53358D",25,0) ; Initialize variables "RTN","DG53358D",26,0) N DFN,IVMERR,IVMLINK,IVMNODE0,IVMDOT,IVMTOT,IVMDONE "RTN","DG53358D",27,0) S IVMDONE=0 "RTN","DG53358D",28,0) ; "RTN","DG53358D",29,0) EN1 ; Get zero node of (#408.31) "RTN","DG53358D",30,0) S IVMNODE0=$G(^DGMT(408.31,IVMMTIEN,0)) "RTN","DG53358D",31,0) I 'IVMNODE0 Q 1 ; test not found "RTN","DG53358D",32,0) S IVMDOT=$P(IVMNODE0,"^") ; date of test "RTN","DG53358D",33,0) S DFN=$P(IVMNODE0,"^",2) "RTN","DG53358D",34,0) S IVMTOT=$P(IVMNODE0,"^",19) ; type of test "RTN","DG53358D",35,0) S IVMLINK=$P($G(^DGMT(408.31,IVMMTIEN,2)),"^",6) "RTN","DG53358D",36,0) ;don't delete copay test linked to valid means test "RTN","DG53358D",37,0) I IVMTOT=2,IVMLINK,$D(^DGMT(408.31,IVMLINK,0)) Q 0 "RTN","DG53358D",38,0) I IVMTOT=1,IVMLINK D I $D(IVMERR) Q 0 ;I MT linkd to copay delete both "RTN","DG53358D",39,0) .D DELETE(IVMLINK,DFN,IVMDOT) ; delete copay "RTN","DG53358D",40,0) D DELETE(IVMMTIEN,DFN,IVMDOT) ; delete copay or MT "RTN","DG53358D",41,0) Q IVMDONE "RTN","DG53358D",42,0) ; "RTN","DG53358D",43,0) DELETE(IVMMTIEN,DFN,IVMDOT) ; delete copay or MT "RTN","DG53358D",44,0) ; "RTN","DG53358D",45,0) ; Get Income Relation IEN array (DGINR) and "RTN","DG53358D",46,0) ; Individual Annual Income IEN array (DGINC) "RTN","DG53358D",47,0) D ALL^DGMTU21(DFN,"VSC",IVMDOT,"IR",IVMMTIEN) "RTN","DG53358D",48,0) ; "RTN","DG53358D",49,0) ; "RTN","DG53358D",50,0) DEL22 ; Delete veteran, spouse, and dependent entries from the "RTN","DG53358D",51,0) ; Income Relation (#408.22) file: "RTN","DG53358D",52,0) ; - Veteran (#408.22) record "RTN","DG53358D",53,0) S DA=$G(DGINR("V")) D "RTN","DG53358D",54,0) .Q:'DA "RTN","DG53358D",55,0) .S DIK="^DGMT(408.22," "RTN","DG53358D",56,0) .D ^DIK "RTN","DG53358D",57,0) ; "RTN","DG53358D",58,0) ; - Spouse (#408.22) record "RTN","DG53358D",59,0) S DA=$G(DGINR("S")) D "RTN","DG53358D",60,0) .Q:'DA "RTN","DG53358D",61,0) .S DIK="^DGMT(408.22," "RTN","DG53358D",62,0) .D ^DIK "RTN","DG53358D",63,0) ; "RTN","DG53358D",64,0) ; - All dependent children (#408.22) records "RTN","DG53358D",65,0) S IVMDEP=0 "RTN","DG53358D",66,0) F S IVMDEP=$O(DGINR("C",IVMDEP)) Q:'IVMDEP D "RTN","DG53358D",67,0) .S DA=$G(DGINR("C",IVMDEP)) "RTN","DG53358D",68,0) .S DIK="^DGMT(408.22," "RTN","DG53358D",69,0) .D ^DIK "RTN","DG53358D",70,0) ; "RTN","DG53358D",71,0) ; "RTN","DG53358D",72,0) DEL21 ; Delete veteran, spouse, and dependent entries from "RTN","DG53358D",73,0) ; Individual Annual Income (#408.21) file: "RTN","DG53358D",74,0) ; - Veteran (#408.21) record "RTN","DG53358D",75,0) S DA=$G(DGINC("V")) D "RTN","DG53358D",76,0) .Q:'DA "RTN","DG53358D",77,0) .S DIK="^DGMT(408.21," "RTN","DG53358D",78,0) .D ^DIK "RTN","DG53358D",79,0) ; "RTN","DG53358D",80,0) ; - Spouse (#408.21) record "RTN","DG53358D",81,0) S DA=$G(DGINC("S")) D "RTN","DG53358D",82,0) .Q:'DA "RTN","DG53358D",83,0) .S DIK="^DGMT(408.21," "RTN","DG53358D",84,0) .D ^DIK "RTN","DG53358D",85,0) ; "RTN","DG53358D",86,0) ; - All dependent children (#408.21) records "RTN","DG53358D",87,0) S IVMDEP=0 "RTN","DG53358D",88,0) F S IVMDEP=$O(DGINC("C",IVMDEP)) Q:'IVMDEP D "RTN","DG53358D",89,0) .S DA=$G(DGINC("C",IVMDEP)) "RTN","DG53358D",90,0) .S DIK="^DGMT(408.21," "RTN","DG53358D",91,0) .D ^DIK "RTN","DG53358D",92,0) ; "RTN","DG53358D",93,0) ; "RTN","DG53358D",94,0) ; Logic for (#408.12/#408.1275) & (#408.13) file entries "RTN","DG53358D",95,0) D SETUPAR "RTN","DG53358D",96,0) ; "RTN","DG53358D",97,0) ; Look for IVM/DCD Patient Realtion (#408.12) file entries. "RTN","DG53358D",98,0) ; If no entries in "AIVM" x-ref, no dependent changes required. "RTN","DG53358D",99,0) S IVM12="" F S IVM12=$O(^DGPR(408.12,"AIVM",IVMMTIEN,IVM12)) Q:'IVM12 D Q:$D(IVMERR) "RTN","DG53358D",100,0) .; -- if can't find entry in (#408.12), set IVMERR "RTN","DG53358D",101,0) .I $G(^DGPR(408.12,+IVM12,0))']"" D Q "RTN","DG53358D",102,0) ..S IVMERR="" Q "RTN","DG53358D",103,0) .; "RTN","DG53358D",104,0) .; - if only one record exists in (#408.1275) mult., then only one "RTN","DG53358D",105,0) .;IVM/DCD dependent to delete "RTN","DG53358D",106,0) .I $P($G(^DGPR(408.12,+IVM12,"E",0)),"^",4)=1 D Q "RTN","DG53358D",107,0) ..; "RTN","DG53358D",108,0) ..; -- if can't find entry in (#408.13), set IVMERR "RTN","DG53358D",109,0) ..S IVM13=$P($P($G(^DGPR(408.12,+IVM12,0)),"^",3),";") "RTN","DG53358D",110,0) ..I $G(^DGPR(408.13,+IVM13,0))']"" D Q "RTN","DG53358D",111,0) ...S IVMERR="" Q "RTN","DG53358D",112,0) ..; "RTN","DG53358D",113,0) ..; -- delete (#408.12) & (#408.13) records for IVM/DCD dependent "RTN","DG53358D",114,0) ..S DA=IVM12,DIK="^DGPR(408.12," D ^DIK K DA,DIK "RTN","DG53358D",115,0) ..S DA=IVM13,DIK="^DGPR(408.13," D ^DIK K DA,DIK "RTN","DG53358D",116,0) ..Q "RTN","DG53358D",117,0) .; "RTN","DG53358D",118,0) .; "RTN","DG53358D",119,0) .; Delete (#408.1275) record for IVM/DCD dependent and "RTN","DG53358D",120,0) .; change demo data in (#408.12) & (#408.13) back to VAMC values. "RTN","DG53358D",121,0) .; OR, Delete (#408.1275) record for inactivated VAMC dependent. "RTN","DG53358D",122,0) .S IVM121="",IVM121=$O(^DGPR(408.12,"AIVM",IVMMTIEN,+IVM12,IVM121)) "RTN","DG53358D",123,0) .; - if can't find entry in (#408.1275), set IVMERR "RTN","DG53358D",124,0) .I $G(^DGPR(408.12,+IVM12,"E",+IVM121,0))']"" D Q "RTN","DG53358D",125,0) ..S IVMERR="" Q "RTN","DG53358D",126,0) .; "RTN","DG53358D",127,0) .S IVMVAMCA=$P($G(^DGPR(408.12,+IVM12,"E",+IVM121,0)),"^",2) "RTN","DG53358D",128,0) .;dependent active? "RTN","DG53358D",129,0) .; "RTN","DG53358D",130,0) .; - If active, inactivate dependant "RTN","DG53358D",131,0) .I IVMVAMCA D "RTN","DG53358D",132,0) ..S DR=".02////0",DA=+IVM121,DA(1)=0 "RTN","DG53358D",133,0) ..S DIE="^DGPR(408.12,"_+IVM12_",""E""," "RTN","DG53358D",134,0) ..D ^DIE S IVMVAMCA=0 Q "RTN","DG53358D",135,0) .; "RTN","DG53358D",136,0) .S DA(1)=IVM12,DA=IVM121,DIK="^DGPR(408.12,"_DA(1)_",""E""," "RTN","DG53358D",137,0) .D ^DIK K DA(1),DA,DIK "RTN","DG53358D",138,0) .; "RTN","DG53358D",139,0) .Q "RTN","DG53358D",140,0) ; "RTN","DG53358D",141,0) ; Complete deletion of income test "RTN","DG53358D",142,0) D EN^DG53358C "RTN","DG53358D",143,0) ; "RTN","DG53358D",144,0) ENQ Q "RTN","DG53358D",145,0) ; "RTN","DG53358D",146,0) ; "RTN","DG53358D",147,0) SETUPAR ; Create array IVMAR1() where "RTN","DG53358D",148,0) ; 1) Subscript is MT Changes Type (#408.42) file node where type of "RTN","DG53358D",149,0) ; change = Name, DOB, SSN, Sex, Relationship. "RTN","DG53358D",150,0) ; 2) 1st piece is (#408.12) or (#408.13) file. "RTN","DG53358D",151,0) ; 3) 2nd piece is (#408.12) or (#408.13) file field number. "RTN","DG53358D",152,0) ; "RTN","DG53358D",153,0) F IVM41=4:1 S IVM411=$P($T(TYPECH+IVM41),";;",2) Q:IVM411="QUIT" D "RTN","DG53358D",154,0) .S IVMAR1($P(IVM411,";"))=$P(IVM411,";",2,3) "RTN","DG53358D",155,0) K IVM41,IVM411 "RTN","DG53358D",156,0) Q "RTN","DG53358D",157,0) ; "RTN","DG53358D",158,0) DELTYPE(DFN,MTDATE,TYPE) ; "RTN","DG53358D",159,0) ;will delete any primary test for patient=DFN for same income year as "RTN","DG53358D",160,0) ;MTDATE for test of type=TYPE "RTN","DG53358D",161,0) ; "RTN","DG53358D",162,0) Q:'$G(DFN) "RTN","DG53358D",163,0) Q:'$G(MTDATE) "RTN","DG53358D",164,0) Q:'$G(TYPE) "RTN","DG53358D",165,0) N MTNODE,YEAR,RET "RTN","DG53358D",166,0) S YEAR=$E(MTDATE,1,3)_1230.999999 "RTN","DG53358D",167,0) D "RTN","DG53358D",168,0) .S MTNODE=$$LST^DGMTU(DFN,YEAR,TYPE) "RTN","DG53358D",169,0) .Q:'+MTNODE "RTN","DG53358D",170,0) .I $E($P(MTNODE,"^",2),1,3)'=$E(YEAR,1,3) Q "RTN","DG53358D",171,0) .;don't want to delete auto-created Rx copay tests -they are deleted by "RTN","DG53358D",172,0) .; deleting the MT that they are based on "RTN","DG53358D",173,0) .I TYPE=2,+$P($G(^DGMT(408.31,+MTNODE,2)),"^",6) Q "RTN","DG53358D",174,0) .I $P(MTNODE,"^",5),$P(MTNODE,"^",5)'=1 I $$EN(+MTNODE) D "RTN","DG53358D",175,0) ..; "RTN","DG53358D",176,0) ..S RET=$$LST^DGMTU(DFN,DT,IVMTYPE) "RTN","DG53358D",177,0) ..I $E($P(RET,"^",2),1,3)'=$E(YEAR,1,3) S RET="" "RTN","DG53358D",178,0) ..D ADD^IVMCMB(DFN,IVMTYPE,"DELETE PRMYTEST",$P(MTNODE,"^",2),$P(MTNODE,"^",4),$P(RET,"^",4)) "RTN","DG53358D",179,0) Q "RTN","DG53358D",180,0) ; "RTN","DG53358D",181,0) TYPECH ; Type of dependent changes (#408.41/#408.42) file "RTN","DG53358D",182,0) ; 1st piece - 408.42 table file node "RTN","DG53358D",183,0) ; 2nd piece - file (408.12/408.13) "RTN","DG53358D",184,0) ; 3rd piece - 408.12/408.13 field "RTN","DG53358D",185,0) ;;16;408.13;.01 "RTN","DG53358D",186,0) ;;17;408.13;.03 "RTN","DG53358D",187,0) ;;18;408.13;.09 "RTN","DG53358D",188,0) ;;19;408.13;.02 "RTN","DG53358D",189,0) ;;20;408.12;.02 "RTN","DG53358D",190,0) ;;QUIT "RTN","DG53358D",191,0) Q "RTN","DG53558") 0^2^B46602062 "RTN","DG53558",1,0) DG53558 ;ALB/GN - DG*5.3*558 CLEANUP FOR DUPE MEANS TEST FILE ; 1/3/04 10:50pm "RTN","DG53558",2,0) ;;5.3;Registration;**558**;3-5-2001 "RTN","DG53558",3,0) ; "RTN","DG53558",4,0) ; Read through the Mean Test file (#408.31) via the "C" xref. "RTN","DG53558",5,0) ; Search for duplicate & Bad tests and delete them. Duplicates are "RTN","DG53558",6,0) ; defined as more than one test for the same patient for the same day "RTN","DG53558",7,0) ; All but the primary test will be deleted and when no primary test "RTN","DG53558",8,0) ; on a given day then the last transmission for that day will be kept "RTN","DG53558",9,0) ; "RTN","DG53558",10,0) ; Bad tests are defined as those that have a NULL status code in "RTN","DG53558",11,0) ; the 0 node of file 408.31. "RTN","DG53558",12,0) ; "RTN","DG53558",13,0) Q "RTN","DG53558",14,0) TEST ; Entry point for testing this routine "RTN","DG53558",15,0) S TESTING=1 "RTN","DG53558",16,0) EN ; Entry point for purging Duplicate Means Tests "RTN","DG53558",17,0) ; "RTN","DG53558",18,0) N QUIT,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTQUEUED,ZTSAVE,CHKPNT "RTN","DG53558",19,0) S CHKPNT=5 "RTN","DG53558",20,0) W !,"Do you want to process a group of "_CHKPNT_" duplicate patients and stop? " "RTN","DG53558",21,0) K DIR "RTN","DG53558",22,0) S DIR("?",1)=" Enter Y to process at least "_CHKPNT_" dupes and stop the utility. This will " "RTN","DG53558",23,0) S DIR("?",2)=" allow you to verify the cleanup in small steps. Enter N to process the " "RTN","DG53558",24,0) S DIR("?")=" remainder of the file to completion." "RTN","DG53558",25,0) S DIR(0)="Y" D ^DIR "RTN","DG53558",26,0) I $D(DTOUT)!$D(DUOUT) W !,"Cancelled...",! Q "RTN","DG53558",27,0) S:'Y CHKPNT=0 ;do not use check points "RTN","DG53558",28,0) ; "RTN","DG53558",29,0) ; setup TM variables and Load "RTN","DG53558",30,0) S ZTRTN=$S($G(TESTING):"QUET^DG53558",1:"QUE^DG53558") "RTN","DG53558",31,0) S ZTDESC="Cleanup Duplicates in the Means Test file" "RTN","DG53558",32,0) S ZTIO="" "RTN","DG53558",33,0) S ZTSAVE("CHKPNT")="" "RTN","DG53558",34,0) ; "RTN","DG53558",35,0) W !!,ZTDESC,! "RTN","DG53558",36,0) ;check if already running or completed. "RTN","DG53558",37,0) S QUIT=$$CHKSTAT "RTN","DG53558",38,0) Q:QUIT "RTN","DG53558",39,0) D ^%ZTLOAD "RTN","DG53558",40,0) L -^XTMP($$NAMSPC) "RTN","DG53558",41,0) I $D(ZTSK) D "RTN","DG53558",42,0) . W !,"This request queued as Task # ",ZTSK,! "RTN","DG53558",43,0) Q "RTN","DG53558",44,0) ; "RTN","DG53558",45,0) QUET ; Entry point for taskman (testing mode) "RTN","DG53558",46,0) S TESTING=1 "RTN","DG53558",47,0) QUE ; Entry point for taskman (live mode) "RTN","DG53558",48,0) N NAMSPC S NAMSPC=$$NAMSPC^DG53558 "RTN","DG53558",49,0) L +^XTMP(NAMSPC):10 I '$T D Q ;quit if can't get a lock "RTN","DG53558",50,0) . S $P(^XTMP(NAMSPC,0,0),U,5)="NO LOCK GAINED" "RTN","DG53558",51,0) N QQ,ZTSTOP,XREC,MTIEN,DIK,DA,IVMTOT,IVMPUR,BEGTIME,PURGDT,IVMBAD "RTN","DG53558",52,0) N DFN,TMP,ICDT,MTST,IVMDUPE,COUNT,PRI,TYPE,TYPNAM,DELETED "RTN","DG53558",53,0) S TESTING=+$G(TESTING) "RTN","DG53558",54,0) K ^TMP(NAMSPC) "RTN","DG53558",55,0) ; "RTN","DG53558",56,0) ;get last run info if exists "RTN","DG53558",57,0) S XREC=$G(^XTMP(NAMSPC,0,0)) "RTN","DG53558",58,0) S DFN=$P(XREC,U,1) ;last REC processed "RTN","DG53558",59,0) S IVMTOT=+$P(XREC,U,2) ;total records processed "RTN","DG53558",60,0) S IVMPUR=+$P(XREC,U,3) ;total dupe records purged "RTN","DG53558",61,0) S IVMBAD=+$P(XREC,U,7) ;total bad records purged "RTN","DG53558",62,0) S IVMDUPE=IVMPUR "RTN","DG53558",63,0) ; "RTN","DG53558",64,0) ;setup XTMP according to stds. "RTN","DG53558",65,0) S BEGTIME=$$NOW^XLFDT() "RTN","DG53558",66,0) S PURGDT=$$FMADD^XLFDT(BEGTIME,30) "RTN","DG53558",67,0) S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME "RTN","DG53558",68,0) S $P(^XTMP(NAMSPC,0),U,3)="Cleanup Duplicate Means Test File" "RTN","DG53558",69,0) S ^XTMP(NAMSPC_".DET",0)=PURGDT_U_BEGTIME "RTN","DG53558",70,0) S $P(^XTMP(NAMSPC_".DET",0),U,3)="Cleanup Duplicate Means Test File detail" "RTN","DG53558",71,0) ;init status field and start date & time if null "RTN","DG53558",72,0) S $P(^XTMP(NAMSPC,0,0),U,5,6)="RUNNING^" "RTN","DG53558",73,0) S:$P(^XTMP(NAMSPC,0,0),U,4)="" $P(^XTMP(NAMSPC,0,0),U,4)=$$NOW^XLFDT "RTN","DG53558",74,0) ; "RTN","DG53558",75,0) ;drive through "C" XREF level of MT file "RTN","DG53558",76,0) S ZTSTOP=0,DELETED=0 "RTN","DG53558",77,0) F QQ=1:1 S DFN=$O(^DGMT(408.31,"C",DFN)) Q:('DFN)!(ZTSTOP) D "RTN","DG53558",78,0) . I CHKPNT>1,IVMPUR>IVMDUPE,IVMPUR-CHKPNT>IVMDUPE S ZTSTOP=1 Q "RTN","DG53558",79,0) . K TMP "RTN","DG53558",80,0) . S IVMTOT=IVMTOT+1 "RTN","DG53558",81,0) . ; "RTN","DG53558",82,0) . ;build local TMP and prioritize dupes "RTN","DG53558",83,0) . S MTIEN=0 "RTN","DG53558",84,0) . F S MTIEN=$O(^DGMT(408.31,"C",DFN,MTIEN)) Q:'MTIEN D "RTN","DG53558",85,0) . . I '$D(^DGMT(408.31,MTIEN,0)) K ^DGMT(408.31,"C",DFN,MTIEN) Q "RTN","DG53558",86,0) . . S ICDT=$P(^DGMT(408.31,MTIEN,0),"^",1) "RTN","DG53558",87,0) . . S MTST=$P(^DGMT(408.31,MTIEN,0),"^",3) "RTN","DG53558",88,0) . . S PRI=+$G(^DGMT(408.31,MTIEN,"PRIM")) "RTN","DG53558",89,0) . . ; "RTN","DG53558",90,0) . . ;test for null MT status & flag as BAD and delete "RTN","DG53558",91,0) . . I MTST="" D Q "RTN","DG53558",92,0) . . . S TYPE=$P($G(^DGMT(408.31,MTIEN,0)),"^",19),TYPNAM="" "RTN","DG53558",93,0) . . . S:TYPE]"" TYPNAM=$G(^DG(408.33,TYPE,0)) "RTN","DG53558",94,0) . . . D DELBAD(MTIEN,DFN,.IVMBAD,.DELETED) "RTN","DG53558",95,0) . . . Q:'DELETED "RTN","DG53558",96,0) . . . S ^XTMP(NAMSPC,DFN,ICDT,999999,MTIEN,"BAD")=TYPE "RTN","DG53558",97,0) . . . S ^XTMP(NAMSPC_".DET",DFN,ICDT,MTIEN,"BAD")=TYPNAM "RTN","DG53558",98,0) . . . S $P(^XTMP(NAMSPC,0,0),U,7)=IVMBAD "RTN","DG53558",99,0) . . ; "RTN","DG53558",100,0) . . S COUNT=+$G(TMP(DFN,ICDT,MTST))+1 "RTN","DG53558",101,0) . . S TMP(DFN,ICDT,MTST)=COUNT "RTN","DG53558",102,0) . . S TMP(DFN,ICDT,MTST,MTIEN)=PRI "RTN","DG53558",103,0) . . S:PRI TMP(DFN,ICDT,MTST,"P")=MTIEN "RTN","DG53558",104,0) . ; "RTN","DG53558",105,0) . ;drive thru TMP and delete all dupes, but last one per day per sts "RTN","DG53558",106,0) . S ICDT=0 "RTN","DG53558",107,0) . F S ICDT=+$O(TMP(DFN,ICDT)) Q:'ICDT D "RTN","DG53558",108,0) . . S MTST="" "RTN","DG53558",109,0) . . F S MTST=$O(TMP(DFN,ICDT,MTST)) Q:MTST="" D "RTN","DG53558",110,0) . . . I +TMP(DFN,ICDT,MTST)<2 Q "RTN","DG53558",111,0) . . . D SETPRI(.TMP):'$D(TMP(DFN,ICDT,MTST,"P")) "RTN","DG53558",112,0) . . . ; drive thru ien's and del dupes "RTN","DG53558",113,0) . . . S MTIEN=0 "RTN","DG53558",114,0) . . . F S MTIEN=$O(TMP(DFN,ICDT,MTST,MTIEN)) Q:'MTIEN D "RTN","DG53558",115,0) . . . . I TMP(DFN,ICDT,MTST,MTIEN)=0 D "RTN","DG53558",116,0) . . . . . S TYPE=$P($G(^DGMT(408.31,MTIEN,0)),"^",19),TYPNAM="" "RTN","DG53558",117,0) . . . . . S:TYPE]"" TYPNAM=$G(^DG(408.33,TYPE,0)) "RTN","DG53558",118,0) . . . . . D DELMT(MTIEN,DFN,.IVMPUR,.DELETED) "RTN","DG53558",119,0) . . . . . Q:'DELETED "RTN","DG53558",120,0) . . . . . M ^XTMP(NAMSPC,DFN,ICDT,MTST)=TMP(DFN,ICDT,MTST) "RTN","DG53558",121,0) . . . . . S ^XTMP(NAMSPC_".DET",DFN,ICDT,MTIEN)=TYPNAM "RTN","DG53558",122,0) . ; "RTN","DG53558",123,0) . ;update last processed info "RTN","DG53558",124,0) . S $P(^XTMP(NAMSPC,0,0),U,1,3)=DFN_U_IVMTOT_U_IVMPUR "RTN","DG53558",125,0) . ; "RTN","DG53558",126,0) . ;check for stop request after every 100 processed DFN recs "RTN","DG53558",127,0) . I QQ#100=0 D "RTN","DG53558",128,0) . . S:$$S^%ZTLOAD ZTSTOP=1 "RTN","DG53558",129,0) . . I $D(^XTMP(NAMSPC,0,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,0,"STOP") "RTN","DG53558",130,0) ; "RTN","DG53558",131,0) ;set status and mail stats "RTN","DG53558",132,0) I ZTSTOP S $P(^XTMP(NAMSPC,0,0),U,5,6)="STOPPED"_U_$$NOW^XLFDT "RTN","DG53558",133,0) E S $P(^XTMP(NAMSPC,0,0),U,5,6)="COMPLETED"_U_$$NOW^XLFDT "RTN","DG53558",134,0) D MAIL^DG53558M "RTN","DG53558",135,0) K TESTING,^TMP(NAMSPC) "RTN","DG53558",136,0) L -^XTMP($$NAMSPC) "RTN","DG53558",137,0) Q "RTN","DG53558",138,0) ; "RTN","DG53558",139,0) SETPRI(TMP) ;set a primary per day to avoid it from being deleted "RTN","DG53558",140,0) N IEN "RTN","DG53558",141,0) S IEN=$O(TMP(DFN,ICDT,MTST,""),-1) "RTN","DG53558",142,0) S TMP(DFN,ICDT,MTST,IEN)=1 "RTN","DG53558",143,0) S TMP(DFN,ICDT,MTST,"P")=IEN "RTN","DG53558",144,0) Q "RTN","DG53558",145,0) ; "RTN","DG53558",146,0) DELBAD(IEN,DFN,PUR,DELETED) ; Kill Bad test "RTN","DG53558",147,0) S DELETED=0 "RTN","DG53558",148,0) Q:'$G(IEN) "RTN","DG53558",149,0) S TESTING=+$G(TESTING,1),DFN=$G(DFN) "RTN","DG53558",150,0) I 'TESTING S DELETED=$$EN^DG53358D(IEN) "RTN","DG53558",151,0) S:TESTING DELETED=1 "RTN","DG53558",152,0) Q:'DELETED "RTN","DG53558",153,0) S IVMBAD=IVMBAD+1 "RTN","DG53558",154,0) I '$D(ZTQUEUED) W !,"Deleting BAD IEN in 408.31 > ",IEN," for DFN > ",DFN "RTN","DG53558",155,0) Q "RTN","DG53558",156,0) ; "RTN","DG53558",157,0) DELMT(IEN,DFN,PUR,DELETED) ; Kill duplicate MT "RTN","DG53558",158,0) S DELETED=0 "RTN","DG53558",159,0) Q:'$G(IEN) "RTN","DG53558",160,0) S TESTING=+$G(TESTING,1),DFN=$G(DFN) "RTN","DG53558",161,0) I 'TESTING S DELETED=$$EN^DG53358D(IEN) "RTN","DG53558",162,0) S:TESTING DELETED=1 "RTN","DG53558",163,0) Q:'DELETED "RTN","DG53558",164,0) S PUR=PUR+1 "RTN","DG53558",165,0) I '$D(ZTQUEUED) W !,"Deleting Dupe IEN in 408.31 > ",IEN," for DFN > ",DFN "RTN","DG53558",166,0) Q "RTN","DG53558",167,0) ; "RTN","DG53558",168,0) CHKSTAT() ;check if job is running, stopped, or completed "RTN","DG53558",169,0) N Y,DUOUT,DTOUT,QUIT,STAT,STIME,NAMSPC "RTN","DG53558",170,0) S NAMSPC=$$NAMSPC "RTN","DG53558",171,0) L +^XTMP(NAMSPC):1 "RTN","DG53558",172,0) I '$T W !!,*7,"*** ALREADY RUNNING ***" H 4 Q 1 "RTN","DG53558",173,0) ; "RTN","DG53558",174,0) ; get job status "RTN","DG53558",175,0) S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,5) "RTN","DG53558",176,0) S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,6) "RTN","DG53558",177,0) S QUIT=0 "RTN","DG53558",178,0) ; "RTN","DG53558",179,0) ;if job Completed, ask to Re-Run "RTN","DG53558",180,0) I STAT="COMPLETED" D "RTN","DG53558",181,0) . W " was Completed on "_$$FMTE^XLFDT(STIME) "RTN","DG53558",182,0) . W !," Do you want to Re-Run again?" "RTN","DG53558",183,0) . K DIR "RTN","DG53558",184,0) . S DIR("?",1)=" Entering Y, will delete the XTMP global where the previous cleanup" "RTN","DG53558",185,0) . S DIR("?")=" information was stored and begin a new job, or N to cancel request" "RTN","DG53558",186,0) . S DIR(0)="Y" D ^DIR "RTN","DG53558",187,0) . I 'Y S QUIT=1 Q "RTN","DG53558",188,0) . W !," ARE YOU SURE?" "RTN","DG53558",189,0) . K DIR "RTN","DG53558",190,0) . S DIR("?")="Enter Y to begin a new Job or N to cancel request" "RTN","DG53558",191,0) . S DIR(0)="Y" D ^DIR "RTN","DG53558",192,0) . I 'Y S QUIT=1 Q "RTN","DG53558",193,0) . ;fall thru to re-run mode, kill ^XTMP "RTN","DG53558",194,0) . K ^XTMP(NAMSPC),^XTMP(NAMSPC_".DET") "RTN","DG53558",195,0) Q QUIT "RTN","DG53558",196,0) ; "RTN","DG53558",197,0) STOP ; alternate stop method "RTN","DG53558",198,0) S ^XTMP($$NAMSPC,0,"STOP")="" "RTN","DG53558",199,0) Q "RTN","DG53558",200,0) ; "RTN","DG53558",201,0) NAMSPC() ; Return a consistent name space variable "RTN","DG53558",202,0) Q "DG53558" "RTN","DG53558M") 0^4^B31371417 "RTN","DG53558M",1,0) DG53558M ;ALB/GN - DG*5.3*558 CLEANUP UTILITES ; 12/30/03 11:50am "RTN","DG53558M",2,0) ;;5.3;Registration;**558**;3-5-2001 "RTN","DG53558M",3,0) ; "RTN","DG53558M",4,0) ; Misc cleanup utilities "RTN","DG53558M",5,0) ; "RTN","DG53558M",6,0) MAIL ; mail stats "RTN","DG53558M",7,0) N BTIME,HTEXT,TEXT,NAMSPC,LIN,TYPNAM,MSGNO "RTN","DG53558M",8,0) S MSGNO=0 "RTN","DG53558M",9,0) S NAMSPC=$$NAMSPC^DG53558 "RTN","DG53558M",10,0) S IVMTOT=$P($G(^XTMP(NAMSPC,0,0)),U,2) "RTN","DG53558M",11,0) S IVMPUR=$P($G(^XTMP(NAMSPC,0,0)),U,3) "RTN","DG53558M",12,0) S BTIME=$P($G(^XTMP(NAMSPC,0,0)),U,4) "RTN","DG53558M",13,0) S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,5) "RTN","DG53558M",14,0) S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,6) "RTN","DG53558M",15,0) S IVMBAD=$P($G(^XTMP(NAMSPC,0,0)),U,7) "RTN","DG53558M",16,0) ; "RTN","DG53558M",17,0) D HDNG(.HTEXT,.MSGNO,.LIN) "RTN","DG53558M",18,0) D SUMRY(.LIN) "RTN","DG53558M",19,0) D MAILIT(HTEXT) "RTN","DG53558M",20,0) ; "RTN","DG53558M",21,0) D SNDDET "RTN","DG53558M",22,0) Q "RTN","DG53558M",23,0) ; "RTN","DG53558M",24,0) HDNG(HTEXT,MSGNO,LIN) ;build heading lines for mail message "RTN","DG53558M",25,0) K ^TMP(NAMSPC,$J,"MSG") "RTN","DG53558M",26,0) S LIN=0 "RTN","DG53558M",27,0) S HTEXT="Cleanup Duplicates in the Means Test file "_STAT_" on " "RTN","DG53558M",28,0) S HTEXT=HTEXT_$$FMTE^XLFDT(STIME) "RTN","DG53558M",29,0) D BLDLINE(HTEXT,.LIN) "RTN","DG53558M",30,0) D BLDLINE("",.LIN) "RTN","DG53558M",31,0) I TESTING S TEXT="** TESTING **" D BLDLINE(TEXT,.LIN) "RTN","DG53558M",32,0) I MSGNO S TEXT="Message number: "_MSGNO D BLDLINE(TEXT,.LIN) "RTN","DG53558M",33,0) D BLDLINE("",.LIN) "RTN","DG53558M",34,0) S MSGNO=MSGNO+1 "RTN","DG53558M",35,0) Q "RTN","DG53558M",36,0) ; "RTN","DG53558M",37,0) SUMRY(LIN) ;build summary lines for mail message "RTN","DG53558M",38,0) S TEXT=" Records Processed: "_$J($FN(IVMTOT,","),11) "RTN","DG53558M",39,0) D BLDLINE(TEXT,.LIN) "RTN","DG53558M",40,0) S TEXT="Duplicate Tests Purged: "_$J($FN(IVMPUR,","),11) "RTN","DG53558M",41,0) D BLDLINE(TEXT,.LIN) "RTN","DG53558M",42,0) S TEXT=" Null Tests Purged: "_$J($FN(IVMBAD,","),11) "RTN","DG53558M",43,0) D BLDLINE(TEXT,.LIN) "RTN","DG53558M",44,0) D BLDLINE("",.LIN) "RTN","DG53558M",45,0) D BLDLINE("",.LIN) "RTN","DG53558M",46,0) D BLDLINE("",.LIN) "RTN","DG53558M",47,0) ; "RTN","DG53558M",48,0) D BLDLINE("Detail changes to follow in subsequent mail messages",.LIN) "RTN","DG53558M",49,0) Q "RTN","DG53558M",50,0) ; "RTN","DG53558M",51,0) SNDDET ;build and send detail messages limit under 2000 lines each "RTN","DG53558M",52,0) N BAD,DATE,GL,MAXLIN,MORE,NAME,SSN "RTN","DG53558M",53,0) S MAXLIN=1995,MORE=0 "RTN","DG53558M",54,0) D HDNG(.HTEXT,.MSGNO,.LIN) "RTN","DG53558M",55,0) ; "RTN","DG53558M",56,0) S GL=$NA(^XTMP(NAMSPC_".DET",1)),TYPNAM="" "RTN","DG53558M",57,0) F S GL=$Q(@GL) Q:GL="" Q:$QS(GL,1)'=(NAMSPC_".DET") D "RTN","DG53558M",58,0) . S MORE=1 ;at least 1 more line to send "RTN","DG53558M",59,0) . S DFN=$QS(GL,2) "RTN","DG53558M",60,0) . S ICDT=$QS(GL,3) "RTN","DG53558M",61,0) . S MTIEN=$QS(GL,4) "RTN","DG53558M",62,0) . S BAD=$QS(GL,5) "RTN","DG53558M",63,0) . S SSN=$P($G(^DPT(DFN,0)),"^",9),NAME=$P($G(^DPT(DFN,0)),"^") "RTN","DG53558M",64,0) . S DATE=$$FMTE^XLFDT(ICDT) "RTN","DG53558M",65,0) . S TYPNAM=$G(@GL) "RTN","DG53558M",66,0) . S TEXT="Dupe> " "RTN","DG53558M",67,0) . S:BAD="BAD" TEXT="Null> " "RTN","DG53558M",68,0) . S TEXT=TEXT_"ssn: "_SSN_" "_$J(TYPNAM,21)_" dated: "_DATE_" ien: "_MTIEN "RTN","DG53558M",69,0) . D BLDLINE(TEXT,.LIN) "RTN","DG53558M",70,0) . ;max lines reached, print a msg "RTN","DG53558M",71,0) . I LIN>MAXLIN D MAILIT(HTEXT),HDNG(.HTEXT,.MSGNO,.LIN) S MORE=0 "RTN","DG53558M",72,0) ; "RTN","DG53558M",73,0) ;print final message if any to print "RTN","DG53558M",74,0) D MAILIT(HTEXT):MORE "RTN","DG53558M",75,0) Q "RTN","DG53558M",76,0) ; "RTN","DG53558M",77,0) BLDLINE(TEXT,LIN) ;build a single line into TMP message global "RTN","DG53558M",78,0) S LIN=LIN+1 "RTN","DG53558M",79,0) S ^TMP(NAMSPC,$J,"MSG",LIN)=TEXT "RTN","DG53558M",80,0) Q "RTN","DG53558M",81,0) MAILIT(HTEXT) ; send the mail message "RTN","DG53558M",82,0) N XMY,XMDUZ,XMSUB,XMTEXT "RTN","DG53558M",83,0) S XMY(DUZ)="",XMDUZ=.5 "RTN","DG53558M",84,0) S XMSUB=HTEXT_" Results" "RTN","DG53558M",85,0) S XMTEXT="^TMP(NAMSPC,$J,""MSG""," "RTN","DG53558M",86,0) D ^XMD "RTN","DG53558M",87,0) Q "RTN","DG53558M",88,0) ; "RTN","DG53558M",89,0) MONITOR ; Monitor job while running "RTN","DG53558M",90,0) N IOINORM,IOINHI,IOUON,IOUOFF,IOBON,IOBOFF,IORVON,IORVOFF,IOHOME "RTN","DG53558M",91,0) N IOELEOL,NAMSPC,REC,IVMTOT,IVMPUR,STIME,IVMEND,RUN,IVMTOTAL,IVMLST "RTN","DG53558M",92,0) N STAT,IVMLINE,IVMBLNK,NOWTIM,%H,DTOUT,I,IVMLEN,IVMQUIT,TITLE,TLEN,X "RTN","DG53558M",93,0) N NOWTIME,PCT,TMP "RTN","DG53558M",94,0) S:'$D(U) U="^" "RTN","DG53558M",95,0) S NAMSPC=$$NAMSPC^DG53558 "RTN","DG53558M",96,0) S TMP=0 F IVMTOTAL=0:1 S TMP=$O(^DGMT(408.31,"C",TMP)) Q:'TMP "RTN","DG53558M",97,0) S IVMQUIT=0 "RTN","DG53558M",98,0) D SCRNSET "RTN","DG53558M",99,0) ; "RTN","DG53558M",100,0) F D Q:IVMQUIT "RTN","DG53558M",101,0) . ;check lock status "RTN","DG53558M",102,0) . L +^XTMP(NAMSPC):0 "RTN","DG53558M",103,0) . I '$T S RUN=1 "RTN","DG53558M",104,0) . E S RUN=0 "RTN","DG53558M",105,0) . L -^XTMP(NAMSPC) "RTN","DG53558M",106,0) . S REC=$G(^XTMP(NAMSPC,0,0)) "RTN","DG53558M",107,0) . S STAT=$P(REC,U,5) S:STAT="" STAT="NOT RUNNING" "RTN","DG53558M",108,0) . S IVMLST=$P(REC,U,1),IVMTOT=$P(REC,U,2),IVMPUR=$P(REC,U,3) "RTN","DG53558M",109,0) . S STIME=$P(REC,U,6),IVMBAD=$P(REC,U,7) "RTN","DG53558M",110,0) . S:IVMTOTAL>0 PCT=IVMTOT/IVMTOTAL "RTN","DG53558M",111,0) . S PCT=PCT*100 "RTN","DG53558M",112,0) . S NOWTIME=$$NOW^XLFDT "RTN","DG53558M",113,0) . I (RUN&(STAT'="RUNNING"))!('RUN&(STAT="RUNNING")) D "RTN","DG53558M",114,0) . . S STAT="ERRORED" "RTN","DG53558M",115,0) . D CLRSCR "RTN","DG53558M",116,0) . S $P(IVMBLNK," ",81)="" "RTN","DG53558M",117,0) . S IVMLINE=IVMBLNK "RTN","DG53558M",118,0) . S TITLE="Cleanup Duplicates in the Means Test file" "RTN","DG53558M",119,0) . S TLEN=(80-$L(TITLE)\2) "RTN","DG53558M",120,0) . W $$FMTE^XLFDT($$NOW^XLFDT,"2P") "RTN","DG53558M",121,0) . W ?65,"Completed ",$FN(PCT,"",0),"%",!! "RTN","DG53558M",122,0) . W ?TLEN,IOINHI,IOUON,TITLE,IOUOFF,IOINORM,! "RTN","DG53558M",123,0) . S IVMLINE=IVMBLNK "RTN","DG53558M",124,0) . S IVMLINE=$$FMTLINE(IVMLINE,4,"Status") "RTN","DG53558M",125,0) . S IVMLINE=$$FMTLINE(IVMLINE,12,"Total recs") "RTN","DG53558M",126,0) . S IVMLINE=$$FMTLINE(IVMLINE,24,"Dupes Purged") "RTN","DG53558M",127,0) . S IVMLINE=$$FMTLINE(IVMLINE,38,"Nulls Purged") "RTN","DG53558M",128,0) . S IVMLINE=$$FMTLINE(IVMLINE,52,"Last DFN") "RTN","DG53558M",129,0) . S IVMLINE=$$FMTLINE(IVMLINE,66,"Completed Time") "RTN","DG53558M",130,0) . W !!,IORVON,IVMLINE,IORVOFF "RTN","DG53558M",131,0) . S IVMLINE=IVMBLNK "RTN","DG53558M",132,0) . S IVMLINE=$$FMTLINE(IVMLINE,2,STAT) "RTN","DG53558M",133,0) . S IVMLINE=$$FMTLINE(IVMLINE,15,IVMTOT) "RTN","DG53558M",134,0) . S IVMLINE=$$FMTLINE(IVMLINE,28,IVMPUR) "RTN","DG53558M",135,0) . S IVMLINE=$$FMTLINE(IVMLINE,40,IVMBAD) "RTN","DG53558M",136,0) . S IVMLINE=$$FMTLINE(IVMLINE,52,IVMLST) "RTN","DG53558M",137,0) . S IVMLINE=$$FMTLINE(IVMLINE,64,$$FMTE^XLFDT(STIME,2)) "RTN","DG53558M",138,0) . W !,IVMLINE "RTN","DG53558M",139,0) . S IVMLINE=IVMBLNK "RTN","DG53558M",140,0) . W !,IVMLINE,!!!!!! "RTN","DG53558M",141,0) . K DIR "RTN","DG53558M",142,0) . S DIR("T")=5 "RTN","DG53558M",143,0) . W ?13,"screen refreshes automatically every "_DIR("T")_" seconds",! "RTN","DG53558M",144,0) . W !!,"Press "_IORVON_""_IORVOFF_" to Stop Monitor...",! "RTN","DG53558M",145,0) . S DIR(0)="EA" "RTN","DG53558M",146,0) . D ^DIR "RTN","DG53558M",147,0) . I '$D(DTOUT) S IVMQUIT=1 "RTN","DG53558M",148,0) . I STAT'="RUNNING" S IVMQUIT=1 "RTN","DG53558M",149,0) W @IOF "RTN","DG53558M",150,0) Q "RTN","DG53558M",151,0) ; "RTN","DG53558M",152,0) FMTLINE(IVMLINE,IVMTB,IVMTX) ; format a line "RTN","DG53558M",153,0) S IVMLEN=$L(IVMTX) "RTN","DG53558M",154,0) S IVMEND=IVMTB+IVMLEN-1 "RTN","DG53558M",155,0) S $E(IVMLINE,IVMTB,IVMEND)=IVMTX "RTN","DG53558M",156,0) Q IVMLINE "RTN","DG53558M",157,0) ; "RTN","DG53558M",158,0) SCRNSET ; setup screen variables "RTN","DG53558M",159,0) S:'$D(IOST(0)) IOST(0)="C-VT320" "RTN","DG53558M",160,0) S X="IOINORM;IOINHI;IOUON;IOUOFF;IOBON;IOBOFF;IORVON;IORVOFF;IOHOME" "RTN","DG53558M",161,0) S X=X_";IOELEOL" D ENDR^%ZISS "RTN","DG53558M",162,0) Q "RTN","DG53558M",163,0) ; "RTN","DG53558M",164,0) CLRSCR ; clear screen and return to normal "RTN","DG53558M",165,0) W IOHOME,IORVOFF,IOBOFF,IOUOFF,IOINORM,@IOF "RTN","DG53558M",166,0) S $X=0,$Y=0 "RTN","DG53558M",167,0) Q "VER") 8.0^22 **END** **END**