Released LR*5.2*425 SEQ #341 Extracted from mail message **KIDS**:LR*5.2*425^ **INSTALL NAME** LR*5.2*425 "BLD",9067,0) LR*5.2*425^LAB SERVICE^0^3130806^y "BLD",9067,1,0) ^9.61A^10^10^3130425^^ "BLD",9067,1,1,0) The following Lab changes or enhancements are included in this build: "BLD",9067,1,2,0) "BLD",9067,1,3,0) 1) CPRS API for Lab to call when a test is modified "BLD",9067,1,4,0) 2) Changes to identify File 60 changes that impact CPRS Quick Orders "BLD",9067,1,5,0) 3) National Lab Release: Hospital Location Change Management Tool "BLD",9067,1,6,0) 4) National Lab Release: Lab Test File 60 Audit Tool "BLD",9067,1,7,0) 5) National Lab Release: Inactivation of Collection Samples File Entries "BLD",9067,1,8,0) 6) National Lab Release: Inactivation of Topography File Entries "BLD",9067,1,9,0) 7) National Lab Release: Lapsed Orders "BLD",9067,1,10,0) "BLD",9067,4,0) ^9.64PA^69.9^5 "BLD",9067,4,60,0) 60 "BLD",9067,4,60,2,0) ^9.641^60^3 "BLD",9067,4,60,2,60,0) LABORATORY TEST (File-top level) "BLD",9067,4,60,2,60,1,0) ^9.6411^9^1 "BLD",9067,4,60,2,60,1,9,0) LAB COLLECTION SAMPLE "BLD",9067,4,60,2,60.01,0) SITE/SPECIMEN (sub-file) "BLD",9067,4,60,2,60.01,1,0) ^9.6411^.01^1 "BLD",9067,4,60,2,60.01,1,.01,0) SITE/SPECIMEN "BLD",9067,4,60,2,60.03,0) COLLECTION SAMPLE (sub-file) "BLD",9067,4,60,2,60.03,1,0) ^9.6411^.01^1 "BLD",9067,4,60,2,60.03,1,.01,0) COLLECTION SAMPLE "BLD",9067,4,60,222) y^n^p^^^^n^^n "BLD",9067,4,60,224) "BLD",9067,4,61,0) 61 "BLD",9067,4,61,2,0) ^9.641^61^1 "BLD",9067,4,61,2,61,0) TOPOGRAPHY FIELD (File-top level) "BLD",9067,4,61,2,61,1,0) ^9.6411^64.9103^1 "BLD",9067,4,61,2,61,1,64.9103,0) INACTIVE DATE "BLD",9067,4,61,222) y^n^p^^^^n^^n "BLD",9067,4,61,224) "BLD",9067,4,62,0) 62 "BLD",9067,4,62,2,0) ^9.641^62^1 "BLD",9067,4,62,2,62,0) COLLECTION SAMPLE (File-top level) "BLD",9067,4,62,2,62,1,0) ^9.6411^64.9101^1 "BLD",9067,4,62,2,62,1,64.9101,0) INACTIVE DATE "BLD",9067,4,62,222) y^n^p^^^^n^^n "BLD",9067,4,62,224) "BLD",9067,4,64.9178,0) 64.9178 "BLD",9067,4,64.9178,222) y^n^f^^n^^y^a^n "BLD",9067,4,64.9178,224) I $P($G(^LABAUD(64.9178,+Y,0)),U)=60 "BLD",9067,4,69.9,0) 69.9 "BLD",9067,4,69.9,2,0) ^9.641^69.9^1 "BLD",9067,4,69.9,2,69.9,0) LABORATORY SITE (File-top level) "BLD",9067,4,69.9,2,69.9,1,0) ^9.6411^64.914^2 "BLD",9067,4,69.9,2,69.9,1,64.913,0) LAST IEN PROCESSED "BLD",9067,4,69.9,2,69.9,1,64.914,0) LAST DATE PROCESSED "BLD",9067,4,69.9,222) y^y^p^^^^n^^n "BLD",9067,4,69.9,224) "BLD",9067,4,"APDD",60,60) "BLD",9067,4,"APDD",60,60,9) "BLD",9067,4,"APDD",60,60.01) "BLD",9067,4,"APDD",60,60.01,.01) "BLD",9067,4,"APDD",60,60.03) "BLD",9067,4,"APDD",60,60.03,.01) "BLD",9067,4,"APDD",61,61) "BLD",9067,4,"APDD",61,61,64.9103) "BLD",9067,4,"APDD",62,62) "BLD",9067,4,"APDD",62,62,64.9101) "BLD",9067,4,"APDD",69.9,69.9) "BLD",9067,4,"APDD",69.9,69.9,64.913) "BLD",9067,4,"APDD",69.9,69.9,64.914) "BLD",9067,4,"B",60,60) "BLD",9067,4,"B",61,61) "BLD",9067,4,"B",62,62) "BLD",9067,4,"B",64.9178,64.9178) "BLD",9067,4,"B",69.9,69.9) "BLD",9067,6) 3^ "BLD",9067,6.3) 30 "BLD",9067,"ABPKG") n "BLD",9067,"INIT") POST^LR425 "BLD",9067,"KRN",0) ^9.67PA^779.2^20 "BLD",9067,"KRN",.4,0) .4 "BLD",9067,"KRN",.4,"NM",0) ^9.68A^2^2 "BLD",9067,"KRN",.4,"NM",1,0) LRJ SYS GET INDIRECT AUDIT FILE #1.1^1.1^0 "BLD",9067,"KRN",.4,"NM",1,99999999) 10000000179^3120928.114139 "BLD",9067,"KRN",.4,"NM",2,0) LRJ SYS DISPLAY FILE 60 CHANGE FILE #1.1^1.1^0 "BLD",9067,"KRN",.4,"NM",2,99999999) 2990000^3121017.181423 "BLD",9067,"KRN",.4,"NM","B","LRJ SYS DISPLAY FILE 60 CHANGE FILE #1.1",2) "BLD",9067,"KRN",.4,"NM","B","LRJ SYS GET INDIRECT AUDIT FILE #1.1",1) "BLD",9067,"KRN",.401,0) .401 "BLD",9067,"KRN",.401,"NM",0) ^9.68A^1^1 "BLD",9067,"KRN",.401,"NM",1,0) LRJ SYS DISPLAY FILE 60 CHANGE FILE #1.1^1.1^0 "BLD",9067,"KRN",.401,"NM",1,99999999) 2990000^3121017.181423 "BLD",9067,"KRN",.401,"NM","B","LRJ SYS DISPLAY FILE 60 CHANGE FILE #1.1",1) "BLD",9067,"KRN",.402,0) .402 "BLD",9067,"KRN",.402,"NM",0) ^9.68A^^ "BLD",9067,"KRN",.403,0) .403 "BLD",9067,"KRN",.5,0) .5 "BLD",9067,"KRN",.84,0) .84 "BLD",9067,"KRN",3.6,0) 3.6 "BLD",9067,"KRN",3.8,0) 3.8 "BLD",9067,"KRN",3.8,"NM",0) ^9.68A^3^3 "BLD",9067,"KRN",3.8,"NM",1,0) LRJ SYS MAP HL TASK REPORT^^0 "BLD",9067,"KRN",3.8,"NM",1,99999999) 10000000179^3120928.114139 "BLD",9067,"KRN",3.8,"NM",2,0) LRJ AUF60 AUDIT TASK REPORT^^0 "BLD",9067,"KRN",3.8,"NM",2,99999999) 2990000^3121017.17565 "BLD",9067,"KRN",3.8,"NM",3,0) LRJ AUF60XT AUDIT TASK REPORT^^0 "BLD",9067,"KRN",3.8,"NM",3,99999999) 2990000^3121017.17565 "BLD",9067,"KRN",3.8,"NM","B","LRJ AUF60 AUDIT TASK REPORT",2) "BLD",9067,"KRN",3.8,"NM","B","LRJ AUF60XT AUDIT TASK REPORT",3) "BLD",9067,"KRN",3.8,"NM","B","LRJ SYS MAP HL TASK REPORT",1) "BLD",9067,"KRN",9.2,0) 9.2 "BLD",9067,"KRN",9.8,0) 9.8 "BLD",9067,"KRN",9.8,"NM",0) ^9.68A^27^20 "BLD",9067,"KRN",9.8,"NM",1,0) LRJPON^^0^B15108369 "BLD",9067,"KRN",9.8,"NM",1,99999999) 2989975^3120911.195759 "BLD",9067,"KRN",9.8,"NM",3,0) LRXREF1^^0^B13794855 "BLD",9067,"KRN",9.8,"NM",3,99999999) 2990000^3120914.151106 "BLD",9067,"KRN",9.8,"NM",4,0) LRSRVR6^^0^B37731233 "BLD",9067,"KRN",9.8,"NM",4,99999999) 2990000^3121001.165526 "BLD",9067,"KRN",9.8,"NM",5,0) LRJSMLU^^0^B39493848 "BLD",9067,"KRN",9.8,"NM",5,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",9.8,"NM",6,0) LRJSML^^0^B27239914 "BLD",9067,"KRN",9.8,"NM",6,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",9.8,"NM",9,0) LRJSML3^^0^B199716407 "BLD",9067,"KRN",9.8,"NM",9,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",9.8,"NM",11,0) LRJSML5^^0^B11779668 "BLD",9067,"KRN",9.8,"NM",11,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",9.8,"NM",12,0) LRJSML6^^0^B72438950 "BLD",9067,"KRN",9.8,"NM",12,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",9.8,"NM",15,0) LRJSMLA^^0^B232140831 "BLD",9067,"KRN",9.8,"NM",15,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",9.8,"NM",16,0) LRJSMLA1^^0^B94292187 "BLD",9067,"KRN",9.8,"NM",16,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",9.8,"NM",17,0) LRJSML1^^0^B28615722 "BLD",9067,"KRN",9.8,"NM",17,99999999) 10000000179^3121010.140016 "BLD",9067,"KRN",9.8,"NM",18,0) LRJSML2^^0^B48324195 "BLD",9067,"KRN",9.8,"NM",18,99999999) 10000000179^3121010.140016 "BLD",9067,"KRN",9.8,"NM",19,0) LRJSML4^^0^B58662393 "BLD",9067,"KRN",9.8,"NM",19,99999999) 10000000179^3121010.140016 "BLD",9067,"KRN",9.8,"NM",20,0) LRJSML8^^0^B94488687 "BLD",9067,"KRN",9.8,"NM",20,99999999) 10000000179^3121010.140016 "BLD",9067,"KRN",9.8,"NM",21,0) LRJUTL3^^0^B817310 "BLD",9067,"KRN",9.8,"NM",21,99999999) 2990000^3121016.174853 "BLD",9067,"KRN",9.8,"NM",23,0) LRJSAU60^^0^B234883150 "BLD",9067,"KRN",9.8,"NM",23,99999999) 2990000^3121017.09493 "BLD",9067,"KRN",9.8,"NM",24,0) LRJSAU^^0^B7630715 "BLD",9067,"KRN",9.8,"NM",24,99999999) 2990000^3121017.181423 "BLD",9067,"KRN",9.8,"NM",25,0) LRJSAU2^^0^B141696414 "BLD",9067,"KRN",9.8,"NM",25,99999999) 2990000^3121017.181423 "BLD",9067,"KRN",9.8,"NM",26,0) LRJSAU3^^0^B1054860 "BLD",9067,"KRN",9.8,"NM",26,99999999) 2990000^3121017.181423 "BLD",9067,"KRN",9.8,"NM",27,0) LRJSAUO^^0^B1765290 "BLD",9067,"KRN",9.8,"NM",27,99999999) 2989975^3121022.01124 "BLD",9067,"KRN",9.8,"NM","B","LRJPON",1) "BLD",9067,"KRN",9.8,"NM","B","LRJSAU",24) "BLD",9067,"KRN",9.8,"NM","B","LRJSAU2",25) "BLD",9067,"KRN",9.8,"NM","B","LRJSAU3",26) "BLD",9067,"KRN",9.8,"NM","B","LRJSAU60",23) "BLD",9067,"KRN",9.8,"NM","B","LRJSAUO",27) "BLD",9067,"KRN",9.8,"NM","B","LRJSML",6) "BLD",9067,"KRN",9.8,"NM","B","LRJSML1",17) "BLD",9067,"KRN",9.8,"NM","B","LRJSML2",18) "BLD",9067,"KRN",9.8,"NM","B","LRJSML3",9) "BLD",9067,"KRN",9.8,"NM","B","LRJSML4",19) "BLD",9067,"KRN",9.8,"NM","B","LRJSML5",11) "BLD",9067,"KRN",9.8,"NM","B","LRJSML6",12) "BLD",9067,"KRN",9.8,"NM","B","LRJSML8",20) "BLD",9067,"KRN",9.8,"NM","B","LRJSMLA",15) "BLD",9067,"KRN",9.8,"NM","B","LRJSMLA1",16) "BLD",9067,"KRN",9.8,"NM","B","LRJSMLU",5) "BLD",9067,"KRN",9.8,"NM","B","LRJUTL3",21) "BLD",9067,"KRN",9.8,"NM","B","LRSRVR6",4) "BLD",9067,"KRN",9.8,"NM","B","LRXREF1",3) "BLD",9067,"KRN",19,0) 19 "BLD",9067,"KRN",19,"NM",0) ^9.68A^10^10 "BLD",9067,"KRN",19,"NM",1,0) LRJ MAINT INACTIVE DT FILE 61^^0 "BLD",9067,"KRN",19,"NM",1,99999999) 2990000^3120914.151106 "BLD",9067,"KRN",19,"NM",2,0) LRJ MAINT INACTIVE DT FILE 62^^0 "BLD",9067,"KRN",19,"NM",2,99999999) 2990000^3120914.151106 "BLD",9067,"KRN",19,"NM",3,0) LRLIAISON^^2 "BLD",9067,"KRN",19,"NM",3,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",19,"NM",4,0) LRJ SYS MAP HL TASKMAN RPT^^0 "BLD",9067,"KRN",19,"NM",4,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",19,"NM",5,0) LRJ HOSPITAL LOCATION MONITOR^^0 "BLD",9067,"KRN",19,"NM",5,99999999) 10000000179^3121003.142422 "BLD",9067,"KRN",19,"NM",6,0) LRJ BACKGROUND F60 AUD FILE^^0 "BLD",9067,"KRN",19,"NM",6,99999999) 2990000^3121017.175824 "BLD",9067,"KRN",19,"NM",7,0) LRJ BACKGROUND F60 AUDIT^^0 "BLD",9067,"KRN",19,"NM",7,99999999) 2990000^3121017.175824 "BLD",9067,"KRN",19,"NM",8,0) LRJ SYS MAP AUF60^^0 "BLD",9067,"KRN",19,"NM",8,99999999) 2990000^3121017.181838 "BLD",9067,"KRN",19,"NM",9,0) LRJ OBSOLETE PENDING ORDERS^^0 "BLD",9067,"KRN",19,"NM",9,99999999) 2989975^3121021.222032 "BLD",9067,"KRN",19,"NM",10,0) LRJ QUICK ORDER CHECK^^0 "BLD",9067,"KRN",19,"NM",10,99999999) 2989975^3121022.01124 "BLD",9067,"KRN",19,"NM","B","LRJ BACKGROUND F60 AUD FILE",6) "BLD",9067,"KRN",19,"NM","B","LRJ BACKGROUND F60 AUDIT",7) "BLD",9067,"KRN",19,"NM","B","LRJ HOSPITAL LOCATION MONITOR",5) "BLD",9067,"KRN",19,"NM","B","LRJ MAINT INACTIVE DT FILE 61",1) "BLD",9067,"KRN",19,"NM","B","LRJ MAINT INACTIVE DT FILE 62",2) "BLD",9067,"KRN",19,"NM","B","LRJ OBSOLETE PENDING ORDERS",9) "BLD",9067,"KRN",19,"NM","B","LRJ QUICK ORDER CHECK",10) "BLD",9067,"KRN",19,"NM","B","LRJ SYS MAP AUF60",8) "BLD",9067,"KRN",19,"NM","B","LRJ SYS MAP HL TASKMAN RPT",4) "BLD",9067,"KRN",19,"NM","B","LRLIAISON",3) "BLD",9067,"KRN",19.1,0) 19.1 "BLD",9067,"KRN",19.1,"NM",0) ^9.68A^1^1 "BLD",9067,"KRN",19.1,"NM",1,0) LRJ HL TOOLS MGR^^0 "BLD",9067,"KRN",19.1,"NM",1,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",19.1,"NM","B","LRJ HL TOOLS MGR",1) "BLD",9067,"KRN",101,0) 101 "BLD",9067,"KRN",101,"NM",0) ^9.68A^23^15 "BLD",9067,"KRN",101,"NM",1,0) LRJ SYS MAP HL ACCEPT CONFIG^^0 "BLD",9067,"KRN",101,"NM",1,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",2,0) LRJ SYS MAP HL AUDIT QUERY^^0 "BLD",9067,"KRN",101,"NM",2,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",3,0) LRJ SYS MAP HL DISP EXT^^0 "BLD",9067,"KRN",101,"NM",3,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",4,0) LRJ SYS MAP HL DISPLAY MESSAGE^^0 "BLD",9067,"KRN",101,"NM",4,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",6,0) LRJ SYS MAP HL MENU^^0 "BLD",9067,"KRN",101,"NM",6,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",7,0) LRJ SYS MAP HL SCHED AUDIT RPT DISP^^0 "BLD",9067,"KRN",101,"NM",7,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",8,0) LRJ SYS MAP HL SCHED AUDIT RPT TASK^^0 "BLD",9067,"KRN",101,"NM",8,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",9,0) LRJ SYS MAP HL SEND EXT^^0 "BLD",9067,"KRN",101,"NM",9,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",10,0) LRJ SYS MAP HL SEND MSG^^0 "BLD",9067,"KRN",101,"NM",10,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",101,"NM",18,0) LRJ SYS MAP AUF60 MENU^^0 "BLD",9067,"KRN",101,"NM",18,99999999) 2990000^3121009.172716 "BLD",9067,"KRN",101,"NM",19,0) LRJ SYS MAP AUF60 SEND DISPLAY MESSAGE^^0 "BLD",9067,"KRN",101,"NM",19,99999999) 2990000^3121009.172716 "BLD",9067,"KRN",101,"NM",20,0) LRJ SYS MAP AUF60 SEND FILE MESSAGE^^0 "BLD",9067,"KRN",101,"NM",20,99999999) 2990000^3121009.172716 "BLD",9067,"KRN",101,"NM",21,0) LRJ SYS MAP AUD DISPLAY FILE 60 CHANGES^^0 "BLD",9067,"KRN",101,"NM",21,99999999) 2990000^3121017.094656 "BLD",9067,"KRN",101,"NM",22,0) LRJ SYS MAP AUD LIST AUDITED FIELDS^^0 "BLD",9067,"KRN",101,"NM",22,99999999) 2990000^3121017.094656 "BLD",9067,"KRN",101,"NM",23,0) LRJ SYS MAP AUD SET FILE 60 AUDITED FLAG^^0 "BLD",9067,"KRN",101,"NM",23,99999999) 2990000^3121017.094656 "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP AUD DISPLAY FILE 60 CHANGES",21) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP AUD LIST AUDITED FIELDS",22) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP AUD SET FILE 60 AUDITED FLAG",23) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP AUF60 MENU",18) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP AUF60 SEND DISPLAY MESSAGE",19) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP AUF60 SEND FILE MESSAGE",20) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL ACCEPT CONFIG",1) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL AUDIT QUERY",2) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL DISP EXT",3) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL DISPLAY MESSAGE",4) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL MENU",6) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL SCHED AUDIT RPT DISP",7) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL SCHED AUDIT RPT TASK",8) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL SEND EXT",9) "BLD",9067,"KRN",101,"NM","B","LRJ SYS MAP HL SEND MSG",10) "BLD",9067,"KRN",409.61,0) 409.61 "BLD",9067,"KRN",409.61,"NM",0) ^9.68A^3^2 "BLD",9067,"KRN",409.61,"NM",1,0) LRJ SYS MAP HL^^0 "BLD",9067,"KRN",409.61,"NM",1,99999999) 10000000179^3121003.121041 "BLD",9067,"KRN",409.61,"NM",3,0) LRJ SYS MAP AUF60^^0 "BLD",9067,"KRN",409.61,"NM",3,99999999) 2990000^3121009.173052 "BLD",9067,"KRN",409.61,"NM","B","LRJ SYS MAP AUF60",3) "BLD",9067,"KRN",409.61,"NM","B","LRJ SYS MAP HL",1) "BLD",9067,"KRN",771,0) 771 "BLD",9067,"KRN",779.2,0) 779.2 "BLD",9067,"KRN",870,0) 870 "BLD",9067,"KRN",8989.51,0) 8989.51 "BLD",9067,"KRN",8989.51,"NM",0) ^9.68A^9^7 "BLD",9067,"KRN",8989.51,"NM",3,0) LRJ LSRP AUF60 LAST END DATE^^0 "BLD",9067,"KRN",8989.51,"NM",3,99999999) 2990000^3121018.032415 "BLD",9067,"KRN",8989.51,"NM",4,0) LRJ LSRP AUF60 LAST START DATE^^0 "BLD",9067,"KRN",8989.51,"NM",4,99999999) 2990000^3121018.032415 "BLD",9067,"KRN",8989.51,"NM",5,0) LRJ LSRP AUF60XT LAST END DATE^^0 "BLD",9067,"KRN",8989.51,"NM",5,99999999) 2990000^3121018.032415 "BLD",9067,"KRN",8989.51,"NM",6,0) LRJ LSRP AUF60XT LAST START DT^^0 "BLD",9067,"KRN",8989.51,"NM",6,99999999) 2990000^3121018.032415 "BLD",9067,"KRN",8989.51,"NM",7,0) LRJ OBSOLETE PENDING ORDERS^^0 "BLD",9067,"KRN",8989.51,"NM",7,99999999) 2989975^3121021.222032 "BLD",9067,"KRN",8989.51,"NM",8,0) LRJ HL LAST END DATE^^0 "BLD",9067,"KRN",8989.51,"NM",9,0) LRJ HL LAST START DATE^^0 "BLD",9067,"KRN",8989.51,"NM","B","LRJ HL LAST END DATE",8) "BLD",9067,"KRN",8989.51,"NM","B","LRJ HL LAST START DATE",9) "BLD",9067,"KRN",8989.51,"NM","B","LRJ LSRP AUF60 LAST END DATE",3) "BLD",9067,"KRN",8989.51,"NM","B","LRJ LSRP AUF60 LAST START DATE",4) "BLD",9067,"KRN",8989.51,"NM","B","LRJ LSRP AUF60XT LAST END DATE",5) "BLD",9067,"KRN",8989.51,"NM","B","LRJ LSRP AUF60XT LAST START DT",6) "BLD",9067,"KRN",8989.51,"NM","B","LRJ OBSOLETE PENDING ORDERS",7) "BLD",9067,"KRN",8989.52,0) 8989.52 "BLD",9067,"KRN",8989.52,"NM",0) ^9.68A^^ "BLD",9067,"KRN",8994,0) 8994 "BLD",9067,"KRN","B",.4,.4) "BLD",9067,"KRN","B",.401,.401) "BLD",9067,"KRN","B",.402,.402) "BLD",9067,"KRN","B",.403,.403) "BLD",9067,"KRN","B",.5,.5) "BLD",9067,"KRN","B",.84,.84) "BLD",9067,"KRN","B",3.6,3.6) "BLD",9067,"KRN","B",3.8,3.8) "BLD",9067,"KRN","B",9.2,9.2) "BLD",9067,"KRN","B",9.8,9.8) "BLD",9067,"KRN","B",19,19) "BLD",9067,"KRN","B",19.1,19.1) "BLD",9067,"KRN","B",101,101) "BLD",9067,"KRN","B",409.61,409.61) "BLD",9067,"KRN","B",771,771) "BLD",9067,"KRN","B",779.2,779.2) "BLD",9067,"KRN","B",870,870) "BLD",9067,"KRN","B",8989.51,8989.51) "BLD",9067,"KRN","B",8989.52,8989.52) "BLD",9067,"KRN","B",8994,8994) "BLD",9067,"PRE") LR425 "BLD",9067,"QUES",0) ^9.62^^ "BLD",9067,"REQB",0) ^9.611^2^2 "BLD",9067,"REQB",1,0) OR*3.0*315^2 "BLD",9067,"REQB",2,0) LR*5.2*350^2 "BLD",9067,"REQB","B","LR*5.2*350",2) "BLD",9067,"REQB","B","OR*3.0*315",1) "DATA",64.9178,1,0) 60 "DATA",64.9178,1,1,0) ^64.9278^^0 "FIA",60) LABORATORY TEST "FIA",60,0) ^LAB(60, "FIA",60,0,0) 60I "FIA",60,0,1) y^n^p^^^^n^^n "FIA",60,0,10) "FIA",60,0,11) "FIA",60,0,"RLRO") "FIA",60,0,"VR") 5.2^LR "FIA",60,60) 1 "FIA",60,60,9) "FIA",60,60,100) "FIA",60,60,300) "FIA",60,60.01) 1 "FIA",60,60.01,.01) "FIA",60,60.03) 1 "FIA",60,60.03,.01) "FIA",61) TOPOGRAPHY FIELD "FIA",61,0) ^LAB(61, "FIA",61,0,0) 61 "FIA",61,0,1) y^n^p^^^^n^^n "FIA",61,0,10) "FIA",61,0,11) "FIA",61,0,"RLRO") "FIA",61,0,"VR") 5.2^LR "FIA",61,61) 1 "FIA",61,61,64.9103) "FIA",62) COLLECTION SAMPLE "FIA",62,0) ^LAB(62, "FIA",62,0,0) 62I "FIA",62,0,1) y^n^p^^^^n^^n "FIA",62,0,10) "FIA",62,0,11) "FIA",62,0,"RLRO") "FIA",62,0,"VR") 5.2^LR "FIA",62,62) 1 "FIA",62,62,64.9101) "FIA",64.9178) LSRP AUDIT CONFIG "FIA",64.9178,0) ^LABAUD(64.9178, "FIA",64.9178,0,0) 64.9178P "FIA",64.9178,0,1) y^n^f^^n^^y^a^n "FIA",64.9178,0,10) "FIA",64.9178,0,11) I $P($G(^LABAUD(64.9178,+Y,0)),U)=60 "FIA",64.9178,0,"RLRO") "FIA",64.9178,0,"VR") 5.2^LR "FIA",64.9178,64.9178) 0 "FIA",64.9178,64.9278) 0 "FIA",69.9) LABORATORY SITE "FIA",69.9,0) ^LAB(69.9, "FIA",69.9,0,0) 69.9 "FIA",69.9,0,1) y^y^p^^^^n^^n "FIA",69.9,0,10) "FIA",69.9,0,11) "FIA",69.9,0,"RLRO") "FIA",69.9,0,"VR") 5.2^LR "FIA",69.9,69.9) 1 "FIA",69.9,69.9,64.913) "FIA",69.9,69.9,64.914) "INIT") POST^LR425 "KRN",.4,1602,-1) 0^2 "KRN",.4,1602,0) LRJ SYS DISPLAY FILE 60 CHANGE^3111116.1048^@^1.1^^@^3130502 "KRN",.4,1602,"%D",0) ^.4001^10^10^3130502^^^ "KRN",.4,1602,"%D",1,0) This print template generates a listing of all the fields in the "KRN",.4,1602,"%D",2,0) LABORATORY TEST (#60) file that have been marked for auditing. The "KRN",.4,1602,"%D",3,0) following fields are included in the print template report: "KRN",.4,1602,"%D",4,0) INTERNAL ENTRY NUMBER (#.01), DATE/TIME RECORDED (#.02), USER (#.04), "KRN",.4,1602,"%D",5,0) FIELD NAME, (#1.1), OLD VALUE (#2) and NEW VALUE (#3). "KRN",.4,1602,"%D",6,0) The print template will then execute SETTMP^LRJSAU60() to "KRN",.4,1602,"%D",7,0) add the cross reference entry in ^TMP("LRDATA",$J,"NEW" for any new entry "KRN",.4,1602,"%D",8,0) or for any existing entry where the change was less than two hours after "KRN",.4,1602,"%D",9,0) the initial record was created. The report is produced by reading "KRN",.4,1602,"%D",10,0) through/formatting the indexed entries found in the ^TMP("LRDATA",$J global. "KRN",.4,1602,"DXS",1,9.2) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P($G(^VA(200,+$P(DIP(1),U,4),0)),U),DIP(2)=$G(X) S X="LRUSER" "KRN",.4,1602,"F",1) "KRN",.4,1602,"F",2) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="LRIEN",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.01,"LRIEN")"~ "KRN",.4,1602,"F",3) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),DIP(2)=$G(X) S X="LRDT",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.02,"LRDT")"~ "KRN",.4,1602,"F",4) X DXS(1,9.2) S X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.04,"LRUSER")"~ "KRN",.4,1602,"F",5) X "N I,Y "_$P(^DD(1.1,1.1,0),U,5,99) S DIP(1)=X S X=DIP(1),DIP(2)=$G(X) S X="LRFLDNM",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#1.1,"LRFLDNM")"~ "KRN",.4,1602,"F",6) X "N I,Y "_$P(^DD(1.1,2,0),U,5,99) S DIP(1)=X S X=DIP(1),DIP(2)=$G(X) S X="LROLD",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#2,"LROLD")"~ "KRN",.4,1602,"F",7) X "N I,Y "_$P(^DD(1.1,3,0),U,5,99) S DIP(1)=X S X=DIP(1),DIP(2)=$G(X) S X="LRNEW",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#3,"LRNEW")"~ "KRN",.4,1602,"F",8) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P(DIP(1),U,3),DIP(2)=$G(X) S X="LRFNUM",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.03,"LRFNUM")"~ "KRN",.4,1602,"F",9) D SETTMP^LRJSAU60(D0,LRIEN,LRDT,LRUSER,LRFLDNM,LRFNUM,LROLD,LRNEW);Z;"D SETTMP^LRJSAU60(D0,LRIEN,LRDT,LRUSER,LRFLDNM,LRFNUM,LROLD,LRNEW)"~ "KRN",.4,1602,"H") LABORATORY TEST AUDIT LIST "KRN",.4,1603,-1) 0^1 "KRN",.4,1603,0) LRJ SYS GET INDIRECT AUDIT^3101025.1307^@^1.1^^@^3130805 "KRN",.4,1603,"%D",0) ^.4001^10^10^3130502^^^^ "KRN",.4,1603,"%D",1,0) This print template generates a listing of the entries in the "KRN",.4,1603,"%D",2,0) WARD LOCATION file (#42), HOSPITAL LOCATION file (#44), and the ROOM-BED "KRN",.4,1603,"%D",3,0) file (#405.4) where changes have occurred to fields that have been marked "KRN",.4,1603,"%D",4,0) for auditing by the Lab software and includes the following AUDIT "KRN",.4,1603,"%D",5,0) fields if available: NUMBER (#.001), INTERNAL ENTRY NUMBER (#.01), "KRN",.4,1603,"%D",6,0) DATE/TIME RECORDED (#.02), FIELD NUMBER (#.03), USER (#.04), RECORD ADDED "KRN",.4,1603,"%D",7,0) (#.05), ENTRY NAME (#1), FIELD NAME (#1.1), OLD VALUE (#2), OLD INTERNAL "KRN",.4,1603,"%D",8,0) VALUE (#2.1), DATATYPE OF OLD VALUE (#2.2), NEW VALUE (#3), NEW INTERNAL "KRN",.4,1603,"%D",9,0) VALUE (#3.1), DATATYPE OF NEW VALUE (#3.2), MENU OPTION USED (#4.1) and "KRN",.4,1603,"%D",10,0) PROTOCOL OR OPTION USED (#4.2). "KRN",.4,1603,"DXS",1,9.2) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P($G(^VA(200,+$P(DIP(1),U,4),0)),U),DIP(2)=$G(X) S X="LRX" "KRN",.4,1603,"DXS",2,9.2) S DIP(2)=$C(59)_$P($G(^DD(1.1,.05,0)),U,3),DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P($P(DIP(2),$C(59)_$P(DIP(1),U,5)_":",2),$C(59)),DIP(3)=$G(X) S X="LRX" "KRN",.4,1603,"DXS",3,9.2) S DIP(2)=$C(59)_$P($G(^DD(1.1,2.2,0)),U,3),DIP(1)=$S($D(^DIA(DIA,D0,2.1)):^(2.1),1:"") S X=$P($P(DIP(2),$C(59)_$P(DIP(1),U,2)_":",2),$C(59)),DIP(3)=$G(X) S X="LRX" "KRN",.4,1603,"DXS",4,9.2) S DIP(2)=$C(59)_$P($G(^DD(1.1,3.2,0)),U,3),DIP(1)=$S($D(^DIA(DIA,D0,3.1)):^(3.1),1:"") S X=$P($P(DIP(2),$C(59)_$P(DIP(1),U,2)_":",2),$C(59)),DIP(3)=$G(X) S X="LRX" "KRN",.4,1603,"DXS",5,9.2) S DIP(1)=$S($D(^DIA(DIA,D0,4.1)):^(4.1),1:"") S X=$P($G(^DIC(19,+$P(DIP(1),U,1),0)),U),DIP(2)=$G(X) S X="LRX" "KRN",.4,1603,"DXS",6,9.2) S DIP(1)=$S($D(^DIA(DIA,D0,4.1)):^(4.1),1:"") S X=$$EXTERNAL^DIDU(1.1,4.2,"",$P(DIP(1),U,2)),DIP(2)=$G(X) S X="LRX" "KRN",.4,1603,"F",1) S X=$S('$D(D0):"",D0<0:"",1:D0),DIP(1)=$G(X) S X="LRX",X1=DIP(1) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.001,"LRX")"~ "KRN",.4,1603,"F",2) SET @LRDATA@(D0,".001")=LRX;Z;"SET @LRDATA@(D0,".001")=LRX"~ "KRN",.4,1603,"F",3) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.01,"LRX")"~ "KRN",.4,1603,"F",4) SET @LRDATA@(D0,".01")=LRX;Z;"SET @LRDATA@(D0,".01")=LRX"~ "KRN",.4,1603,"F",5) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.02,"LRX")"~ "KRN",.4,1603,"F",6) SET @LRDATA@(D0,".02")=LRX;Z;"SET @LRDATA@(D0,".02")=LRX"~ "KRN",.4,1603,"F",7) S DIP(1)=$S($D(^DIA(DIA,D0,0)):^(0),1:"") S X=$P(DIP(1),U,3),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.03,"LRX")"~ "KRN",.4,1603,"F",8) SET @LRDATA@(D0,".03")=LRX;Z;"SET @LRDATA@(D0,".03")=LRX"~ "KRN",.4,1603,"F",9) X DXS(1,9.2) S X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.04,"LRX")"~ "KRN",.4,1603,"F",10) SET @LRDATA@(D0,".04")=LRX;Z;"SET @LRDATA@(D0,".04")=LRX"~ "KRN",.4,1603,"F",11) X DXS(2,9.2) S X1=DIP(3) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#.05,"LRX")"~ "KRN",.4,1603,"F",12) SET @LRDATA@(D0,".05")=LRX;Z;"SET @LRDATA@(D0,".05")=LRX"~ "KRN",.4,1603,"F",13) X "N I,Y "_$P(^DD(1.1,1,0),U,5,99) S DIP(1)=X S X=DIP(1),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#1,"LRX")"~ "KRN",.4,1603,"F",14) SET @LRDATA@(D0,"1")=LRX;Z;"SET @LRDATA@(D0,"1")=LRX"~ "KRN",.4,1603,"F",15) X "N I,Y "_$P(^DD(1.1,1.1,0),U,5,99) S DIP(1)=X S X=DIP(1),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#1.1,"LRX")"~ "KRN",.4,1603,"F",16) SET @LRDATA@(D0,"1.1")=LRX;Z;"SET @LRDATA@(D0,"1.1")=LRX"~ "KRN",.4,1603,"F",17) X "N I,Y "_$P(^DD(1.1,2,0),U,5,99) S DIP(1)=X S X=DIP(1),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#2,"LRX")"~ "KRN",.4,1603,"F",18) SET @LRDATA@(D0,"2")=LRX;Z;"SET @LRDATA@(D0,"2")=LRX"~ "KRN",.4,1603,"F",19) S DIP(1)=$S($D(^DIA(DIA,D0,2.1)):^(2.1),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#2.1,"LRX")"~ "KRN",.4,1603,"F",20) SET @LRDATA@(D0,"2.1")=LRX;Z;"SET @LRDATA@(D0,"2.1")=LRX"~ "KRN",.4,1603,"F",21) X DXS(3,9.2) S X1=DIP(3) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#2.2,"LRX")"~ "KRN",.4,1603,"F",22) SET @LRDATA@(D0,"2.2")=LRX;Z;"SET @LRDATA@(D0,"2.2")=LRX"~ "KRN",.4,1603,"F",23) X "N I,Y "_$P(^DD(1.1,3,0),U,5,99) S DIP(1)=X S X=DIP(1),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#3,"LRX")"~ "KRN",.4,1603,"F",24) SET @LRDATA@(D0,"3")=LRX;Z;"SET @LRDATA@(D0,"3")=LRX"~ "KRN",.4,1603,"F",25) S DIP(1)=$S($D(^DIA(DIA,D0,3.1)):^(3.1),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="LRX",X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#3.1,"LRX")"~ "KRN",.4,1603,"F",26) SET @LRDATA@(D0,"3.1")=LRX;Z;"SET @LRDATA@(D0,"3.1")=LRX"~ "KRN",.4,1603,"F",27) X DXS(4,9.2) S X1=DIP(3) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#3.2,"LRX")"~ "KRN",.4,1603,"F",28) SET @LRDATA@(D0,"3.2")=LRX;Z;"SET @LRDATA@(D0,"3.2")=LRX"~ "KRN",.4,1603,"F",29) X DXS(5,9.2) S X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#4.1,"LRX")"~ "KRN",.4,1603,"F",30) SET @LRDATA@(D0,"4.1")=LRX;Z;"SET @LRDATA@(D0,"4.1")=LRX"~ "KRN",.4,1603,"F",31) N DIERR X DXS(6,9.2) S X1=DIP(2) S:X]""&(X'[U)&(X'["$C(94)") @X=X1,X=X1 W X K DIP;Z;"SET(#4.2,"LRX")"~ "KRN",.4,1603,"F",32) SET @LRDATA@(D0,"4.2")=LRX;Z;"SET @LRDATA@(D0,"4.2")=LRX"~ "KRN",.4,1603,"H") LABORATORY TEST AUDIT LIST "KRN",.401,994,-1) 0^1 "KRN",.401,994,0) LRJ SYS DISPLAY FILE 60 CHANGE^3100712.1351^@^1.1^^@^3130502 "KRN",.401,994,2,0) ^.4014^2^2 "KRN",.401,994,2,1,0) 1.1^.02^DATE/TIME RECORDED^@^^^^^^1 "KRN",.401,994,2,1,"ASK") 1 "KRN",.401,994,2,1,"F") 3130425.102399^3130425.1024^Apr 25,2013@10:24 "KRN",.401,994,2,1,"GET") S DISX(1)=$P($G(^DIA(DIA,D0,0)),U,2) "KRN",.401,994,2,1,"IX") ^DIA(DIA,"C",^DIA(DIA,^2 "KRN",.401,994,2,1,"QCON") I (DISX(1)]]3130425.102399)&(DISX(1)']]3130502.1024) "KRN",.401,994,2,1,"T") 3130502.1024^3130502.1024^May 2,2013@10:24 "KRN",.401,994,2,1,"TXT") DATE/TIME RECORDED from Apr 25,2013@10:24 to May 2,2013@10:24 "KRN",.401,994,2,2,0) 1.1^.01^INTERNAL ENTRY NUMBER^@^^^^^^4 "KRN",.401,994,2,2,"GET") S DISX(2)=$P($G(^DIA(DIA,D0,0)),U) "KRN",.401,994,2,2,"IX") ^DIA(60,"B",^DIA(60,^2 "KRN",.401,994,2,2,"QCON") I DISX(2)'="" "KRN",.401,994,2,2,"TXT") INTERNAL ENTRY NUMBER not null "KRN",.401,994,2,"B",1.1,1) "KRN",.401,994,2,"B",1.1,2) "KRN",.401,994,"%D",0) ^^9^9^3110706^ "KRN",.401,994,"%D",1,0) This sort template is used by the Display File 60 Changes [LRJ SYS MAP "KRN",.401,994,"%D",2,0) AUD DISPLAY FILE 60 CHANGES] protocol of the Audit Manager subsystem to "KRN",.401,994,"%D",3,0) display audit information based on changes to LABORATORY TEST file (#60). "KRN",.401,994,"%D",4,0) (Routine: AUDISP^LRJSAU60) "KRN",.401,994,"%D",5,0) "KRN",.401,994,"%D",6,0) This sort template is also used by the Display New Person File Changes "KRN",.401,994,"%D",7,0) [LRJ SYS MAP AUD DISPLAY NEW PERSON FILE CHANGES] protocol of the Audit "KRN",.401,994,"%D",8,0) Manager subsystem to display audit information based on changes to NEW "KRN",.401,994,"%D",9,0) PERSON file (#200). (Routine: AUDISP^LRJSAUNP) "KRN",3.8,298,-1) 0^1 "KRN",3.8,298,0) LRJ SYS MAP HL TASK REPORT^PU^n^^^^ "KRN",3.8,298,2,0) ^3.801^7^7^3121019^^^^ "KRN",3.8,298,2,1,0) This mail group receives the Hospital Location System Change Management "KRN",3.8,298,2,2,0) extract report generated by the TaskMan option: "KRN",3.8,298,2,3,0) LRJ SYS MAP HL TASKMAN RPT "KRN",3.8,298,2,4,0) "KRN",3.8,298,2,5,0) It should contain LIMS and COTS Configuration Managers responsible for "KRN",3.8,298,2,6,0) keeping Hospital Location Rooms and Beds on Vista in synchronization with "KRN",3.8,298,2,7,0) those defined on a remote Lab configuration run by the VA Medical Center. "KRN",3.8,298,3) "KRN",3.8,299,-1) 0^2 "KRN",3.8,299,0) LRJ AUF60 AUDIT TASK REPORT^PU^y^^^^ "KRN",3.8,299,2,0) ^3.801^1^1^3100602^^^^ "KRN",3.8,299,2,1,0) This mail group receives File 60 audit reports generated by TaskMan. "KRN",3.8,299,3) "KRN",3.8,300,-1) 0^3 "KRN",3.8,300,0) LRJ AUF60XT AUDIT TASK REPORT^PU^y^^^^ "KRN",3.8,300,2,0) ^3.801^1^1^3100525^^^ "KRN",3.8,300,2,1,0) This mail group receives delimited file extracts from File 60 audits. "KRN",3.8,300,3) "KRN",19,1240,-1) 2^3 "KRN",19,1240,0) LRLIAISON^Lab liaison menu^^M^.5^LRLIASON^^^^^^14 "KRN",19,1240,10,0) ^19.01PI^39^39 "KRN",19,1240,10,36,0) 11423 "KRN",19,1240,10,36,"^") LRJ MAINT INACTIVE DT FILE 61 "KRN",19,1240,10,37,0) 11424 "KRN",19,1240,10,37,"^") LRJ MAINT INACTIVE DT FILE 62 "KRN",19,1240,10,38,0) 11425 "KRN",19,1240,10,38,"^") LRJ HOSPITAL LOCATION MONITOR "KRN",19,1240,10,39,0) 11426 "KRN",19,1240,10,39,"^") LRJ SYS MAP AUF60 "KRN",19,1240,"U") LAB LIAISON MENU "KRN",19,11419,-1) 0^4 "KRN",19,11419,0) LRJ SYS MAP HL TASKMAN RPT^LRJ SYS MAP HL Change Management TaskMan Report^^R^^^^^^^^LAB SERVICE^^1 "KRN",19,11419,1,0) ^19.06^3^3^3110725^^ "KRN",19,11419,1,1,0) This option is scheduled and run from VA TaskManager. It generates "KRN",19,11419,1,2,0) a report of changes to the Hospital Locations, Ward Locations, and "KRN",19,11419,1,3,0) Room-Bed entries since the task last ran. "KRN",19,11419,20) D TSKMMARY^LRJSML2("^TMP($J,""LRJ SYS"")","^TMP($J,""LRDATA"")") "KRN",19,11419,99) 61325,51255 "KRN",19,11419,200.9) y "KRN",19,11419,"U") LRJ SYS MAP HL CHANGE MANAGEME "KRN",19,11420,-1) 0^7 "KRN",19,11420,0) LRJ BACKGROUND F60 AUDIT^TaskMan File 60 Audit in Display Format^^R^^^^^^^^LAB SERVICE^^1 "KRN",19,11420,1,0) ^19.06^2^2^3091125^^^^ "KRN",19,11420,1,1,0) This option is tied to the TaskMan process which generates mail messages "KRN",19,11420,1,2,0) in display format based on audits which occur after File 60 changes. "KRN",19,11420,20) D TSKMMARY^LRJSAU2("AUF60","File 60 Audit","DISPLAY") "KRN",19,11420,25) LRJSAU2 "KRN",19,11420,200.9) y "KRN",19,11420,"U") TASKMAN FILE 60 AUDIT IN DISPL "KRN",19,11421,-1) 0^6 "KRN",19,11421,0) LRJ BACKGROUND F60 AUD FILE^TaskMan file format file 60 audits^^R^^^^^^^^LAB SERVICE^^1 "KRN",19,11421,1,0) ^^2^2^3090929^ "KRN",19,11421,1,1,0) This option is tied to the TaskMan process which generates delimited "KRN",19,11421,1,2,0) files based on audits which occur after File 60 changes. "KRN",19,11421,20) D TSKMMARY^LRJSAU2("AUF60XT","File 60 Audit","FILE") "KRN",19,11421,25) LRJSAU2 "KRN",19,11421,200.9) y "KRN",19,11421,"U") TASKMAN FILE FORMAT FILE 60 AU "KRN",19,11422,-1) 0^9 "KRN",19,11422,0) LRJ OBSOLETE PENDING ORDERS^Obsolete Pending Lab Orders^^R^^^^^^^^LAB SERVICE "KRN",19,11422,1,0) ^19.06^12^12^3130425^^ "KRN",19,11422,1,1,0) This option is responsible for automatically lapsing (obsoleting) pending "KRN",19,11422,1,2,0) lab orders. The order will be canceled in lab and an order status update "KRN",19,11422,1,3,0) message will be sent to CPRS with a new status of lapsed. "KRN",19,11422,1,4,0) "KRN",19,11422,1,5,0) This lapsing is based on a parameter: LRJ OBSOLETE PENDING ORDERS. The "KRN",19,11422,1,6,0) value of this parameter will be compared to the GRACE PERIOD FOR "KRN",19,11422,1,7,0) ORDERS field (#15) in the LABORATORY SITE file (#69.9). The smaller of "KRN",19,11422,1,8,0) the two will be used as the number of days before a pending order is "KRN",19,11422,1,9,0) considered to be obsolete. If neither of these values is defined, a "KRN",19,11422,1,10,0) MailMan message will be sent to the LMI mail group. "KRN",19,11422,1,11,0) "KRN",19,11422,1,12,0) This option should be queued to run in TASKMAN nightly. "KRN",19,11422,25) EN^LRJPON "KRN",19,11422,"U") OBSOLETE PENDING LAB ORDERS "KRN",19,11423,-1) 0^1 "KRN",19,11423,0) LRJ MAINT INACTIVE DT FILE 61^Edit Inactive Date - TOPOGRAPHY FIELD^^E^^LRLIASON^^^^^^ "KRN",19,11423,1,0) ^^3^3^3100907^ "KRN",19,11423,1,1,0) This option allows you to edit the INACTIVE DATE field for a TOPOGRAPHY "KRN",19,11423,1,2,0) FIELD entry. Entry of a date in this field will prevent this entry from "KRN",19,11423,1,3,0) being extracted to the COTS LIMS on or after this date. "KRN",19,11423,30) LAB(61, "KRN",19,11423,31) AEMNOQ "KRN",19,11423,32) Select TOPOGRAPHY FIELD: "KRN",19,11423,50) LAB(61, "KRN",19,11423,51) 64.9103 "KRN",19,11423,"U") EDIT INACTIVE DATE - TOPOGRAPH "KRN",19,11424,-1) 0^2 "KRN",19,11424,0) LRJ MAINT INACTIVE DT FILE 62^Edit Inactive Date - COLLECTION SAMPLE^^E^^LRLIASON^^^^^^ "KRN",19,11424,1,0) ^^3^3^3100907^ "KRN",19,11424,1,1,0) This option allows you to edit the INACTIVE DATE field for a COLLECTION "KRN",19,11424,1,2,0) SAMPLE entry. Entry of a date in this field will prevent this entry from "KRN",19,11424,1,3,0) being extracted to the COTS LIMS on or after this date. "KRN",19,11424,30) LAB(62, "KRN",19,11424,31) AEMNOQ "KRN",19,11424,32) Select COLLECTION SAMPLE: "KRN",19,11424,50) LAB(62, "KRN",19,11424,51) 64.9101 "KRN",19,11424,"U") EDIT INACTIVE DATE - COLLECTIO "KRN",19,11425,-1) 0^5 "KRN",19,11425,0) LRJ HOSPITAL LOCATION MONITOR^Hospital Location Monitor Tool^^R^^^^^^^^LAB SERVICE "KRN",19,11425,1,0) ^19.06^2^2^3121003^^ "KRN",19,11425,1,1,0) This option invokes the ListManager List Template application that allows "KRN",19,11425,1,2,0) access to the Hospital Location Monitor tool. "KRN",19,11425,25) EN^LRJSML1 "KRN",19,11425,"U") HOSPITAL LOCATION MONITOR TOOL "KRN",19,11426,-1) 0^8 "KRN",19,11426,0) LRJ SYS MAP AUF60^File 60 Audit Manager^^A^^^^^^^^^^1 "KRN",19,11426,1,0) ^19.06^2^2^3121018^^^^ "KRN",19,11426,1,1,0) This menu option provides access to the Lab File 60 Audit Tool which is "KRN",19,11426,1,2,0) used to manage the auditing of LABORATORY TEST file (#60) fields. "KRN",19,11426,20) D F60^LRJSAU "KRN",19,11426,"U") FILE 60 AUDIT MANAGER "KRN",19,11427,-1) 0^10 "KRN",19,11427,0) LRJ QUICK ORDER CHECK^LRJ QUICK ORDER SEARCH^^R^^^^^^^^ "KRN",19,11427,1,0) ^19.06^4^4^3130502^^ "KRN",19,11427,1,1,0) This option should be scheduled. It will search the Lab 60 audit for "KRN",19,11427,1,2,0) tests where certain fields have been edited. If a test is found where "KRN",19,11427,1,3,0) those fields have been changed, the routine will call a CPRS API to "KRN",19,11427,1,4,0) determine if they are included in a quick order. "KRN",19,11427,25) EN^LRJSAUO "KRN",19,11427,"U") LRJ QUICK ORDER SEARCH "KRN",19.1,565,-1) 0^1 "KRN",19.1,565,0) LRJ HL TOOLS MGR^Hospital Location Monitor Key^^n "KRN",19.1,565,1,0) ^19.11^2^2^3121003^^ "KRN",19.1,565,1,1,0) This key is used to protect the LRJ Hospital Location Tools so that only "KRN",19.1,565,1,2,0) management staff can execute the protected functionality. "KRN",101,4496,-1) 0^22 "KRN",101,4496,0) LRJ SYS MAP AUD LIST AUDITED FIELDS^List Audited Fields^^A^^^^^^^^LAB SERVICE "KRN",101,4496,1,0) ^^2^2^3110725^ "KRN",101,4496,1,1,0) This protocol lists fields which are audited in the LABORATORY TEST file "KRN",101,4496,1,2,0) (#60). "KRN",101,4496,10,0) ^101.01PA "KRN",101,4496,20) D AUDLIST^LRJSAU60 "KRN",101,4496,99) 62973,36176 "KRN",101,4497,-1) 0^21 "KRN",101,4497,0) LRJ SYS MAP AUD DISPLAY FILE 60 CHANGES^Display File 60 Changes^^A^^^^^^^^LAB SERVICE "KRN",101,4497,1,0) ^^2^2^3110725^ "KRN",101,4497,1,1,0) This protocol displays audit information based on changes to "KRN",101,4497,1,2,0) LABORATORY TEST file (#60). "KRN",101,4497,10,0) ^101.01PA "KRN",101,4497,20) D AUDISP^LRJSAU60 "KRN",101,4497,99) 62973,36176 "KRN",101,4498,-1) 0^23 "KRN",101,4498,0) LRJ SYS MAP AUD SET FILE 60 AUDITED FLAG^Set Audited Flag for Fields^^A^^^^^^^^LAB SERVICE "KRN",101,4498,1,0) ^^2^2^3110725^ "KRN",101,4498,1,1,0) This protocol sets audits for additional LABORATORY TEST file (#60) fields "KRN",101,4498,1,2,0) based on user preference. "KRN",101,4498,2,0) ^101.02A^1^1 "KRN",101,4498,2,1,0) SF "KRN",101,4498,2,"B","SF",1) "KRN",101,4498,15) S VALMBCK="R" "KRN",101,4498,20) D AUDSET^LRJSAU60 "KRN",101,4498,99) 62973,36176 "KRN",101,4499,-1) 0^6 "KRN",101,4499,0) LRJ SYS MAP HL MENU^LRJ SYS Map HL Menu^^M^^^^^^^^LAB SERVICE "KRN",101,4499,1,0) ^101.06^2^2^3121019^^^^ "KRN",101,4499,1,1,0) This Protocol Menu provides the functions that support Hospital Location "KRN",101,4499,1,2,0) Change Monitoring of location changes made in VistA (via ADT actions). "KRN",101,4499,2,0) ^101.02A^1^1 "KRN",101,4499,2,1,0) HLM "KRN",101,4499,2,"B","HLM",1) "KRN",101,4499,4) 40^4 "KRN",101,4499,10,0) ^101.01PA^11^11 "KRN",101,4499,10,2,0) 4500^DM^12^ "KRN",101,4499,10,2,"^") LRJ SYS MAP HL DISPLAY MESSAGE "KRN",101,4499,10,3,0) 4501^DE^11^ "KRN",101,4499,10,3,"^") LRJ SYS MAP HL DISP EXT "KRN",101,4499,10,4,0) 4502^SM^22^ "KRN",101,4499,10,4,"^") LRJ SYS MAP HL SEND MSG "KRN",101,4499,10,6,0) 4503^SX^21^ "KRN",101,4499,10,6,"^") LRJ SYS MAP HL SEND EXT "KRN",101,4499,10,8,0) 4508^DS^23^ "KRN",101,4499,10,8,"^") LRJ SYS MAP HL SCHED AUDIT RPT DISP "KRN",101,4499,10,9,0) 4507^AQ^13^ "KRN",101,4499,10,9,"^") LRJ SYS MAP HL AUDIT QUERY "KRN",101,4499,10,10,0) 4509^ST^24^ "KRN",101,4499,10,10,"^") LRJ SYS MAP HL SCHED AUDIT RPT TASK "KRN",101,4499,10,11,0) 4510^AE^14^ "KRN",101,4499,10,11,"^") LRJ SYS MAP HL ACCEPT CONFIG "KRN",101,4499,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),U),24)) ^(24) "KRN",101,4499,26) DO SHOW^VALM "KRN",101,4499,28) Select Action: "KRN",101,4499,99) 62973,36176 "KRN",101,4500,-1) 0^4 "KRN",101,4500,0) LRJ SYS MAP HL DISPLAY MESSAGE^Display Mail Message^^A^^^^^^^^LAB SERVICE "KRN",101,4500,1,0) ^101.06^2^2^3110727^^^^ "KRN",101,4500,1,1,0) This protocol will display the Hospital Location file edit extract into "KRN",101,4500,1,2,0) a Mailman format. "KRN",101,4500,2,0) ^101.02A^2^1 "KRN",101,4500,2,2,0) DM "KRN",101,4500,2,"B","DM",2) "KRN",101,4500,20) D CREATMM^LRJSML1("^TMP($J,""LRJ SYS"")") "KRN",101,4500,99) 62973,36176 "KRN",101,4501,-1) 0^3 "KRN",101,4501,0) LRJ SYS MAP HL DISP EXT^Display Extracted (Raw) Data^^A^^^^^^^^LAB SERVICE "KRN",101,4501,1,0) ^^2^2^3081006^ "KRN",101,4501,1,1,0) This Action Protocol will re-display the raw Hospital Location data "KRN",101,4501,1,2,0) extracted from the Audit file. "KRN",101,4501,2,0) ^101.02A^1^1 "KRN",101,4501,2,1,0) DE "KRN",101,4501,2,"B","DE",1) "KRN",101,4501,20) D DISPEXT^LRJSML1("^TMP($J,""LRJ SYS"")") "KRN",101,4501,99) 62973,36176 "KRN",101,4502,-1) 0^10 "KRN",101,4502,0) LRJ SYS MAP HL SEND MSG^Send Mail Message^^A^^^^^^^^LAB SERVICE "KRN",101,4502,1,0) ^^2^2^3081008^ "KRN",101,4502,1,1,0) This action will convert the extracted Raw Hospital Location changes to "KRN",101,4502,1,2,0) a readable format and forward a mail message to the user. "KRN",101,4502,2,0) ^101.02A^1^1 "KRN",101,4502,2,1,0) SM "KRN",101,4502,2,"B","SM",1) "KRN",101,4502,20) D CRTMMARY^LRJSML2("^TMP($J,""LRJ SYS"")","^TMP($J,""LRDATA"")") "KRN",101,4502,99) 62973,36176 "KRN",101,4503,-1) 0^9 "KRN",101,4503,0) LRJ SYS MAP HL SEND EXT^Send Extract File^^A^^^^^^^^LAB SERVICE "KRN",101,4503,1,0) ^^2^2^3081017^ "KRN",101,4503,1,1,0) This action will create a .TXT file of the Hospital Location changes "KRN",101,4503,1,2,0) extract file and mail it to the user. "KRN",101,4503,2,0) ^101.02A^1^1 "KRN",101,4503,2,1,0) SX "KRN",101,4503,2,"B","SX",1) "KRN",101,4503,20) D CRTXTMM^LRJSML2("^TMP($J,""LRJ SYS"")") "KRN",101,4503,99) 62973,36176 "KRN",101,4504,-1) 0^18 "KRN",101,4504,0) LRJ SYS MAP AUF60 MENU^File 60 Audit Menu^^M^^^^^^^^LAB SERVICE "KRN",101,4504,1,0) ^101.06^1^1^3130425^^^^ "KRN",101,4504,1,1,0) This protocol menu provides the functions used to manage auditing in Lab. "KRN",101,4504,2,0) ^101.02A^1^1 "KRN",101,4504,2,1,0) AUD "KRN",101,4504,2,"B","AUD",1) "KRN",101,4504,4) 40^4^^ "KRN",101,4504,10,0) ^101.01PA^6^6 "KRN",101,4504,10,2,0) 4498^SF^11^ "KRN",101,4504,10,2,"^") LRJ SYS MAP AUD SET FILE 60 AUDITED FLAG "KRN",101,4504,10,3,0) 4496^LF^12^ "KRN",101,4504,10,3,"^") LRJ SYS MAP AUD LIST AUDITED FIELDS "KRN",101,4504,10,4,0) 4497^DF^13^ "KRN",101,4504,10,4,"^") LRJ SYS MAP AUD DISPLAY FILE 60 CHANGES "KRN",101,4504,10,5,0) 4505^SM^21^^^Send Display in Mail "KRN",101,4504,10,5,"^") LRJ SYS MAP AUF60 SEND DISPLAY MESSAGE "KRN",101,4504,10,6,0) 4506^SX^22^^^Send Extract File in Mail "KRN",101,4504,10,6,"^") LRJ SYS MAP AUF60 SEND FILE MESSAGE "KRN",101,4504,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),U),24)) ^(24) "KRN",101,4504,26) D SHOW^VALM "KRN",101,4504,28) Select Action: "KRN",101,4504,99) 62973,36176 "KRN",101,4505,-1) 0^19 "KRN",101,4505,0) LRJ SYS MAP AUF60 SEND DISPLAY MESSAGE^Send Display as Mail Message^^A^^^^^^^^LAB SERVICE "KRN",101,4505,1,0) ^^2^2^3110725^ "KRN",101,4505,1,1,0) This protocol will send a display of the LABORATORY TEST file (#60) audit "KRN",101,4505,1,2,0) information as a mail message. "KRN",101,4505,2,0) ^101.02A^2^2 "KRN",101,4505,2,1,0) DM "KRN",101,4505,2,2,0) SM "KRN",101,4505,2,"B","DM",1) "KRN",101,4505,2,"B","SM",2) "KRN",101,4505,4) ^^^ "KRN",101,4505,15) S VALMBCK="R" "KRN",101,4505,20) D CRTMMARY^LRJSAU2("^TMP(""LRJ SYS F60 AUD MANAGER"",$J)","AUF60","File 60 Audit","LRJSAU60","^TMP(""LRJ SYS F60 AUD MANAGER"",$J)") "KRN",101,4505,99) 62973,36176 "KRN",101,4506,-1) 0^20 "KRN",101,4506,0) LRJ SYS MAP AUF60 SEND FILE MESSAGE^Send File 60 Audit Delimited File^^A^^^^^^^^LAB SERVICE "KRN",101,4506,1,0) ^^3^3^3110725^ "KRN",101,4506,1,1,0) This protocol allows a delimited file to be sent in a mail message. The "KRN",101,4506,1,2,0) file contains information based on audits which are set after changes to "KRN",101,4506,1,3,0) the LABORATORY TEST file (#60). "KRN",101,4506,2,0) ^101.02A^1^1 "KRN",101,4506,2,1,0) SX "KRN",101,4506,2,"B","SX",1) "KRN",101,4506,4) ^^^ "KRN",101,4506,15) S VALMBCK="R" "KRN",101,4506,20) D CRTXTMM^LRJSAU2("^TMP(""LRJ SYS F60 AUD MANAGER"",$J,""EXTRACT"")","AUF60","File 60 Audit","LRJSAU60") "KRN",101,4506,99) 62973,36176 "KRN",101,4507,-1) 0^2 "KRN",101,4507,0) LRJ SYS MAP HL AUDIT QUERY^Hospital Location Audit Query^^A^^^^^^^^ "KRN",101,4507,1,0) ^101.06^2^2^3121019^^ "KRN",101,4507,1,1,0) This Protocol allows a user to select a type of query for the Hospital "KRN",101,4507,1,2,0) Location extract report. "KRN",101,4507,2,0) ^101.02A^1^1 "KRN",101,4507,2,1,0) AQ "KRN",101,4507,2,"B","AQ",1) "KRN",101,4507,20) D CDRNG^LRJSML4 "KRN",101,4507,99) 62973,36176 "KRN",101,4508,-1) 0^7 "KRN",101,4508,0) LRJ SYS MAP HL SCHED AUDIT RPT DISP^Show LRJ SYS MAP HL TASKMAN RPT sch^^A^^^^^^^^LAB SERVICE "KRN",101,4508,1,0) ^^9^9^3110718^ "KRN",101,4508,1,1,0) This action allows the user to view the Hospital Location Change "KRN",101,4508,1,2,0) Management System Audit Task Option Schedule report and includes the "KRN",101,4508,1,3,0) following details: "KRN",101,4508,1,4,0) "KRN",101,4508,1,5,0) o Name of the option scheduled to be run "KRN",101,4508,1,6,0) o Task ID "KRN",101,4508,1,7,0) o Start Time for job "KRN",101,4508,1,8,0) o Rescheduling Frequency "KRN",101,4508,1,9,0) o Date this TaskMan job was originally scheduled "KRN",101,4508,4) ^^^ST "KRN",101,4508,20) D INIT^LRJSML5 "KRN",101,4508,24) "KRN",101,4508,99) 62973,36176 "KRN",101,4509,-1) 0^8 "KRN",101,4509,0) LRJ SYS MAP HL SCHED AUDIT RPT TASK^Sched LRJ SYS MAP HL TASKMAN RPT^^A^^^^^^^^LAB SERVICE "KRN",101,4509,1,0) ^^2^2^3110718^ "KRN",101,4509,1,1,0) This action will schedule the 'LRJ SYS MAP HL Change Management TaskMan "KRN",101,4509,1,2,0) Report' option [LRJ SYS MAP HL TASKMAN RPT] as a background task. "KRN",101,4509,4) ^^^CT "KRN",101,4509,20) D SCHDBCKG^LRJSML6 "KRN",101,4509,24) I $$MGRCHK^LRJSMLU "KRN",101,4509,99) 62973,36176 "KRN",101,4510,-1) 0^1 "KRN",101,4510,0) LRJ SYS MAP HL ACCEPT CONFIG^Accept/edit HL config dates^^A^^^^^^^^LAB SERVICE "KRN",101,4510,1,0) ^101.06^7^7^3121019^^^ "KRN",101,4510,1,1,0) This Protocol is exercised from the Hospital Location Change Monitoring "KRN",101,4510,1,2,0) System. It is executed when: "KRN",101,4510,1,3,0) 1) The first time the site has synchronized Lab related Hospital Locations "KRN",101,4510,1,4,0) in VistA with those locations on a separate configuration. "KRN",101,4510,1,5,0) 2) The site has corrected Lab related Hospital Location(s) on a remote "KRN",101,4510,1,6,0) configuration and the begin or end dates for the TaskMan report "KRN",101,4510,1,7,0) need to be edited to reflect the time of the change. "KRN",101,4510,4) ^^^AC "KRN",101,4510,20) D ACPTCNFG^LRJSML6 "KRN",101,4510,24) I $$MGRCHK^LRJSMLU "KRN",101,4510,99) 62973,36176 "KRN",409.61,710,-1) 0^1 "KRN",409.61,710,0) LRJ SYS MAP HL^1^^80^5^18^0^1^^LRJ SYS MAP HL MENU^Lab Hospital Location Tools^1^^1 "KRN",409.61,710,1) ^VALM HIDDEN ACTIONS "KRN",409.61,710,"ARRAY") ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "KRN",409.61,710,"FNL") D EXIT^LRJSML1 "KRN",409.61,710,"HDR") D HDR^LRJSML1 "KRN",409.61,710,"HLP") D HELP^LRJSML1 "KRN",409.61,710,"INIT") D INIT^LRJSML1 "KRN",409.61,711,-1) 0^3 "KRN",409.61,711,0) LRJ SYS MAP AUF60^1^^80^5^19^0^1^^LRJ SYS MAP AUF60 MENU^Lab File 60 Audit Menu^1^^1 "KRN",409.61,711,1) ^VALM HIDDEN ACTIONS "KRN",409.61,711,"ARRAY") ^TMP("LRJ SYS F60 AUD MANAGER",$J) "KRN",409.61,711,"COL",0) ^409.621^1^1 "KRN",409.61,711,"COL",1,0) HEADER^2^75 "KRN",409.61,711,"COL","B","HEADER",1) "KRN",409.61,711,"FNL") D EXIT^LRJSAU "KRN",409.61,711,"HDR") D HDR2^LRJSAU "KRN",409.61,711,"HLP") D HELP^LRJSAU "KRN",409.61,711,"INIT") D INIT^LRJSAU "KRN",8989.51,752,-1) 0^9 "KRN",8989.51,752,0) LRJ HL LAST START DATE^HL Report Last Start Date/Time^0^^HL Report Last Start Date/Time "KRN",8989.51,752,1) D^::T^This was the start date used when the TaskMan HL Change Report last completed. "KRN",8989.51,752,6) D^::T "KRN",8989.51,752,20,0) ^^5^5^3100629^ "KRN",8989.51,752,20,1,0) This field indicates the start date used when the Hospital Location Change "KRN",8989.51,752,20,2,0) Report messages were previously generated by TaskMan. "KRN",8989.51,752,20,3,0) "KRN",8989.51,752,20,4,0) The purpose of this data is to record the previous start date for the "KRN",8989.51,752,20,5,0) report generated by the TaskMan job. "KRN",8989.51,752,30,0) ^8989.513I^1^1 "KRN",8989.51,752,30,1,0) 1^4.2 "KRN",8989.51,753,-1) 0^8 "KRN",8989.51,753,0) LRJ HL LAST END DATE^HL Report Last End Date/Time^0^^HL Report Last End Date/Time "KRN",8989.51,753,1) D^::T^This was the end date used when the TaskMan HL Change Report last completed. "KRN",8989.51,753,6) D^::T "KRN",8989.51,753,20,0) ^^13^13^3100629^ "KRN",8989.51,753,20,1,0) This field indicates the end date used when the Hospital Location Change "KRN",8989.51,753,20,2,0) Report messages were previously generated by TaskMan. "KRN",8989.51,753,20,3,0) "KRN",8989.51,753,20,4,0) The purpose of this data is to record the previous end date for the "KRN",8989.51,753,20,5,0) report generated by the TaskMan job. It is used to prevent the TaskMan "KRN",8989.51,753,20,6,0) job from reporting a Hospital Location change or addition more than once "KRN",8989.51,753,20,7,0) and differently than was previously reported. "KRN",8989.51,753,20,8,0) "KRN",8989.51,753,20,9,0) This date will be the start date used when the Hospital Location Change "KRN",8989.51,753,20,10,0) Report messages are next generated by the TaskMan option. "KRN",8989.51,753,20,11,0) "KRN",8989.51,753,20,12,0) CHANGING THIS DATE WILL AFFECT THE INFORMATION REPORTED THE NEXT TIME "KRN",8989.51,753,20,13,0) TASKMAN RUNS THE LRJ SYS MAP HL TASKMAN RPT. "KRN",8989.51,753,30,0) ^8989.513I^1^1 "KRN",8989.51,753,30,1,0) 1^4.2 "KRN",8989.51,754,-1) 0^4 "KRN",8989.51,754,0) LRJ LSRP AUF60 LAST START DATE^File 60 Audit Report Last Start Date^0^File 60 Audit Rpt Last Start Date/Time^File 60 Audit Rpt Last Start Date/Time^0 "KRN",8989.51,754,1) D^::T^This was the start date used when the File 60 Audit Report last completed. "KRN",8989.51,754,6) D^::T "KRN",8989.51,754,20,0) ^^5^5^3100629^ "KRN",8989.51,754,20,1,0) This field indicates the start date used when the File 60 Audit Report "KRN",8989.51,754,20,2,0) messages were previously generated by TaskMan. "KRN",8989.51,754,20,3,0) "KRN",8989.51,754,20,4,0) The purpose of this data is to record the previous start date for the "KRN",8989.51,754,20,5,0) report generated by the TaskMan job. "KRN",8989.51,754,30,0) ^8989.513I^1^1 "KRN",8989.51,754,30,1,0) 1^4.2 "KRN",8989.51,755,-1) 0^3 "KRN",8989.51,755,0) LRJ LSRP AUF60 LAST END DATE^File 60 Audit Report Last End Date^0^File 60 Audit Report Last End Date^File 60 Audit Report Last End Date^0 "KRN",8989.51,755,1) D^::T^This was the end date used when the Taskman File 60 Audit Report last completed. "KRN",8989.51,755,6) D^::T "KRN",8989.51,755,20,0) ^^9^9^3100629^ "KRN",8989.51,755,20,1,0) This field indicates the end date used when the File 60 Audit Report "KRN",8989.51,755,20,2,0) messages were previously generated by TaskMan. "KRN",8989.51,755,20,3,0) "KRN",8989.51,755,20,4,0) The purpose of this data is to record the previous end date for the "KRN",8989.51,755,20,5,0) report generated by the TaskMan job. This date will be the start date "KRN",8989.51,755,20,6,0) used when File 60 audit messages are next generated by the TaskMan option. "KRN",8989.51,755,20,7,0) "KRN",8989.51,755,20,8,0) CHANGING THIS DATE WILL AFFECT THE INFORMATION REPORTED THE NEXT TIME "KRN",8989.51,755,20,9,0) TASKMAN RUNS THE File 60 Audit Report. "KRN",8989.51,755,30,0) ^8989.513I^1^1 "KRN",8989.51,755,30,1,0) 1^4.2 "KRN",8989.51,756,-1) 0^6 "KRN",8989.51,756,0) LRJ LSRP AUF60XT LAST START DT^File 60 Audit (extract) Last Start Date^0^File 60 Audit (extract) Last Start Date^File 60 Audit (extract) Last Start Date^0 "KRN",8989.51,756,1) D^::T^This was the start date used when the File 60 extract file was last completed. "KRN",8989.51,756,6) D^::T^This was the start date used when the File 60 extract file was last completed. "KRN",8989.51,756,20,0) ^^2^2^3090929^ "KRN",8989.51,756,20,1,0) This indicates the last start date used when the automatic file "KRN",8989.51,756,20,2,0) extractions based on file 60 audits were generated by TaskMan. "KRN",8989.51,756,30,0) ^8989.513I^1^1 "KRN",8989.51,756,30,1,0) 1^4.2 "KRN",8989.51,757,-1) 0^5 "KRN",8989.51,757,0) LRJ LSRP AUF60XT LAST END DATE^File 60 Audit (extract) Last End Date^0^File 60 Audit (extract) Last End Date^File 60 Audit (extract) Last End Date^0 "KRN",8989.51,757,1) D^::T^This was the end date when the File 60 extract file last completed. "KRN",8989.51,757,6) D^::T^This was the end date when the File 60 extract file last completed. "KRN",8989.51,757,20,0) ^^2^2^3090929^ "KRN",8989.51,757,20,1,0) This indicates the end date used when the automatic file extractions "KRN",8989.51,757,20,2,0) based on file 60 audits were generated by TaskMan. "KRN",8989.51,757,30,0) ^8989.513I^1^1 "KRN",8989.51,757,30,1,0) 1^4.2 "KRN",8989.51,758,-1) 0^7 "KRN",8989.51,758,0) LRJ OBSOLETE PENDING ORDERS^OBSOLETE PENDING ORDERS DEFAULT^0^^NUMBER OF DAYS "KRN",8989.51,758,1) N^1:365^Enter the number of days before pending orders are considered obsolete. "KRN",8989.51,758,20,0) ^8989.512^4^4^3130425^^^ "KRN",8989.51,758,20,1,0) The purpose of this parameter is to store the number of days before "KRN",8989.51,758,20,2,0) pending orders will be considered obsolete. When this number of days has "KRN",8989.51,758,20,3,0) passed, the order will be canceled in legacy lab and a lapse order status "KRN",8989.51,758,20,4,0) update will be sent to CPRS. "KRN",8989.51,758,30,0) ^8989.513I^1^1 "KRN",8989.51,758,30,1,0) 10^4.2 "MBREQ") 0 "ORD",3,19.1) 19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1 "ORD",3,19.1,0) SECURITY KEY "ORD",5,.4) .4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%) "ORD",5,.4,0) PRINT TEMPLATE "ORD",6,.401) .401;6;;;EDEOUT^DIFROMSO(.401,DA,"",XPDA);FPRE^DIFROMSI(.401,"",XPDA);EPRE^DIFROMSI(.401,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.401,DA,"",XPDA);DEL^DIFROMSK(.401,"",%) "ORD",6,.401,0) SORT TEMPLATE "ORD",11,3.8) 3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%) "ORD",11,3.8,0) MAIL GROUP "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "ORD",20,8989.51) 8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%) "ORD",20,8989.51,0) PARAMETER DEFINITION "PKG",14,-1) 1^1 "PKG",14,0) LAB SERVICE^LR^CORE LAB SYSTEM "PKG",14,20,0) ^9.402P^1^1 "PKG",14,20,1,0) 2^^LRXDRPT "PKG",14,20,1,1) "PKG",14,20,"B",2,1) "PKG",14,22,0) ^9.49I^1^1 "PKG",14,22,1,0) 5.2^2940927^2960610 "PKG",14,22,1,"PAH",1,0) 425^3130806^1255 "PKG",14,22,1,"PAH",1,1,0) ^^10^10^3130806 "PKG",14,22,1,"PAH",1,1,1,0) The following Lab changes or enhancements are included in this build: "PKG",14,22,1,"PAH",1,1,2,0) "PKG",14,22,1,"PAH",1,1,3,0) 1) CPRS API for Lab to call when a test is modified "PKG",14,22,1,"PAH",1,1,4,0) 2) Changes to identify File 60 changes that impact CPRS Quick Orders "PKG",14,22,1,"PAH",1,1,5,0) 3) National Lab Release: Hospital Location Change Management Tool "PKG",14,22,1,"PAH",1,1,6,0) 4) National Lab Release: Lab Test File 60 Audit Tool "PKG",14,22,1,"PAH",1,1,7,0) 5) National Lab Release: Inactivation of Collection Samples File Entries "PKG",14,22,1,"PAH",1,1,8,0) 6) National Lab Release: Inactivation of Topography File Entries "PKG",14,22,1,"PAH",1,1,9,0) 7) National Lab Release: Lapsed Orders "PKG",14,22,1,"PAH",1,1,10,0) "PRE") LR425 "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") NO "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") NO "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") NO "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") 21 "RTN","LR425") 0^^B66054547^n/a "RTN","LR425",1,0) LR425 ;ALB/GTS - LR*5.2*425 KIDS POST-INIT ROUTINE ;09/28/2012 11:25 "RTN","LR425",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LR425",3,0) ; "RTN","LR425",4,0) ; "RTN","LR425",5,0) ;Environment check for LSRP: ENSTART, CHK4LSRP, LSRPEX and Call Environment check in LR*425 "RTN","LR425",6,0) ENSTART ; -- Generic Lab environment check "RTN","LR425",7,0) ; May prevent loading of the transport global. "RTN","LR425",8,0) ; Environment check is done only during the install. "RTN","LR425",9,0) ; "RTN","LR425",10,0) N LRMSG,LAPOS,LRALST,MSG,BAD,LSRPEND,X "RTN","LR425",11,0) S LSRPEND="N/A" "RTN","LR425",12,0) S XPDNOQUE=1 ;no queuing "RTN","LR425",13,0) S LAPOS=$G(IOM,80) S:LAPOS<1 LAPOS=80 "RTN","LR425",14,0) D LMES($$CJ^XLFSTR("***"_$S('$G(XPDENV):" 'Transport Global Load'",1:" 'Installation'")_" Environment Check started ***",LAPOS),1,"B") "RTN","LR425",15,0) ; "RTN","LR425",16,0) ; Check for LMI mailgroup "RTN","LR425",17,0) D LMES("'LMI' Mail Group must exist.",10,"B") "RTN","LR425",18,0) D LMES("Checking for 'LMI' Mail Group...",15) "RTN","LR425",19,0) S X=$$FIND1^DIC(3.8,,"BOQUX","LMI","B","","LAMSG") "RTN","LR425",20,0) I 'X D Q ;QUIT/Abort if LMI Mailgroup is not defined "RTN","LR425",21,0) . D LMES("Mail Group (#3.8) 'LMI' does not exist.",20) "RTN","LR425",22,0) . D LMES($$CJ^XLFSTR("* * * Environment failed. Aborting. * * *",LAPOS),1,"B") "RTN","LR425",23,0) . S XPDABORT=2 ; Leave transport global "RTN","LR425",24,0) . D LSRPEX "RTN","LR425",25,0) E D "RTN","LR425",26,0) . D LMES("'LMI' Mail Group exists.",20) "RTN","LR425",27,0) . D LMES("Continuing...",25) "RTN","LR425",28,0) ; "RTN","LR425",29,0) I '$G(XPDENV) D Q ;QUIT if Loading Distribution "RTN","LR425",30,0) . NEW LRC383,LAC75,LRP393,LAP76 "RTN","LR425",31,0) . SET MSG="Distribution for '"_$G(XPDNM,"Unknown patch")_"' loaded "_$$HTE^XLFDT($H) "RTN","LR425",32,0) . DO LMES(" ",1) "RTN","LR425",33,0) . DO LMES("Sending distribution loaded alert...",7,"B") "RTN","LR425",34,0) . DO ALERT(MSG) "RTN","LR425",35,0) . SET LRC383=$$PATCH^XPDUTL("LR*5.2*383") "RTN","LR425",36,0) . SET LAC75=$$PATCH^XPDUTL("LA*5.2*75") "RTN","LR425",37,0) . SET LRP393=$$PATCH^XPDUTL("LR*5.2*393") "RTN","LR425",38,0) . SET LAP76=$$PATCH^XPDUTL("LA*5.2*76") "RTN","LR425",39,0) . SET LSRPEND=(LRC383!LAC75!LRP393!LAP76) "RTN","LR425",40,0) . DO LSRPEX "RTN","LR425",41,0) ; "RTN","LR425",42,0) ;Continue if $G(XPDENV) - Installation underway, Check for LSRP "RTN","LR425",43,0) D LMES("Sending install started alert...",7,"B") "RTN","LR425",44,0) S MSG="Installation of '"_$G(XPDNM,"Unknown patch")_"' started "_$$HTE^XLFDT($H) "RTN","LR425",45,0) D ALERT(MSG) "RTN","LR425",46,0) ; "RTN","LR425",47,0) D CHK4LSRP "RTN","LR425",48,0) D LSRPEX "RTN","LR425",49,0) Q "RTN","LR425",50,0) ; "RTN","LR425",51,0) CHK4LSRP ; [During Installation...] Check if LSRP is installed at site, do NOT install over LSRP "RTN","LR425",52,0) NEW LRC383,LAC75,LRP393,LAP76 "RTN","LR425",53,0) SET LRC383=$$PATCH^XPDUTL("LR*5.2*383") "RTN","LR425",54,0) SET LAC75=$$PATCH^XPDUTL("LA*5.2*75") "RTN","LR425",55,0) SET LRP393=$$PATCH^XPDUTL("LR*5.2*393") "RTN","LR425",56,0) SET LAP76=$$PATCH^XPDUTL("LA*5.2*76") "RTN","LR425",57,0) IF (LRC383!LAC75!LRP393!LAP76) DO ;LSRP Site? "RTN","LR425",58,0) . NEW LRMGR,LROVRD "RTN","LR425",59,0) . DO OWNSKEY^XUSRB(.LRMGR,"LRJ CERNER MGR") "RTN","LR425",60,0) . DO OWNSKEY^XUSRB(.LROVRD,"LRJ CERNER OVERRIDE") "RTN","LR425",61,0) . IF ($G(LRMGR(0))=0)!($G(LROVRD(0))=0) DO ;Hold LRJ CERNER MGR & LRJ CERNER OVERRIDE keys? "RTN","LR425",62,0) . . SET XPDABORT=1 "RTN","LR425",63,0) . . SET BAD=1 "RTN","LR425",64,0) . . SET BAD(1)="** LSRP is installed at this site!! **" "RTN","LR425",65,0) . . SET BAD(2)="All Lab (LR/LA namespaced) patches must be installed by the LSRP Triage team." "RTN","LR425",66,0) . ELSE DO "RTN","LR425",67,0) . . NEW DIR,X,Y,DTOUT,DIRUT,DUOUT,LROK "RTN","LR425",68,0) . . WRITE ! "RTN","LR425",69,0) . . SET DIR(0)="Y" "RTN","LR425",70,0) . . SET DIR("A",1)="You are installing a Legacy Lab patch at a LSRP Site." "RTN","LR425",71,0) . . SET DIR("A",2)="The LSRP Triage Team should be coordinating this installation." "RTN","LR425",72,0) . . SET DIR("A",3)="If LSRP Triage is NOT coordinating, DO NOT INSTALL THIS PATCH!" "RTN","LR425",73,0) . . SET DIR("A")="Do you want to install" "RTN","LR425",74,0) . . SET DIR("B")="NO" "RTN","LR425",75,0) . . SET DIR("?",1)="You have the privileges to install this patch." "RTN","LR425",76,0) . . SET DIR("?",2)="Installing means LSRP Triage has determined if this patch will" "RTN","LR425",77,0) . . SET DIR("?")="overwrite LSRP system structures and how to address the conflicts." "RTN","LR425",78,0) . . DO ^DIR "RTN","LR425",79,0) . . SET LROK=+Y "RTN","LR425",80,0) . . SET LSRPEND='+Y "RTN","LR425",81,0) . . IF 'LROK DO "RTN","LR425",82,0) . . . SET XPDABORT=1 "RTN","LR425",83,0) . . . DO LMES("Installer with DUZ: "_DUZ_" defering to LSRP Triage.",20,"B") "RTN","LR425",84,0) . . . DO:$G(XPDENV) LMES("Installation will stop and remove global.",25) "RTN","LR425",85,0) . . . DO LMES($$CJ^XLFSTR("* * * Install stopped during Environment check. * * *",LAPOS),1,"B") "RTN","LR425",86,0) Q "RTN","LR425",87,0) ; "RTN","LR425",88,0) LSRPEX ; LSRP Exit message for Install log "RTN","LR425",89,0) NEW LAPOS,MSG "RTN","LR425",90,0) SET LAPOS=$G(IOM,80) S:LAPOS<1 LAPOS=80 "RTN","LR425",91,0) IF $G(XPDQUIT)!$G(XPDABORT) DO QUIT ; "RTN","LR425",92,0) . W !!,$C(7) "RTN","LR425",93,0) . D:LSRPEND=1 LMES($$CJ^XLFSTR("* * * Installer aborted installation. * * *",LAPOS),1,"B") "RTN","LR425",94,0) . D:LSRPEND="N/A" LMES($$CJ^XLFSTR("* * * Environment Check FAILED * * *",LAPOS),1,"B") "RTN","LR425",95,0) . I $G(BAD(1))'="" D LMES($$CJ^XLFSTR(BAD(1),LAPOS),1,"B") "RTN","LR425",96,0) . I $G(BAD(2))'="" D LMES($$CJ^XLFSTR(BAD(2),LAPOS),1,"B") "RTN","LR425",97,0) . D LMES("Sending Install aborted alert...",7,"B") "RTN","LR425",98,0) . S MSG="Installation of '"_$G(XPDNM,"Unknown patch")_"' Aborted "_$$HTE^XLFDT($H) "RTN","LR425",99,0) . D ALERT(MSG) "RTN","LR425",100,0) . D LMES("",1,"B") "RTN","LR425",101,0) ; "RTN","LR425",102,0) I '$G(XPDENV),LSRPEND=1 D "RTN","LR425",103,0) . DO LMES("Sending 'Lab Patch at LSRP site' alert...",7,"B") "RTN","LR425",104,0) . SET MSG="Transport global for Lab patch available at LSRP site. Notify LSRP Triage!" "RTN","LR425",105,0) . DO ALERT(MSG) "RTN","LR425",106,0) . DO LMES($$CJ^XLFSTR("* * Loaded Lab patch on a LSRP Site. * *",LAPOS),1,"B") "RTN","LR425",107,0) . DO LMES($$CJ^XLFSTR("** Installation must be coordinated with LSRP Triage Team! **",LAPOS),1,"") "RTN","LR425",108,0) . DO LMES("",1,"B") "RTN","LR425",109,0) I '$G(XPDENV),LSRPEND=0 D LMES($$CJ^XLFSTR("--- Lab Environment okay ---",LAPOS),1,"B") "RTN","LR425",110,0) ; "RTN","LR425",111,0) D LMES(" ",1,"B") "RTN","LR425",112,0) IF $G(XPDENV),LSRPEND="N/A" D LMES($$CJ^XLFSTR("--- Lab Environment okay ---",LAPOS),1,"B") "RTN","LR425",113,0) IF $G(XPDENV),LSRPEND=0 D LMES($$CJ^XLFSTR("--- LSRP Environment okay for install with LSRP Triage assistance. ---",LAPOS),1,"B") "RTN","LR425",114,0) IF $G(XPDENV),LSRPEND=1 D LMES($$CJ^XLFSTR("--- LSRP Environment not OK for install. Requires LSRP Triage assistance. ---",LAPOS),1,"B") ;Bullet Proof "RTN","LR425",115,0) QUIT "RTN","LR425",116,0) ; "RTN","LR425",117,0) POST ; -- post-init for LR*5.2*425 "RTN","LR425",118,0) N LAPOS "RTN","LR425",119,0) S LAPOS=$G(IOM,80) S:LAPOS<1 LAPOS=80 "RTN","LR425",120,0) D LMES($$CJ^XLFSTR("*** Post install started ***",LAPOS),1,"B") "RTN","LR425",121,0) ; "RTN","LR425",122,0) D AUDSET("LRJSMLA1","patient location") ;Enable Fileman auditing for HLCMS (Hospital Location monitoring) "RTN","LR425",123,0) D LMES("Enable Auditing for selected LABORATORY TEST file (#60) fields...",10,"B") "RTN","LR425",124,0) D AUDSET^LRJSAU ; Set up auditing on LABORATORY TEST file fields "RTN","LR425",125,0) ; "RTN","LR425",126,0) D LMES("Checking parameters for file 60 audit changes affecting quick orders...",10,"B") "RTN","LR425",127,0) D SETP ; Set parameters in file 69.9 if previous file 60 audits exist "RTN","LR425",128,0) ; "RTN","LR425",129,0) D LMES($$CJ^XLFSTR("*** Post install completed ***",LAPOS),1,"B") "RTN","LR425",130,0) D LMES("",1,"B") "RTN","LR425",131,0) D LMES("Sending install completion alert to mail group G.LMI",7,"B") "RTN","LR425",132,0) D ALERT("Installation of '"_$G(XPDNM,"Unknown patch")_"' completed "_$$HTE^XLFDT($H)) "RTN","LR425",133,0) Q "RTN","LR425",134,0) ; "RTN","LR425",135,0) AUDSET(LROU,LRFILTXT) ; -- enable audit on select Hospital Location, Ward Location and Room-Bed fields "RTN","LR425",136,0) ; "RTN","LR425",137,0) ;INPUT : LROU - Name of routine containing "AFLDS" tag. "RTN","LR425",138,0) ; LRFILTXT - Descriptive text of data being audited for message. "RTN","LR425",139,0) ; "RTN","LR425",140,0) NEW LRI,LRAFLDS,LRJ,LRFLD "RTN","LR425",141,0) D LMES("Enable Auditing for selected "_LRFILTXT_" fields...",10,"B") "RTN","LR425",142,0) FOR LRI=1:1 SET LRAFLDS=$P($TEXT(AFLDS+LRI^@LROU),";;",2) QUIT:LRAFLDS="" DO "RTN","LR425",143,0) . DO TURNON^DIAUTL(+LRAFLDS,$P(LRAFLDS,"^",2)) ;IA #5611 allows audit in HL files "RTN","LR425",144,0) . D LMES("Turn on Audit Attribute for the following fields in file: "_$P(LRAFLDS,"^"),15,"B") "RTN","LR425",145,0) . F LRJ=1:1 S LRFLD=$P($P(LRAFLDS,"^",2),";",LRJ) Q:LRFLD="" D LMES("Field #: "_LRFLD,20) "RTN","LR425",146,0) ; "RTN","LR425",147,0) D LMES("Continuing...",20) "RTN","LR425",148,0) D LMES("",1,"B") "RTN","LR425",149,0) QUIT "RTN","LR425",150,0) ; "RTN","LR425",151,0) SETP ; Set parameters for the latest file 60 audit file entries affecting quick orders, if not already set "RTN","LR425",152,0) N LRLIEN,LRLDATE,LRMSG,LRD "RTN","LR425",153,0) S LRLIEN=+$O(^DIA(60,"A"),-1) "RTN","LR425",154,0) S LRLDATE=$P($G(^DIA(60,+$O(^DIA(60,"A"),-1),0)),U,2) "RTN","LR425",155,0) I 'LRLIEN,'LRLDATE D Q "RTN","LR425",156,0) . D LMES("No previous file 60 audits found, no parameter update necessary",15) "RTN","LR425",157,0) D GETS^DIQ(69.9,1,"64.913;64.914","I","LRD") "RTN","LR425",158,0) I $G(LRD(69.9,"1,",64.913,"I"))=""!($G(LRD(69.9,"1,",64.914,"I"))="") D Q "RTN","LR425",159,0) . K LRD "RTN","LR425",160,0) . S LRD(69.9,"1,",64.913)=LRLIEN,LRD(69.9,"1,",64.914)=LRLDATE "RTN","LR425",161,0) . D FILE^DIE("","LRD","LRMSG") "RTN","LR425",162,0) . D LMES("Parameters updated based on data found for last file 60 audit",15) "RTN","LR425",163,0) . D LMES("LAST IEN: "_LRLIEN_" LAST DATE: "_$$FMTE^XLFDT(LRLDATE,2),20) "RTN","LR425",164,0) D LMES("Parameters are already set, no update necessary",15) "RTN","LR425",165,0) Q "RTN","LR425",166,0) ; "RTN","LR425",167,0) LMES(STR,SPCNUM,BVAR) ; List text in output display "RTN","LR425",168,0) ; "RTN","LR425",169,0) ; INPUT: "RTN","LR425",170,0) ; STR - String to output "RTN","LR425",171,0) ; SPCNUM - # Leading spaces "RTN","LR425",172,0) ; BVAR - Null: Do not print a blank prior to text (Default) [MES] "RTN","LR425",173,0) ; "B" : Print a blank prior to text [BMES] "RTN","LR425",174,0) ; "RTN","LR425",175,0) ; Write string in a single line list "RTN","LR425",176,0) N LRMSG "RTN","LR425",177,0) S LRMSG="" "RTN","LR425",178,0) S:+$G(SPCNUM)=0 SPCNUM=1 "RTN","LR425",179,0) S $P(LRMSG," ",SPCNUM)=STR "RTN","LR425",180,0) D:$G(BVAR)'="B" MES^XPDUTL(LRMSG) "RTN","LR425",181,0) D:$G(BVAR)="B" BMES^XPDUTL(LRMSG) "RTN","LR425",182,0) Q "RTN","LR425",183,0) ; "RTN","LR425",184,0) ALERT(MSG) ;Send Alert message "RTN","LR425",185,0) ;Input: MSG - Alert message to send "RTN","LR425",186,0) N XQA,XQAMSG "RTN","LR425",187,0) S XQAMSG=$G(MSG) "RTN","LR425",188,0) ; "RTN","LR425",189,0) I $$GOTLOCAL^XMXAPIG("LMI") DO "RTN","LR425",190,0) . S XQA("G.LMI")="" "RTN","LR425",191,0) . D LMES("Alert addressed to mail group G.LMI",10) "RTN","LR425",192,0) E DO "RTN","LR425",193,0) . S XQA(DUZ)="" "RTN","LR425",194,0) . D LMES("LMI Mail group not defined. Alert addressed to installer.",10) "RTN","LR425",195,0) ; "RTN","LR425",196,0) D:$G(MSG)]"" LMES(MSG,80-$L(MSG)) "RTN","LR425",197,0) D LMES(" ",1) "RTN","LR425",198,0) I '$$SETUP1^XQALERT DO "RTN","LR425",199,0) .D:$G(MSG)']"" LMES($$CJ^XLFSTR("Alert Message string not defined.",IOM),1) "RTN","LR425",200,0) .D LMES($$CJ^XLFSTR("** Alert error occured...Alert not sent!! **",IOM),1,"B") "RTN","LR425",201,0) Q "RTN","LRJPON") 0^1^B15108369^n/a "RTN","LRJPON",1,0) LRJPON ;ALB/JLC - OBSOLETE PENDING ORDERS;08/25/2010 12:32:47 "RTN","LRJPON",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJPON",3,0) ; "RTN","LRJPON",4,0) ; "RTN","LRJPON",5,0) ; Reference to ^OR(100 supported by IA #3582 "RTN","LRJPON",6,0) ; Reference to STATUS^ORCSAVE2 supported by IA #5903 "RTN","LRJPON",7,0) ; "RTN","LRJPON",8,0) EN ;search for pending orders older than the obsolete (lapse) timeframe "RTN","LRJPON",9,0) N LRORD,LRDATE,LRSN,LRLAPSE,LRDATE,%,X1,X2,X,LRT,LRCANC,A1,A2,LRDUZ,X,DT,A,LRIFN,LRSTOP "RTN","LRJPON",10,0) S A1=$$GET^XPAR("SYS","LRJ OBSOLETE PENDING ORDERS",1,"I") "RTN","LRJPON",11,0) S A2=$P($G(^LAB(69.9,1,0)),"^",9) "RTN","LRJPON",12,0) I A1="",A2="" D MSG(1) Q "RTN","LRJPON",13,0) I A1="",A2]"" S X2=A2 D MSG(2,A2) "RTN","LRJPON",14,0) I A2="",A1]"" S X2=A1 D MSG(3,A1) "RTN","LRJPON",15,0) I A1]"",A2]"" I A1'LRLAPSE D I $$REQ2STOP() S ZSTOP=1 Q "RTN","LRJPON",22,0) . S LRSN=0 "RTN","LRJPON",23,0) . F S LRSN=$O(^LRO(69,LRDATE,1,LRSN)) Q:'LRSN D I $$REQ2STOP() Q "RTN","LRJPON",24,0) .. S A=$G(^LRO(69,LRDATE,1,LRSN,0)) I A="" Q "RTN","LRJPON",25,0) .. I $P(A,"^")="" Q "RTN","LRJPON",26,0) .. I $P($G(^LRO(69,LRDATE,1,LRSN,1)),"^")]"" Q "RTN","LRJPON",27,0) .. S (LRT,LRSTOP)=0 "RTN","LRJPON",28,0) .. F S LRT=$O(^LRO(69,LRDATE,1,LRSN,2,LRT)) Q:'LRT D "RTN","LRJPON",29,0) ... S A=$G(^LRO(69,LRDATE,1,LRSN,2,LRT,0)) I $P(A,"^",9)="CA" Q "RTN","LRJPON",30,0) ... I $P(A,"^",6)]""!($P(A,"^",14)]"") S LRSTOP=$$CHECK(A,LRDATE,LRSN) "RTN","LRJPON",31,0) ... S $P(^LRO(69,LRDATE,1,LRSN,2,LRT,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^L^"_LRDUZ "RTN","LRJPON",32,0) ... I '$D(^LRO(69,LRDATE,1,LRSN,2,LRT,1.1,0)) S ^(0)="^^^^"_DT "RTN","LRJPON",33,0) ... S X=1+$O(^LRO(69,LRDATE,1,LRSN,2,LRT,1.1,9999),-1) "RTN","LRJPON",34,0) ... S $P(^LRO(69,LRDATE,1,LRSN,2,LRT,1.1,0),"^",3,4)=X_"^"_X,^(X,0)="Obsolete Order" "RTN","LRJPON",35,0) ... I 'LRSTOP S LRIFN=$P($G(^LRO(69,LRDATE,1,LRSN,2,LRT,0)),"^",7) I LRIFN]"" D STATUS^ORCSAVE2(LRIFN,14) "RTN","LRJPON",36,0) .. D NEW^LR7OB1(LRDATE,LRSN,"Z@") "RTN","LRJPON",37,0) S $P(^LAB(69.9,1,64.9104),"^")=$P($$NOW^XLFDT,".") "RTN","LRJPON",38,0) L -^LRJPON "RTN","LRJPON",39,0) Q "RTN","LRJPON",40,0) ; "RTN","LRJPON",41,0) CHECK(PREV,LDATE,LSN) ; "RTN","LRJPON",42,0) N B,LRCOM,ORIFN "RTN","LRJPON",43,0) S ORIFN=$P(PREV,"^",7) I ORIFN="" Q 1 "RTN","LRJPON",44,0) I $P($G(^OR(100,ORIFN,3)),"^",3)'=5 Q 1 "RTN","LRJPON",45,0) S B=$G(^OR(100,ORIFN,4)) I LDATE'=$P(B,";",2)!(LSN'=$P(B,";",3)) Q 1 "RTN","LRJPON",46,0) Q 0 "RTN","LRJPON",47,0) REQ2STOP() ; "RTN","LRJPON",48,0) ; Check for task stop request "RTN","LRJPON",49,0) ; Returns 1 if stop request made. "RTN","LRJPON",50,0) N STATUS,X "RTN","LRJPON",51,0) S STATUS=0 "RTN","LRJPON",52,0) I '$D(ZTQUEUED) Q 0 "RTN","LRJPON",53,0) S X=$$S^%ZTLOAD() "RTN","LRJPON",54,0) I X D ; "RTN","LRJPON",55,0) . S (STATUS,ZTSTOP)=1 "RTN","LRJPON",56,0) . S X=$$S^%ZTLOAD("Received shutdown request") "RTN","LRJPON",57,0) ; "RTN","LRJPON",58,0) I $Q Q STATUS "RTN","LRJPON",59,0) Q "RTN","LRJPON",60,0) ; "RTN","LRJPON",61,0) MSG(ERR,DAYS) ;send mail message "RTN","LRJPON",62,0) K XMY N XMDUZ,XMSUB,XMTEXT,A "RTN","LRJPON",63,0) S XMDUZ="ORDERS, OBSOLETE",XMY("G.LMI")="",XMSUB="OBSOLETE ORDER PARAMETER(S) ISSUE" "RTN","LRJPON",64,0) I ERR=1 D "RTN","LRJPON",65,0) . S A(1)="Both the GRACE PERIOD FOR ORDERS field in file 69.9 and the LRJ OBSOLETE" "RTN","LRJPON",66,0) . S A(2)="PENDING ORDERS parameter are blank." "RTN","LRJPON",67,0) . S A(3)=" " "RTN","LRJPON",68,0) . S A(4)="One of these fields must be populated in order for the process to obsolete" "RTN","LRJPON",69,0) . S A(5)="pending orders to run." "RTN","LRJPON",70,0) I ERR=2!(ERR=3) D "RTN","LRJPON",71,0) . S A(1)="The "_$S(ERR=2:"LRJ OBSOLETE PENDING ORDERS parameter",1:"GRACE PERIOD FOR ORDERS field")_" is blank." "RTN","LRJPON",72,0) . S A(2)=" " "RTN","LRJPON",73,0) . S A(3)="The value: "_DAYS_" days was used for determining the 'obsolete' date." "RTN","LRJPON",74,0) I ERR=4 D "RTN","LRJPON",75,0) . S A(1)="The LRJ OBSOLETE PENDING ORDERS parameter is currently set to "_DAYS_"." "RTN","LRJPON",76,0) . S A(2)=" " "RTN","LRJPON",77,0) . S A(3)="This is either the same or greater than the GRACE PERIOD FOR ORDERS field in" "RTN","LRJPON",78,0) . S A(4)="file 69.9. LRJ OBSOLETE PENDING ORDERS should always be less." "RTN","LRJPON",79,0) . S A(5)=" " "RTN","LRJPON",80,0) . S A(6)="Please correct these settings. You may have to contact IRM for help changing" "RTN","LRJPON",81,0) . S A(7)="the parameter." "RTN","LRJPON",82,0) S XMTEXT="A(" D ^XMD "RTN","LRJPON",83,0) Q "RTN","LRJSAU") 0^24^B7630715^n/a "RTN","LRJSAU",1,0) LRJSAU ;ALB/PO/DK/TMK Lab Audit Manager ;13 Jul 2009 2:29 AM "RTN","LRJSAU",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSAU",3,0) ; "RTN","LRJSAU",4,0) F60 ;File 60 entry point "RTN","LRJSAU",5,0) D EN2 "RTN","LRJSAU",6,0) K ^TMP("LRJ SYS F60 AUD MANAGER",$J) "RTN","LRJSAU",7,0) Q "RTN","LRJSAU",8,0) ; "RTN","LRJSAU",9,0) EN2 ; -- main entry point for LRJ SYS AUF60 MANAGER (file 60) "RTN","LRJSAU",10,0) ; -- required interface routine variable "RTN","LRJSAU",11,0) N LRJSROU S LRJSROU="LRJSAU" "RTN","LRJSAU",12,0) K ^TMP("LRJ SYS F60 AUD MANAGER",$J) "RTN","LRJSAU",13,0) D MSG2^LRJSAU60 "RTN","LRJSAU",14,0) D EN^VALM("LRJ SYS MAP AUF60") "RTN","LRJSAU",15,0) Q "RTN","LRJSAU",16,0) ; "RTN","LRJSAU",17,0) HDR2 ; -- header code "RTN","LRJSAU",18,0) S VALMHDR(1)=" Lab File 60 Audit Manager" "RTN","LRJSAU",19,0) S VALMHDR(2)=" Version: "_$$VERNUM()_" Build: "_$$BLDNUM() "RTN","LRJSAU",20,0) Q "RTN","LRJSAU",21,0) ; "RTN","LRJSAU",22,0) BUILD ; -- build display array "RTN","LRJSAU",23,0) K ^TMP("LRJ SYS F60 AUD MANAGER",$J) "RTN","LRJSAU",24,0) S VALMCNT=0 "RTN","LRJSAU",25,0) D AUDCHK^LRJSAU60(1) "RTN","LRJSAU",26,0) Q "RTN","LRJSAU",27,0) ; "RTN","LRJSAU",28,0) HELP ; -- help code "RTN","LRJSAU",29,0) N X "RTN","LRJSAU",30,0) S X="?" D DISP^XQORM1 W !! "RTN","LRJSAU",31,0) Q "RTN","LRJSAU",32,0) ; "RTN","LRJSAU",33,0) EXIT ; -- exit code "RTN","LRJSAU",34,0) K ^TMP("LRJ SYS F60 AUD MANAGER",$J) "RTN","LRJSAU",35,0) Q "RTN","LRJSAU",36,0) ; "RTN","LRJSAU",37,0) EXPND ; -- expand code "RTN","LRJSAU",38,0) Q "RTN","LRJSAU",39,0) ; "RTN","LRJSAU",40,0) INIT ; -- init variables and list array "RTN","LRJSAU",41,0) K ^TMP("LRJ SYS F60 AUD MANAGER",$J) "RTN","LRJSAU",42,0) D CHGCAP^VALM("HEADER","") "RTN","LRJSAU",43,0) S VALMCNT=0 "RTN","LRJSAU",44,0) Q "RTN","LRJSAU",45,0) ; "RTN","LRJSAU",46,0) BLDNUM() ; -- returns the build number "RTN","LRJSAU",47,0) QUIT +$PIECE($PIECE($TEXT(LRJSAU+1),";",7),"Build ",2) "RTN","LRJSAU",48,0) ; "RTN","LRJSAU",49,0) VERNUM() ; -- returns the version number for this build "RTN","LRJSAU",50,0) QUIT +$PIECE($TEXT(LRJSAU+1),";",3) "RTN","LRJSAU",51,0) ; "RTN","LRJSAU",52,0) CLEAR ; -- clean up entries "RTN","LRJSAU",53,0) D REFRESH "RTN","LRJSAU",54,0) Q "RTN","LRJSAU",55,0) ; "RTN","LRJSAU",56,0) REFRESH ; -- refresh display "RTN","LRJSAU",57,0) D BUILD "RTN","LRJSAU",58,0) D CHGCAP^VALM("HEADER","") "RTN","LRJSAU",59,0) S VALMBCK="R" "RTN","LRJSAU",60,0) Q "RTN","LRJSAU",61,0) ; "RTN","LRJSAU",62,0) KILL ; -- kill off build data "RTN","LRJSAU",63,0) K ^TMP("LRJ SYS F60 AUD MANAGER",$J) "RTN","LRJSAU",64,0) K ^TMP($J,"LRAUDREQ") "RTN","LRJSAU",65,0) S VALMBG=1 "RTN","LRJSAU",66,0) S VALMBCK="R" "RTN","LRJSAU",67,0) Q "RTN","LRJSAU",68,0) ; "RTN","LRJSAU",69,0) AUDSET ; enable audit fields for file 60 "RTN","LRJSAU",70,0) ; called from POST^LR425 "RTN","LRJSAU",71,0) ; ICR 4122 "RTN","LRJSAU",72,0) N LRI,LRAFLDS,LRSUB,LRSTR,LRAUDFIL "RTN","LRJSAU",73,0) F LRI=1:1 S LRAFLDS=$P($TEXT(AFLDS+LRI),";;",2) Q:LRAFLDS="$$END$$" D "RTN","LRJSAU",74,0) . S LRAUDFIL=+$P($P(LRAFLDS,"^"),";",2) ; Pull off subfield # to get subfile if there "RTN","LRJSAU",75,0) . I LRAUDFIL D ; Get subfile # "RTN","LRJSAU",76,0) . . S LRAUDFIL=$$GFLDSB^LRJSAU60(+LRAFLDS,LRAUDFIL) "RTN","LRJSAU",77,0) . S:'LRAUDFIL LRAUDFIL=+LRAFLDS "RTN","LRJSAU",78,0) . ;the following turns audit on for fields specified in SRS "RTN","LRJSAU",79,0) . D TURNON^DIAUTL(LRAUDFIL,$P(LRAFLDS,"^",2)) "RTN","LRJSAU",80,0) Q "RTN","LRJSAU",81,0) ; "RTN","LRJSAU",82,0) ADD(VALMCNT,MSG,LRBOLD) ; -- add line to build display "RTN","LRJSAU",83,0) SET VALMCNT=VALMCNT+1 "RTN","LRJSAU",84,0) DO SET^VALM10(VALMCNT,MSG) "RTN","LRJSAU",85,0) IF $GET(LRBOLD) DO CNTRL^VALM10(VALMCNT,1,79,IOINHI,IOINORM) "RTN","LRJSAU",86,0) QUIT "RTN","LRJSAU",87,0) ; "RTN","LRJSAU",88,0) ; AFLDS data: 1st ^ piece: File #_[;_field # of subfile]-> if needed "RTN","LRJSAU",89,0) ; 2nd ^ piece: the field #'s within that file/subfile to audit, separated by ; "RTN","LRJSAU",90,0) AFLDS ;fields to be audited according to SRS "RTN","LRJSAU",91,0) ;;60^.01;3;4;8;17;18;64.1 "RTN","LRJSAU",92,0) ;;60;100^.01;1;2;95.3 "RTN","LRJSAU",93,0) ;;60;200^.01 "RTN","LRJSAU",94,0) ;;60;300^.01 "RTN","LRJSAU",95,0) ;;60;2^.01 "RTN","LRJSAU",96,0) ;;60;6^.01;1 "RTN","LRJSAU",97,0) ;;60;500^.01 "RTN","LRJSAU",98,0) ;;60;500.1^.01 "RTN","LRJSAU",99,0) ;;$$END$$ "RTN","LRJSAU2") 0^25^B141696414^n/a "RTN","LRJSAU2",1,0) LRJSAU2 ;ALB/GTS/DK/TMK - Lab Vista Audit Utilities;08/16/2010 15:53:28 "RTN","LRJSAU2",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSAU2",3,0) ; "RTN","LRJSAU2",4,0) ; "RTN","LRJSAU2",5,0) KILL ;Kill off build data "RTN","LRJSAU2",6,0) K ^TMP("LRJ SYS MAP AUD MSG",$J) "RTN","LRJSAU2",7,0) K ^TMP("LRJ SYS MAP AUD MANAGER",$J) "RTN","LRJSAU2",8,0) Q "RTN","LRJSAU2",9,0) ; "RTN","LRJSAU2",10,0) LISTHLMM(LRHLARY) ; Store audit information in the display array "RTN","LRJSAU2",11,0) ; INPUT - "RTN","LRJSAU2",12,0) ; LRHLARY - Array of raw extract data "RTN","LRJSAU2",13,0) ; "RTN","LRJSAU2",14,0) N LRREF,LRFROM,LRTO "RTN","LRJSAU2",15,0) ;get top level with date information "RTN","LRJSAU2",16,0) S LRREF=$P(LRHLARY,")")_",1)" "RTN","LRJSAU2",17,0) S LRFROM=$P($G(@LRREF),"^") "RTN","LRJSAU2",18,0) S LRTO=$P($G(@LRREF),"^",2) "RTN","LRJSAU2",19,0) D KILL "RTN","LRJSAU2",20,0) D KILL^VALM10() "RTN","LRJSAU2",21,0) D CRTRPTAR(LRHLARY,LRFROM,LRTO,"DISPLAY","") "RTN","LRJSAU2",22,0) Q "RTN","LRJSAU2",23,0) ; "RTN","LRJSAU2",24,0) CRTRPTAR(LRHLARY,LRFROM,LRTO,LROUTPT,LRMMARY) ; Store info in the display array "RTN","LRJSAU2",25,0) ; INPUT - "RTN","LRJSAU2",26,0) ; LRHLARY - Array of raw extract data "RTN","LRJSAU2",27,0) ; LRFROM - Start date for report "RTN","LRJSAU2",28,0) ; LRTO - End date for report "RTN","LRJSAU2",29,0) ; LROUTPT - "DISPLAY" for Listman; "MAIL" for mail message "RTN","LRJSAU2",30,0) ; LRMMARY - Mail message output array "RTN","LRJSAU2",31,0) ; "RTN","LRJSAU2",32,0) N X,XN,XP,NODE,X1,X2,X3 "RTN","LRJSAU2",33,0) N LRFSTLNE,LRPARAM,LRLNCTN,LRLNCNT,LRVALST "RTN","LRJSAU2",34,0) S VALM("TITLE")=AUDES_" Audit Message" "RTN","LRJSAU2",35,0) S:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSAU2",36,0) S:$G(LROUTPT)="" LROUTPT="DISPLAY" "RTN","LRJSAU2",37,0) S LRFSTLNE=0 "RTN","LRJSAU2",38,0) S X=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSAU2",39,0) I LROUTPT="MAIL" D "RTN","LRJSAU2",40,0) .S LRLNCNT=0 "RTN","LRJSAU2",41,0) .D LRADDNOD^LRJSAU3(.LRLNCNT,X,"",LROUTPT,LRMMARY) "RTN","LRJSAU2",42,0) Q "RTN","LRJSAU2",43,0) ; "RTN","LRJSAU2",44,0) ;THE FOLLOWING API is to be called from a Taskman "RTN","LRJSAU2",45,0) ;scheduled job LRJ SYS MAP [autyp] TASKMAN RPT where autyp=audit type "RTN","LRJSAU2",46,0) ;;;TASKMAN should call D TSKMMARY^LRJSAU2(AUTYP,AUDES,"^TMP(""LRJ SYS F60 AUD MANAGER"",$J)","^TMP(""LRJ SYS F60 AUD MANAGER"",$J)") "RTN","LRJSAU2",47,0) TSKMMARY(AUTYP,AUDES,AUFMT) ;TASKMAN API for Mail Message array "RTN","LRJSAU2",48,0) ; "RTN","LRJSAU2",49,0) ;INPUT (Roots for arrays to be created) "RTN","LRJSAU2",50,0) ;AUTYP=Audit Type (AUF60 = File 60, AUF60XT = File 60 extract delimited file "RTN","LRJSAU2",51,0) ;AUDES=Description (File 60 Audit, New Person Audit) "RTN","LRJSAU2",52,0) ; LRHLARY - Array of Raw Data "RTN","LRJSAU2",53,0) ; LRMMARY - Mail Message array to send in message "RTN","LRJSAU2",54,0) ;AUFMT=format (Readable Display=DISPLAY; Delimited file =FILE) "RTN","LRJSAU2",55,0) ; "RTN","LRJSAU2",56,0) ; "RTN","LRJSAU2",57,0) N $ESTACK,$ETRAP S $ETRAP="D TSKERR^LRJSAU2" "RTN","LRJSAU2",58,0) N LRFROM,LRTO,LRTOMM,LRMSUBJ,XQSND,ERR,LRTOVA,LRTASKVA,LRINSTVA,AUSUB,TSKCALL,ZTIO "RTN","LRJSAU2",59,0) ; "RTN","LRJSAU2",60,0) ;;TO DO: GIVE INSTRUCTIONS FOR SCHEDULING THE FREQUENCY OF TASK JOB VIA TASKMAN "RTN","LRJSAU2",61,0) ;; "RTN","LRJSAU2",62,0) D NOW^%DTC "RTN","LRJSAU2",63,0) S LRTO=$E(%,1,12) ;NOW is end date/time "RTN","LRJSAU2",64,0) K %,X,%H,%I(1),%I(2),%I(3) "RTN","LRJSAU2",65,0) S LRFROM=$$GET^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST END DATE",1,"Q") "RTN","LRJSAU2",66,0) ; "RTN","LRJSAU2",67,0) ;If report hasn't been run before, generate for previous 7 days "RTN","LRJSAU2",68,0) I LRFROM="" D "RTN","LRJSAU2",69,0) .S X1=LRTO "RTN","LRJSAU2",70,0) .S X2=-7 "RTN","LRJSAU2",71,0) .D C^%DTC "RTN","LRJSAU2",72,0) .S LRFROM=X "RTN","LRJSAU2",73,0) .K X,%H "RTN","LRJSAU2",74,0) ; "RTN","LRJSAU2",75,0) D EN^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST END DATE",,LRTO,.ERR) "RTN","LRJSAU2",76,0) D EN^XPAR("SYS","LRJ LSRP "_AUTYP_" LAST START DATE",,LRFROM,.ERR) "RTN","LRJSAU2",77,0) ; "RTN","LRJSAU2",78,0) S TSKCALL=1,ZTIO="" "RTN","LRJSAU2",79,0) I AUTYP["AUF60" D AUDISP^LRJSAU60 "RTN","LRJSAU2",80,0) I AUTYP'["AUF60" Q "RTN","LRJSAU2",81,0) S AUSUB=$S(AUTYP["AUF60":"F60",1:"") "RTN","LRJSAU2",82,0) S (LRHLARY,LRMMARY)="^TMP(""LRJ SYS ""_AUSUB_"" AUD MANAGER"",$J)" "RTN","LRJSAU2",83,0) I AUTYP["XT" S (LRHLARY,LRMMARY)="^TMP(""LRJ SYS ""_AUSUB_"" AUD MANAGER"",$J,""EXTRACT"")" "RTN","LRJSAU2",84,0) ; "RTN","LRJSAU2",85,0) I $D(@LRHLARY) D "RTN","LRJSAU2",86,0) . S LRLPCNT=1 "RTN","LRJSAU2",87,0) . S @LRMMARY@(LRLPCNT)=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSAU2",88,0) . I AUFMT="DISPLAY" D "RTN","LRJSAU2",89,0) . . F XCAT="NEW","OLD" D "RTN","LRJSAU2",90,0) . . . S (LRNODE,LRSUB)=0 "RTN","LRJSAU2",91,0) . . . I '$D(@LRHLARY@(XCAT)) D Q "RTN","LRJSAU2",92,0) . . . . S LRLPCNT=LRLPCNT+1 "RTN","LRJSAU2",93,0) . . . . S @LRMMARY@(LRLPCNT)=" No "_$S(XCAT="NEW":"new",1:"modified")_" entries" "RTN","LRJSAU2",94,0) . . . S LRLPCNT=LRLPCNT+1 "RTN","LRJSAU2",95,0) . . . S @LRMMARY@(LRLPCNT)="" "RTN","LRJSAU2",96,0) . . . S LRLPCNT=LRLPCNT+1 "RTN","LRJSAU2",97,0) . . . S @LRMMARY@(LRLPCNT)=$S(XCAT="NEW":"New",1:"Modified")_" entries" "RTN","LRJSAU2",98,0) . . . S LRLPCNT=LRLPCNT+1 "RTN","LRJSAU2",99,0) . . . S @LRMMARY@(LRLPCNT)="" "RTN","LRJSAU2",100,0) . . . F S LRNODE=$O(@LRHLARY@(XCAT,LRNODE)) Q:LRNODE="" D "RTN","LRJSAU2",101,0) . . . . F S LRSUB=$O(@LRHLARY@(XCAT,LRNODE,LRSUB)) Q:LRSUB="" D "RTN","LRJSAU2",102,0) . . . . . S LRLPCNT=LRLPCNT+1 "RTN","LRJSAU2",103,0) . . . . . S @LRMMARY@(LRLPCNT)=$G(@LRHLARY@(XCAT,LRNODE,LRSUB)) "RTN","LRJSAU2",104,0) . . S LRMSUBJ=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSAU2",105,0) . . S LRTOMM("G.LRJ "_AUTYP_" AUDIT TASK REPORT")="" "RTN","LRJSAU2",106,0) . . S XQSND=DUZ "RTN","LRJSAU2",107,0) . . D SNDMSG(LRMSUBJ,XQSND,LRMMARY,.LRTOMM,1) ;"1" = created by Taskman; send to Mailgroup "RTN","LRJSAU2",108,0) . ;Send Extract message with attachments "RTN","LRJSAU2",109,0) . Q:AUFMT="DISPLAY" "RTN","LRJSAU2",110,0) . S LRMSUBJ=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSAU2",111,0) . ; "RTN","LRJSAU2",112,0) . ;Check for Network addresses and mail attachment "RTN","LRJSAU2",113,0) . S LRINSTVA("ADDR FLAGS")="R" ;Do not Restrict Message addressing "RTN","LRJSAU2",114,0) . S LRINSTVA("FROM")="LSRP_"_AUTYP_" USER_ACTION" "RTN","LRJSAU2",115,0) . S XQSND=DUZ "RTN","LRJSAU2",116,0) . S LRTOVA(XQSND)="" "RTN","LRJSAU2",117,0) . ;Array of raw extract, Array of message text for networkd address, Message subject "RTN","LRJSAU2",118,0) . ; "RTN","LRJSAU2",119,0) . S LRTOMM("G.LRJ "_AUTYP_" AUDIT TASK REPORT")="" "RTN","LRJSAU2",120,0) . D OUTLKARY(LRHLARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ) "RTN","LRJSAU2",121,0) . D SNDMSG(LRMSUBJ,XQSND,"^TMP($J,""LRNETMSG"")",.LRTOMM,1) "RTN","LRJSAU2",122,0) . ; "RTN","LRJSAU2",123,0) K @LRHLARY,@LRMMARY,^TMP($J,"LRNETMSG") "RTN","LRJSAU2",124,0) Q "RTN","LRJSAU2",125,0) ; "RTN","LRJSAU2",126,0) TSKERR ; Error trap to send bulletin if queued report encounters a system error "RTN","LRJSAU2",127,0) N XMTEXT,XMY,XMSUB,XQSND "RTN","LRJSAU2",128,0) S XMY("G.LRJ "_AUTYP_" AUDIT TASK REPORT")="" "RTN","LRJSAU2",129,0) S XMSUB=AUDES_" AUTOMATED REPORT ERROR" "RTN","LRJSAU2",130,0) S XMTEXT(1)="This message is to inform you that the "_AUDES_" automated report" "RTN","LRJSAU2",131,0) S XMTEXT(2)="has encountered an error and did not complete. Please contact your" "RTN","LRJSAU2",132,0) S XMTEXT(3)="system manager for further details." "RTN","LRJSAU2",133,0) S XMTEXT(4)=" " "RTN","LRJSAU2",134,0) S XMTEXT(5)="ERROR OCCURRED: "_$$FMTE^XLFDT($$NOW^XLFDT,"2") "RTN","LRJSAU2",135,0) S XMTEXT(6)="ERROR MESSAGE : "_$$EC^%ZOSV "RTN","LRJSAU2",136,0) S XQSND=DUZ "RTN","LRJSAU2",137,0) D SNDMSG(XMSUB,XQSND,"XMTEXT",.XMY,1) "RTN","LRJSAU2",138,0) ; "RTN","LRJSAU2",139,0) ; log error in standard error trap "RTN","LRJSAU2",140,0) D ^%ZTER "RTN","LRJSAU2",141,0) D UNWIND^%ZTER "RTN","LRJSAU2",142,0) Q "RTN","LRJSAU2",143,0) ; "RTN","LRJSAU2",144,0) CRTMMARY(LRHLARY,AUTYP,AUDES,AURTN,LRMMARY) ;Load Mail Message array "RTN","LRJSAU2",145,0) ;INPUT "RTN","LRJSAU2",146,0) ; LRHLARY - Array of Raw Data "RTN","LRJSAU2",147,0) ;AUTYP = audit type (ex: AUF60 for File 60 audit "RTN","LRJSAU2",148,0) ;AUDES = audit description (ex. File 60, New Person) "RTN","LRJSAU2",149,0) ;AURTN = audit specific utility routine (ex. LRJSAU60 for file 60) "RTN","LRJSAU2",150,0) ; LRMMARY - Mail Message array to send in message "RTN","LRJSAU2",151,0) ; "RTN","LRJSAU2",152,0) N LRMSUBJ,XQSND,LRFROM,LRTO,XQSND,LRNODE,LRSAVE,LRLPCNT,XCAT,LRSUB,LRREF,LRTOMM "RTN","LRJSAU2",153,0) ; "RTN","LRJSAU2",154,0) D LISTHLMM(LRHLARY) "RTN","LRJSAU2",155,0) ;get top level with date information "RTN","LRJSAU2",156,0) ;may seem like duplicate work since LISTHLMM has the same logic "RTN","LRJSAU2",157,0) ;but LISTHLMM also called from other routine(s) "RTN","LRJSAU2",158,0) ;may be safer to keep this logic here "RTN","LRJSAU2",159,0) S LRREF=$P(LRHLARY,")")_",1)" "RTN","LRJSAU2",160,0) S LRFROM=$P($G(@LRREF),"^") "RTN","LRJSAU2",161,0) S LRTO=$P($G(@LRREF),"^",2) "RTN","LRJSAU2",162,0) I LRFROM="" D Q "RTN","LRJSAU2",163,0) . W !,?10,"First invoke ""DF"" option" "RTN","LRJSAU2",164,0) . D PAUSE^VALM1 "RTN","LRJSAU2",165,0) . I AUTYP["F60" D F60^LRJSAU "RTN","LRJSAU2",166,0) ; "RTN","LRJSAU2",167,0) S LRMSUBJ=AUDES_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSAU2",168,0) S XQSND=DUZ,LRLPCNT=1 "RTN","LRJSAU2",169,0) I '$G(LRMMARY) S LRMMARY="^TMP(""LRJ SYS "_$E(AUTYP,3,99)_" AUD MANAGER"",$J)" "RTN","LRJSAU2",170,0) S @LRMMARY@(LRLPCNT)=LRMSUBJ "RTN","LRJSAU2",171,0) F XCAT="NEW","OLD" D "RTN","LRJSAU2",172,0) . S (LRNODE,LRSUB)=0 "RTN","LRJSAU2",173,0) . I '$D(@VALMAR@(XCAT)) D Q "RTN","LRJSAU2",174,0) . . S LRLPCNT=LRLPCNT+1 "RTN","LRJSAU2",175,0) . . S @LRMMARY@(LRLPCNT)=" No "_$S(XCAT="NEW":"new",1:"modified")_" entries" "RTN","LRJSAU2",176,0) . S LRLPCNT=LRLPCNT+1 "RTN","LRJSAU2",177,0) . S @LRMMARY@(LRLPCNT)=$S(XCAT="NEW":"New",1:"Modified")_" entries" "RTN","LRJSAU2",178,0) D SNDMSG(LRMSUBJ,XQSND,LRMMARY,.LRTOMM,0) "RTN","LRJSAU2",179,0) S @LRREF=LRFROM_"^"_LRTO "RTN","LRJSAU2",180,0) ;I $O(@VALMAR@(0))="" K @LRMMARY@(1),@LRMMARY@(2),@LRMMARY@(3) "RTN","LRJSAU2",181,0) Q "RTN","LRJSAU2",182,0) ; "RTN","LRJSAU2",183,0) SNDMSG(LRMSUBJ,XQSND,LRMSGARY,LRTOMM,LRTASK) ;Send message to requestor "RTN","LRJSAU2",184,0) ;INPUT: "RTN","LRJSAU2",185,0) ; LRMSUBJ - Subject of message being generated "RTN","LRJSAU2",186,0) ; XQSND - User's DUZ, Group Name, or S.server name "RTN","LRJSAU2",187,0) ; LRMSGARY - Array containing message text "RTN","LRJSAU2",188,0) ; LRTOMM - Array containing users, groups, etc who should receive the message "RTN","LRJSAU2",189,0) ; LRTASK - If defined, indicates this is called from TASKMAN job "RTN","LRJSAU2",190,0) ; "RTN","LRJSAU2",191,0) N LRINSTMM,LRTASKMM,XMERR,XMZ,LRLPCNT,LRTYPE "RTN","LRJSAU2",192,0) ; "RTN","LRJSAU2",193,0) S:'$D(LRTASK) LRTASK=0 "RTN","LRJSAU2",194,0) I 'LRTASK D "RTN","LRJSAU2",195,0) . K XMERR "RTN","LRJSAU2",196,0) . S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict Message addressing "RTN","LRJSAU2",197,0) . S LRTYPE="S" "RTN","LRJSAU2",198,0) . D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM) "RTN","LRJSAU2",199,0) . S LRLPCNT="" "RTN","LRJSAU2",200,0) . F S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT="" S LRTOMM(LRLPCNT)="" "RTN","LRJSAU2",201,0) ; "RTN","LRJSAU2",202,0) I +$G(XMERR)'>0 DO "RTN","LRJSAU2",203,0) . ;no need to set additional VistA recipients - added LRTOMM as parameter "RTN","LRJSAU2",204,0) . S LRINSTMM("FROM")="LSRP_"_AUTYP_"_USER_ACTION" "RTN","LRJSAU2",205,0) . S LRMSUBJ=$E(LRMSUBJ,1,65) "RTN","LRJSAU2",206,0) . D SENDMSG^XMXAPI(XQSND,LRMSUBJ,LRMSGARY,.LRTOMM,.LRINSTMM,.LRTASKMM) "RTN","LRJSAU2",207,0) ; "RTN","LRJSAU2",208,0) ;K @LRMSGARY,^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG") "RTN","LRJSAU2",209,0) Q "RTN","LRJSAU2",210,0) ; "RTN","LRJSAU2",211,0) ;Following Protocol invokes this API: LRJ SYS MAP AUF60 SEND EXT "RTN","LRJSAU2",212,0) CRTXTMM(LRHLARY,AUTYP,AUDES,AURTN) ;Load Mail Message array "RTN","LRJSAU2",213,0) ;INPUT "RTN","LRJSAU2",214,0) ; LRHLARY - Array of Raw Data [^TMP($J,"LRJ SYS") when called by LRJ SYS MAP HL SEND MSG] "RTN","LRJSAU2",215,0) ; "RTN","LRJSAU2",216,0) N LRMSUBJ,XQSND "RTN","LRJSAU2",217,0) S LRREF=$P(LRHLARY,"""EXTRACT""")_"1,0)" "RTN","LRJSAU2",218,0) S LRMSUBJ=$G(@LRREF) "RTN","LRJSAU2",219,0) I LRMSUBJ="" D Q "RTN","LRJSAU2",220,0) . W !,?10,"First invoke ""DF"" option" "RTN","LRJSAU2",221,0) . D PAUSE^VALM1 "RTN","LRJSAU2",222,0) . I AUTYP["F60" D F60^LRJSAU "RTN","LRJSAU2",223,0) ; "RTN","LRJSAU2",224,0) S XQSND=DUZ "RTN","LRJSAU2",225,0) D SNDEXT(LRMSUBJ,XQSND,LRHLARY) "RTN","LRJSAU2",226,0) Q "RTN","LRJSAU2",227,0) ; "RTN","LRJSAU2",228,0) SNDEXT(LRMSUBJ,XQSND,LREXTARY) ;Send extract to requestor "RTN","LRJSAU2",229,0) ;INPUT: "RTN","LRJSAU2",230,0) ; LRMSUBJ - Subject of message being generated "RTN","LRJSAU2",231,0) ; XQSND - User's DUZ, Group Name, or S.server name "RTN","LRJSAU2",232,0) ; LREXTARY - Array containing message text. "RTN","LRJSAU2",233,0) ; "RTN","LRJSAU2",234,0) N LRINSTMM,LRINSTVA,LRTASKMM,LRTASKVA,LRTOMM,LRTOVA,XMERR,XMZ,LRLPCNT,LRTYPE "RTN","LRJSAU2",235,0) ; "RTN","LRJSAU2",236,0) S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict Message addressing "RTN","LRJSAU2",237,0) S LRTYPE="S" "RTN","LRJSAU2",238,0) K XMERR "RTN","LRJSAU2",239,0) D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM) "RTN","LRJSAU2",240,0) ; "RTN","LRJSAU2",241,0) ;Check for Network addresses and mail attachment "RTN","LRJSAU2",242,0) S LRINSTVA("ADDR FLAGS")="R" ;Do not Restrict Message addressing "RTN","LRJSAU2",243,0) S LRINSTVA("FROM")="LSRP_"_AUTYP_"_USER_ACTION" "RTN","LRJSAU2",244,0) S LRMSUBJ=$E(LRMSUBJ,1,65) "RTN","LRJSAU2",245,0) S LRLPCNT="" "RTN","LRJSAU2",246,0) F S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT="" S LRTOVA(LRLPCNT)="" "RTN","LRJSAU2",247,0) I +$G(XMERR)'>0 DO "RTN","LRJSAU2",248,0) .D OUTLKARY(LREXTARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ) "RTN","LRJSAU2",249,0) .D SENDMSG^XMXAPI(XQSND,LRMSUBJ,"^TMP($J,""LRNETMSG"")",.LRTOVA,.LRINSTVA,.LRTASKVA) "RTN","LRJSAU2",250,0) ; "RTN","LRJSAU2",251,0) K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG") "RTN","LRJSAU2",252,0) Q "RTN","LRJSAU2",253,0) ; "RTN","LRJSAU2",254,0) OUTLKARY(LRHLARY,LRHLOTLK,LRMSUBJ) ;Create array of attachments "RTN","LRJSAU2",255,0) ;INPUT: "RTN","LRJSAU2",256,0) ; LRHLARY - Array containing message text "RTN","LRJSAU2",257,0) ; LRHLOTLK - Array containing message text for network addresses "RTN","LRJSAU2",258,0) ; LRMSUBJ - Subject of message "RTN","LRJSAU2",259,0) ; "RTN","LRJSAU2",260,0) N LRFILNM,LRFILNM1,LRFILNM2,LRDTTM,LRCRLF,LRSTR,LRNODE,LROUTNOD,LRNODATA,XSUB "RTN","LRJSAU2",261,0) S LRSTR="" "RTN","LRJSAU2",262,0) S LRNODATA=0 "RTN","LRJSAU2",263,0) S LRCRLF=$C(13,10) "RTN","LRJSAU2",264,0) K @LRHLOTLK "RTN","LRJSAU2",265,0) S @LRHLOTLK@(1)="Extract Generated......: "_$$FMTE^XLFDT($$NOW^XLFDT)_LRCRLF "RTN","LRJSAU2",266,0) S @LRHLOTLK@(2)=" " "RTN","LRJSAU2",267,0) S @LRHLOTLK@(3)="Extract Requested......: "_LRMSUBJ_LRCRLF "RTN","LRJSAU2",268,0) S @LRHLOTLK@(4)=" " "RTN","LRJSAU2",269,0) ; "RTN","LRJSAU2",270,0) S LRDTTM=$$NOW^XLFDT "RTN","LRJSAU2",271,0) S LRFILNM1=AUTYP_"_EXT_NEW_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".csv" "RTN","LRJSAU2",272,0) S LRFILNM2=AUTYP_"_EXT_MOD_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".csv" "RTN","LRJSAU2",273,0) S @LRHLOTLK@(5)=$S($D(@LRHLARY@("NEW")):"Attached LMOF",1:"No")_" NEW "_AUDES_" Entries"_$S($D(@LRHLARY@("NEW")):": "_LRFILNM1,1:"")_LRCRLF "RTN","LRJSAU2",274,0) S @LRHLOTLK@(6)=" " "RTN","LRJSAU2",275,0) S @LRHLOTLK@(7)=$S($D(@LRHLARY@("OLD")):"Attached LMOF",1:"No")_" MODIFIED "_AUDES_" Entries"_$S($D(@LRHLARY@("OLD")):": "_LRFILNM2,1:"")_LRCRLF "RTN","LRJSAU2",276,0) S:($O(@LRHLARY@(0))="") LRNODATA=1 "RTN","LRJSAU2",277,0) S @LRHLOTLK@(8)=" " "RTN","LRJSAU2",278,0) S:(LRNODATA=0) @LRHLOTLK@(9)=" " "RTN","LRJSAU2",279,0) S:(LRNODATA=1) @LRHLOTLK@(9)="No data was extracted for date range!!" "RTN","LRJSAU2",280,0) ; "RTN","LRJSAU2",281,0) ;Begin output of "NEW" entries "RTN","LRJSAU2",282,0) F XSUB="NEW","OLD" D "RTN","LRJSAU2",283,0) . S LRNODE=0,LRSTR="",LROUTNOD=$S(XSUB="NEW":10,XSUB="OLD"&($D(@LRHLARY@("NEW"))):LROUTNOD+4,1:10) "RTN","LRJSAU2",284,0) . I $D(@LRHLARY@(XSUB)) D "RTN","LRJSAU2",285,0) . . S LRFILNM=$S(XSUB="NEW":LRFILNM1,1:LRFILNM2) "RTN","LRJSAU2",286,0) . . S @LRHLOTLK@(LROUTNOD)=$$UUBEGFN(LRFILNM) "RTN","LRJSAU2",287,0) . . F S LRNODE=$O(@LRHLARY@(XSUB,LRNODE)) Q:(LRNODE)="" D "RTN","LRJSAU2",288,0) . . . S LRSTR=LRSTR_@LRHLARY@(XSUB,LRNODE)_LRCRLF "RTN","LRJSAU2",289,0) . . . D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK) "RTN","LRJSAU2",290,0) . . S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN(LRSTR) "RTN","LRJSAU2",291,0) . . S @LRHLOTLK@(LROUTNOD+2)=" " "RTN","LRJSAU2",292,0) . . S @LRHLOTLK@(LROUTNOD+3)="end" "RTN","LRJSAU2",293,0) Q "RTN","LRJSAU2",294,0) ; "RTN","LRJSAU2",295,0) UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding "RTN","LRJSAU2",296,0) ; Call with LRFILENM = name of uuencoded file attachment "RTN","LRJSAU2",297,0) ; "RTN","LRJSAU2",298,0) ; Returns LRX = string with "begin..."_file name "RTN","LRJSAU2",299,0) ; "RTN","LRJSAU2",300,0) N LRX "RTN","LRJSAU2",301,0) S LRX="begin 644 "_LRFILENM "RTN","LRJSAU2",302,0) Q LRX "RTN","LRJSAU2",303,0) ; "RTN","LRJSAU2",304,0) ENCODE(LRSTR,LRDTANOD,LRHLOTLK) ;Encode a string, keep remainder for next line "RTN","LRJSAU2",305,0) ;INPUT: "RTN","LRJSAU2",306,0) ; LRSTR - String to send in message; call by reference, Remainder returned in LRSTR "RTN","LRJSAU2",307,0) ; LRDTANOD - Number of next Node to store message line in array "RTN","LRJSAU2",308,0) ; LRHLOTLK - Array containing message text for network addresses "RTN","LRJSAU2",309,0) ; "RTN","LRJSAU2",310,0) N LRQUIT,LRLEN,LRX "RTN","LRJSAU2",311,0) S LRQUIT=0,LRLEN=$L(LRSTR) "RTN","LRJSAU2",312,0) F D Q:LRQUIT "RTN","LRJSAU2",313,0) . I $L(LRSTR)<45 S LRQUIT=1 Q "RTN","LRJSAU2",314,0) . S LRX=$E(LRSTR,1,45) "RTN","LRJSAU2",315,0) . S LRDTANOD=LRDTANOD+1,@LRHLOTLK@(LRDTANOD)=$$UUEN(LRX) "RTN","LRJSAU2",316,0) . S LRSTR=$E(LRSTR,46,LRLEN) "RTN","LRJSAU2",317,0) Q "RTN","LRJSAU2",318,0) ; "RTN","LRJSAU2",319,0) UUEN(STR) ; Uuencode string passed in. "RTN","LRJSAU2",320,0) N J,K,LEN,LRI,LRX,S,TMP,X,Y "RTN","LRJSAU2",321,0) S TMP="",LEN=$L(STR) "RTN","LRJSAU2",322,0) F LRI=1:3:LEN D "RTN","LRJSAU2",323,0) . S LRX=$E(STR,LRI,LRI+2) "RTN","LRJSAU2",324,0) . I $L(LRX)<3 S LRX=LRX_$E(" ",1,3-$L(LRX)) "RTN","LRJSAU2",325,0) . S S=$A(LRX,1)*256+$A(LRX,2)*256+$A(LRX,3),Y="" "RTN","LRJSAU2",326,0) . F K=0:1:23 S Y=(S\(2**K)#2)_Y "RTN","LRJSAU2",327,0) . F K=1:6:24 D "RTN","LRJSAU2",328,0) . . S J=$$DEC^XLFUTL($E(Y,K,K+5),2) "RTN","LRJSAU2",329,0) . . S TMP=TMP_$C(J+32) "RTN","LRJSAU2",330,0) S TMP=$C(LEN+32)_TMP "RTN","LRJSAU2",331,0) Q TMP "RTN","LRJSAU2",332,0) ; "RTN","LRJSAU2",333,0) ; "RTN","LRJSAU2",334,0) PARAMED(AUTYP,AUDES) ;Edit the Dates referenced by tasked Option "LRJ SYS MAP [autyp] TASKMAN RPT" "RTN","LRJSAU2",335,0) ;where AUTYP=audit type (ex. AUF60 for File 60 audit "RTN","LRJSAU2",336,0) ; This API invokes the Edit Instance and Value of a Parameter API to edit the following "RTN","LRJSAU2",337,0) ; Parameters: "RTN","LRJSAU2",338,0) ; LRJ LSRP [autyp] LAST START DATE "RTN","LRJSAU2",339,0) ; LRJ LSRP [autyp] LAST END DATE "RTN","LRJSAU2",340,0) ; "RTN","LRJSAU2",341,0) ; These parameters control the period that the Audit file extract is performed via the "RTN","LRJSAU2",342,0) ; TaskMan scheduled job for the "LRJ SYS MAP [autyp] TASKMAN RPT" option "RTN","LRJSAU2",343,0) ; "RTN","LRJSAU2",344,0) W !!,"Lab "_AUDES_" Audit extract dates record the report dates" "RTN","LRJSAU2",345,0) W !," for the last extract created by the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option." "RTN","LRJSAU2",346,0) W !," The LRJ LSRP "_AUTYP_" LAST END DATE is the start date used by the next execution" "RTN","LRJSAU2",347,0) W !," of the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option.",! "RTN","LRJSAU2",348,0) W !!,"WARNING: Editing the LRJ LSRP "_AUTYP_" LAST END DATE will affect the information" "RTN","LRJSAU2",349,0) W !," reported by the LRJ SYS MAP "_AUTYP_" TASKMAN RPT option. This option makes" "RTN","LRJSAU2",350,0) W !," assumptions about data previously reported based upon this date." "RTN","LRJSAU2",351,0) W !!,"A USER CHANGING THE 'LRJ LSRP "_AUTYP_" LAST END DATE' MUST UNDERSTAND THE RESULT" "RTN","LRJSAU2",352,0) W !," OF THE CHANGE MADE AND RECONCILE THE REPORTS CREATED AGAINST THE PREVIOUS" "RTN","LRJSAU2",353,0) W !," REPORT CREATED!",!! "RTN","LRJSAU2",354,0) ; "RTN","LRJSAU2",355,0) D EDITPAR^XPAREDIT("LRJ LSRP "_AUTYP_" LAST START "_$S(AUTYP["XT":"DT",1:"DATE")) "RTN","LRJSAU2",356,0) W !!,"-------------------------------------------------------------------------------" "RTN","LRJSAU2",357,0) D EDITPAR^XPAREDIT("LRJ LSRP "_AUTYP_" LAST END DATE") "RTN","LRJSAU2",358,0) ;;D EN^XPAREDIT ;;IA #2336 "RTN","LRJSAU2",359,0) Q "RTN","LRJSAU3") 0^26^B1054860^n/a "RTN","LRJSAU3",1,0) LRJSAU3 ;ALB/GTS/DK - Lab Vista Audit Utilities - 2;03/31/2009 "RTN","LRJSAU3",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSAU3",3,0) ; "RTN","LRJSAU3",4,0) LRADDNOD(LRNODECT,LRCUR,LRPREV,LROUTPT,LRMMARY) ;Include Prev value in string and add to mail array. "RTN","LRJSAU3",5,0) ; INPUT: "RTN","LRJSAU3",6,0) ; LRNODECT - Node number "RTN","LRJSAU3",7,0) ; LRCUR - Current entry display "RTN","LRJSAU3",8,0) ; LRPREV - Previous entry display "RTN","LRJSAU3",9,0) ; LROUTPT - Type of array to populate (Display or Mail) "RTN","LRJSAU3",10,0) ; LRMMARY - Array of output for Mail messages "RTN","LRJSAU3",11,0) ; "RTN","LRJSAU3",12,0) ; OUTPUT: "RTN","LRJSAU3",13,0) ; Display array "RTN","LRJSAU3",14,0) ; "RTN","LRJSAU3",15,0) N LRLGTH "RTN","LRJSAU3",16,0) S:$G(LRPREV)="" LRPREV="" "RTN","LRJSAU3",17,0) S:$G(LROUTPT)="" LROUTPT="DISPLAY" "RTN","LRJSAU3",18,0) S:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSAU3",19,0) S LRLGTH=$L(LRCUR) "RTN","LRJSAU3",20,0) S LRCUR=LRCUR_$J(LRPREV,3+$L(LRPREV)+(42-LRLGTH)) "RTN","LRJSAU3",21,0) D:LROUTPT="DISPLAY" ADD^LRJSAU(.LRNODECT,LRCUR) "RTN","LRJSAU3",22,0) D:LROUTPT="MAIL" LRADDLNE(.LRNODECT,LRCUR,LRMMARY) "RTN","LRJSAU3",23,0) Q "RTN","LRJSAU3",24,0) ; "RTN","LRJSAU3",25,0) LRADDLNE(LRNODECT,MSG,LRMMARY) ; -- add line to build display "RTN","LRJSAU3",26,0) ;INPUT: "RTN","LRJSAU3",27,0) ; LRNODECT - Node number "RTN","LRJSAU3",28,0) ; MSG - Text to mail "RTN","LRJSAU3",29,0) ; LRMMARY - Array for MailMan call "RTN","LRJSAU3",30,0) ; "RTN","LRJSAU3",31,0) ;OUTPUT: "RTN","LRJSAU3",32,0) ; Array for Mail message "RTN","LRJSAU3",33,0) ; "RTN","LRJSAU3",34,0) S LRNODECT=LRNODECT+1 "RTN","LRJSAU3",35,0) S @LRMMARY@(LRNODECT)=MSG "RTN","LRJSAU3",36,0) Q "RTN","LRJSAU60") 0^23^B234883150^n/a "RTN","LRJSAU60",1,0) LRJSAU60 ;ALB/PO/DK/TMK Lab File 60 Audit Manager ;08/16/2010 15:54:29 "RTN","LRJSAU60",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSAU60",3,0) ; "RTN","LRJSAU60",4,0) ;Reference to direct lookup via fileman to DD global supported by ICR #4281 "RTN","LRJSAU60",5,0) ;Reference to direct lookup of subfile name in DD global supported by ICR #4768 "RTN","LRJSAU60",6,0) ;Reference to sort and print templates in file 1.1 (AUDIT) supported by ICR #4806 "RTN","LRJSAU60",7,0) ; "RTN","LRJSAU60",8,0) AUDSET ; -- enable audit fields for file 60 "RTN","LRJSAU60",9,0) ; Called from: "RTN","LRJSAU60",10,0) ; LRJ SYS SET AUDITED FLAG FOR FIELDS protocol "RTN","LRJSAU60",11,0) ; "RTN","LRJSAU60",12,0) N LRI,LRAFLDS,FILENUM,FIELDNUM,FIELDNAM,XINDEX,XISAUD,XAUDSET,Q "RTN","LRJSAU60",13,0) N DIR,DIC,DIK,DA,DUOUT,DTOUT,DIROUT,X,Y "RTN","LRJSAU60",14,0) D FULL^VALM1 "RTN","LRJSAU60",15,0) I '$D(^TMP($J,"LRAUDREQ")) D "RTN","LRJSAU60",16,0) .F LRI=1:1 S LRALINE=$P($TEXT(AFLDS+LRI^LRJSAU),";;",2) Q:LRALINE="$$END$$" D "RTN","LRJSAU60",17,0) ..I +LRALINE'=60 Q "RTN","LRJSAU60",18,0) ..S LRSUBFLD=$P($P(LRALINE,"^"),";",2) "RTN","LRJSAU60",19,0) ..F Q=1:1:$L($P(LRALINE,"^",2),";") D "RTN","LRJSAU60",20,0) ...I 'LRSUBFLD S ^TMP($J,"LRAUDREQ","60,"_$P($P(LRALINE,"^",2),";",Q))=1 Q "RTN","LRJSAU60",21,0) ...S ^TMP($J,"LRAUDREQ","60,"_LRSUBFLD_","_$P($P(LRALINE,"^",2),";",Q))=1 "RTN","LRJSAU60",22,0) S FIELDNUM="",DIC="^DD(60," ;ICR 4281 "RTN","LRJSAU60",23,0) S DIC(0)="AEQZ",DIC("A")="Field: " "RTN","LRJSAU60",24,0) F D ^DIC D Q:Y'="" "RTN","LRJSAU60",25,0) .I Y>0,$G(^TMP($J,"LRAUDREQ","60,"_+Y)) D "RTN","LRJSAU60",26,0) ..W !,"'SF' cannot be used to turn auditing off for any required audit field." "RTN","LRJSAU60",27,0) ..S Y="" "RTN","LRJSAU60",28,0) .I Y>0 S FIELDNUM=$P(Y,"^"),FIELDNAM=$P(Y,"^",2) "RTN","LRJSAU60",29,0) Q:FIELDNUM="" "RTN","LRJSAU60",30,0) ;check if field is multiple "RTN","LRJSAU60",31,0) S FILENUM=+$$GFLDSB(60,FIELDNUM),FILENUM=$S(FILENUM>0:FILENUM,1:60) "RTN","LRJSAU60",32,0) I FILENUM'=60 D "RTN","LRJSAU60",33,0) . S DIC="^DD("_FILENUM_"," ; ICR 4281 "RTN","LRJSAU60",34,0) . S DIC(0)="AEQMZ",DIC("A")="Sub-File "_FIELDNAM_" Field: " "RTN","LRJSAU60",35,0) . F D ^DIC D Q:Y'="" "RTN","LRJSAU60",36,0) .. I Y>0,$G(^TMP($J,"LRAUDREQ","60,"_FIELDNUM_","_+Y)) D "RTN","LRJSAU60",37,0) ... W !,"'SF' cannot be used to turn auditing off for any required audit field." "RTN","LRJSAU60",38,0) ... S Y="" "RTN","LRJSAU60",39,0) .S FIELDNUM=$S(Y>0:$P(Y,"^"),1:"") "RTN","LRJSAU60",40,0) Q:FIELDNUM="" "RTN","LRJSAU60",41,0) S XISAUD=$$ISAUDON(FILENUM,FIELDNUM) "RTN","LRJSAU60",42,0) W !," File "_FILENUM_" - Field "_FIELDNUM_" is "_$S(XISAUD:"already ",1:"not currently ")_"audited." "RTN","LRJSAU60",43,0) N DIR "RTN","LRJSAU60",44,0) S DIR(0)="Y" "RTN","LRJSAU60",45,0) S DIR("A")="Do you wish to turn auditing "_$S(XISAUD:"OFF ",1:"ON ")_"for this field?" "RTN","LRJSAU60",46,0) S DIR("B")="No" "RTN","LRJSAU60",47,0) D ^DIR K DIR "RTN","LRJSAU60",48,0) I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "RTN","LRJSAU60",49,0) S XAUDSET=+Y "RTN","LRJSAU60",50,0) N DIR "RTN","LRJSAU60",51,0) I 'XAUDSET D Q "RTN","LRJSAU60",52,0) .W !!," NO ACTION TAKEN" "RTN","LRJSAU60",53,0) .D PAUSE^VALM1 "RTN","LRJSAU60",54,0) .D REFRESH^LRJSAU "RTN","LRJSAU60",55,0) ;if not audited, turn auditing on "RTN","LRJSAU60",56,0) I 'XISAUD D Q "RTN","LRJSAU60",57,0) .S XINDEX=$O(^LABAUD(64.9178,"B",60,"")) "RTN","LRJSAU60",58,0) .S XSUB=$S(FILENUM=60:FIELDNUM,1:FILENUM_","_FIELDNUM) "RTN","LRJSAU60",59,0) .S DIC(0)="L",DA(1)=XINDEX,DLAYGO=64.9178 "RTN","LRJSAU60",60,0) .S DIC="^LABAUD(64.9178,"_XINDEX_",1,",X=XSUB "RTN","LRJSAU60",61,0) .D FILE^DICN K DLAYGO "RTN","LRJSAU60",62,0) .D TURNON^DIAUTL(FILENUM,FIELDNUM) "RTN","LRJSAU60",63,0) .W !!," CHANGE MADE: File "_FILENUM_" - Field "_FIELDNUM_" is now audited" "RTN","LRJSAU60",64,0) .D PAUSE^VALM1 "RTN","LRJSAU60",65,0) .D REFRESH^LRJSAU "RTN","LRJSAU60",66,0) ;if audited, turn auditing off "RTN","LRJSAU60",67,0) I XISAUD D "RTN","LRJSAU60",68,0) .S XINDEX=$O(^LABAUD(64.9178,"B",60,"")) "RTN","LRJSAU60",69,0) .S XSUB=$S(FILENUM=60:FIELDNUM,1:FILENUM_","_FIELDNUM) "RTN","LRJSAU60",70,0) .I $D(^LABAUD(64.9178,XINDEX,1,"B",XSUB)) D "RTN","LRJSAU60",71,0) .. S DA(1)=XINDEX "RTN","LRJSAU60",72,0) .. S DA=$O(^LABAUD(64.9178,XINDEX,1,"B",XSUB,"")) "RTN","LRJSAU60",73,0) .. S DIK="^LABAUD(64.9178,"_XINDEX_",1," "RTN","LRJSAU60",74,0) .. D ^DIK "RTN","LRJSAU60",75,0) .D TURNON^DIAUTL(FILENUM,FIELDNUM,"n") "RTN","LRJSAU60",76,0) .W !!," CHANGE MADE: File "_FILENUM_" - Field "_FIELDNUM_" is now NOT audited" "RTN","LRJSAU60",77,0) .D PAUSE^VALM1 "RTN","LRJSAU60",78,0) .D REFRESH^LRJSAU "RTN","LRJSAU60",79,0) Q "RTN","LRJSAU60",80,0) ; "RTN","LRJSAU60",81,0) AUDLIST ; -- list file 60 audited fields "RTN","LRJSAU60",82,0) ; Called from: "RTN","LRJSAU60",83,0) ; LRJ SYS LIST AUDITED FIELDS protocol "RTN","LRJSAU60",84,0) ; "RTN","LRJSAU60",85,0) N X "RTN","LRJSAU60",86,0) D FULL^VALM1 "RTN","LRJSAU60",87,0) S VALMCNT=0 "RTN","LRJSAU60",88,0) D KILL^LRJSAU "RTN","LRJSAU60",89,0) D KILL^VALM10() "RTN","LRJSAU60",90,0) S X=$$AUDCHK(1) "RTN","LRJSAU60",91,0) Q "RTN","LRJSAU60",92,0) ; "RTN","LRJSAU60",93,0) AUDISP ; -- Display file 60 changes "RTN","LRJSAU60",94,0) ; Called from: "RTN","LRJSAU60",95,0) ; LRJ SYS DISPLAY FILE 60 CHANGES protocol "RTN","LRJSAU60",96,0) ; "RTN","LRJSAU60",97,0) ; VALMCNT - [global/Input/Output] last entry in List Manager "RTN","LRJSAU60",98,0) ; VALMAR - [global/Output] reference to List Manager buffer "RTN","LRJSAU60",99,0) ; like "^TMP("LRJ SYS ORDERS MANAGER",$JOB)" "RTN","LRJSAU60",100,0) ; "RTN","LRJSAU60",101,0) ;TSKCALL set if called from TaskMan "RTN","LRJSAU60",102,0) N FR,TO,FLDS,DIC,IOP,LRD0,LRD00,X,LRDATA,XSUB,XENT,XSTR,XLRIEN,XLRIEN1,XD1,XSQ,XD2,XSP,XLOINC "RTN","LRJSAU60",103,0) N LRDT,LRDONE,LRFAC,LRFLDNM,LRGBL,LRIEN,LRNEW,LRARRY,LROLD,LROUT,LRSET,LRUSER,SPACE,LRDEV,XNEW,BY "RTN","LRJSAU60",104,0) I '$G(TSKCALL) N LRTODT,LRFRDT,LRTO,LRFROM D FULL^VALM1 "RTN","LRJSAU60",105,0) S VALMCNT=0,XSUB=" " "RTN","LRJSAU60",106,0) D KILL^LRJSAU "RTN","LRJSAU60",107,0) I '$G(TSKCALL) D KILL^VALM10() "RTN","LRJSAU60",108,0) S SPACE=$J("",47) "RTN","LRJSAU60",109,0) S LROUT=0 "RTN","LRJSAU60",110,0) ; set up parameters to run the print template to a null device and store the results in LRDATA array "RTN","LRJSAU60",111,0) ; in case there is no null defined, print template with IOP of ";;99999" still will store the results in LRDATA "RTN","LRJSAU60",112,0) ; "RTN","LRJSAU60",113,0) ;kill to variable DIA needed because otherwise carryover "RTN","LRJSAU60",114,0) ;occurs if user invokes various audits in same session - [krused] "RTN","LRJSAU60",115,0) K DIA "RTN","LRJSAU60",116,0) S DIC="^DIA(60," ;ICR #4806 "RTN","LRJSAU60",117,0) S BY="[LRJ SYS DISPLAY FILE 60 CHANGE]" "RTN","LRJSAU60",118,0) S FLDS="[LRJ SYS DISPLAY FILE 60 CHANGE]" "RTN","LRJSAU60",119,0) ; "RTN","LRJSAU60",120,0) F LRDEV="NULL DEVICE","NULL" S IOP=$$GIOP(LRDEV) QUIT:IOP'="" "RTN","LRJSAU60",121,0) I IOP="" S IOP=";;99999" ; if no IOP then set the number of lines per page to maximum "RTN","LRJSAU60",122,0) ; "RTN","LRJSAU60",123,0) I '$G(TSKCALL) D FILENUM(.LROUT) Q:LROUT "RTN","LRJSAU60",124,0) I '$G(TSKCALL) I $G(LRFRDT)=""!($G(LRTODT)="") G AUDISP "RTN","LRJSAU60",125,0) I '$G(TSKCALL) I LRFRDT<0!(LRTODT<0) G AUDISP "RTN","LRJSAU60",126,0) I $G(TSKCALL) S LRFRDT=LRFROM,LRTODT=LRTO "RTN","LRJSAU60",127,0) ; wait message in case many audits to search through "RTN","LRJSAU60",128,0) I '$G(TSKCALL) D WAIT^DICD "RTN","LRJSAU60",129,0) K ^TMP("LRDATA",$J) "RTN","LRJSAU60",130,0) S FR=LRFRDT,TO=LRTODT "RTN","LRJSAU60",131,0) D EN1^DIP "RTN","LRJSAU60",132,0) ; "RTN","LRJSAU60",133,0) ; put the results from ^TMP("LRDATA",$J... into List Manager "RTN","LRJSAU60",134,0) S ^TMP("LRJ SYS F60 AUD MANAGER",$J,1)=LRFRDT_"^"_LRTODT "RTN","LRJSAU60",135,0) I '$G(TSKCALL) D "RTN","LRJSAU60",136,0) .S X="File 60 Audit - From "_$$FMTE^XLFDT(LRFRDT)_" to "_$$FMTE^XLFDT(LRTODT) "RTN","LRJSAU60",137,0) .D ADD^LRJSAU(.VALMCNT,X) "RTN","LRJSAU60",138,0) S LRD0=0 "RTN","LRJSAU60",139,0) F S LRD0=$O(^TMP("LRDATA",$J,LRD0)) Q:'LRD0 D "RTN","LRJSAU60",140,0) .; sort by new entry added ... all changes made within 2 hours are 'NEW', not 'MODIFIED' "RTN","LRJSAU60",141,0) .K LRARRY "RTN","LRJSAU60",142,0) .S LRIEN=+$G(^TMP("LRDATA",$J,LRD0,"LRIEN")) "RTN","LRJSAU60",143,0) .S LRNEW=+$O(^TMP("LRDATA",$J,"NEW",LRIEN,0)) "RTN","LRJSAU60",144,0) .I LRNEW,'$D(^TMP("LRDATA",$J,"NEW",LRIEN,LRD0)) S LRNEW=0 ; new entry changed outside 2 hr window "RTN","LRJSAU60",145,0) .I LRNEW Q:'$G(^TMP("LRDATA",$J,"NEW",LRIEN,LRD0)) ; change to new entry made inside 2 hr window "RTN","LRJSAU60",146,0) .S LRDT=$G(^TMP("LRDATA",$J,LRD0,"LRDT")) "RTN","LRJSAU60",147,0) .I LRNEW D ; flag all changed records associated with 'NEW' file 60 entry "RTN","LRJSAU60",148,0) .. N Z "RTN","LRJSAU60",149,0) .. S Z=0 F S Z=$O(^TMP("LRDATA",$J,"NEW",LRIEN,Z)) Q:'Z S LRARRY(Z)=1 "RTN","LRJSAU60",150,0) . I 'LRNEW S LRARRY(LRD0)="" "RTN","LRJSAU60",151,0) . ; LRD00 = ien of the audit file "RTN","LRJSAU60",152,0) . S LRD00=0 "RTN","LRJSAU60",153,0) . F S LRD00=$O(LRARRY(LRD00)) Q:'LRD00 D "RTN","LRJSAU60",154,0) .. K LRDATA,LRSET M LRDATA=^TMP("LRDATA",$J,LRD00) "RTN","LRJSAU60",155,0) .. S LRDT=LRDATA("LRDT") "RTN","LRJSAU60",156,0) .. S X=" "_$E($$FMTE^XLFDT(LRDT)_SPACE,1,25)_$E(LRDATA("LRUSER")_SPACE,1,40)_LRDATA("LRIEN") "RTN","LRJSAU60",157,0) .. S XSUB=$S(LRARRY(LRD00):"NEW",1:"OLD") "RTN","LRJSAU60",158,0) .. S ^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD00,"LRDT")=X "RTN","LRJSAU60",159,0) .. S X=$P($G(^LAB(60,+$G(LRDATA("LRIEN")),0)),"^") "RTN","LRJSAU60",160,0) .. I X="" S X="NONE (DELETED BEFORE BEING COMPLETELY DEFINED)" "RTN","LRJSAU60",161,0) .. S X=" TEST NAME: "_X "RTN","LRJSAU60",162,0) .. S LRSET("LRIEN")=X "RTN","LRJSAU60",163,0) .. S X=" FIELD NAME: "_LRDATA("LRFLDNM") "RTN","LRJSAU60",164,0) .. S LRSET("LRFLDNM")=X "RTN","LRJSAU60",165,0) .. S X=" OLD VALUE: "_LRDATA("LROLD") "RTN","LRJSAU60",166,0) .. S LRSET("LROLD")=X "RTN","LRJSAU60",167,0) .. S X=" NEW VALUE: "_LRDATA("LRNEW") "RTN","LRJSAU60",168,0) .. S LRSET("LRNEW")=X "RTN","LRJSAU60",169,0) .. M ^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD00)=LRSET "RTN","LRJSAU60",170,0) .. ;extract file if user requests "RTN","LRJSAU60",171,0) .. S XLRIEN=$P(LRDATA("LRIEN"),","),XLRIEN1=$TR($P(LRDATA("LRIEN"),",",2,999),",","~") "RTN","LRJSAU60",172,0) .. S ^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB,XLRIEN,LRDATA("LRFNUM")_";"_LRDATA("LRFLDNM")_$S(XLRIEN="":"",1:"-"_XLRIEN1),LRDATA("LRDT"),LRD00)="" "RTN","LRJSAU60",173,0) ;create extract file entry "RTN","LRJSAU60",174,0) S (XSUB,XLRIEN,XD1)="",LRFAC=$$NAME^XUAF4($$KSP^XUPARAM("INST")) "RTN","LRJSAU60",175,0) F S XSUB=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB)) Q:XSUB="" D "RTN","LRJSAU60",176,0) .S LRGBL=$NA(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT",XSUB)) "RTN","LRJSAU60",177,0) .S XSTR="File 60 Audit "_$S(XSUB="NEW":"New_",1:"Modified ")_" Entries - From "_$$FMTE^XLFDT(LRFRDT)_" to "_$$FMTE^XLFDT(LRTODT) "RTN","LRJSAU60",178,0) .S @LRGBL@(1)=$TR(XSTR,",","") "RTN","LRJSAU60",179,0) .S @LRGBL@(2)="Facility,Test Name,Subscript,IEN~subfile IEN,NLT Code,Place holder,Site/Specimen~LOINC,Synonym(s)" "RTN","LRJSAU60",180,0) .S @LRGBL@(2)=@LRGBL@(2)_",Fld #,Fld name,Date/Time of change,Previous value,New value" "RTN","LRJSAU60",181,0) .S XSQ=2 "RTN","LRJSAU60",182,0) .F S XLRIEN=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB,XLRIEN)) Q:XLRIEN="" D "RTN","LRJSAU60",183,0) ..N LRREC,Z "RTN","LRJSAU60",184,0) ..K XLRAR M XLRAR=^LAB(60,XLRIEN) "RTN","LRJSAU60",185,0) ..S LRREC=$NA(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB,XLRIEN)) "RTN","LRJSAU60",186,0) ..F S LRREC=$Q(@LRREC) Q:$QS(LRREC,5)'=XLRIEN D "RTN","LRJSAU60",187,0) ...S XSQ=XSQ+1,LRD00=$QS(LRREC,8) "RTN","LRJSAU60",188,0) ...K LRDATA "RTN","LRJSAU60",189,0) ...M LRDATA=^TMP("LRDATA",$J,LRD00) "RTN","LRJSAU60",190,0) ...;facility name "RTN","LRJSAU60",191,0) ...S XSTR=$TR(LRFAC,","," ") "RTN","LRJSAU60",192,0) ...;test name "RTN","LRJSAU60",193,0) ...S XLRAR(0)=$TR($G(XLRAR(0)),","," ") "RTN","LRJSAU60",194,0) ...I XLRAR(0)="" S XLRAR(0)="NONE (DELETED BEFORE BEING COMPLETELY DEFINED)" "RTN","LRJSAU60",195,0) ...S XSTR=XSTR_","_$P($G(XLRAR(0)),"^") "RTN","LRJSAU60",196,0) ...;test subscript "RTN","LRJSAU60",197,0) ...S XSTR=XSTR_","_$P($G(XLRAR(0)),"^",4) "RTN","LRJSAU60",198,0) ...;IEN~subfile iens "RTN","LRJSAU60",199,0) ...S Z=$P($QS(LRREC,6),"-",2) "RTN","LRJSAU60",200,0) ...S XSTR=XSTR_","_XLRIEN_$S(Z="":"",1:"~"_Z) "RTN","LRJSAU60",201,0) ...;NLT code "RTN","LRJSAU60",202,0) ...S XD1=$P($G(XLRAR(64)),"^") "RTN","LRJSAU60",203,0) ...I XD1]"" S XD1=$P($G(^LAM(XD1,0)),"^",2)_"~" "RTN","LRJSAU60",204,0) ...S XSTR=XSTR_","_XD1 "RTN","LRJSAU60",205,0) ...;Place holder "RTN","LRJSAU60",206,0) ...S XSTR=XSTR_",~" "RTN","LRJSAU60",207,0) ...;site/specimen(s) which linked to LOINC codes at subscript 95.3 "RTN","LRJSAU60",208,0) ...S XD1=0,(XD2,XSP,XLOINC)="" F S XD1=$O(XLRAR(1,XD1)) Q:XD1="" Q:XD1'?1N.N D "RTN","LRJSAU60",209,0) ....S XSP=$P($G(XLRAR(1,XD1,0)),"^"),XSP=$S(XSP]"":$P($G(^LAB(61,XSP,0)),"^"),1:"") "RTN","LRJSAU60",210,0) ....S XLOINC=$G(XLRAR(1,XD1,95.3)) "RTN","LRJSAU60",211,0) ....I XLOINC]"" S XLOINC=$$GET1^DIQ(60.01,XD1_","_XLRIEN,95.3,,"LRMSG") "RTN","LRJSAU60",212,0) ....S XD2=$S(XD2]"":XD2_";",1:"")_XSP_"~"_XLOINC "RTN","LRJSAU60",213,0) ...S XSTR=XSTR_","_$TR(XD2,","," ") "RTN","LRJSAU60",214,0) ...;synonym(s) -- string together "RTN","LRJSAU60",215,0) ...S XD1=0,XD2="" F S XD1=$O(XLRAR(5,XD1)) Q:XD1="" Q:XD1'?1N.N S XD2=$S(XD2]"":XD2_";",1:"")_$P(XLRAR(5,XD1,0),"^") "RTN","LRJSAU60",216,0) ...S XSTR=XSTR_","_$TR(XD2,","," ") "RTN","LRJSAU60",217,0) ...; field number "RTN","LRJSAU60",218,0) ...S:LRDATA("LRFNUM")["," LRDATA("LRFNUM")=""""_LRDATA("LRFNUM")_"""" "RTN","LRJSAU60",219,0) ...S XSTR=XSTR_","_LRDATA("LRFNUM") "RTN","LRJSAU60",220,0) ...; field name "RTN","LRJSAU60",221,0) ...S:LRDATA("LRFLDNM")["," LRDATA("LRFLDNM")=""""_LRDATA("LRFLDNM")_"""" "RTN","LRJSAU60",222,0) ...S XSTR=XSTR_","_LRDATA("LRFLDNM") "RTN","LRJSAU60",223,0) ...; date/time changed "RTN","LRJSAU60",224,0) ...S XSTR=XSTR_","_LRDATA("LRDT") "RTN","LRJSAU60",225,0) ...; old value "RTN","LRJSAU60",226,0) ...S:LRDATA("LROLD")["," LRDATA("LROLD")=""""_LRDATA("LROLD")_"""" "RTN","LRJSAU60",227,0) ...S XSTR=XSTR_","_LRDATA("LROLD") "RTN","LRJSAU60",228,0) ...; new value "RTN","LRJSAU60",229,0) ...S:LRDATA("LRNEW")["," LRDATA("LRNEW")=""""_LRDATA("LRNEW")_"""" "RTN","LRJSAU60",230,0) ...S XSTR=XSTR_","_LRDATA("LRNEW") "RTN","LRJSAU60",231,0) ...S @LRGBL@(XSQ)=XSTR "RTN","LRJSAU60",232,0) .Q:$G(TSKCALL) "RTN","LRJSAU60",233,0) .S VALMHDR(1)=$J("",21)_"Laboratory Test File (#60) Changes" "RTN","LRJSAU60",234,0) .S VALMHDR(2)=$J("",9)_"Date Range: "_$$FMTE^XLFDT(LRFRDT)_" to "_$$FMTE^XLFDT(LRTODT) "RTN","LRJSAU60",235,0) .D CHGCAP^VALM("HEADER","DT RECORDED"_$J("",14)_"USER"_$J("",36)_"IEN(s) ") "RTN","LRJSAU60",236,0) I '$G(TSKCALL) F XSUB="NEW","OLD" D "RTN","LRJSAU60",237,0) .I '$D(^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB)) D Q "RTN","LRJSAU60",238,0) ..D ADD^LRJSAU(.VALMCNT,"") "RTN","LRJSAU60",239,0) ..S X="No "_$S(XSUB="NEW":"New",1:"Modified")_" Entries" "RTN","LRJSAU60",240,0) ..D ADD^LRJSAU(.VALMCNT,X) "RTN","LRJSAU60",241,0) ..D ADD^LRJSAU(.VALMCNT,"") "RTN","LRJSAU60",242,0) .D ADD^LRJSAU(.VALMCNT,"") "RTN","LRJSAU60",243,0) .S X=$S(XSUB="NEW":"New",1:"Modified")_" Entries" "RTN","LRJSAU60",244,0) .D ADD^LRJSAU(.VALMCNT,X) "RTN","LRJSAU60",245,0) .D ADD^LRJSAU(.VALMCNT,"") "RTN","LRJSAU60",246,0) .S (LRD0,XENT)="" "RTN","LRJSAU60",247,0) .F S LRD0=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD0)) Q:LRD0="" D "RTN","LRJSAU60",248,0) ..F S XENT=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD0,XENT)) Q:XENT="" D "RTN","LRJSAU60",249,0) ...S X=^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD0,XENT) "RTN","LRJSAU60",250,0) ...D ADD^LRJSAU(.VALMCNT,X) "RTN","LRJSAU60",251,0) Q "RTN","LRJSAU60",252,0) ; "RTN","LRJSAU60",253,0) AUDCHK(DISPLAY) ; -- check files/fields to see if they are audited for file 60 "RTN","LRJSAU60",254,0) ; "RTN","LRJSAU60",255,0) ; DISPLAY - [Input/Optional] "RTN","LRJSAU60",256,0) ; - if 0 or does not exist, return 1 if all fields in the list are audited, 0 otherwise "RTN","LRJSAU60",257,0) ; if 1 or -1 populate the VALMCNT array too as described below. "RTN","LRJSAU60",258,0) ; - if 1 populate VALMCNT for all the fields in the list and change the VALM header "RTN","LRJSAU60",259,0) ; - if -1 populate VALMCNT for all the fields that their audit field is turned off, but do not change the VALM header "RTN","LRJSAU60",260,0) ; "RTN","LRJSAU60",261,0) ; VALMCNT - [global/Input/Output] last entry in List Manager "RTN","LRJSAU60",262,0) ; VALMAR - [global/Output] reference to List Manager list of fields that their audit is on or off, "RTN","LRJSAU60",263,0) ; like "^TMP("LRJ SYS ORDERS MANAGER",$JOB)" "RTN","LRJSAU60",264,0) ; "RTN","LRJSAU60",265,0) ; Returns 1 if all audited fields are on, otherwise 0. "RTN","LRJSAU60",266,0) ; "RTN","LRJSAU60",267,0) N LRI,LRJ,LRALINE,LRAFLDS,LRSUBFLD,LRAUDIT,X,FLDAUDIT,SPACE,HDRDISP,FLDTITL,XAUD,XFILENUM,XNEW "RTN","LRJSAU60",268,0) S SPACE=$J("",47) "RTN","LRJSAU60",269,0) S DISPLAY=+$G(DISPLAY),XNEW=0 "RTN","LRJSAU60",270,0) S HDRDISP=0 ; intialize as header not displayed "RTN","LRJSAU60",271,0) S LRAUDIT=1 ; assume audit is ON for all fields "RTN","LRJSAU60",272,0) F LRI=1:1 S LRALINE=$P($TEXT(AFLDS+LRI^LRJSAU),";;",2) Q:LRALINE="$$END$$" D "RTN","LRJSAU60",273,0) .I +LRALINE'=60 Q "RTN","LRJSAU60",274,0) .S LRSUBFLD=$P($P(LRALINE,"^"),";",2) "RTN","LRJSAU60",275,0) .F LRJ=1:1 S LRAFLDS=$P($P(LRALINE,"^",2),";",LRJ) Q:LRAFLDS="" D "RTN","LRJSAU60",276,0) .. D AUDCHK2(+LRALINE,LRSUBFLD,LRAFLDS) "RTN","LRJSAU60",277,0) N MONLIST S FILENUM=60 D GMONLIST(FILENUM,.MONLIST) "RTN","LRJSAU60",278,0) S XFILENUM="",XNEW=1 "RTN","LRJSAU60",279,0) F S XFILENUM=$O(MONLIST(XFILENUM)) Q:XFILENUM="" D "RTN","LRJSAU60",280,0) .S LRALINE=MONLIST(XFILENUM) "RTN","LRJSAU60",281,0) .F LRJ=1:1 S LRAFLDS=$P(LRALINE,";",LRJ) Q:LRAFLDS="" D "RTN","LRJSAU60",282,0) .. I XFILENUM=FILENUM,LRJ=1 Q "RTN","LRJSAU60",283,0) .. D AUDCHK2(XFILENUM,"",LRAFLDS) "RTN","LRJSAU60",284,0) Q LRAUDIT "RTN","LRJSAU60",285,0) ; "RTN","LRJSAU60",286,0) AUDCHK2(XFILENUM,XFLDSUB,LRAFLDS) ; "RTN","LRJSAU60",287,0) ; XFILENUM (input) - file or subfile # if known "RTN","LRJSAU60",288,0) ; XFLDSUB (input/opt) - If a subfield and subfile not in XFILENUM, this is the field # for the subfile "RTN","LRJSAU60",289,0) N X "RTN","LRJSAU60",290,0) S FLDAUDIT=1 ; assume audit is ON for ONLY this field. "RTN","LRJSAU60",291,0) I XFLDSUB D ; If present, field is within a subfile XFLDSUB of XFILENUM "RTN","LRJSAU60",292,0) .N OUT "RTN","LRJSAU60",293,0) .S OUT=+$$GFLDSB(XFILENUM,XFLDSUB) "RTN","LRJSAU60",294,0) .I OUT S XFILENUM=OUT "RTN","LRJSAU60",295,0) I '$$ISAUDON(XFILENUM,LRAFLDS) S LRAUDIT=0,FLDAUDIT=0 "RTN","LRJSAU60",296,0) I (DISPLAY=1)!((DISPLAY=-1)&(FLDAUDIT=0)) D "RTN","LRJSAU60",297,0) .I 'HDRDISP D ; if the header is not already displayed, display it. "RTN","LRJSAU60",298,0) ..S FLDTITL="Field"_$J("",15)_"File Name"_$J("",11)_"Field Name"_$J("",15)_"Audit"_$J("",14) "RTN","LRJSAU60",299,0) ..I DISPLAY=1 D "RTN","LRJSAU60",300,0) ...S VALMHDR(1)=$J("",26)_"List of Audited Fields" "RTN","LRJSAU60",301,0) ...S VALMHDR(2)=" Asterisk (*) beside field name denotes required field for audit" "RTN","LRJSAU60",302,0) ...D CHGCAP^VALM("HEADER",FLDTITL) "RTN","LRJSAU60",303,0) ..I DISPLAY=-1 D "RTN","LRJSAU60",304,0) ...D ADD^LRJSAU(.VALMCNT," "_FLDTITL) "RTN","LRJSAU60",305,0) ...S X=" ",$P(X,"-",73)="" "RTN","LRJSAU60",306,0) ...D ADD^LRJSAU(.VALMCNT,X) "RTN","LRJSAU60",307,0) ..S HDRDISP=1 ; flag the header as displayed "RTN","LRJSAU60",308,0) ..Q "RTN","LRJSAU60",309,0) .S X=" "_60_"."_$S(XFILENUM=60&($E(LRAFLDS)="."):$P(LRAFLDS,".",2),XFILENUM=60:LRAFLDS,1:XFILENUM) "RTN","LRJSAU60",310,0) .I XFILENUM'=60 S X=X_$S($E(LRAFLDS)'=".":".",1:"")_LRAFLDS "RTN","LRJSAU60",311,0) .S X=$E(X_SPACE,1,17) "RTN","LRJSAU60",312,0) .S X=X_$E($$GFILENM(XFILENUM)_SPACE,1,19)_" " "RTN","LRJSAU60",313,0) .S X=X_$E($$GFLDNM(XFILENUM,LRAFLDS)_$S('$G(XNEW):"*",1:" ")_SPACE,1,27) "RTN","LRJSAU60",314,0) .S XAUD=$$GET1^DID(XFILENUM,LRAFLDS,"","AUDIT") "RTN","LRJSAU60",315,0) .S X=X_" "_$S(XAUD]"":XAUD,1:"** NOT AUDITED **") "RTN","LRJSAU60",316,0) .D ADD^LRJSAU(.VALMCNT,X) "RTN","LRJSAU60",317,0) Q "RTN","LRJSAU60",318,0) ; "RTN","LRJSAU60",319,0) ISAUDON(FILENUM,FLDNUM) ; -- is audit on for the given file/field number "RTN","LRJSAU60",320,0) Q ($$GET1^DID(FILENUM,FLDNUM,"","AUDIT")["YES, ALWAYS") "RTN","LRJSAU60",321,0) ; "RTN","LRJSAU60",322,0) GFLDSB(FILENUM,FLDNUM) ;if field is multiple, return subfile # "RTN","LRJSAU60",323,0) N LRX "RTN","LRJSAU60",324,0) D FIELD^DID(FILENUM,FLDNUM,"","SPECIFIER","LRX") "RTN","LRJSAU60",325,0) Q +$G(LRX("SPECIFIER")) "RTN","LRJSAU60",326,0) ; "RTN","LRJSAU60",327,0) GFILENM(FILENUM) ; -- get the file/subfile name for given file ien "RTN","LRJSAU60",328,0) N LRX,LRE "RTN","LRJSAU60",329,0) I $D(^DIC(FILENUM,0)) D ; Not a subfile "RTN","LRJSAU60",330,0) .S LRX=$$GET1^DID(FILENUM,"","","NAME","LRX","LRE") "RTN","LRJSAU60",331,0) E D ; subfile "RTN","LRJSAU60",332,0) .S LRX=$O(^DD(FILENUM,0,"NM","")) "RTN","LRJSAU60",333,0) Q $G(LRX) "RTN","LRJSAU60",334,0) ; "RTN","LRJSAU60",335,0) GFLDNM(FILENUM,FLDNUM) ; -- get the field name for given file/sub-file ien and field number "RTN","LRJSAU60",336,0) N OUT "RTN","LRJSAU60",337,0) D FIELD^DID(FILENUM,FLDNUM,"","LABEL","OUT") "RTN","LRJSAU60",338,0) Q $G(OUT("LABEL")) "RTN","LRJSAU60",339,0) ; "RTN","LRJSAU60",340,0) GMONLIST(FILENUM,MONLIST) ; return the list of fields to be monitored from configuration file. "RTN","LRJSAU60",341,0) N ARR,IEN,FLDNUM,FLDLIST,NODE,VAR,XFILENUM "RTN","LRJSAU60",342,0) S IEN=$O(^LABAUD(64.9178,"B",FILENUM,0)) "RTN","LRJSAU60",343,0) D GETS^DIQ(64.9178,IEN_",","**","","ARR") "RTN","LRJSAU60",344,0) S VAR="ARR" "RTN","LRJSAU60",345,0) S MONLIST="" "RTN","LRJSAU60",346,0) S NODE=$NAME(@VAR@(64.9178)) "RTN","LRJSAU60",347,0) F S NODE=$Q(@NODE) Q:NODE="" Q:$QS(NODE,3)'=.01 D "RTN","LRJSAU60",348,0) .S FLDNUM=$P(@NODE,"^",1) "RTN","LRJSAU60",349,0) .S XFILENUM=$S(FLDNUM'[",":60,1:$P(FLDNUM,",")) "RTN","LRJSAU60",350,0) .S MONLIST(XFILENUM)=$S($D(MONLIST(XFILENUM)):MONLIST(XFILENUM)_";",1:"")_$S(FLDNUM'[",":FLDNUM,1:$P(FLDNUM,",",2)) "RTN","LRJSAU60",351,0) Q "RTN","LRJSAU60",352,0) ; "RTN","LRJSAU60",353,0) ; if '^' out of prompts, allow exit/added parameter "RTN","LRJSAU60",354,0) FILENUM(LROUT) ; "RTN","LRJSAU60",355,0) K DIR "RTN","LRJSAU60",356,0) S LROUT=0 "RTN","LRJSAU60",357,0) S FILENUM=60 "RTN","LRJSAU60",358,0) D GIENLIST(FILENUM,.IENLIST) "RTN","LRJSAU60",359,0) I $D(DTOUT)!$D(DUOUT) S LROUT=1 Q "RTN","LRJSAU60",360,0) I '$D(IENLIST) W !," ALL TESTS" "RTN","LRJSAU60",361,0) ;Select FROM DATE "RTN","LRJSAU60",362,0) S LRFRDT=$$DATEENT("Select Start date: ",,"-NOW") "RTN","LRJSAU60",363,0) I LRFRDT<1 S:$D(DTOUT)!$D(DUOUT) LROUT=1 Q "RTN","LRJSAU60",364,0) S LRTODT=$$DATEENT(" Select End date: ",LRFRDT,"-NOW") "RTN","LRJSAU60",365,0) I $D(DTOUT)!$D(DUOUT) S LROUT=1 Q "RTN","LRJSAU60",366,0) I +LRTODT<1 S:$D(DTOUT)!$D(DUOUT) LROUT=1 Q "RTN","LRJSAU60",367,0) D MSG2 "RTN","LRJSAU60",368,0) Q "RTN","LRJSAU60",369,0) ; "RTN","LRJSAU60",370,0) GIENLIST(FILENUM,IENLIST) ; get list of entries (ien) For a given file into IENLIST array. "RTN","LRJSAU60",371,0) N DIC,X,Y,U "RTN","LRJSAU60",372,0) K IENLIST "RTN","LRJSAU60",373,0) S DIC("0")="AEQM" "RTN","LRJSAU60",374,0) S DIC=FILENUM "RTN","LRJSAU60",375,0) S Y=-1 "RTN","LRJSAU60",376,0) F D Q:+Y=-1 "RTN","LRJSAU60",377,0) .D ^DIC "RTN","LRJSAU60",378,0) .S:+Y'=-1 IENLIST(+Y)="" "RTN","LRJSAU60",379,0) Q "RTN","LRJSAU60",380,0) ; "RTN","LRJSAU60",381,0) DATEENT(LRPRMPT,LRBD,LRED) ;Prompt for extract date "RTN","LRJSAU60",382,0) ;INPUT "RTN","LRJSAU60",383,0) ; LRPRMPT - Prompt displayed to user "RTN","LRJSAU60",384,0) ; LRBD - Begin date of range "RTN","LRJSAU60",385,0) ; LRED - End date of range "RTN","LRJSAU60",386,0) ; "RTN","LRJSAU60",387,0) ;RETURN "RTN","LRJSAU60",388,0) ; LRDT "RTN","LRJSAU60",389,0) ; SUCCESS: FILEMAN INTERNALLY FORMATED DATE "RTN","LRJSAU60",390,0) ; FAILURE: -1 "RTN","LRJSAU60",391,0) ; "RTN","LRJSAU60",392,0) N LRDT,LRGOOD,X,Y "RTN","LRJSAU60",393,0) S LRGOOD=0 "RTN","LRJSAU60",394,0) S:+$G(LRED)>0 %DT(0)=LRED "RTN","LRJSAU60",395,0) S:$G(LRED)["NOW" %DT(0)=LRED "RTN","LRJSAU60",396,0) S %DT("A")=LRPRMPT "RTN","LRJSAU60",397,0) S %DT("B")="TODAY" ;Default for [Start] date entry "RTN","LRJSAU60",398,0) S %DT="AEPST" "RTN","LRJSAU60",399,0) D:LRPRMPT["Start" ^%DT ;Prompt for Start date "RTN","LRJSAU60",400,0) ; "RTN","LRJSAU60",401,0) ;Prompt for End date with conditions "RTN","LRJSAU60",402,0) I LRPRMPT["End" D "RTN","LRJSAU60",403,0) .F Q:LRGOOD D "RTN","LRJSAU60",404,0) ..S %DT("B")="NOW" ;Change default for End Date entry "RTN","LRJSAU60",405,0) ..D ^%DT "RTN","LRJSAU60",406,0) ..W:((YLRBD)!(Y=LRBD)!($D(DTOUT))!(X="^")) LRGOOD=1 "RTN","LRJSAU60",408,0) S LRDT=Y "RTN","LRJSAU60",409,0) K Y,%DT "RTN","LRJSAU60",410,0) Q LRDT "RTN","LRJSAU60",411,0) ; "RTN","LRJSAU60",412,0) MSG2 ; -- set default message "RTN","LRJSAU60",413,0) N LREND,LRBEGIN,LRAUTMSG "RTN","LRJSAU60",414,0) S LRBEGIN=$$GET^XPAR("SYS","LRJ LSRP AUF60 LAST START DATE",1,"Q") "RTN","LRJSAU60",415,0) S LREND=$$GET^XPAR("SYS","LRJ LSRP AUF60 LAST END DATE",1,"Q") "RTN","LRJSAU60",416,0) I (LRBEGIN'="")!(LREND'="") D "RTN","LRJSAU60",417,0) .S LRAUTMSG="Last Task Rpt "_$S(LRBEGIN'="":$$FMTE^XLFDT(LRBEGIN),1:"undeed")_" - "_$S(LREND'="":$$FMTE^XLFDT(LREND),1:"undefined") "RTN","LRJSAU60",418,0) I LRBEGIN="",LREND="" D "RTN","LRJSAU60",419,0) .S LRAUTMSG="Tasked Report has not run!" "RTN","LRJSAU60",420,0) S VALMSG=LRAUTMSG "RTN","LRJSAU60",421,0) Q "RTN","LRJSAU60",422,0) ; "RTN","LRJSAU60",423,0) GIOP(DEVICE) ; -- return the device if exist and it is not FORCED to queue, otherwise return "" "RTN","LRJSAU60",424,0) N POP "RTN","LRJSAU60",425,0) S IOP=DEVICE "RTN","LRJSAU60",426,0) S %ZIS="N" ; so the ^%ZIS call does not open the device. "RTN","LRJSAU60",427,0) D ^%ZIS ; return the characteristics of the device. "RTN","LRJSAU60",428,0) I POP=1 DO ; does the device exist? "RTN","LRJSAU60",429,0) .S DEVICE="" "RTN","LRJSAU60",430,0) E D "RTN","LRJSAU60",431,0) .; is the queuing forced forced for this device? "RTN","LRJSAU60",432,0) .I $P(^%ZIS(1,IOS,0),"^",12)=1 S DEVICE="" "RTN","LRJSAU60",433,0) ; "RTN","LRJSAU60",434,0) D ^%ZISC ; restore the device variables "RTN","LRJSAU60",435,0) Q DEVICE "RTN","LRJSAU60",436,0) ; "RTN","LRJSAU60",437,0) SETTMP(D0,LRIEN,LRDT,LRUSER,LRFLDNM,LRFNUM,LROLD,LRNEW) ; "RTN","LRJSAU60",438,0) ; ^TMP("LRDATA",$J,OLD/NEW determination,test ien,data element)=data element value "RTN","LRJSAU60",439,0) I $D(IENLIST),'$D(IENLIST(+LRIEN)) Q ; test is not one of those selected "RTN","LRJSAU60",440,0) N Q "RTN","LRJSAU60",441,0) F Q="LRIEN","LRDT","LRUSER","LRFLDNM","LRFNUM","LROLD","LRNEW" S ^TMP("LRDATA",$J,D0,Q)=@Q "RTN","LRJSAU60",442,0) ;determine if new test was entered "RTN","LRJSAU60",443,0) I LRFLDNM="NAME",LROLD["7200 S ^TMP("LRDATA",$J,"NEW",+LRIEN,D0)="" "RTN","LRJSAU60",451,0) Q "RTN","LRJSAU60",452,0) ; "RTN","LRJSAUO") 0^27^B1765290^n/a "RTN","LRJSAUO",1,0) LRJSAUO ;ALB/JLC - CALL CPRS IF CERTAIN FIELDS EDITED;10/21/2012 12:32:47 "RTN","LRJSAUO",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSAUO",3,0) ; "RTN","LRJSAUO",4,0) ; "RTN","LRJSAUO",5,0) ; Reference to ^ORUQO supported by IA 5756 "RTN","LRJSAUO",6,0) ; "RTN","LRJSAUO",7,0) Q "RTN","LRJSAUO",8,0) EN ;search fiile 60 audit for entries to use for quick order search "RTN","LRJSAUO",9,0) N A1,A2,LRAIEN,LRADT,LRF,A,LRT "RTN","LRJSAUO",10,0) S A1=$G(^LAB(69.9,1,64.9103)),LRAIEN=$P(A1,"^"),LRADT=$P(A1,"^",2) "RTN","LRJSAUO",11,0) L +^LRJSAUO:$G(DILOCKTM,5) E Q "RTN","LRJSAUO",12,0) I LRAIEN="" S LRAIEN=0 "RTN","LRJSAUO",13,0) I '$D(^DIA(60,LRAIEN)) S LRAIEN=0 "RTN","LRJSAUO",14,0) I $D(^DIA(60,LRAIEN,0)),$P(^(0),"^",2)'=LRADT S LRAIEN=0 "RTN","LRJSAUO",15,0) F S LRAIEN=$O(^DIA(60,LRAIEN)) Q:'LRAIEN D I $$REQ2STOP() S ZSTOP=1 Q "RTN","LRJSAUO",16,0) . S A=^DIA(60,LRAIEN,0),LRT=+A,LRF=$P(A,"^",3) "RTN","LRJSAUO",17,0) . I LRF'=.01,LRF'=3,LRF'=17,LRF'=18,LRF'="300,.01" Q "RTN","LRJSAUO",18,0) . D CHECKLR^ORUQO(LRT,$P($G(^LAB(60,LRT,0)),"^")) "RTN","LRJSAUO",19,0) . S ^LAB(69.9,1,64.9103)=LRAIEN_"^"_$P(A,"^",2) "RTN","LRJSAUO",20,0) L -^LRJSAUO "RTN","LRJSAUO",21,0) Q "RTN","LRJSAUO",22,0) ; "RTN","LRJSAUO",23,0) REQ2STOP() ; "RTN","LRJSAUO",24,0) ; Check for task stop request "RTN","LRJSAUO",25,0) ; Returns 1 if stop request made. "RTN","LRJSAUO",26,0) N STATUS,X "RTN","LRJSAUO",27,0) S STATUS=0 "RTN","LRJSAUO",28,0) I '$D(ZTQUEUED) Q 0 "RTN","LRJSAUO",29,0) S X=$$S^%ZTLOAD() "RTN","LRJSAUO",30,0) I X D ; "RTN","LRJSAUO",31,0) . S (STATUS,ZTSTOP)=1 "RTN","LRJSAUO",32,0) . S X=$$S^%ZTLOAD("Received shutdown request") "RTN","LRJSAUO",33,0) ; "RTN","LRJSAUO",34,0) I $Q Q STATUS "RTN","LRJSAUO",35,0) Q "RTN","LRJSML") 0^6^B27239914^n/a "RTN","LRJSML",1,0) LRJSML ;ALB/GTS - Lab Vista Hospital Location Utilities;02/24/2010 11:00:25 "RTN","LRJSML",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML",3,0) ; "RTN","LRJSML",4,0) ; "RTN","LRJSML",5,0) HDR ; -- header code "RTN","LRJSML",6,0) SET VALMHDR(1)=" Lab Hospital Location Change Extract" "RTN","LRJSML",7,0) SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU() "RTN","LRJSML",8,0) Q "RTN","LRJSML",9,0) ; "RTN","LRJSML",10,0) INIT ;* init variables and list array "RTN","LRJSML",11,0) N LRFROM,LRTO "RTN","LRJSML",12,0) D CREATRPT(.LRFROM,.LRTO,"^TMP($J,""LRJ SYS"")") "RTN","LRJSML",13,0) I (+$G(LRFROM)'>0)!(+$G(LRTO)'>0) DO "RTN","LRJSML",14,0) . S VALMBCK="Q" "RTN","LRJSML",15,0) . S VALMQUIT=1 "RTN","LRJSML",16,0) I (+$G(LRFROM)>0),(+$G(LRTO)>0) DO "RTN","LRJSML",17,0) . D CLEAR(LRFROM,LRTO,"^TMP($J,""LRJ SYS"")") "RTN","LRJSML",18,0) . D MSG "RTN","LRJSML",19,0) QUIT "RTN","LRJSML",20,0) ; "RTN","LRJSML",21,0) CLEAR(LRFROM,LRTO,LRHLARY) ;* clean up entries "RTN","LRJSML",22,0) DO REFRESH(LRFROM,LRTO,LRHLARY) "RTN","LRJSML",23,0) QUIT "RTN","LRJSML",24,0) ; "RTN","LRJSML",25,0) MSG ; -- set default message "RTN","LRJSML",26,0) N LREND,LRBEGIN,LRAUTMSG "RTN","LRJSML",27,0) S LRBEGIN=$$GET^XPAR("SYS","LRJ HL LAST START DATE",1,"Q") "RTN","LRJSML",28,0) S LREND=$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q") "RTN","LRJSML",29,0) I (LRBEGIN'="")!(LREND'="") D "RTN","LRJSML",30,0) .S LRAUTMSG="Task Rpt "_$S(LRBEGIN'="":$$FMTE^XLFDT(LRBEGIN),1:"undefined")_" - "_$S(LREND'="":$$FMTE^XLFDT(LREND),1:"undefined") "RTN","LRJSML",31,0) ; "RTN","LRJSML",32,0) I LRBEGIN="",LREND="" D "RTN","LRJSML",33,0) .S LRAUTMSG="Tasked Report has not run!" "RTN","LRJSML",34,0) S VALMSG=LRAUTMSG "RTN","LRJSML",35,0) QUIT "RTN","LRJSML",36,0) ; "RTN","LRJSML",37,0) REFRESH(LRFROM,LRTO,LRHLARY) ;* refresh display "RTN","LRJSML",38,0) DO BUILD(LRFROM,LRTO,LRHLARY) "RTN","LRJSML",39,0) D MSG "RTN","LRJSML",40,0) SET VALMBCK="R" "RTN","LRJSML",41,0) SET VALMBG=1 "RTN","LRJSML",42,0) QUIT "RTN","LRJSML",43,0) ; "RTN","LRJSML",44,0) BUILD(LRFROM,LRTO,LRHLARY) ; -- build display array "RTN","LRJSML",45,0) ; "RTN","LRJSML",46,0) ;INPUT "RTN","LRJSML",47,0) ; LRFROM - Start report date (Optional) "RTN","LRJSML",48,0) ; LRTO - End report date (Optional) "RTN","LRJSML",49,0) ; LRHLARY - Array of raw data extract (Required) "RTN","LRJSML",50,0) ; "RTN","LRJSML",51,0) QUIT:'$D(LRHLARY) ;QUIT if LRHLARY is not defined) "RTN","LRJSML",52,0) ; "RTN","LRJSML",53,0) NEW LRSTATUS,LRJERRCT,LRX "RTN","LRJSML",54,0) DO KILL^VALM10() "RTN","LRJSML",55,0) SET VALMCNT=0 "RTN","LRJSML",56,0) S LRX=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_LRFROM,1:"")_$S($D(LRTO):" to "_LRTO,1:"") "RTN","LRJSML",57,0) D ADD^LRJSMLU(.VALMCNT,LRX) "RTN","LRJSML",58,0) DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX)-1,IOUON,IOUOFF_IOINORM) "RTN","LRJSML",59,0) ; "RTN","LRJSML",60,0) D LISTHL(LRFROM,LRTO,LRHLARY) "RTN","LRJSML",61,0) ; "RTN","LRJSML",62,0) ;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If enhance send message HL MFN, see if can check link here. "RTN","LRJSML",63,0) Q "RTN","LRJSML",64,0) ; "RTN","LRJSML",65,0) LISTHL(LRFROM,LRTO,LRHLARY) ; -- place Hospital Locations in the display array "RTN","LRJSML",66,0) NEW X,NODE "RTN","LRJSML",67,0) DO KILL^VALM10() "RTN","LRJSML",68,0) SET VALMCNT=0 "RTN","LRJSML",69,0) SET X=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML",70,0) DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML",71,0) DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM) "RTN","LRJSML",72,0) D ADD^LRJSMLU(.VALMCNT," ") "RTN","LRJSML",73,0) SET NODE=0 "RTN","LRJSML",74,0) FOR SET NODE=$ORDER(@LRHLARY@(NODE)) QUIT:NODE="" DO "RTN","LRJSML",75,0) . SET X=@LRHLARY@(NODE) "RTN","LRJSML",76,0) . DO BREAK(.VALMCNT,X,NODE) "RTN","LRJSML",77,0) QUIT "RTN","LRJSML",78,0) ; "RTN","LRJSML",79,0) BREAK(VALMCNT,X,NODE) ; -- break into 79/80 char chunks for display "RTN","LRJSML",80,0) NEW LAOUT,LAX,SUBNODE,C "RTN","LRJSML",81,0) SET C="" ; -- continuation character "RTN","LRJSML",82,0) SET LAX=NODE_" : "_X "RTN","LRJSML",83,0) DO ADD^LRJSMLU(.VALMCNT,C_$EXTRACT(LAX,1,80)) "RTN","LRJSML",84,0) SET C="+" "RTN","LRJSML",85,0) SET LAOUT=$EXTRACT(LAX,81,159) "RTN","LRJSML",86,0) IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT) "RTN","LRJSML",87,0) SET LAOUT=$EXTRACT(LAX,160,239) "RTN","LRJSML",88,0) IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT) "RTN","LRJSML",89,0) SET LAOUT=$EXTRACT(LAX,240,255) "RTN","LRJSML",90,0) IF $LENGTH(LAOUT)>0 DO ADD^LRJSMLU(.VALMCNT,C_LAOUT) "RTN","LRJSML",91,0) QUIT "RTN","LRJSML",92,0) ; "RTN","LRJSML",93,0) ; "RTN","LRJSML",94,0) CREATRPT(LRFROM,LRTO,LRHLARY) ;Create array of HL changes between selected dates "RTN","LRJSML",95,0) N DIR "RTN","LRJSML",96,0) ; "RTN","LRJSML",97,0) W !!," Enter Hospital Location Extract Date Range...",! "RTN","LRJSML",98,0) ; "RTN","LRJSML",99,0) S LRFROM=$$DATEENT("Select Start date: ",,"-NOW") "RTN","LRJSML",100,0) Q:+LRFROM<1 "RTN","LRJSML",101,0) S LRTO=$$DATEENT(" Select End date: ",LRFROM,"-NOW") "RTN","LRJSML",102,0) Q:+LRTO<1 "RTN","LRJSML",103,0) D MSG "RTN","LRJSML",104,0) ; "RTN","LRJSML",105,0) ;Call Report API "RTN","LRJSML",106,0) D BLDREC^LRJSMLA(LRFROM,LRTO,LRHLARY) "RTN","LRJSML",107,0) ; "RTN","LRJSML",108,0) Q "RTN","LRJSML",109,0) ; "RTN","LRJSML",110,0) DATEENT(LRPRMPT,LRBD,LRED) ;Prompt for extract date "RTN","LRJSML",111,0) ;INPUT "RTN","LRJSML",112,0) ; LRPRMPT - Prompt displayed to user "RTN","LRJSML",113,0) ; LRBD - Begin date of range "RTN","LRJSML",114,0) ; LRED - End date of range "RTN","LRJSML",115,0) ; "RTN","LRJSML",116,0) ;RETURN "RTN","LRJSML",117,0) ; LRDT "RTN","LRJSML",118,0) ; SUCCESS: FILEMAN INTERNALLY FORMATED DATE "RTN","LRJSML",119,0) ; FAILURE: -1 "RTN","LRJSML",120,0) ; "RTN","LRJSML",121,0) N LRDT,LRGOOD "RTN","LRJSML",122,0) S LRGOOD=0 "RTN","LRJSML",123,0) S:+$G(LRED)>0 %DT(0)=LRED "RTN","LRJSML",124,0) S:$G(LRED)["NOW" %DT(0)=LRED "RTN","LRJSML",125,0) S %DT("A")=LRPRMPT "RTN","LRJSML",126,0) S %DT("B")="TODAY" ;Default for [Start] date entry "RTN","LRJSML",127,0) S %DT="AEPST" "RTN","LRJSML",128,0) D:LRPRMPT["Start" ^%DT ;Prompt for Start date "RTN","LRJSML",129,0) ; "RTN","LRJSML",130,0) ;Prompt for End date with conditions "RTN","LRJSML",131,0) I LRPRMPT["End" DO "RTN","LRJSML",132,0) . F Q:LRGOOD DO "RTN","LRJSML",133,0) . . S %DT("B")="NOW" ;Change default for End Date entry "RTN","LRJSML",134,0) . . D ^%DT "RTN","LRJSML",135,0) . . W:((YLRBD)!(Y=LRBD)!($D(DTOUT))!(X="^")) LRGOOD=1 "RTN","LRJSML",137,0) S LRDT=Y "RTN","LRJSML",138,0) K Y,%DT "RTN","LRJSML",139,0) Q LRDT "RTN","LRJSML",140,0) ; "RTN","LRJSML",141,0) DISPEXT(LRHLARY) ;Display Raw HL changes extracted "RTN","LRJSML",142,0) ; "RTN","LRJSML",143,0) ; This API will change the ListMan display array to a raw extract format "RTN","LRJSML",144,0) ;INPUT "RTN","LRJSML",145,0) ; LRHLARY - Array of raw extract data. "RTN","LRJSML",146,0) ; "RTN","LRJSML",147,0) NEW LRFROM,LRTO "RTN","LRJSML",148,0) D HDR "RTN","LRJSML",149,0) ; "RTN","LRJSML",150,0) ;Pull date range of extract from ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML",151,0) D GETDATE^LRJSML8(.LRFROM,.LRTO) "RTN","LRJSML",152,0) IF (+LRFROM=0)!(+LRTO=0) DO "RTN","LRJSML",153,0) .SET LRFROM=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^") "RTN","LRJSML",154,0) .SET LRTO=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^",2) "RTN","LRJSML",155,0) SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO "RTN","LRJSML",156,0) KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML",157,0) D REFRESH(LRFROM,LRTO,LRHLARY) "RTN","LRJSML",158,0) D MSG "RTN","LRJSML",159,0) S VALMBCK="R" "RTN","LRJSML",160,0) S VALMBG=1 "RTN","LRJSML",161,0) Q "RTN","LRJSML",162,0) ; "RTN","LRJSML",163,0) MMHDR ; -- header code for Mail Message display "RTN","LRJSML",164,0) SET VALMHDR(1)=" Lab Hospital Location Change Message" "RTN","LRJSML",165,0) SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU() "RTN","LRJSML",166,0) Q "RTN","LRJSML1") 0^17^B28615722^n/a "RTN","LRJSML1",1,0) LRJSML1 ;ALB/GTS - Lab Vista Hospital Location Initialization;02/24/2010 14:44:01 "RTN","LRJSML1",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML1",3,0) ; "RTN","LRJSML1",4,0) ; "RTN","LRJSML1",5,0) EN ; -- main entry point for LRJ SYS MAP HL List Template "RTN","LRJSML1",6,0) ; "RTN","LRJSML1",7,0) ; -- required interface routine variable "RTN","LRJSML1",8,0) NEW LRJSROU "RTN","LRJSML1",9,0) SET LRJSROU="LRJSML1" "RTN","LRJSML1",10,0) DO EN^VALM("LRJ SYS MAP HL") "RTN","LRJSML1",11,0) QUIT "RTN","LRJSML1",12,0) ; "RTN","LRJSML1",13,0) HDR ; -- header code "RTN","LRJSML1",14,0) SET VALMHDR(1)=" Lab Hospital Location Definition Extract" "RTN","LRJSML1",15,0) SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU() "RTN","LRJSML1",16,0) QUIT "RTN","LRJSML1",17,0) ; "RTN","LRJSML1",18,0) INIT ;* init variables and list array "RTN","LRJSML1",19,0) KILL ^TMP("LRJ SYS USER MANAGER - DATES",$JOB),^TMP("LRJ SYS USER MANAGER - INIT",$JOB) "RTN","LRJSML1",20,0) KILL ^TMP($J,"LRJ SYS","OUT") "RTN","LRJSML1",21,0) DO CREATRPT("^TMP($J,""LRJ SYS"")") "RTN","LRJSML1",22,0) DO CLEAR("^TMP($J,""LRJ SYS"")") "RTN","LRJSML1",23,0) SET ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)=1 "RTN","LRJSML1",24,0) QUIT "RTN","LRJSML1",25,0) ; "RTN","LRJSML1",26,0) GETLINK() ; -- get logical link name "RTN","LRJSML1",27,0) ;;If enhance to send extracted data via via HL MFN, change LA7JMFN to correct link "RTN","LRJSML1",28,0) QUIT "LA7JMFN" "RTN","LRJSML1",29,0) ; "RTN","LRJSML1",30,0) CLEAR(LRHLARY) ;* clean up entries "RTN","LRJSML1",31,0) DO REFRESH(LRHLARY) "RTN","LRJSML1",32,0) QUIT "RTN","LRJSML1",33,0) ; "RTN","LRJSML1",34,0) REFRESH(LRHLARY) ;* refresh display "RTN","LRJSML1",35,0) DO BUILD(LRHLARY) "RTN","LRJSML1",36,0) D MSG^LRJSML "RTN","LRJSML1",37,0) SET VALMBCK="R" "RTN","LRJSML1",38,0) SET VALMBG=1 "RTN","LRJSML1",39,0) QUIT "RTN","LRJSML1",40,0) ; "RTN","LRJSML1",41,0) HELP ;* help code "RTN","LRJSML1",42,0) SET X="?" D DISP^XQORM1 W !! "RTN","LRJSML1",43,0) DO MSG^LRJSML "RTN","LRJSML1",44,0) DO HDR "RTN","LRJSML1",45,0) QUIT "RTN","LRJSML1",46,0) ; "RTN","LRJSML1",47,0) EXIT ; -- exit code "RTN","LRJSML1",48,0) KILL ^TMP($J,"LRJ SYS"),^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML1",49,0) KILL ^TMP("LRJ SYS USER MANAGER - DATES",$JOB),^TMP("LRJ SYS USER MANAGER - INIT",$JOB) "RTN","LRJSML1",50,0) DO CLEAR^VALM1 "RTN","LRJSML1",51,0) Q "RTN","LRJSML1",52,0) ; "RTN","LRJSML1",53,0) EXPND ; -- expand code "RTN","LRJSML1",54,0) QUIT "RTN","LRJSML1",55,0) ; "RTN","LRJSML1",56,0) BUILD(LRHLARY) ; -- build display array "RTN","LRJSML1",57,0) ; "RTN","LRJSML1",58,0) ;INPUT "RTN","LRJSML1",59,0) ; LRHLARY - Array of raw data extract (Required) "RTN","LRJSML1",60,0) ; "RTN","LRJSML1",61,0) QUIT:'$D(LRHLARY) ;QUIT if LRHLARY is not defined) "RTN","LRJSML1",62,0) ; "RTN","LRJSML1",63,0) NEW LRSTATUS,LRJERRCT,LRX "RTN","LRJSML1",64,0) DO KILL "RTN","LRJSML1",65,0) DO KILL^VALM10() "RTN","LRJSML1",66,0) SET VALMCNT=0 "RTN","LRJSML1",67,0) SET LRX=" Hospital Locations currently defined in legacy VistA:" "RTN","LRJSML1",68,0) DO ADD^LRJSMLU(.VALMCNT,LRX) "RTN","LRJSML1",69,0) DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX),IOUON,IOUOFF_IOINORM) "RTN","LRJSML1",70,0) ; "RTN","LRJSML1",71,0) DO LISTHL(LRHLARY) "RTN","LRJSML1",72,0) ; "RTN","LRJSML1",73,0) ;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If enhance to send HL MFN message, see if can check link here. "RTN","LRJSML1",74,0) QUIT "RTN","LRJSML1",75,0) ; "RTN","LRJSML1",76,0) KILL ; -- kill off display data array "RTN","LRJSML1",77,0) KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML1",78,0) QUIT "RTN","LRJSML1",79,0) ; "RTN","LRJSML1",80,0) LISTHL(LRHLARY,X) ; -- place Hospital Locations in the display array "RTN","LRJSML1",81,0) ;Input: "RTN","LRJSML1",82,0) ; LRHLARY - Array root for raw data of Extracted Locations "RTN","LRJSML1",83,0) ; X - First line heading for display array (Defaults to Current Location heading) "RTN","LRJSML1",84,0) ; "RTN","LRJSML1",85,0) NEW NODE "RTN","LRJSML1",86,0) DO KILL "RTN","LRJSML1",87,0) DO KILL^VALM10() "RTN","LRJSML1",88,0) SET VALMCNT=0 "RTN","LRJSML1",89,0) SET:$G(X)="" X=" Hospital Locations currently defined in legacy VistA:" "RTN","LRJSML1",90,0) DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML1",91,0) DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM) "RTN","LRJSML1",92,0) D ADD^LRJSMLU(.VALMCNT," ") "RTN","LRJSML1",93,0) SET NODE=0 "RTN","LRJSML1",94,0) FOR SET NODE=$ORDER(@LRHLARY@(NODE)) QUIT:NODE="" DO "RTN","LRJSML1",95,0) . S X=@LRHLARY@(NODE) "RTN","LRJSML1",96,0) . DO BREAK^LRJSML(.VALMCNT,X,NODE) "RTN","LRJSML1",97,0) QUIT "RTN","LRJSML1",98,0) ; "RTN","LRJSML1",99,0) CREATRPT(LRHLARY) ;Create initial array of Hospital Location definition "RTN","LRJSML1",100,0) ; INPUT: "RTN","LRJSML1",101,0) ; LRHLARY - Array root for initial HL extract "RTN","LRJSML1",102,0) N DIR "RTN","LRJSML1",103,0) ; "RTN","LRJSML1",104,0) D MSG^LRJSML ;Display last report dates "RTN","LRJSML1",105,0) D HDR "RTN","LRJSML1",106,0) ; "RTN","LRJSML1",107,0) ;Call Report API "RTN","LRJSML1",108,0) W ! "RTN","LRJSML1",109,0) D EXTHL^LRJSML4(LRHLARY) "RTN","LRJSML1",110,0) ; "RTN","LRJSML1",111,0) Q "RTN","LRJSML1",112,0) ; "RTN","LRJSML1",113,0) ;;Action code for Hospital Location Mapping Manager actions "RTN","LRJSML1",114,0) ; "RTN","LRJSML1",115,0) DISPEXT(LRHLARY) ;Display Raw HL changes extracted "RTN","LRJSML1",116,0) ; "RTN","LRJSML1",117,0) ;Called from Protocol: LRJ SYS MAP HL DISP EXT "RTN","LRJSML1",118,0) ; "RTN","LRJSML1",119,0) ; This API will change the ListMan display array to a raw extract format "RTN","LRJSML1",120,0) ;INPUT "RTN","LRJSML1",121,0) ; LRHLARY - Array of raw extract data. "RTN","LRJSML1",122,0) ; "RTN","LRJSML1",123,0) NEW LRINIT,LRFROM,LRTO "RTN","LRJSML1",124,0) SET (LRFROM,LRTO)="" "RTN","LRJSML1",125,0) SET LRINIT=$$INITCK() "RTN","LRJSML1",126,0) ; "RTN","LRJSML1",127,0) IF LRINIT DO "RTN","LRJSML1",128,0) .DO HDR "RTN","LRJSML1",129,0) .KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML1",130,0) .DO REFRESH(LRHLARY) "RTN","LRJSML1",131,0) ; "RTN","LRJSML1",132,0) IF 'LRINIT DO "RTN","LRJSML1",133,0) .DO HDR^LRJSML "RTN","LRJSML1",134,0) .DO SETRNG(.LRFROM,.LRTO) "RTN","LRJSML1",135,0) .KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML1",136,0) .SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO "RTN","LRJSML1",137,0) .DO REFRESH^LRJSML(LRFROM,LRTO,LRHLARY) ;* refresh display "RTN","LRJSML1",138,0) QUIT "RTN","LRJSML1",139,0) ; "RTN","LRJSML1",140,0) CREATMM(LRHLARY) ;Create a mail message array "RTN","LRJSML1",141,0) ; "RTN","LRJSML1",142,0) ;Called from Protocol: LRJ SYS MAP HL DISPLAY MESSAGE "RTN","LRJSML1",143,0) ; "RTN","LRJSML1",144,0) ; This API will change the ListMan display array to a Mail Message format "RTN","LRJSML1",145,0) ;INPUT "RTN","LRJSML1",146,0) ; LRHLARY - Array of raw extract data. "RTN","LRJSML1",147,0) ; "RTN","LRJSML1",148,0) IF '$D(LRHLARY) DO "RTN","LRJSML1",149,0) .W !!,"Extract not completed...",! "RTN","LRJSML1",150,0) .DO PAUSE^VALM1 "RTN","LRJSML1",151,0) .DO HDR "RTN","LRJSML1",152,0) .DO REFRESH(LRHLARY) "RTN","LRJSML1",153,0) ; "RTN","LRJSML1",154,0) IF $D(LRHLARY) DO "RTN","LRJSML1",155,0) .NEW LRINIT "RTN","LRJSML1",156,0) .SET LRINIT=$$INITCK() "RTN","LRJSML1",157,0) .D MMHDR "RTN","LRJSML1",158,0) .IF $P($G(@LRHLARY@(1)),"^",1)'=" NO CHANGES FOUND!!" DO "RTN","LRJSML1",159,0) ..DO LISTHLMM^LRJSML8(LRHLARY) "RTN","LRJSML1",160,0) ..D MSG^LRJSML "RTN","LRJSML1",161,0) ..S VALMBCK="R" "RTN","LRJSML1",162,0) ..S VALMBG=1 "RTN","LRJSML1",163,0) .D:$P($G(@LRHLARY@(1)),"^",1)=" NO CHANGES FOUND!!" DISPEXT(LRHLARY) "RTN","LRJSML1",164,0) ; "RTN","LRJSML1",165,0) QUIT "RTN","LRJSML1",166,0) ; "RTN","LRJSML1",167,0) MMHDR ; -- header code for Mail Message display "RTN","LRJSML1",168,0) NEW LRINIT "RTN","LRJSML1",169,0) SET LRINIT=$$INITCK() "RTN","LRJSML1",170,0) SET:LRINIT VALMHDR(1)=" Lab Hospital Location Definition Extract Message" "RTN","LRJSML1",171,0) SET:'LRINIT VALMHDR(1)=" Lab Hospital Location Change Extract Message" "RTN","LRJSML1",172,0) SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU() "RTN","LRJSML1",173,0) QUIT "RTN","LRJSML1",174,0) ; "RTN","LRJSML1",175,0) SETRNG(LRFROM,LRTO) ; Get current change Extract Date range "RTN","LRJSML1",176,0) DO GETDATE^LRJSML8(.LRFROM,.LRTO) "RTN","LRJSML1",177,0) IF (+LRFROM=0)!(+LRTO=0) DO "RTN","LRJSML1",178,0) .SET LRFROM=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^") "RTN","LRJSML1",179,0) .SET LRTO=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^",2) "RTN","LRJSML1",180,0) QUIT "RTN","LRJSML1",181,0) ; "RTN","LRJSML1",182,0) INITCK() ;Return Initialization report indicator "RTN","LRJSML1",183,0) ; 1 : Init extract "RTN","LRJSML1",184,0) ; 0 : Not Init extract [Default] "RTN","LRJSML1",185,0) ; "RTN","LRJSML1",186,0) QUIT +$G(^TMP("LRJ SYS USER MANAGER - INIT",$JOB)) "RTN","LRJSML2") 0^18^B48324195^n/a "RTN","LRJSML2",1,0) LRJSML2 ;ALB/GTS - Lab Vista Hospital Location Utilities;02/24/2010 14:31:15 "RTN","LRJSML2",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML2",3,0) ; "RTN","LRJSML2",4,0) ; "RTN","LRJSML2",5,0) ;Following API called from TaskMan scheduled job (LRJ SYS MAP HL TASKMAN RPT) "RTN","LRJSML2",6,0) TSKMMARY(LRHLARY,LRMMARY) ;TASKMAN API for Mail Message array "RTN","LRJSML2",7,0) ; "RTN","LRJSML2",8,0) ;INPUT (Roots for arrays to create) "RTN","LRJSML2",9,0) ; LRHLARY - Raw Data Array [^TMP($J,"LRJ SYS") when called by LRJ SYS MAP HL SEND MSG] "RTN","LRJSML2",10,0) ; LRMMARY - Mail Message array to send in msg [^TMP($J,"LRDATA")] "RTN","LRJSML2",11,0) ; "RTN","LRJSML2",12,0) NEW LRFROM,LRTO,LRMSUBJ,XQSND,ERR,LRTOVA,LRTASKVA,LRINSTVA "RTN","LRJSML2",13,0) DO NOW^%DTC "RTN","LRJSML2",14,0) SET LRTO=$E(%,1,12) ;NOW: end date/time "RTN","LRJSML2",15,0) KILL %,X,%H,%I(1),%I(2),%I(3) "RTN","LRJSML2",16,0) SET:'$D(LRINIT) LRINIT=+$G(^TMP("LRJ SYS USER MANAGER - INIT",$JOB)) "RTN","LRJSML2",17,0) SET LRFROM=$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q") ;* IA #2263 "RTN","LRJSML2",18,0) ; "RTN","LRJSML2",19,0) IF LRFROM="" DO TSKERMSG^LRJSML6(LRMMARY) ;Current config not yet accepted "RTN","LRJSML2",20,0) ; "RTN","LRJSML2",21,0) ; Current Config accepted "RTN","LRJSML2",22,0) IF LRFROM'="" DO "RTN","LRJSML2",23,0) .DO EN^XPAR("SYS","LRJ HL LAST END DATE",,LRTO,.ERR) ;* IA #2263 "RTN","LRJSML2",24,0) .DO EN^XPAR("SYS","LRJ HL LAST START DATE",,LRFROM,.ERR) ;* IA #2263 "RTN","LRJSML2",25,0) .; "RTN","LRJSML2",26,0) .DO BLDREC^LRJSMLA(LRFROM,LRTO,LRHLARY) "RTN","LRJSML2",27,0) .; "RTN","LRJSML2",28,0) .IF ^TMP($J,"LRJ SYS",1)=" NO CHANGES FOUND!!" DO "RTN","LRJSML2",29,0) ..NEW LRPARAM,LRLNCNT "RTN","LRJSML2",30,0) ..SET:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSML2",31,0) ..SET LRLNCNT=0 "RTN","LRJSML2",32,0) ..SET X=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML2",33,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT,X,"","MAIL",LRMMARY) "RTN","LRJSML2",34,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT," ","","MAIL",LRMMARY) "RTN","LRJSML2",35,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT," ","","MAIL",LRMMARY) "RTN","LRJSML2",36,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT,"********************************************","","MAIL",LRMMARY) "RTN","LRJSML2",37,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT,"* *","","MAIL",LRMMARY) "RTN","LRJSML2",38,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT,"* NO CHANGES FOUND FOR THIS DATE RANGE!! *","","MAIL",LRMMARY) "RTN","LRJSML2",39,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT,"* *","","MAIL",LRMMARY) "RTN","LRJSML2",40,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT,"********************************************","","MAIL",LRMMARY) "RTN","LRJSML2",41,0) ..DO LRADDNOD^LRJSML3(.LRLNCNT," ","","MAIL",LRMMARY) "RTN","LRJSML2",42,0) ..SET LRMSUBJ="NO HL changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML2",43,0) ..SET XQSND=DUZ "RTN","LRJSML2",44,0) ..DO SNDMSG^LRJSML8(LRMSUBJ,XQSND,LRMMARY,1) ;"1" = created by TaskMan; send to Mailgroup "RTN","LRJSML2",45,0) .; "RTN","LRJSML2",46,0) .IF ^TMP($J,"LRJ SYS",1)'=" NO CHANGES FOUND!!" DO "RTN","LRJSML2",47,0) ..DO CRTRPTAR^LRJSML8(LRHLARY,LRFROM,LRTO,"MAIL",LRMMARY) "RTN","LRJSML2",48,0) ..; "RTN","LRJSML2",49,0) ..SET LRMSUBJ="HL changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML2",50,0) ..SET XQSND=DUZ "RTN","LRJSML2",51,0) ..DO SNDMSG^LRJSML8(LRMSUBJ,XQSND,LRMMARY,1) ;"1" = created by TaskMan; send to Mailgroup "RTN","LRJSML2",52,0) ..; "RTN","LRJSML2",53,0) ..;Send Extract msg with attachmts "RTN","LRJSML2",54,0) ..SET LRMSUBJ="HL extract"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML2",55,0) ..; "RTN","LRJSML2",56,0) ..;Check Network addresses and mail attachmt "RTN","LRJSML2",57,0) ..SET LRINSTVA("ADDR FLAGS")="R" ;Do not Restrict Message addressing "RTN","LRJSML2",58,0) ..SET LRINSTVA("FROM")="LAB_HLCSM_USER_ACTION" "RTN","LRJSML2",59,0) ..SET LRTOVA(XQSND)="" "RTN","LRJSML2",60,0) ..SET LRTOVA("G.LRJ SYS MAP HL TASK REPORT")="" "RTN","LRJSML2",61,0) ..; "RTN","LRJSML2",62,0) ..DO OUTLKARY^LRJSML8(LRHLARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ) "RTN","LRJSML2",63,0) ..DO SENDMSG^XMXAPI(XQSND,LRMSUBJ,"^TMP($J,""LRNETMSG"")",.LRTOVA,.LRINSTVA) "RTN","LRJSML2",64,0) ; "RTN","LRJSML2",65,0) KILL @LRHLARY,@LRMMARY,^TMP($J,"LRNETMSG") "RTN","LRJSML2",66,0) QUIT "RTN","LRJSML2",67,0) ; "RTN","LRJSML2",68,0) CRTMMARY(LRHLARY,LRMMARY) ;Load Hospital Locations in Mail Msg array "RTN","LRJSML2",69,0) ; Protocol: LRJ SYS MAP HL SEND MSG "RTN","LRJSML2",70,0) ;INPUT "RTN","LRJSML2",71,0) ; LRHLARY - Raw Data Array "RTN","LRJSML2",72,0) ; [^TMP($J,"LRJ SYS") when called by LRJ SYS MAP HL SEND MSG] "RTN","LRJSML2",73,0) ; LRMMARY - Mail Msg array to send in message [^TMP($J,"LRDATA")] "RTN","LRJSML2",74,0) ; "RTN","LRJSML2",75,0) NEW LRMSUBJ,XQSND,LRFROM,LRTO,XQSND,LRNODE,LRLPCNT,LRINIT "RTN","LRJSML2",76,0) ; "RTN","LRJSML2",77,0) DO FULL^VALM1 "RTN","LRJSML2",78,0) SET LRINIT=$$INITCK^LRJSML1() "RTN","LRJSML2",79,0) DO LISTHLMM^LRJSML8(LRHLARY) "RTN","LRJSML2",80,0) IF 'LRINIT DO "RTN","LRJSML2",81,0) .DO SETRNG^LRJSML1(.LRFROM,.LRTO) "RTN","LRJSML2",82,0) .SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO "RTN","LRJSML2",83,0) ; "RTN","LRJSML2",84,0) S:('LRINIT) LRMSUBJ="HL changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML2",85,0) IF LRINIT SET LRMSUBJ="HL Configurations on "_$$FMTE^XLFDT($P($G(^TMP($J,"LRJ SYS",1)),"^",11)) "RTN","LRJSML2",86,0) S XQSND=DUZ "RTN","LRJSML2",87,0) S (LRNODE,LRLPCNT)=0 "RTN","LRJSML2",88,0) DO CREATMM^LRJSML1(LRHLARY) ;; Excutes REFRESH^LRJSML1 setting VALMBCK & VALMBG "RTN","LRJSML2",89,0) F S LRNODE=$O(@VALMAR@(LRNODE)) Q:LRNODE="" DO "RTN","LRJSML2",90,0) .S LRLPCNT=LRLPCNT+1 "RTN","LRJSML2",91,0) .S @LRMMARY@(LRLPCNT)=@VALMAR@(LRNODE,0) "RTN","LRJSML2",92,0) .I LRLPCNT=1 D LRADDLNE^LRJSML3(.LRLPCNT,"",LRMMARY) "RTN","LRJSML2",93,0) .I @VALMAR@(LRNODE,0)["BEDS" DO "RTN","LRJSML2",94,0) ..D LRADDLNE^LRJSML3(.LRLPCNT,"",LRMMARY) "RTN","LRJSML2",95,0) ..D LRADDLNE^LRJSML3(.LRLPCNT,"",LRMMARY) "RTN","LRJSML2",96,0) IF '$D(@VALMAR@(2,0)) DO "RTN","LRJSML2",97,0) . DO LRADDLNE^LRJSML3(.LRLPCNT,"",LRMMARY) "RTN","LRJSML2",98,0) . DO LRADDLNE^LRJSML3(.LRLPCNT," No data was extracted for date range!!",LRMMARY) "RTN","LRJSML2",99,0) . DO LRADDLNE^LRJSML3(.LRLPCNT,"",LRMMARY) "RTN","LRJSML2",100,0) DO SNDMSG^LRJSML8(LRMSUBJ,XQSND,LRMMARY,0) "RTN","LRJSML2",101,0) IF $O(@VALMAR@(0))="" K @LRMMARY@(1),@LRMMARY@(2),@LRMMARY@(3) "RTN","LRJSML2",102,0) Q "RTN","LRJSML2",103,0) ; "RTN","LRJSML2",104,0) ;Protocol invokes this API: LRJ SYS MAP HL SEND EXT "RTN","LRJSML2",105,0) CRTXTMM(LRHLARY) ;Load Hospital Locations in the Mail Msg array "RTN","LRJSML2",106,0) ;INPUT "RTN","LRJSML2",107,0) ; LRHLARY - Raw Data Array [^TMP($J,"LRJ SYS") when called by LRJ SYS MAP HL SEND MSG] "RTN","LRJSML2",108,0) ; "RTN","LRJSML2",109,0) NEW LRFROM,LRTO,LRMSUBJ,XQSND,LRINIT "RTN","LRJSML2",110,0) SET (LRFROM,LRTO)="" "RTN","LRJSML2",111,0) SET LRINIT=$$INITCK^LRJSML1() "RTN","LRJSML2",112,0) ; "RTN","LRJSML2",113,0) DO FULL^VALM1 "RTN","LRJSML2",114,0) ; "RTN","LRJSML2",115,0) WRITE !!,"This action will send an E-mail message that includes the raw extracts as" "RTN","LRJSML2",116,0) WRITE !," attachments to selected users. Large extract files can take time to create." "RTN","LRJSML2",117,0) ; "RTN","LRJSML2",118,0) IF '$D(LRINIT) SET LRINIT=+$G(^TMP("LRJ SYS USER MANAGER - INIT",$JOB)) "RTN","LRJSML2",119,0) ; "RTN","LRJSML2",120,0) IF 'LRINIT DO "RTN","LRJSML2",121,0) .DO SETRNG^LRJSML1(.LRFROM,.LRTO) "RTN","LRJSML2",122,0) .SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO "RTN","LRJSML2",123,0) .SET LRMSUBJ="HL extract"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML2",124,0) SET:LRINIT LRMSUBJ="HL Configuration extract on "_$$FMTE^XLFDT($P($G(^TMP($J,"LRJ SYS",1)),"^",11)) "RTN","LRJSML2",125,0) SET XQSND=DUZ "RTN","LRJSML2",126,0) DO SNDEXT^LRJSML8(LRMSUBJ,XQSND,LRHLARY) "RTN","LRJSML2",127,0) DO DISPEXT^LRJSML1(LRHLARY) "RTN","LRJSML2",128,0) DO MSG^LRJSML "RTN","LRJSML2",129,0) SET VALMBCK="R" "RTN","LRJSML2",130,0) SET VALMBG=1 "RTN","LRJSML2",131,0) QUIT "RTN","LRJSML2",132,0) ; "RTN","LRJSML2",133,0) ;Called by: ACPTCNFG^LRJSML6 "RTN","LRJSML2",134,0) PARAMED ;Edit Dates referenced by tasked Option "LRJ SYS MAP HL TASKMAN RPT" "RTN","LRJSML2",135,0) ; This API invokes Edit Instance and Value of Parameter API to edit following Parameters: "RTN","LRJSML2",136,0) ; LRJ HL LAST START DATE "RTN","LRJSML2",137,0) ; LRJ HL LAST END DATE "RTN","LRJSML2",138,0) ; "RTN","LRJSML2",139,0) ; These parameters control the period that the Audit file extract is performed via the "RTN","LRJSML2",140,0) ; TaskMan scheduled job for the "LRJ SYS MAP HL TASKMAN RPT" option "RTN","LRJSML2",141,0) NEW LROK "RTN","LRJSML2",142,0) SET LROK=1 "RTN","LRJSML2",143,0) ; "RTN","LRJSML2",144,0) WRITE !!,"Lab Hospital Location Audit extract dates indicate the report dates" "RTN","LRJSML2",145,0) WRITE !," for the most recent Legacy VistA Hospital Location extract completed." "RTN","LRJSML2",146,0) WRITE !!,"The LRJ HL LAST END DATE is the start date/time used by the next" "RTN","LRJSML2",147,0) WRITE !," execution of the LRJ SYS MAP HL TASKMAN RPT option." "RTN","LRJSML2",148,0) WRITE !!,"WARNING: Editing the LRJ HL LAST END DATE will affect the information" "RTN","LRJSML2",149,0) WRITE !," reported by the LRJ SYS MAP HL TASKMAN RPT option. This option makes" "RTN","LRJSML2",150,0) WRITE !," assumptions about data previously reported based upon this date.",! "RTN","LRJSML2",151,0) WRITE !!,"A USER CHANGING THE 'LRJ HL LAST END DATE' MUST UNDERSTAND THE RESULT" "RTN","LRJSML2",152,0) WRITE !," OF THE CHANGE MADE AND [IF NECESSARY] RECONCILE THE NEXT REPORT AGAINST" "RTN","LRJSML2",153,0) WRITE !," PREVIOUS REPORTS TO ASSURE LAB LOCATIONS DEFINED ON COTS MATCH" "RTN","LRJSML2",154,0) WRITE !," THOSE DEFINED ON LEGACY VISTA!",! "RTN","LRJSML2",155,0) SET DIR(0)="E" "RTN","LRJSML2",156,0) DO ^DIR "RTN","LRJSML2",157,0) SET LROK=+Y "RTN","LRJSML2",158,0) KILL X,Y,DTOUT,DUOUT,DIROUT "RTN","LRJSML2",159,0) ; "RTN","LRJSML2",160,0) IF LROK DO "RTN","LRJSML2",161,0) .D EDITPAR^XPAREDIT("LRJ HL LAST START DATE") ;;IA #2336 "RTN","LRJSML2",162,0) .WRITE !!,"-------------------------------------------------------------------------------" "RTN","LRJSML2",163,0) .D EDITPAR^XPAREDIT("LRJ HL LAST END DATE") ;;IA #2336 "RTN","LRJSML2",164,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML2",165,0) Q "RTN","LRJSML3") 0^9^B199716407^n/a "RTN","LRJSML3",1,0) LRJSML3 ;ALB/GTS - Lab Vista Hospital Location Utilities - 2;02/17/2010 09:42:19 "RTN","LRJSML3",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML3",3,0) ; "RTN","LRJSML3",4,0) ; "RTN","LRJSML3",5,0) SETNPARM(LRVALST,LRPARAM) ;Set New Params "RTN","LRJSML3",6,0) S LRPARAM("LRRM")=$P(LRVALST,"^",2) "RTN","LRJSML3",7,0) S LRPARAM("LROBED")=$P(LRVALST,"^",3) "RTN","LRJSML3",8,0) S LRPARAM("LRHD")=$P(LRVALST,"^",4) "RTN","LRJSML3",9,0) S LRPARAM("LRFSTLNE")=$P(LRVALST,"^",5) "RTN","LRJSML3",10,0) S LRPARAM("LRINIT")=$P(LRVALST,"^",6) "RTN","LRJSML3",11,0) QUIT "RTN","LRJSML3",12,0) ; "RTN","LRJSML3",13,0) SETEPARM(LRVALST,LRPARAM) ;Set Edited Params "RTN","LRJSML3",14,0) S LRPARAM("LRCRM")=$P(LRVALST,"^",2) "RTN","LRJSML3",15,0) S LRPARAM("LRCBED")=$P(LRVALST,"^",3) "RTN","LRJSML3",16,0) S LRPARAM("LRPRM")=$P(LRVALST,"^",5) "RTN","LRJSML3",17,0) S LRPARAM("LRPBED")=$P(LRVALST,"^",6) "RTN","LRJSML3",18,0) S LRPARAM("LRFSTLNE")=$P(LRVALST,"^",7) "RTN","LRJSML3",19,0) S LRPARAM("LRINIT")=$P(LRVALST,"^",8) "RTN","LRJSML3",20,0) QUIT "RTN","LRJSML3",21,0) ; "RTN","LRJSML3",22,0) MMDISPN(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Break into 79/80 char chunks for Cur Val display "RTN","LRJSML3",23,0) ; VALMCNT - Cur output array line number "RTN","LRJSML3",24,0) ; LRPARAM - Array with parameters passed "RTN","LRJSML3",25,0) ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message "RTN","LRJSML3",26,0) ; LRMMARY - Mail message output array (Optional) "RTN","LRJSML3",27,0) ; "RTN","LRJSML3",28,0) ;Array params sent & received (LRPARAM) "RTN","LRJSML3",29,0) ; XN - NEW HL extract data "RTN","LRJSML3",30,0) ; LEGEND: "RTN","LRJSML3",31,0) ; NEW^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date "RTN","LRJSML3",32,0) ; ^Reactivation Date^Accessed by^Chng Date/Time "RTN","LRJSML3",33,0) ; "RTN","LRJSML3",34,0) ; NEW^ROOM^Hosp Loc Name^Type^Inst^Div^Room "RTN","LRJSML3",35,0) ; NEW^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed "RTN","LRJSML3",36,0) ; LRLOC - Cur Hosp Loc header Info "RTN","LRJSML3",37,0) ; LRRM - Cur Hosp Loc Room Info "RTN","LRJSML3",38,0) ; LROBED - Cur Hosp Loc Bed Info "RTN","LRJSML3",39,0) ; LRHD - Header (Location or Room) to display "RTN","LRJSML3",40,0) ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed "RTN","LRJSML3",41,0) ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change) "RTN","LRJSML3",42,0) ; "RTN","LRJSML3",43,0) N LRIEN,LRDTTYP,LRVALST,LRINIT "RTN","LRJSML3",44,0) N LRXN,LRLOC,LRRM,LROBED,LRHD,LRFSTLNE "RTN","LRJSML3",45,0) N LRLOCVAR,LRSUB,LPCNT,LRROOT "RTN","LRJSML3",46,0) ; "RTN","LRJSML3",47,0) S:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSML3",48,0) S:$G(LROUTPT)="" LROUTPT="DISPLAY" "RTN","LRJSML3",49,0) ; "RTN","LRJSML3",50,0) ;Put Array params in local vars "RTN","LRJSML3",51,0) S LRXN=LRPARAM("XN") "RTN","LRJSML3",52,0) ; "RTN","LRJSML3",53,0) S LRLOCVAR="LRLOC^LRRM^LROBED^LRHD^LRFSTLNE^LRINIT" "RTN","LRJSML3",54,0) S LRROOT="LRPARAM" "RTN","LRJSML3",55,0) F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB) "RTN","LRJSML3",56,0) ; "RTN","LRJSML3",57,0) S LRDTTYP=$P(LRXN,"^",2) ;Type of data node (LOCATION, ROOM or BED) "RTN","LRJSML3",58,0) I LRDTTYP="LOCATION" DO "RTN","LRJSML3",59,0) .I LRLOC'="" DO "RTN","LRJSML3",60,0) ..D LRNEWOUT(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) "RTN","LRJSML3",61,0) ..; "RTN","LRJSML3",62,0) ..;Set Array params "RTN","LRJSML3",63,0) ..S LRRM=LRPARAM("LRRM") "RTN","LRJSML3",64,0) ..S LROBED=LRPARAM("LROBED") "RTN","LRJSML3",65,0) ..S LRHD=LRPARAM("LRHD") "RTN","LRJSML3",66,0) ..S LRPARAM("LRFSTLNE")=LRFSTLNE "RTN","LRJSML3",67,0) .S:'LRINIT LRHD="CHANGE DETAIL (NEW)" "RTN","LRJSML3",68,0) .S:LRINIT LRHD="CURRENT DEFINITION" "RTN","LRJSML3",69,0) .S LRLOC="^^"_$P(LRXN,"^",3,11) "RTN","LRJSML3",70,0) ; "RTN","LRJSML3",71,0) I LRDTTYP="ROOM" DO "RTN","LRJSML3",72,0) .I LRRM'="" DO "RTN","LRJSML3",73,0) ..; "RTN","LRJSML3",74,0) ..;Reset Array params "RTN","LRJSML3",75,0) ..S LRPARAM("LRFSTLNE")=LRFSTLNE "RTN","LRJSML3",76,0) ..D LRNEWOUT(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) "RTN","LRJSML3",77,0) ..; "RTN","LRJSML3",78,0) ..;Set Array params "RTN","LRJSML3",79,0) ..S LRRM=LRPARAM("LRRM") "RTN","LRJSML3",80,0) ..S LROBED=LRPARAM("LROBED") "RTN","LRJSML3",81,0) ..S LRHD=LRPARAM("LRHD") "RTN","LRJSML3",82,0) ..S LRFSTLNE=LRPARAM("LRFSTLNE") "RTN","LRJSML3",83,0) .S:'LRINIT LRHD="CHANGE DETAIL (NEW)" "RTN","LRJSML3",84,0) .S:LRINIT LRHD="CURRENT DEFINITION" "RTN","LRJSML3",85,0) .S LRRM=$P(LRXN,"^",8) "RTN","LRJSML3",86,0) ; "RTN","LRJSML3",87,0) I LRDTTYP="BED" S:LROBED'="" LROBED=LROBED_" ; "_$P(LRXN,"^",9) S:LROBED="" LROBED=$P(LRXN,"^",9) "RTN","LRJSML3",88,0) ; "RTN","LRJSML3",89,0) ;Reset Array params "RTN","LRJSML3",90,0) S LRPARAM("LRLOC")=LRLOC "RTN","LRJSML3",91,0) S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRINIT "RTN","LRJSML3",92,0) D SETNPARM(LRVALST,.LRPARAM) "RTN","LRJSML3",93,0) Q "RTN","LRJSML3",94,0) ; "RTN","LRJSML3",95,0) LRNEWOUT(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Output New location "RTN","LRJSML3",96,0) ;INPUT PARAMS: "RTN","LRJSML3",97,0) ; VALMCNT - Cur Line number of output array "RTN","LRJSML3",98,0) ; LRPARAM - Array with params passed "RTN","LRJSML3",99,0) ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail message "RTN","LRJSML3",100,0) ; LRMMARY - Mail message output array (Optional) "RTN","LRJSML3",101,0) ; "RTN","LRJSML3",102,0) ;Array params sent & received (LRPARAM) "RTN","LRJSML3",103,0) ; LRLOC - Cur Hosp Loc Info "RTN","LRJSML3",104,0) ; LRRM - Cur Hosp Loc Room Info "RTN","LRJSML3",105,0) ; LROBED - Cur Hosp Loc Bed Info "RTN","LRJSML3",106,0) ; LRHD - Header Info "RTN","LRJSML3",107,0) ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed "RTN","LRJSML3",108,0) ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change) "RTN","LRJSML3",109,0) ; "RTN","LRJSML3",110,0) N LRLOCVAR,LRROOT,LPCNT,LRSUB "RTN","LRJSML3",111,0) N LAX,LRIEN,LRNNAME,LRTYPE,LRINST,LRDIV,LRINACT,LRREACT,LRUSR,LRDTCG "RTN","LRJSML3",112,0) N LRLOC,LRRM,LROBED,LRHD,LRFSTLNE,LRVALST,LRINIT "RTN","LRJSML3",113,0) ; "RTN","LRJSML3",114,0) ;Put Array params in local vars "RTN","LRJSML3",115,0) S LRLOCVAR="LRLOC^LRRM^LROBED^LRHD^LRFSTLNE^LRINIT" "RTN","LRJSML3",116,0) S LRROOT="LRPARAM" "RTN","LRJSML3",117,0) F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB) "RTN","LRJSML3",118,0) ; "RTN","LRJSML3",119,0) ;Set variables passed in LRPARAM("LRLOC") "RTN","LRJSML3",120,0) S LRIEN=$P(LRLOC,"^",3) "RTN","LRJSML3",121,0) S LRNNAME=$P(LRLOC,"^",4) "RTN","LRJSML3",122,0) S LRTYPE=$P(LRLOC,"^",5) "RTN","LRJSML3",123,0) S LRINST=$P(LRLOC,"^",6) "RTN","LRJSML3",124,0) S LRDIV=$P(LRLOC,"^",7) "RTN","LRJSML3",125,0) S LRINACT=$P(LRLOC,"^",8) "RTN","LRJSML3",126,0) S LRREACT=$P(LRLOC,"^",9) "RTN","LRJSML3",127,0) S LRUSR=$P(LRLOC,"^",10) "RTN","LRJSML3",128,0) S LRDTCG=$P(LRLOC,"^",11) "RTN","LRJSML3",129,0) ; "RTN","LRJSML3",130,0) D:+LRFSTLNE>0 LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",131,0) D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",132,0) D LRADDNOD(.VALMCNT," "_LRHD,"",LROUTPT,LRMMARY) "RTN","LRJSML3",133,0) IF LROUTPT="DISPLAY" DO "RTN","LRJSML3",134,0) .DO CNTRL^VALM10(VALMCNT,8,$LENGTH(LRHD),IOUON,IOUOFF_IOINORM) "RTN","LRJSML3",135,0) ; "RTN","LRJSML3",136,0) ;Output Location info "RTN","LRJSML3",137,0) S LAX=" IEN: "_LRIEN "RTN","LRJSML3",138,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",139,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM) "RTN","LRJSML3",140,0) S LAX=" NAME: "_LRNNAME "RTN","LRJSML3",141,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",142,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",143,0) S LAX=" TYPE: "_LRTYPE "RTN","LRJSML3",144,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",145,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",146,0) S LAX=" INST: "_LRINST "RTN","LRJSML3",147,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",148,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",149,0) S LAX=" DIV: "_LRDIV "RTN","LRJSML3",150,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",151,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM) "RTN","LRJSML3",152,0) S LAX="INACT: "_$$FMTE^XLFDT(LRINACT) "RTN","LRJSML3",153,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",154,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM) "RTN","LRJSML3",155,0) S LAX=" ACT: "_$$FMTE^XLFDT(LRREACT) "RTN","LRJSML3",156,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",157,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM) "RTN","LRJSML3",158,0) ; "RTN","LRJSML3",159,0) ;Output edit info "RTN","LRJSML3",160,0) S:LRINIT LAX=" " "RTN","LRJSML3",161,0) S:'LRINIT LAX=" CHANGED BY: "_LRUSR "RTN","LRJSML3",162,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",163,0) IF LROUTPT="DISPLAY",'LRINIT D CNTRL^VALM10(VALMCNT,10,11,IOINHI,IOINORM) "RTN","LRJSML3",164,0) IF 'LRINIT DO "RTN","LRJSML3",165,0) .S LAX=" DATE/TIME OF CHANGE: "_$$FMTE^XLFDT(LRDTCG) "RTN","LRJSML3",166,0) .D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",167,0) .D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,20,IOINHI,IOINORM) "RTN","LRJSML3",168,0) ; "RTN","LRJSML3",169,0) ;Output Room/Bed info "RTN","LRJSML3",170,0) D LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",171,0) S LAX=" ROOM: "_LRRM "RTN","LRJSML3",172,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",173,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",174,0) S LAX=" BEDS: "_LROBED "RTN","LRJSML3",175,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",176,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",177,0) D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",178,0) ; "RTN","LRJSML3",179,0) IF LRINIT DO LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",180,0) ; "RTN","LRJSML3",181,0) S (LRRM,LROBED,LRHD)="" "RTN","LRJSML3",182,0) S LRFSTLNE=1 "RTN","LRJSML3",183,0) ; "RTN","LRJSML3",184,0) ;Reset Param array "RTN","LRJSML3",185,0) S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRINIT "RTN","LRJSML3",186,0) D SETNPARM(LRVALST,.LRPARAM) "RTN","LRJSML3",187,0) S LRPARAM("LRLOC")=LRLOC "RTN","LRJSML3",188,0) Q "RTN","LRJSML3",189,0) ; "RTN","LRJSML3",190,0) MMDISPC(VALMCNT,LRPARAM,LROUTPT,LRMMARY) ;Break into 79/80 char chunks for Cur Val display "RTN","LRJSML3",191,0) ; "RTN","LRJSML3",192,0) ;Input params "RTN","LRJSML3",193,0) ; VALMCNT - Cur Line number of output array "RTN","LRJSML3",194,0) ; LRPARAM - Array with parameters passed "RTN","LRJSML3",195,0) ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message "RTN","LRJSML3",196,0) ; LRMMARY - Mail message output array (Optional) "RTN","LRJSML3",197,0) ; "RTN","LRJSML3",198,0) ;Array params sent & received (LRPARAM) "RTN","LRJSML3",199,0) ; XN - CURRENT HL extract data "RTN","LRJSML3",200,0) ; LEGEND: "RTN","LRJSML3",201,0) ; CURRENT^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date "RTN","LRJSML3",202,0) ; ^Reactivation Date^Accessed by^Chng Date/Time "RTN","LRJSML3",203,0) ; "RTN","LRJSML3",204,0) ; CURRENT^ROOM^Hosp Loc Name^Type^Inst^Div^Room "RTN","LRJSML3",205,0) ; CURRENT^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed "RTN","LRJSML3",206,0) ; "RTN","LRJSML3",207,0) ; XP - PREVIOUS HL extract data "RTN","LRJSML3",208,0) ; LEGEND: "RTN","LRJSML3",209,0) ; PREVIOUS^LOCATION^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date "RTN","LRJSML3",210,0) ; ^Reactivation Date^Accessed by^Chng Date/Time "RTN","LRJSML3",211,0) ; "RTN","LRJSML3",212,0) ; PREVIOUS^ROOM^Hosp Loc Name^Type^Inst^Div^Room "RTN","LRJSML3",213,0) ; PREVIOUS^BED^Hosp Loc Name^Type^Inst^Div^Room^Bed "RTN","LRJSML3",214,0) ; "RTN","LRJSML3",215,0) ; LRCLOC - Cur Hosp Loc info "RTN","LRJSML3",216,0) ; LRCRM - Cur Hosp Loc Room info "RTN","LRJSML3",217,0) ; LRCBED - Cur Hosp Loc Bed info "RTN","LRJSML3",218,0) ; LRPLOC - Prev Hosp Loc info "RTN","LRJSML3",219,0) ; LRPRM - Prev Hosp Loc Room info "RTN","LRJSML3",220,0) ; LRPBED - Prev Hosp Loc Bed info "RTN","LRJSML3",221,0) ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed "RTN","LRJSML3",222,0) ; LRNEWLOC- Value 1 = the location not printed "RTN","LRJSML3",223,0) ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change) "RTN","LRJSML3",224,0) ; "RTN","LRJSML3",225,0) ; "RTN","LRJSML3",226,0) N LRDTTYP,LRVALST,LRNEWLOC,LRINIT "RTN","LRJSML3",227,0) N LRXC,LRXP,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE,LRCHGARY "RTN","LRJSML3",228,0) N LRLOCVAR,LRSUB,LPCNT,LRROOT "RTN","LRJSML3",229,0) ; "RTN","LRJSML3",230,0) S:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSML3",231,0) S:$G(LROUTPT)="" LROUTPT="DISPLAY" "RTN","LRJSML3",232,0) ; "RTN","LRJSML3",233,0) ;Put Array params in local vars "RTN","LRJSML3",234,0) S LRXC=LRPARAM("XN") "RTN","LRJSML3",235,0) S LRXP=LRPARAM("XP") "RTN","LRJSML3",236,0) ; "RTN","LRJSML3",237,0) S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT" "RTN","LRJSML3",238,0) S LRROOT="LRPARAM" "RTN","LRJSML3",239,0) F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB) "RTN","LRJSML3",240,0) ; "RTN","LRJSML3",241,0) S LRDTTYP=$P(LRXC,"^",2) ;Data node type (LOCATION, ROOM or BED) "RTN","LRJSML3",242,0) ; "RTN","LRJSML3",243,0) I LRDTTYP="LOCATION" DO "RTN","LRJSML3",244,0) .I LRCLOC'="" DO "RTN","LRJSML3",245,0) ..; "RTN","LRJSML3",246,0) ..;Set array & Print "RTN","LRJSML3",247,0) ..S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT "RTN","LRJSML3",248,0) ..D SETEPARM(LRVALST,.LRCHGARY) "RTN","LRJSML3",249,0) ..S LRCHGARY("LRNEWLOC")=LRNEWLOC "RTN","LRJSML3",250,0) ..S LRCHGARY("LRCLOC")=LRCLOC "RTN","LRJSML3",251,0) ..S LRCHGARY("LRPLOC")=LRPLOC "RTN","LRJSML3",252,0) ..; "RTN","LRJSML3",253,0) ..D LRLOUT(.VALMCNT,.LRCHGARY,LROUTPT,.LRPARAM,.LRVALST,LRMMARY) "RTN","LRJSML3",254,0) ..; "RTN","LRJSML3",255,0) ..;Put Array params (LRCHGARY) in local vars "RTN","LRJSML3",256,0) ..S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE" "RTN","LRJSML3",257,0) ..S LRROOT="LRCHGARY" "RTN","LRJSML3",258,0) ..F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB) "RTN","LRJSML3",259,0) .; "RTN","LRJSML3",260,0) .S LRNEWLOC=1 "RTN","LRJSML3",261,0) .S (LRCRM,LRCBED,LRPRM,LRPBED)="" "RTN","LRJSML3",262,0) ; "RTN","LRJSML3",263,0) ;If Room node exists, next node is Bed "RTN","LRJSML3",264,0) I LRDTTYP="ROOM" DO "RTN","LRJSML3",265,0) .I LRCBED="" DO "RTN","LRJSML3",266,0) ..S LRCRM=$P(LRXC,"^",8) "RTN","LRJSML3",267,0) ..S LRPRM=$P(LRXP,"^",8) "RTN","LRJSML3",268,0) ; "RTN","LRJSML3",269,0) ;ROOM/BED info output on BED node "RTN","LRJSML3",270,0) I LRDTTYP="BED" DO "RTN","LRJSML3",271,0) .S LRCRM=$P(LRXC,"^",8) "RTN","LRJSML3",272,0) .S LRPRM=$P(LRXP,"^",8) "RTN","LRJSML3",273,0) .S LRCBED=$P(LRXC,"^",9) "RTN","LRJSML3",274,0) .S LRPBED=$P(LRXP,"^",9) "RTN","LRJSML3",275,0) .; "RTN","LRJSML3",276,0) .;Set array & Print "RTN","LRJSML3",277,0) .S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT "RTN","LRJSML3",278,0) .D SETEPARM(LRVALST,.LRCHGARY) "RTN","LRJSML3",279,0) .S LRCHGARY("LRNEWLOC")=LRNEWLOC "RTN","LRJSML3",280,0) .S LRCHGARY("LRCLOC")=LRCLOC "RTN","LRJSML3",281,0) .S LRCHGARY("LRPLOC")=LRPLOC "RTN","LRJSML3",282,0) .; "RTN","LRJSML3",283,0) .D LRRBOUT(.VALMCNT,.LRCHGARY,LROUTPT,.LRPARAM,.LRVALST,LRMMARY) "RTN","LRJSML3",284,0) .; "RTN","LRJSML3",285,0) .;Put Array params (LRCHGARY) in local vars "RTN","LRJSML3",286,0) .S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE" "RTN","LRJSML3",287,0) .S LRROOT="LRCHGARY" "RTN","LRJSML3",288,0) .F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB) "RTN","LRJSML3",289,0) ; "RTN","LRJSML3",290,0) ;Reset Array param "RTN","LRJSML3",291,0) S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT "RTN","LRJSML3",292,0) D SETEPARM(LRVALST,.LRPARAM) "RTN","LRJSML3",293,0) S LRPARAM("LRCLOC")=LRCLOC "RTN","LRJSML3",294,0) S LRPARAM("LRPLOC")=LRPLOC "RTN","LRJSML3",295,0) S LRPARAM("LRNEWLOC")=LRNEWLOC "RTN","LRJSML3",296,0) Q "RTN","LRJSML3",297,0) ; "RTN","LRJSML3",298,0) LRLOUT(VALMCNT,LRCHGARY,LROUTPT,LRPARAM,LRVALST,LRMMARY) ; Output Loc "RTN","LRJSML3",299,0) ;INPUT: "RTN","LRJSML3",300,0) ; VALMCNT - Cur Line number of output array "RTN","LRJSML3",301,0) ; LRCHGARY- Array of param passed by ref "RTN","LRJSML3",302,0) ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail message "RTN","LRJSML3",303,0) ; LRPARAM - Array with parameters passed "RTN","LRJSML3",304,0) ; LRVALST - Carat delimited list of location data "RTN","LRJSML3",305,0) ; LRMMARY - Mail message output array (Optional) "RTN","LRJSML3",306,0) ; "RTN","LRJSML3",307,0) ;Array Parameters sent and received (LRCHGARY) "RTN","LRJSML3",308,0) ; LRCLOC - CURRENT HL extract data "RTN","LRJSML3",309,0) ; LRPLOC - PREVIOUS Hosp Loc Data "RTN","LRJSML3",310,0) ; LEGEND (LRCLOC & LRPLOC): "RTN","LRJSML3",311,0) ; ^^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date "RTN","LRJSML3",312,0) ; ^Reactivation Date^Accessed by^Chng Date/Time "RTN","LRJSML3",313,0) ; "RTN","LRJSML3",314,0) ; LRCRM - Cur Hosp Loc Room Info "RTN","LRJSML3",315,0) ; LRCBED - Cur Hosp Loc Bed Info "RTN","LRJSML3",316,0) ; LRPRM - Prev Hosp Loc Room Info "RTN","LRJSML3",317,0) ; LRPBED - Prev Hosp Loc Bed Info "RTN","LRJSML3",318,0) ; LRFSTLNE- Value 1 - 1st line printed, 0 - 1st line hasn't printed "RTN","LRJSML3",319,0) ; LRNEWLOC- Value 1 = the location has not been printed "RTN","LRJSML3",320,0) ; LRINIT - Init extract ; Change extract (1: Init; 0: Change) "RTN","LRJSML3",321,0) ; "RTN","LRJSML3",322,0) N LAX,C,LRIEN,LRNNAME,LRTYPE,LRINST,LRDIV,LRINACT "RTN","LRJSML3",323,0) N LRONAME,LROTYPE,LROINST,LRODIV,LROINACT,LROREACT,LRODTOUT,LRNEWLOC "RTN","LRJSML3",324,0) N LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE,LRDTCG,LRUSR,LRINIT,LRREACT "RTN","LRJSML3",325,0) N LRLOCVAR,LRSUB,LPCNT,LRROOT "RTN","LRJSML3",326,0) ; "RTN","LRJSML3",327,0) ;Put Array params (LRCHGARY) in local vars "RTN","LRJSML3",328,0) S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT" "RTN","LRJSML3",329,0) S LRROOT="LRCHGARY" "RTN","LRJSML3",330,0) F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB) "RTN","LRJSML3",331,0) ; "RTN","LRJSML3",332,0) S C="" ;-- Continue char "RTN","LRJSML3",333,0) D:+LRFSTLNE>0 LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",334,0) D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",335,0) D LRADDNOD(.VALMCNT," CHANGE DETAIL (CURRENT) CHANGE DETAIL (PREVIOUS)","",LROUTPT,LRMMARY) "RTN","LRJSML3",336,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,8,$LENGTH("CHANGE DETAIL (CURRENT)"),IOUON,IOUOFF_IOINORM) "RTN","LRJSML3",337,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,46,$LENGTH("CHANGE DETAIL (PREVIOUS)"),IOUON,IOUOFF_IOINORM) "RTN","LRJSML3",338,0) ; "RTN","LRJSML3",339,0) ;Set new Current values passed in LRCHGARY("LRCLOC") "RTN","LRJSML3",340,0) S LRIEN=$P(LRCLOC,"^",3) "RTN","LRJSML3",341,0) S LRNNAME=$P(LRCLOC,"^",4) "RTN","LRJSML3",342,0) S LRTYPE=$P(LRCLOC,"^",5) "RTN","LRJSML3",343,0) S LRINST=$P(LRCLOC,"^",6) "RTN","LRJSML3",344,0) S LRDIV=$P(LRCLOC,"^",7) "RTN","LRJSML3",345,0) S LRINACT=$P(LRCLOC,"^",8) "RTN","LRJSML3",346,0) S LRREACT=$P(LRCLOC,"^",9) "RTN","LRJSML3",347,0) S LRUSR=$P(LRCLOC,"^",10) "RTN","LRJSML3",348,0) S LRDTCG=$P(LRCLOC,"^",11) "RTN","LRJSML3",349,0) ; "RTN","LRJSML3",350,0) ;Set Previous values passed in LRCHGARY("LRPLOC") "RTN","LRJSML3",351,0) S LRONAME=$P(LRPLOC,"^",4) "RTN","LRJSML3",352,0) S LROTYPE=$P(LRPLOC,"^",5) "RTN","LRJSML3",353,0) S LROINST=$P(LRPLOC,"^",6) "RTN","LRJSML3",354,0) S LRODIV=$P(LRPLOC,"^",7) "RTN","LRJSML3",355,0) S LROINACT=$P(LRPLOC,"^",8) "RTN","LRJSML3",356,0) S LROREACT=$P(LRPLOC,"^",9) "RTN","LRJSML3",357,0) ; "RTN","LRJSML3",358,0) S LAX=" IEN: "_LRIEN "RTN","LRJSML3",359,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",360,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,4,IOINHI,IOINORM) "RTN","LRJSML3",361,0) ; "RTN","LRJSML3",362,0) S LAX=" NAME: "_LRNNAME "RTN","LRJSML3",363,0) D LRADDNOD(.VALMCNT,LAX,LRONAME,LROUTPT,LRMMARY) "RTN","LRJSML3",364,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",365,0) ; "RTN","LRJSML3",366,0) S LAX=" TYPE: "_LRTYPE "RTN","LRJSML3",367,0) D LRADDNOD(.VALMCNT,LAX,LROTYPE,LROUTPT,LRMMARY) "RTN","LRJSML3",368,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",369,0) ; "RTN","LRJSML3",370,0) S LAX=" INST: "_LRINST "RTN","LRJSML3",371,0) D LRADDNOD(.VALMCNT,LAX,LROINST,LROUTPT,LRMMARY) "RTN","LRJSML3",372,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",373,0) ; "RTN","LRJSML3",374,0) S LAX=" DIV: "_LRDIV "RTN","LRJSML3",375,0) D LRADDNOD(.VALMCNT,LAX,LRODIV,LROUTPT,LRMMARY) "RTN","LRJSML3",376,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,3,5,IOINHI,IOINORM) "RTN","LRJSML3",377,0) ; "RTN","LRJSML3",378,0) S LAX="INACT: "_$$FMTE^XLFDT(LRINACT) "RTN","LRJSML3",379,0) S LRODTOUT=$$FMTE^XLFDT(LROINACT) "RTN","LRJSML3",380,0) D LRADDNOD(.VALMCNT,LAX,LRODTOUT,LROUTPT,LRMMARY) "RTN","LRJSML3",381,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM) "RTN","LRJSML3",382,0) ; "RTN","LRJSML3",383,0) S LAX=" ACT: "_$$FMTE^XLFDT(LRREACT) "RTN","LRJSML3",384,0) S LRODTOUT=$$FMTE^XLFDT(LROREACT) "RTN","LRJSML3",385,0) D LRADDNOD(.VALMCNT,LAX,LRODTOUT,LROUTPT,LRMMARY) "RTN","LRJSML3",386,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,1,6,IOINHI,IOINORM) "RTN","LRJSML3",387,0) ; "RTN","LRJSML3",388,0) ;Output edit info "RTN","LRJSML3",389,0) S:LRINIT LAX=" " "RTN","LRJSML3",390,0) S:'LRINIT LAX=" CHANGED BY: "_LRUSR "RTN","LRJSML3",391,0) D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",392,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,10,11,IOINHI,IOINORM) "RTN","LRJSML3",393,0) ; "RTN","LRJSML3",394,0) IF 'LRINIT DO "RTN","LRJSML3",395,0) .S LAX=" DATE/TIME OF CHANGE: "_$$FMTE^XLFDT(LRDTCG) "RTN","LRJSML3",396,0) .D LRADDNOD(.VALMCNT,LAX,"",LROUTPT,LRMMARY) "RTN","LRJSML3",397,0) .D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,20,IOINHI,IOINORM) "RTN","LRJSML3",398,0) ; "RTN","LRJSML3",399,0) D LRADDNOD(.VALMCNT,"","",LROUTPT,LRMMARY) "RTN","LRJSML3",400,0) S LRNEWLOC=0 "RTN","LRJSML3",401,0) ; "RTN","LRJSML3",402,0) ;Reset Parameter Array "RTN","LRJSML3",403,0) S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT "RTN","LRJSML3",404,0) D SETEPARM(LRVALST,.LRPARAM) "RTN","LRJSML3",405,0) S LRPARAM("LRCLOC")=LRCLOC "RTN","LRJSML3",406,0) S LRPARAM("LRPLOC")=LRPLOC "RTN","LRJSML3",407,0) Q "RTN","LRJSML3",408,0) ; "RTN","LRJSML3",409,0) LRRBOUT(VALMCNT,LRCHGARY,LROUTPT,LRPARAM,LRVALST,LRMMARY) ;Output Room/Bed "RTN","LRJSML3",410,0) ;INPUT: "RTN","LRJSML3",411,0) ; VALMCNT - Cur Line number of output array "RTN","LRJSML3",412,0) ; LRCHGARY- Array of parameters passed by reference "RTN","LRJSML3",413,0) ; LROUTPT - "DISPLAY" : Listman; "MAIL" : Mail Message "RTN","LRJSML3",414,0) ; LRPARAM - Array with parameters passed "RTN","LRJSML3",415,0) ; LRVALST - Carat delimited list of location data "RTN","LRJSML3",416,0) ; LRMMARY - Mail message output array (Optional) "RTN","LRJSML3",417,0) ; "RTN","LRJSML3",418,0) ;Array Params (LRCHGARY) sent and received "RTN","LRJSML3",419,0) ; LRCLOC - CURRENT HL extract data "RTN","LRJSML3",420,0) ; LRPLOC - PREVIOUS Hosp Loc data "RTN","LRJSML3",421,0) ; LEGEND (LRCLOC & LRPLOC): "RTN","LRJSML3",422,0) ; ^^IEN^Hosp Loc Name^Type^Inst^Div^Inactivation Date "RTN","LRJSML3",423,0) ; ^Reactivation Date^Accessed by^Chng Date/Time "RTN","LRJSML3",424,0) ; "RTN","LRJSML3",425,0) ; LRCRM - Cur Hosp Loc Room Info "RTN","LRJSML3",426,0) ; LRCBED - Cur Hosp Loc Bed Info "RTN","LRJSML3",427,0) ; LRPRM - Prev Hosp Loc Room Info "RTN","LRJSML3",428,0) ; LRPBED - Prev Hosp Loc Bed Info "RTN","LRJSML3",429,0) ; LRFSTLNE- Value 1 = 1st line printed, 0 = 1st line hasn't printed "RTN","LRJSML3",430,0) ; LRNEWLOC- Value 1 = the location has not been printed "RTN","LRJSML3",431,0) ; LRINIT - Init extract or Change extract (1: Initialization; 0: Change) "RTN","LRJSML3",432,0) ; "RTN","LRJSML3",433,0) N LAX,C,LRNEWLOC,LRINIT "RTN","LRJSML3",434,0) N LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED,LRFSTLNE "RTN","LRJSML3",435,0) N LRLOCVAR,LRSUB,LPCNT,LRROOT "RTN","LRJSML3",436,0) ; "RTN","LRJSML3",437,0) ;Put Array params (LRCHGARY) in local vars "RTN","LRJSML3",438,0) S LRLOCVAR="LRCLOC^LRCRM^LRCBED^LRPLOC^LRPRM^LRPBED^LRFSTLNE^LRNEWLOC^LRINIT" "RTN","LRJSML3",439,0) S LRROOT="LRCHGARY" "RTN","LRJSML3",440,0) F LPCNT=1:1 S LRSUB=$P(LRLOCVAR,"^",LPCNT) Q:LRSUB="" S @LRSUB=@LRROOT@(LRSUB) "RTN","LRJSML3",441,0) ; "RTN","LRJSML3",442,0) S C="" ;-- Continue char "RTN","LRJSML3",443,0) ;Output Room/Bed changes "RTN","LRJSML3",444,0) S LAX=" ROOM: "_LRCRM "RTN","LRJSML3",445,0) D LRADDNOD(.VALMCNT,LAX,LRPRM,LROUTPT,LRMMARY) "RTN","LRJSML3",446,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",447,0) ; "RTN","LRJSML3",448,0) S LAX=" BEDS: "_LRCBED "RTN","LRJSML3",449,0) D LRADDNOD(.VALMCNT,LAX,LRPBED,LROUTPT,LRMMARY) "RTN","LRJSML3",450,0) D:LROUTPT="DISPLAY" CNTRL^VALM10(VALMCNT,2,5,IOINHI,IOINORM) "RTN","LRJSML3",451,0) D:LROUTPT="MAIL" LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",452,0) ; "RTN","LRJSML3",453,0) I LRINIT D LRADDNOD(.VALMCNT," ","",LROUTPT,LRMMARY) "RTN","LRJSML3",454,0) ; "RTN","LRJSML3",455,0) ;Reset Parameter Array "RTN","LRJSML3",456,0) S (LRCBED,LRPBED)="" "RTN","LRJSML3",457,0) S LRFSTLNE=1 "RTN","LRJSML3",458,0) ; "RTN","LRJSML3",459,0) S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRINIT "RTN","LRJSML3",460,0) D SETEPARM(LRVALST,.LRPARAM) "RTN","LRJSML3",461,0) S LRPARAM("LRCLOC")=LRCLOC "RTN","LRJSML3",462,0) S LRPARAM("LRPLOC")=LRPLOC "RTN","LRJSML3",463,0) Q "RTN","LRJSML3",464,0) ; "RTN","LRJSML3",465,0) LRADDNOD(LRNODECT,LRCUR,LRPREV,LROUTPT,LRMMARY) ;Include Prev value in string, add to mail array "RTN","LRJSML3",466,0) ; INPUT: "RTN","LRJSML3",467,0) ; LRNODECT - Node number "RTN","LRJSML3",468,0) ; LRCUR - Cur entry display "RTN","LRJSML3",469,0) ; LRPREV - Prev entry display "RTN","LRJSML3",470,0) ; LROUTPT - Type of array to populate (Display or Mail) "RTN","LRJSML3",471,0) ; LRMMARY - Array of output for Mail messages "RTN","LRJSML3",472,0) ; "RTN","LRJSML3",473,0) ; OUTPUT: "RTN","LRJSML3",474,0) ; Display array "RTN","LRJSML3",475,0) ; "RTN","LRJSML3",476,0) N LRLGTH "RTN","LRJSML3",477,0) S:$G(LRPREV)="" LRPREV="" "RTN","LRJSML3",478,0) S:$G(LROUTPT)="" LROUTPT="DISPLAY" "RTN","LRJSML3",479,0) S:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSML3",480,0) S LRLGTH=$L(LRCUR) "RTN","LRJSML3",481,0) S LRCUR=LRCUR_$J(LRPREV,3+$L(LRPREV)+(42-LRLGTH)) "RTN","LRJSML3",482,0) D:LROUTPT="DISPLAY" ADD^LRJSMLU(.LRNODECT,LRCUR) "RTN","LRJSML3",483,0) D:LROUTPT="MAIL" LRADDLNE(.LRNODECT,LRCUR,LRMMARY) "RTN","LRJSML3",484,0) Q "RTN","LRJSML3",485,0) ; "RTN","LRJSML3",486,0) LRADDLNE(LRNODECT,MSG,LRMMARY) ; -- add line to build display "RTN","LRJSML3",487,0) ;INPUT: "RTN","LRJSML3",488,0) ; LRNODECT - Node number "RTN","LRJSML3",489,0) ; MSG - Text to mail "RTN","LRJSML3",490,0) ; LRMMARY - Array for MailMan call "RTN","LRJSML3",491,0) ; "RTN","LRJSML3",492,0) ;OUTPUT: "RTN","LRJSML3",493,0) ; Array for Mail message "RTN","LRJSML3",494,0) ; "RTN","LRJSML3",495,0) S LRNODECT=LRNODECT+1 "RTN","LRJSML3",496,0) S @LRMMARY@(LRNODECT)=MSG "RTN","LRJSML3",497,0) Q "RTN","LRJSML4") 0^19^B58662393^n/a "RTN","LRJSML4",1,0) LRJSML4 ;ALB/GTS - Lab Vista Hospital Location Pre-Patch Utilities;02/24/2010 14:01:37 "RTN","LRJSML4",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML4",3,0) ; "RTN","LRJSML4",4,0) ; "RTN","LRJSML4",5,0) EXTHL(LRES) ;** Create HL output array "RTN","LRJSML4",6,0) ;Create array of active Hospital Locations of type Clinic, Ward, Operating Room "RTN","LRJSML4",7,0) ;Add associated Ward Location to the array "RTN","LRJSML4",8,0) ;Find Room-Beds assocated with the Ward Location "RTN","LRJSML4",9,0) ; "RTN","LRJSML4",10,0) ;INPUT: "RTN","LRJSML4",11,0) ; LRES - Node for array of active locations and room-beds "RTN","LRJSML4",12,0) ; "RTN","LRJSML4",13,0) ;OUTPUT: "RTN","LRJSML4",14,0) ; LRES - List Array of active hospital locations (Clinic, Ward, OR) "RTN","LRJSML4",15,0) ; "RTN","LRJSML4",16,0) ;Set LRES array in the following format: "RTN","LRJSML4",17,0) ;^TMP(545954627,"LRJ SYS",#)=NEW^LOCATION^HL IEN^HL Name^HL Type^Institution^Division^InActive Dt (NULL)^Active Dt(NULL)^Person making change^Chnge Dt/Tm "RTN","LRJSML4",18,0) ;^TMP(545954627,"LRJ SYS",#+1)=NEW^ROOM^HL IEN^HL Name^HL Type^Institution^Division^Room^ "RTN","LRJSML4",19,0) ;^TMP(545954627,"LRJ SYS",#+2)=NEW^BED^HL IEN^HL Name^HL Type^Institution^Division^Room^Bed "RTN","LRJSML4",20,0) ;^TMP(545954627,"LRJ SYS",#+3)=NEW^BED^HL IEN^HL Name^HL Type^Institution^Division^Room^Bed "RTN","LRJSML4",21,0) ; "RTN","LRJSML4",22,0) ;IA #10040 allows reference the following fields: "RTN","LRJSML4",23,0) ; Hospital Location #44, Field #.01 [NAME] (LRHLNAME) [FILEMAN] "RTN","LRJSML4",24,0) ; Hospital Location #44, Field #2 [TYPE] (LRHLTYPE) [FILEMAN] "RTN","LRJSML4",25,0) ; Hospital Location #44, Field #3 [INSTITUTION] (LRHLINST) [FILEMAN] "RTN","LRJSML4",26,0) ; Hospital Location #44, Field #3.5 [DIVISION] (LRHLDIV) [FILEMAN] "RTN","LRJSML4",27,0) ; Hospital Location #44, Field #42 [WARD LOCATION FILE POINTER] (LRWPTR) [DIRECT GLOBAL ACCESS] "RTN","LRJSML4",28,0) ; Hospital Location #44, Field #2505 [INACTIVE DATE] (LRINACT) [FILEMAN] "RTN","LRJSML4",29,0) ; Hospital Location #44, Field #2506 [REACTIVATION DATE] (LRREACT) [FILEMAN] "RTN","LRJSML4",30,0) ; "RTN","LRJSML4",31,0) ;IA #1380 allows reference to Room-Bed file: "RTN","LRJSML4",32,0) ; Room-Bed #405.4, Field #.01 [NAME] (LRRMBD) [DIRECT GLOBAL ACCESS] "RTN","LRJSML4",33,0) ; X-Ref on Wards Which Can Assign multiple in Room-Bed file (405.4^W) "RTN","LRJSML4",34,0) ; [^DG(405.4,"W",$E(X,1,30),DA(1),DA)] [DIRECT GLOBAL ACCESS] "RTN","LRJSML4",35,0) ; "RTN","LRJSML4",36,0) NEW LRHLIEN,LRTYPEIN,LRINACTI,LRREACTI,LRNODE,LRNOW "RTN","LRJSML4",37,0) NEW LRLP,LRCHAR "RTN","LRJSML4",38,0) ;Loop HL file screening TYPE and INACTIVE/REACTIVATION dates "RTN","LRJSML4",39,0) ;QUESTION: Does the HLCMS system report items that are not inactive but have future dates? "RTN","LRJSML4",40,0) ;ANSWER: HLCMS reports changes to inactive/active dates. "RTN","LRJSML4",41,0) ; Want to report locations that are now active or will become active in the future. "RTN","LRJSML4",42,0) ; If INACT=NULL then report "RTN","LRJSML4",43,0) ; If INACT'=NULL then... "RTN","LRJSML4",44,0) ; IF ACT>NOW then report [If (INACTNOW)!(INACT>NOW,ACT>NOW)] "RTN","LRJSML4",45,0) ; If INACT>NOW,ACTINACT then report "RTN","LRJSML4",47,0) ; "RTN","LRJSML4",48,0) ;Pull Name, Type, Institution, Division, WL PTR, Inactivation Date, ReActivation Date from file 44 "RTN","LRJSML4",49,0) ;Find Room-Beds that have the same WL PTR, check for OOS dates and report if in-service. "RTN","LRJSML4",50,0) DO IOXY^XGF(IOSL-1,53) "RTN","LRJSML4",51,0) WRITE "[Extract Locations..." "RTN","LRJSML4",52,0) SET LRHLIEN="" "RTN","LRJSML4",53,0) SET (LRHLIEN,LRNODE,LRCHAR)=0 "RTN","LRJSML4",54,0) D NOW^%DTC "RTN","LRJSML4",55,0) SET LRNOW=% "RTN","LRJSML4",56,0) KILL %,%H,%I,X "RTN","LRJSML4",57,0) FOR SET LRHLIEN=$O(^SC(LRHLIEN)) QUIT:+LRHLIEN'>0 DO "RTN","LRJSML4",58,0) .D HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSML4",59,0) .SET (LRTYPEIN,LRINACTI,LRREACTI)="" "RTN","LRJSML4",60,0) .SET LRTYPEIN=$$GET1^DIQ(44,LRHLIEN_",",2,"I") ;HL Type (INT) "RTN","LRJSML4",61,0) .; "RTN","LRJSML4",62,0) .;IF TYPE IS 'CLINIC', 'WARD', 'OPERATING ROOM' "RTN","LRJSML4",63,0) .IF (LRTYPEIN="C")!(LRTYPEIN="W")!(LRTYPEIN="OR") DO "RTN","LRJSML4",64,0) ..SET LRINACTI=$$GET1^DIQ(44,LRHLIEN_",",2505,"I") ;HL Inact Dte (INT) "RTN","LRJSML4",65,0) ..SET LRREACTI=$$GET1^DIQ(44,LRHLIEN_",",2506,"I") ;HL React Dte (INT) "RTN","LRJSML4",66,0) ..IF LRINACTI="" DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW) "RTN","LRJSML4",67,0) ..IF LRINACTI'="" DO "RTN","LRJSML4",68,0) ...IF LRREACTI>LRNOW DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW) "RTN","LRJSML4",69,0) ...IF LRINACTI>LRNOW,LRREACTILRINACTI DO SETARRY(.LRES,.LRNODE,LRHLIEN,LRNOW) "RTN","LRJSML4",71,0) QUIT "RTN","LRJSML4",72,0) ; "RTN","LRJSML4",73,0) SETARRY(LRES,LRNODE,LRHLIEN,LRNOW) ;Set Location Array "RTN","LRJSML4",74,0) ;INPUT: "RTN","LRJSML4",75,0) ; LRES - Array to create and return "RTN","LRJSML4",76,0) ; LRNODE - Last node # added to array "RTN","LRJSML4",77,0) ; LRHLIEN - Hospital Location (#44) IEN "RTN","LRJSML4",78,0) ; LRNOW - Date/Time creating array "RTN","LRJSML4",79,0) ; "RTN","LRJSML4",80,0) ;OUTPUT: "RTN","LRJSML4",81,0) ; LRES - Array with Location/Room/Bed nodes added "RTN","LRJSML4",82,0) ; "RTN","LRJSML4",83,0) NEW LRHLNAME,LRHLTYPE,LRINST,LRDIV,LRRMBD,LRINACT,LRREACT,LRWPTR,LRRMBDPT,LRRMOLD,LRBED,LRROOM "RTN","LRJSML4",84,0) SET (LRHLNAME,LRHLTYPE,LRINST,LRDIV,LRRMBD,LRINACT,LRREACT,LRWPTR,LRRMBDPT,LRRMOLD)="" "RTN","LRJSML4",85,0) SET LRNODE=LRNODE+1 "RTN","LRJSML4",86,0) SET LRINACT=$$GET1^DIQ(44,LRHLIEN_",",2505) ;HL Inact Dte (EXT) "RTN","LRJSML4",87,0) SET LRREACT=$$GET1^DIQ(44,LRHLIEN_",",2506) ;HL React Dte (EXT) "RTN","LRJSML4",88,0) SET LRHLTYPE=$$GET1^DIQ(44,LRHLIEN_",",2) ;HL Type (EXT) "RTN","LRJSML4",89,0) SET LRHLNAME=$$GET1^DIQ(44,LRHLIEN_",",.01) ;HL Name (EXT) "RTN","LRJSML4",90,0) SET LRINST=$$GET1^DIQ(44,LRHLIEN_",",3) ;HL Inst (EXT) "RTN","LRJSML4",91,0) SET LRDIV=$$GET1^DIQ(44,LRHLIEN_",",3.5) ;HL Div (EXT) "RTN","LRJSML4",92,0) SET LRWPTR=+$P($G(^SC(LRHLIEN,42)),"^") ;Ward Loc PTR (EXT) "RTN","LRJSML4",93,0) SET @LRES@(LRNODE)="NEW^LOCATION^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRINACT_"^"_LRREACT_"^"_"ADT ADMINISTRATOR "_"^"_LRNOW "RTN","LRJSML4",94,0) FOR SET LRRMBDPT=$O(^DG(405.4,"W",LRWPTR,LRRMBDPT)) QUIT:+LRRMBDPT=0 DO "RTN","LRJSML4",95,0) .SET LRNODE=LRNODE+1 "RTN","LRJSML4",96,0) .SET LRRMBD=$P(^DG(405.4,LRRMBDPT,0),"^") "RTN","LRJSML4",97,0) .SET LRROOM=$P(LRRMBD,"-") "RTN","LRJSML4",98,0) .IF LRROOM'=LRRMOLD DO "RTN","LRJSML4",99,0) ..SET @LRES@(LRNODE)="NEW^ROOM^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRROOM_"^" "RTN","LRJSML4",100,0) ..SET LRRMOLD=LRROOM "RTN","LRJSML4",101,0) ..SET LRNODE=LRNODE+1 "RTN","LRJSML4",102,0) .SET LRBED=$P(LRRMBD,"-",2,10) "RTN","LRJSML4",103,0) .SET @LRES@(LRNODE)="NEW^BED^"_LRHLIEN_"^"_LRHLNAME_"^"_LRHLTYPE_"^"_LRINST_"^"_LRDIV_"^"_LRROOM_"^"_LRBED "RTN","LRJSML4",104,0) QUIT "RTN","LRJSML4",105,0) ; "RTN","LRJSML4",106,0) CDRNG ;Protocol: LRJ SYS MAP HL AUDIT QUERY to select the report type "RTN","LRJSML4",107,0) D FULL^VALM1 "RTN","LRJSML4",108,0) NEW LRTYPE "RTN","LRJSML4",109,0) SET LRTYPE=$$TYPESEL() "RTN","LRJSML4",110,0) ; "RTN","LRJSML4",111,0) ;Reset screen display "RTN","LRJSML4",112,0) IF LRTYPE'=-1 DO "RTN","LRJSML4",113,0) .DO:LRTYPE="C" INIT "RTN","LRJSML4",114,0) .DO:LRTYPE="I" INIT^LRJSML1 "RTN","LRJSML4",115,0) IF LRTYPE=-1 D MSG^LRJSML SET VALMBCK="R" "RTN","LRJSML4",116,0) QUIT "RTN","LRJSML4",117,0) ; "RTN","LRJSML4",118,0) INIT ;* init variables and list array "RTN","LRJSML4",119,0) N LRFROM,LRTO "RTN","LRJSML4",120,0) K ^TMP($J,"LRJ SYS"),^TMP("LRJ SYS USER MANAGER - DATES",$JOB) "RTN","LRJSML4",121,0) K ^TMP("LRJ SYS USER MANAGER - INIT",$JOB) "RTN","LRJSML4",122,0) DO IOXY^XGF(IOSL-1,53) "RTN","LRJSML4",123,0) WRITE "[Extract Locations..." "RTN","LRJSML4",124,0) D CREATRPT(.LRFROM,.LRTO,"^TMP($J,""LRJ SYS"")") "RTN","LRJSML4",125,0) I (+$G(LRFROM)'>0)!(+$G(LRTO)'>0) DO "RTN","LRJSML4",126,0) . S VALMBCK="R" "RTN","LRJSML4",127,0) . S VALMBG=1 "RTN","LRJSML4",128,0) I (+$G(LRFROM)>0),(+$G(LRTO)>0) DO "RTN","LRJSML4",129,0) . D CLEAR(LRFROM,LRTO,"^TMP($J,""LRJ SYS"")") "RTN","LRJSML4",130,0) . D HDR^LRJSML "RTN","LRJSML4",131,0) . D MSG^LRJSML "RTN","LRJSML4",132,0) QUIT "RTN","LRJSML4",133,0) ; "RTN","LRJSML4",134,0) CREATRPT(LRFROM,LRTO,LRHLARY) ;Create array of HL changes between selected dates "RTN","LRJSML4",135,0) N DIR "RTN","LRJSML4",136,0) ; "RTN","LRJSML4",137,0) W !!," Enter Hospital Location Extract Date Range...",! "RTN","LRJSML4",138,0) ; "RTN","LRJSML4",139,0) S LRFROM=$$DATEENT("Select Start date: ",,"-NOW") "RTN","LRJSML4",140,0) Q:+LRFROM<1 "RTN","LRJSML4",141,0) S LRTO=$$DATEENT(" Select End date: ",LRFROM,"-NOW") "RTN","LRJSML4",142,0) Q:+LRTO<1 "RTN","LRJSML4",143,0) SET ^TMP("LRJ SYS USER MANAGER - INIT",$JOB)=0 "RTN","LRJSML4",144,0) D HDR^LRJSML "RTN","LRJSML4",145,0) D MSG^LRJSML "RTN","LRJSML4",146,0) ; "RTN","LRJSML4",147,0) ;Call Report API "RTN","LRJSML4",148,0) D BLDREC^LRJSMLA(LRFROM,LRTO,LRHLARY) "RTN","LRJSML4",149,0) ; "RTN","LRJSML4",150,0) Q "RTN","LRJSML4",151,0) ; "RTN","LRJSML4",152,0) DATEENT(LRPRMPT,LRBD,LRED) ;Prompt for extract date "RTN","LRJSML4",153,0) ;INPUT "RTN","LRJSML4",154,0) ; LRPRMPT - Prompt displayed to user "RTN","LRJSML4",155,0) ; LRBD - Begin date of range "RTN","LRJSML4",156,0) ; LRED - End date of range "RTN","LRJSML4",157,0) ; "RTN","LRJSML4",158,0) ;RETURN "RTN","LRJSML4",159,0) ; LRDT "RTN","LRJSML4",160,0) ; SUCCESS: FILEMAN INTERNALLY FORMATED DATE "RTN","LRJSML4",161,0) ; FAILURE: -1 "RTN","LRJSML4",162,0) ; "RTN","LRJSML4",163,0) N LRDT,LRGOOD "RTN","LRJSML4",164,0) S LRGOOD=0 "RTN","LRJSML4",165,0) S:+$G(LRED)>0 %DT(0)=LRED "RTN","LRJSML4",166,0) S:$G(LRED)["NOW" %DT(0)=LRED "RTN","LRJSML4",167,0) S %DT("A")=LRPRMPT "RTN","LRJSML4",168,0) S %DT("B")="TODAY" ;Default for [Start] date entry "RTN","LRJSML4",169,0) S %DT="AEPST" "RTN","LRJSML4",170,0) D:LRPRMPT["Start" ^%DT ;Prompt for Start date "RTN","LRJSML4",171,0) ; "RTN","LRJSML4",172,0) ;Prompt for End date with conditions "RTN","LRJSML4",173,0) I LRPRMPT["End" DO "RTN","LRJSML4",174,0) . F Q:LRGOOD DO "RTN","LRJSML4",175,0) . . S %DT("B")="NOW" ;Change default for End Date entry "RTN","LRJSML4",176,0) . . D ^%DT "RTN","LRJSML4",177,0) . . W:((YLRBD)!(Y=LRBD)!($D(DTOUT))!(X="^")) LRGOOD=1 "RTN","LRJSML4",179,0) S LRDT=Y "RTN","LRJSML4",180,0) K Y,%DT "RTN","LRJSML4",181,0) Q LRDT "RTN","LRJSML4",182,0) ; "RTN","LRJSML4",183,0) CLEAR(LRFROM,LRTO,LRHLARY) ;* clean up entries "RTN","LRJSML4",184,0) DO REFRESH(LRFROM,LRTO,LRHLARY) "RTN","LRJSML4",185,0) QUIT "RTN","LRJSML4",186,0) ; "RTN","LRJSML4",187,0) REFRESH(LRFROM,LRTO,LRHLARY) ;* refresh display "RTN","LRJSML4",188,0) DO BUILD(LRFROM,LRTO,LRHLARY) "RTN","LRJSML4",189,0) D MSG^LRJSML "RTN","LRJSML4",190,0) SET VALMBCK="R" "RTN","LRJSML4",191,0) SET VALMBG=1 "RTN","LRJSML4",192,0) QUIT "RTN","LRJSML4",193,0) ; "RTN","LRJSML4",194,0) BUILD(LRFROM,LRTO,LRHLARY) ; -- build display array "RTN","LRJSML4",195,0) ; "RTN","LRJSML4",196,0) ;INPUT "RTN","LRJSML4",197,0) ; LRFROM - Start report date (Optional) "RTN","LRJSML4",198,0) ; LRTO - End report date (Optional) "RTN","LRJSML4",199,0) ; LRHLARY - Array of raw data extract (Required) "RTN","LRJSML4",200,0) ; "RTN","LRJSML4",201,0) QUIT:'$D(LRHLARY) ;QUIT if LRHLARY is not defined) "RTN","LRJSML4",202,0) ; "RTN","LRJSML4",203,0) NEW LRSTATUS,LRJERRCT,LRX "RTN","LRJSML4",204,0) DO KILL "RTN","LRJSML4",205,0) DO KILL^VALM10() "RTN","LRJSML4",206,0) SET VALMCNT=0 "RTN","LRJSML4",207,0) S LRX=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_LRFROM,1:"")_$S($D(LRTO):" to "_LRTO,1:"") "RTN","LRJSML4",208,0) D ADD^LRJSMLU(.VALMCNT,LRX) "RTN","LRJSML4",209,0) DO CNTRL^VALM10(VALMCNT,1,$LENGTH(LRX)-1,IOUON,IOUOFF_IOINORM) "RTN","LRJSML4",210,0) ; "RTN","LRJSML4",211,0) D KILL "RTN","LRJSML4",212,0) SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO "RTN","LRJSML4",213,0) D LISTHL^LRJSML(LRFROM,LRTO,LRHLARY) "RTN","LRJSML4",214,0) ; "RTN","LRJSML4",215,0) ;;D GETLINK^LRJSML1(.VALMCNT,$$GETLINK()) ;;If add function to send HL MFN message, see if can check link here. "RTN","LRJSML4",216,0) Q "RTN","LRJSML4",217,0) ; "RTN","LRJSML4",218,0) KILL ; -- kill off display data array "RTN","LRJSML4",219,0) KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML4",220,0) QUIT "RTN","LRJSML4",221,0) ; "RTN","LRJSML4",222,0) TYPESEL() ;Select type of report "RTN","LRJSML4",223,0) ;OUTPUT "RTN","LRJSML4",224,0) ; LRJRSLT : "I" - Initialization Extract "RTN","LRJSML4",225,0) ; : "C" - Change Audit Extract "RTN","LRJSML4",226,0) ; : "P" - Inactive Location Extract "RTN","LRJSML4",227,0) ; : -1 - Abort "RTN","LRJSML4",228,0) NEW LRJRSLT "RTN","LRJSML4",229,0) SET LRJRSLT=-1 "RTN","LRJSML4",230,0) NEW DIR "RTN","LRJSML4",231,0) SET DIR("A")=" Enter Extract Report Type" "RTN","LRJSML4",232,0) SET DIR(0)="SO^I:Initialization Rpt;C:Location Change Rpt" "RTN","LRJSML4",233,0) SET DIR("?")="^D PROHELP^LRJSML4" "RTN","LRJSML4",234,0) SET DIR("L",1)=" Select one of the following:" "RTN","LRJSML4",235,0) SET DIR("L",2)=" I : Initialization/Current Location Report" "RTN","LRJSML4",236,0) SET DIR("L")=" C : Location Change Report" "RTN","LRJSML4",237,0) DO ^DIR "RTN","LRJSML4",238,0) SET:"ICP"[Y LRJRSLT=Y "RTN","LRJSML4",239,0) SET:($D(DTOUT)!$D(DUOUT)!(Y="")) LRJRSLT=-1 "RTN","LRJSML4",240,0) SET:"ICP"'[Y LRJRSLT=-1 "RTN","LRJSML4",241,0) KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML4",242,0) QUIT LRJRSLT "RTN","LRJSML4",243,0) ; "RTN","LRJSML4",244,0) PROHELP ;Help with type of report prompt "RTN","LRJSML4",245,0) WRITE !,"Enter 'I' to extract all currently active locations." "RTN","LRJSML4",246,0) WRITE !,"Enter 'C' to extract the location changes for a selected date range." "RTN","LRJSML4",247,0) QUIT "RTN","LRJSML5") 0^11^B11779668^n/a "RTN","LRJSML5",1,0) LRJSML5 ;ALB/GTS - Lab Vista Hospital Location Pre-Patch Utilities;02/22/2010 14:51:41 "RTN","LRJSML5",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML5",3,0) ; "RTN","LRJSML5",4,0) ; "RTN","LRJSML5",5,0) INIT ;* init variables and list array "RTN","LRJSML5",6,0) ;Called from Protocol: LRJ SYS MAP HL SCHED AUDIT RPT DISP "RTN","LRJSML5",7,0) ; "RTN","LRJSML5",8,0) ; This API will show the HLCMS Audit Rpt Task schedule "RTN","LRJSML5",9,0) ; "RTN","LRJSML5",10,0) NEW LRFROM,LRTO "RTN","LRJSML5",11,0) SET (LRFROM,LRTO)="" "RTN","LRJSML5",12,0) DO GETDATE^LRJSML8(.LRFROM,.LRTO) "RTN","LRJSML5",13,0) D KILL "RTN","LRJSML5",14,0) IF (+LRFROM=0)!(+LRTO=0) DO "RTN","LRJSML5",15,0) .SET LRFROM=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^") "RTN","LRJSML5",16,0) .SET LRTO=$P($G(^TMP("LRJ SYS USER MANAGER - DATES",$JOB)),"^",2) "RTN","LRJSML5",17,0) SET ^TMP("LRJ SYS USER MANAGER - DATES",$JOB)=LRFROM_"^"_LRTO "RTN","LRJSML5",18,0) D CREATRPT "RTN","LRJSML5",19,0) D HDR "RTN","LRJSML5",20,0) D REFRESH "RTN","LRJSML5",21,0) QUIT "RTN","LRJSML5",22,0) ; "RTN","LRJSML5",23,0) REFRESH ;* refresh display "RTN","LRJSML5",24,0) D MSG^LRJSML "RTN","LRJSML5",25,0) SET VALMBCK="R" "RTN","LRJSML5",26,0) SET VALMBG=1 "RTN","LRJSML5",27,0) QUIT "RTN","LRJSML5",28,0) ; "RTN","LRJSML5",29,0) CREATRPT ;Create array of Hospital Location changes between selected dates "RTN","LRJSML5",30,0) N LRSCHED "RTN","LRJSML5",31,0) D OPTSTAT^XUTMOPT("LRJ SYS MAP HL TASKMAN RPT",.LRSCHED) "RTN","LRJSML5",32,0) D BLDREC(.LRSCHED) ;Create outarray "RTN","LRJSML5",33,0) Q "RTN","LRJSML5",34,0) ; "RTN","LRJSML5",35,0) BLDREC(LRSCHED) ;Build Listman Output for background task "RTN","LRJSML5",36,0) ; INPUT: "RTN","LRJSML5",37,0) ; LRSCHED : Schedule information about option "RTN","LRJSML5",38,0) ; format - "RTN","LRJSML5",39,0) ; task number^scheduled time^reschedule freq^special queuing flag "RTN","LRJSML5",40,0) ; "RTN","LRJSML5",41,0) NEW X,PCE,LROPTDAT "RTN","LRJSML5",42,0) DO KILL^VALM10() "RTN","LRJSML5",43,0) SET VALMCNT=0 "RTN","LRJSML5",44,0) SET X=" Hospital Location Audit task schedule" "RTN","LRJSML5",45,0) DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML5",46,0) DO CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM) "RTN","LRJSML5",47,0) D ADD^LRJSMLU(.VALMCNT," ") "RTN","LRJSML5",48,0) SET X=" OPTION: LRJ SYS MAP HL TASKMAN RPT" "RTN","LRJSML5",49,0) D ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML5",50,0) IF +$G(LRSCHED(1))=0 DO "RTN","LRJSML5",51,0) .SET X=" TASK ID: Not Scheduled" "RTN","LRJSML5",52,0) .DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML5",53,0) .SET X="QUEUED TO RUN AT WHAT TIME: Not Scheduled" "RTN","LRJSML5",54,0) .DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML5",55,0) .SET X=" RESCHEDULING FREQUENCY: Not Scheduled" "RTN","LRJSML5",56,0) .DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML5",57,0) ; "RTN","LRJSML5",58,0) IF +$G(LRSCHED(1))'=0 DO "RTN","LRJSML5",59,0) .SET PCE=0 "RTN","LRJSML5",60,0) .FOR PCE=1:1:3 SET LROPTDAT=$P(LRSCHED(1),"^",PCE) DO "RTN","LRJSML5",61,0) ..SET:PCE=1 X=" TASK ID: "_$S(LROPTDAT'="":LROPTDAT,1:"Not Scheduled") "RTN","LRJSML5",62,0) ..IF PCE=2 DO "RTN","LRJSML5",63,0) ...NEW LROUTDT,Y "RTN","LRJSML5",64,0) ...SET Y=LROPTDAT "RTN","LRJSML5",65,0) ...DO DD^%DT "RTN","LRJSML5",66,0) ...SET LROUTDT=Y "RTN","LRJSML5",67,0) ...SET X="QUEUED TO RUN AT WHAT TIME: "_$S(LROUTDT'="":LROUTDT,1:"Not Scheduled") "RTN","LRJSML5",68,0) ..SET:PCE=3 X=" RESCHEDULING FREQUENCY: "_$S(LROPTDAT'="":LROPTDAT,1:"Not Scheduled") "RTN","LRJSML5",69,0) ..DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML5",70,0) D ADD^LRJSMLU(.VALMCNT," ") "RTN","LRJSML5",71,0) D ADD^LRJSMLU(.VALMCNT," ") "RTN","LRJSML5",72,0) D ADD^LRJSMLU(.VALMCNT," ") "RTN","LRJSML5",73,0) D ADD^LRJSMLU(.VALMCNT," ") "RTN","LRJSML5",74,0) SET LROPTDAT="" "RTN","LRJSML5",75,0) SET LROPTDAT=$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q") "RTN","LRJSML5",76,0) SET X="Hospital Location Audit Automated Reporting begin Date: "_$S(LROPTDAT'="":$$FMTE^XLFDT(LROPTDAT),1:"Not indicated") "RTN","LRJSML5",77,0) DO ADD^LRJSMLU(.VALMCNT,X) "RTN","LRJSML5",78,0) QUIT "RTN","LRJSML5",79,0) KILL ; -- kill off display data array "RTN","LRJSML5",80,0) KILL ^TMP("LRJ SYS MAP HL INIT MGR",$JOB) "RTN","LRJSML5",81,0) QUIT "RTN","LRJSML5",82,0) ; "RTN","LRJSML5",83,0) HDR ; -- header code "RTN","LRJSML5",84,0) SET VALMHDR(1)=" LAB Hospital Location Change Audit Task Option Schedule" "RTN","LRJSML5",85,0) SET VALMHDR(2)=" Version: "_$$VERNUM^LRJSMLU()_" Build: "_$$BLDNUM^LRJSMLU() "RTN","LRJSML5",86,0) Q "RTN","LRJSML6") 0^12^B72438950^n/a "RTN","LRJSML6",1,0) LRJSML6 ;ALB/GTS - Lab Vista Hospital Location Initialization;02/22/2010 14:37:07 "RTN","LRJSML6",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML6",3,0) ; "RTN","LRJSML6",4,0) ; "RTN","LRJSML6",5,0) SCHDBCKG ;Schedule the HL Change Audit Rpt "RTN","LRJSML6",6,0) ; "RTN","LRJSML6",7,0) ;Called from Protocol: LRJ SYS MAP HL SCHED AUDIT RPT TASK "RTN","LRJSML6",8,0) ; "RTN","LRJSML6",9,0) NEW LROK,LRSTDTM,LROPT,LRFREQ,LRPARMDT,LRSCHED "RTN","LRJSML6",10,0) D FULL^VALM1 "RTN","LRJSML6",11,0) SET LROK=1 "RTN","LRJSML6",12,0) WRITE !!,"This action will schedule the 'LRJ SYS MAP HL Change Management TaskMan Report'" "RTN","LRJSML6",13,0) WRITE !," option [LRJ SYS MAP HL TASKMAN RPT] as a background task.",! "RTN","LRJSML6",14,0) ; "RTN","LRJSML6",15,0) IF +$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q")>0 SET LROK=1 ;* IA #2263 "RTN","LRJSML6",16,0) IF +$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q")'>0 SET LROK=0 "RTN","LRJSML6",17,0) ; "RTN","LRJSML6",18,0) IF 'LROK DO "RTN","LRJSML6",19,0) .SET DIR("A",1)="" "RTN","LRJSML6",20,0) .SET DIR("A",2)="Hospital Location configuration has not been accepted!! Check configuration." "RTN","LRJSML6",21,0) .SET DIR("A",3)="" "RTN","LRJSML6",22,0) .SET DIR("A",4)="When Hospital Locations on legacy VistA match those on COTS," "RTN","LRJSML6",23,0) .SET DIR("A",5)=" execute the 'Accept/edit current HL config dates' action and then" "RTN","LRJSML6",24,0) .SET DIR("A",6)=" schedule the background task via this action." "RTN","LRJSML6",25,0) .SET DIR("A",7)="" "RTN","LRJSML6",26,0) .SET DIR("A")="Press RETURN to redisplay Lab Hospital Location Tools..." "RTN","LRJSML6",27,0) .SET DIR(0)="E" "RTN","LRJSML6",28,0) .DO ^DIR "RTN","LRJSML6",29,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",30,0) ; "RTN","LRJSML6",31,0) ;If End Date defined, Prompt to set Background job "RTN","LRJSML6",32,0) IF LROK DO "RTN","LRJSML6",33,0) .WRITE ! "RTN","LRJSML6",34,0) .SET DIR(0)="Y" "RTN","LRJSML6",35,0) .SET DIR("A")="Do you want to do this" "RTN","LRJSML6",36,0) .SET DIR("B")="NO" "RTN","LRJSML6",37,0) .SET DIR("?",1)="Define the TaskMan schedule for running the 'LRJ SYS MAP HL TASKMAN RPT' option." "RTN","LRJSML6",38,0) .SET DIR("?",2)="This option will report changes to hospital locations since the last time the" "RTN","LRJSML6",39,0) .SET DIR("?")="report was generated [current value of LRJ HL LAST END DATE]." "RTN","LRJSML6",40,0) .DO ^DIR "RTN","LRJSML6",41,0) .SET LROK=+Y "RTN","LRJSML6",42,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",43,0) ; "RTN","LRJSML6",44,0) ;Prompt for start time "RTN","LRJSML6",45,0) IF LROK DO "RTN","LRJSML6",46,0) .NEW STRESULT,LRDEFSD "RTN","LRJSML6",47,0) .DO OPTSTAT^XUTMOPT("LRJ SYS MAP HL TASKMAN RPT",.LRSCHED) "RTN","LRJSML6",48,0) .SET LRDEFSD=$P($G(LRSCHED(1)),"^",2) "RTN","LRJSML6",49,0) .SET LRDEFSD=$$FMTE^XLFDT(LRDEFSD) "RTN","LRJSML6",50,0) .SET STRESULT=$$STARTDTM^LRJSMLU(LRDEFSD) "RTN","LRJSML6",51,0) .SET LRSTDTM=$P(STRESULT,"^",2) "RTN","LRJSML6",52,0) .SET LROK=+STRESULT "RTN","LRJSML6",53,0) .IF LROK,LRSTDTM="" SET LRSTDTM=$P(STRESULT,"^",3) "RTN","LRJSML6",54,0) ; "RTN","LRJSML6",55,0) IF LROK,LRSTDTM="@" DO "RTN","LRJSML6",56,0) .NEW LRERR,LRDELTSK "RTN","LRJSML6",57,0) .SET DIR(0)="Y" "RTN","LRJSML6",58,0) .SET DIR("A")="Are you sure you want to delete the background task" "RTN","LRJSML6",59,0) .SET DIR("B")="NO" "RTN","LRJSML6",60,0) .SET DIR("?")="You are about to de-schedule the LRJ SYS MAP HL Change Management Task" "RTN","LRJSML6",61,0) .DO ^DIR "RTN","LRJSML6",62,0) .SET LRDELTSK=+Y "RTN","LRJSML6",63,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",64,0) .DO:LRDELTSK RESCH^XUTMOPT("LRJ SYS MAP HL TASKMAN RPT","@","","@","L",.LRERR) "RTN","LRJSML6",65,0) .IF +$G(LRERR)<0 DO "RTN","LRJSML6",66,0) ..SET DIR("A",1)="LRJ SYS MAP HL TASKMAN RPT option not found!!" "RTN","LRJSML6",67,0) ..SET DIR("A",2)="Check Installation before running this option again." "RTN","LRJSML6",68,0) ..SET DIR(0)="E" "RTN","LRJSML6",69,0) ..DO ^DIR "RTN","LRJSML6",70,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",71,0) .SET LROK=0 "RTN","LRJSML6",72,0) ; "RTN","LRJSML6",73,0) ;Prompt for frequency when task is scheduled "RTN","LRJSML6",74,0) IF LROK DO "RTN","LRJSML6",75,0) .NEW LRDEFFRQ "RTN","LRJSML6",76,0) .SET LRDEFFRQ=$P($G(LRSCHED(1)),"^",3) "RTN","LRJSML6",77,0) .SET DIR(0)="FAr^^D BJITS^LRJSMLU" "RTN","LRJSML6",78,0) .SET DIR("A")="RESCHEDULING FREQUENCY: " "RTN","LRJSML6",79,0) .SET:$G(LRDEFFRQ)="" DIR("B")="1D" "RTN","LRJSML6",80,0) .SET:$G(LRDEFFRQ)'="" DIR("B")=LRDEFFRQ "RTN","LRJSML6",81,0) .SET DIR("?")="^D ITSHELP^LRJSMLU(X)" "RTN","LRJSML6",82,0) .DO ^DIR "RTN","LRJSML6",83,0) .SET LRFREQ=Y "RTN","LRJSML6",84,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",85,0) .IF $$ENTCHK(LRFREQ)>0 DO "RTN","LRJSML6",86,0) ..DO RESCH^XUTMOPT("LRJ SYS MAP HL TASKMAN RPT",LRSTDTM,"",LRFREQ,"L",.LRERR) "RTN","LRJSML6",87,0) ..SET LROK=0 "RTN","LRJSML6",88,0) ; "RTN","LRJSML6",89,0) ;Show updated task schedule "RTN","LRJSML6",90,0) DO INIT^LRJSML5 ;Sets VALMBCK & VALMBG "RTN","LRJSML6",91,0) QUIT "RTN","LRJSML6",92,0) ; "RTN","LRJSML6",93,0) TSKERMSG(LRMMARY) ; Send message when Task job runs before HL config accepted "RTN","LRJSML6",94,0) NEW LRPARAM,LRLNCNT,LRMSUBJ,XQSND "RTN","LRJSML6",95,0) SET:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSML6",96,0) SET LRLNCNT=0 "RTN","LRJSML6",97,0) SET X=" VistA LRJ SYS MAP HL TASKMAN RPT was scheduled and run but the current" "RTN","LRJSML6",98,0) DO LRADDNOD^LRJSML3(.LRLNCNT,X,"","MAIL",LRMMARY) "RTN","LRJSML6",99,0) SET X=" Lab Hospital Location configuration has not been accepted!" "RTN","LRJSML6",100,0) DO LRADDNOD^LRJSML3(.LRLNCNT,X,"","MAIL",LRMMARY) "RTN","LRJSML6",101,0) DO LRADDNOD^LRJSML3(.LRLNCNT," ","","MAIL",LRMMARY) "RTN","LRJSML6",102,0) DO LRADDNOD^LRJSML3(.LRLNCNT," ","","MAIL",LRMMARY) "RTN","LRJSML6",103,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"*************************************************************","","MAIL",LRMMARY) "RTN","LRJSML6",104,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* *","","MAIL",LRMMARY) "RTN","LRJSML6",105,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* HL AUDIT REPORT NOT GENERATED!! *","","MAIL",LRMMARY) "RTN","LRJSML6",106,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* *","","MAIL",LRMMARY) "RTN","LRJSML6",107,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* Use the Hospital Location Monitor Tools 'Accept *","","MAIL",LRMMARY) "RTN","LRJSML6",108,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* current HL config/edit dates' action to accept *","","MAIL",LRMMARY) "RTN","LRJSML6",109,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* Hospital Locations configured on COTS and schedule *","","MAIL",LRMMARY) "RTN","LRJSML6",110,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* the 'LRJ SYS MAP HL TASKMAN RPT' option! *","","MAIL",LRMMARY) "RTN","LRJSML6",111,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"* *","","MAIL",LRMMARY) "RTN","LRJSML6",112,0) DO LRADDNOD^LRJSML3(.LRLNCNT,"*************************************************************","","MAIL",LRMMARY) "RTN","LRJSML6",113,0) DO LRADDNOD^LRJSML3(.LRLNCNT," ","","MAIL",LRMMARY) "RTN","LRJSML6",114,0) SET LRMSUBJ="Audit Report not Generated"_$S(+$G(LRTO)>0:" on "_$$FMTE^XLFDT(LRTO),1:"")_"!!" "RTN","LRJSML6",115,0) SET XQSND=DUZ "RTN","LRJSML6",116,0) DO SNDMSG^LRJSML8(LRMSUBJ,XQSND,LRMMARY,1) ;"1" = created by TaskMan; send to Mailgroup "RTN","LRJSML6",117,0) QUIT "RTN","LRJSML6",118,0) ; "RTN","LRJSML6",119,0) ENTCHK(X) ;Check X for legit frequency indicator "RTN","LRJSML6",120,0) ; "RTN","LRJSML6",121,0) ; Output: "RTN","LRJSML6",122,0) ; 1 - X is legit frequencey "RTN","LRJSML6",123,0) ; 0 - X is not legit frequency "RTN","LRJSML6",124,0) ; "RTN","LRJSML6",125,0) IF X?1.3N1"H" Q 1 "RTN","LRJSML6",126,0) IF X?1.4N1"S" Q 1 "RTN","LRJSML6",127,0) IF X?1.3N1"D" Q 1 "RTN","LRJSML6",128,0) IF X?1.2N1"M" Q 1 "RTN","LRJSML6",129,0) IF X?1.2N1"M(".E1")" Q 1 "RTN","LRJSML6",130,0) IF "MTWRFSUDE"[$E(X),"@,"[$E(X,2) Q 1 "RTN","LRJSML6",131,0) QUIT 0 "RTN","LRJSML6",132,0) ; "RTN","LRJSML6",133,0) BJITT ;input transform for time (#2) "RTN","LRJSML6",134,0) N Y,%,DIR S %DT="ETRXF" D ^%DT S X=Y,%=$$NOW^XLFDT() I %+.0002>X K X "RTN","LRJSML6",135,0) I '$D(X) DO "RTN","LRJSML6",136,0) .W !,?5,"The current time is ",$E(%,9,10),":",$E(%,11,12) "RTN","LRJSML6",137,0) .W !,?2,"Queued time must be at least 2 minutes later than the current time." "RTN","LRJSML6",138,0) Q "RTN","LRJSML6",139,0) ; "RTN","LRJSML6",140,0) ACPTCNFG ; Accept the current HL Configuration or edit parameters for LRJ SYS MAP HL TASKMAN RPT "RTN","LRJSML6",141,0) ;Called from Protocol: LRJ SYS MAP HL ACCEPT CONFIG "RTN","LRJSML6",142,0) ; "RTN","LRJSML6",143,0) ; This API will update the Last Start/End date for the HLCMS background task report "RTN","LRJSML6",144,0) NEW LROK,LRSTDTM,LROPT,LRPARMDT,LREND,LRBEGIN,LRAUDMSG,LRACTEDT "RTN","LRJSML6",145,0) D FULL^VALM1 "RTN","LRJSML6",146,0) SET LRACTEDT="" "RTN","LRJSML6",147,0) SET LROK=1 "RTN","LRJSML6",148,0) SET LRBEGIN=$$GET^XPAR("SYS","LRJ HL LAST START DATE",1,"Q") ;* IA #2263 "RTN","LRJSML6",149,0) SET LREND=$$GET^XPAR("SYS","LRJ HL LAST END DATE",1,"Q") "RTN","LRJSML6",150,0) IF +LRBEGIN'>0,+LREND'>0 SET LRACTEDT="ACCEPT" "RTN","LRJSML6",151,0) IF (+LRBEGIN>0)!(+LREND>0) SET LRACTEDT="EDIT" "RTN","LRJSML6",152,0) IF LRACTEDT="ACCEPT" DO "RTN","LRJSML6",153,0) .WRITE !,"This action will accept the current Hospital Location configuration on" "RTN","LRJSML6",154,0) .WRITE !," COTS and define reporting start dates for the [LRJ SYS MAP HL TASKMAN RPT]" "RTN","LRJSML6",155,0) .WRITE !," background task." "RTN","LRJSML6",156,0) .; "RTN","LRJSML6",157,0) .;Prompt to accept current config "RTN","LRJSML6",158,0) .SET DIR(0)="Y" "RTN","LRJSML6",159,0) .SET DIR("A")="Accept current Lab Hospital Location Config" "RTN","LRJSML6",160,0) .SET DIR("B")="NO" "RTN","LRJSML6",161,0) .SET DIR("?",1)="Accepting the current configuration will set the" "RTN","LRJSML6",162,0) .SET DIR("?",2)="LRJ HL LAST START DATE and LRJ HL LAST END DATE parameters." "RTN","LRJSML6",163,0) .SET DIR("?",3)="If COTS locations match legacy VistA, enter 'YES'." "RTN","LRJSML6",164,0) .SET DIR("?")="If COTS locations do NOT match legacy VistA, enter 'NO'." "RTN","LRJSML6",165,0) .DO ^DIR "RTN","LRJSML6",166,0) .SET LROK=Y "RTN","LRJSML6",167,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",168,0) .; "RTN","LRJSML6",169,0) .;If accept config, set parameters "RTN","LRJSML6",170,0) .IF LROK DO "RTN","LRJSML6",171,0) ..NEW ERR "RTN","LRJSML6",172,0) ..DO NOW^%DTC "RTN","LRJSML6",173,0) ..SET LRPARMDT=$E(%,1,12) ;Set NOW for Parameter date "RTN","LRJSML6",174,0) ..DO EN^XPAR("SYS","LRJ HL LAST END DATE",,LRPARMDT,.ERR) ;* IA #2263 "RTN","LRJSML6",175,0) ..DO EN^XPAR("SYS","LRJ HL LAST START DATE",,LRPARMDT,.ERR) "RTN","LRJSML6",176,0) .; "RTN","LRJSML6",177,0) .IF 'LROK DO "RTN","LRJSML6",178,0) ..SET DIR("A",1)=" " "RTN","LRJSML6",179,0) ..SET DIR("A",2)=" Current configuration not accepted!!" "RTN","LRJSML6",180,0) ..SET DIR("A",3)=" " "RTN","LRJSML6",181,0) ..SET DIR("A")="Press Return to continue" "RTN","LRJSML6",182,0) ..SET DIR(0)="E" "RTN","LRJSML6",183,0) ..DO ^DIR "RTN","LRJSML6",184,0) ..KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",185,0) ; "RTN","LRJSML6",186,0) IF LRACTEDT="EDIT" DO "RTN","LRJSML6",187,0) .SET DIR(0)="Y" "RTN","LRJSML6",188,0) .SET DIR("A",1)=" " "RTN","LRJSML6",189,0) .SET DIR("A",2)="Previous Audit Report dates are "_$S(LRBEGIN'="":$$FMTE^XLFDT(LRBEGIN),1:"undefined")_" - "_$S(LREND'="":$$FMTE^XLFDT(LREND),1:"undefined") "RTN","LRJSML6",190,0) .SET DIR("A",3)=" " "RTN","LRJSML6",191,0) .SET DIR("A")="Do you want to edit these dates" "RTN","LRJSML6",192,0) .SET DIR("B")="NO" "RTN","LRJSML6",193,0) .SET DIR("?",1)="These dates control the window of time in which Hospital Location changes" "RTN","LRJSML6",194,0) .SET DIR("?",2)="are reported. The Tasked reports assume COTS Hospital Location" "RTN","LRJSML6",195,0) .SET DIR("?",3)="configurations are current as of the End Date. Changing these dates will" "RTN","LRJSML6",196,0) .SET DIR("?")="change the report generated by the LRJ SYS MAP HL TASKMAN RPT background job!!" "RTN","LRJSML6",197,0) .D ^DIR "RTN","LRJSML6",198,0) .SET LROK=Y "RTN","LRJSML6",199,0) .KILL DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSML6",200,0) .IF LROK D PARAMED^LRJSML2 "RTN","LRJSML6",201,0) ;IF TASK SCHEDULE SCREEN DO INIT^LRJSML5 ELSE... "RTN","LRJSML6",202,0) IF ^TMP("LRJ SYS MAP HL INIT MGR",$J,1,0)=" Hospital Location Audit task schedule" DO "RTN","LRJSML6",203,0) .DO INIT^LRJSML5 "RTN","LRJSML6",204,0) E DO "RTN","LRJSML6",205,0) .D MSG^LRJSML "RTN","LRJSML6",206,0) .SET VALMBCK="R" "RTN","LRJSML6",207,0) QUIT "RTN","LRJSML8") 0^20^B94488687^n/a "RTN","LRJSML8",1,0) LRJSML8 ;ALB/GTS - Lab Vista Hospital Location Utilities;04/23/2012 09:05 "RTN","LRJSML8",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSML8",3,0) ; "RTN","LRJSML8",4,0) ; "RTN","LRJSML8",5,0) LISTHLMM(LRHLARY) ; Store Hospital Locations in display array "RTN","LRJSML8",6,0) ; INPUT - "RTN","LRJSML8",7,0) ; LRHLARY - Array of raw extract data "RTN","LRJSML8",8,0) ; "RTN","LRJSML8",9,0) NEW LRFROM,LRTO,LRINIT "RTN","LRJSML8",10,0) SET LRINIT=$$INITCK^LRJSML1() "RTN","LRJSML8",11,0) IF LRINIT SET (LRFROM,LRTO)="" "RTN","LRJSML8",12,0) IF 'LRINIT DO SETRNG^LRJSML1(.LRFROM,.LRTO) "RTN","LRJSML8",13,0) DO KILL^VALM10() "RTN","LRJSML8",14,0) DO CRTRPTAR(LRHLARY,LRFROM,LRTO,"DISPLAY","") "RTN","LRJSML8",15,0) QUIT "RTN","LRJSML8",16,0) ; "RTN","LRJSML8",17,0) CRTRPTAR(LRHLARY,LRFROM,LRTO,LROUTPT,LRMMARY) ; Store Hospital Locations in display array "RTN","LRJSML8",18,0) ; INPUT - "RTN","LRJSML8",19,0) ; LRHLARY - Raw extract data Array "RTN","LRJSML8",20,0) ; LRFROM - Report Start date "RTN","LRJSML8",21,0) ; LRTO - Report End date "RTN","LRJSML8",22,0) ; LROUTPT - "DISPLAY" - Listman; "MAIL" - mail message "RTN","LRJSML8",23,0) ; LRMMARY - Mail msg output array "RTN","LRJSML8",24,0) ; "RTN","LRJSML8",25,0) NEW X,LRXN,LRXP,NODE,LRLOC,LRRM,LROBED,LRHD,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED "RTN","LRJSML8",26,0) NEW LRFSTLNE,LRPARAM,LRLNCTN,LRLNCNT,LRVALST,LRNEWLOC,LRINIT,LRNOTCHG "RTN","LRJSML8",27,0) SET:$G(LRMMARY)="" LRMMARY="" "RTN","LRJSML8",28,0) SET:$G(LROUTPT)="" LROUTPT="DISPLAY" "RTN","LRJSML8",29,0) SET LRINIT=$$INITCK^LRJSML1() "RTN","LRJSML8",30,0) SET LRNOTCHG=(LRINIT) "RTN","LRJSML8",31,0) SET LRFSTLNE=0 "RTN","LRJSML8",32,0) SET LRNEWLOC=1 "RTN","LRJSML8",33,0) SET (LRLOC,LRRM,LROBED,LRCLOC,LRCRM,LRCBED,LRPLOC,LRPRM,LRPBED)="" "RTN","LRJSML8",34,0) SET:('LRNOTCHG) LRHD="NEW LOCATION" "RTN","LRJSML8",35,0) SET:(LRNOTCHG) LRHD="CURRENT LOCATION" "RTN","LRJSML8",36,0) SET X=$$XSET(LRINIT,LRFROM,LRTO) "RTN","LRJSML8",37,0) ; "RTN","LRJSML8",38,0) I LROUTPT="MAIL" DO "RTN","LRJSML8",39,0) .S LRLNCNT=0 "RTN","LRJSML8",40,0) .D LRADDNOD^LRJSML3(.LRLNCNT,X,"",LROUTPT,LRMMARY) "RTN","LRJSML8",41,0) I LROUTPT="DISPLAY" DO "RTN","LRJSML8",42,0) .S VALMCNT=0 "RTN","LRJSML8",43,0) .D LRADDNOD^LRJSML3(.VALMCNT,X,"",LROUTPT,LRMMARY) "RTN","LRJSML8",44,0) .D CNTRL^VALM10(VALMCNT,2,$LENGTH(X)-1,IOUON,IOUOFF_IOINORM) "RTN","LRJSML8",45,0) ; "RTN","LRJSML8",46,0) ;Loop extract array "RTN","LRJSML8",47,0) S NODE=0 "RTN","LRJSML8",48,0) F S NODE=$ORDER(@LRHLARY@(NODE)) Q:NODE="" DO "RTN","LRJSML8",49,0) .S LRXN=@LRHLARY@(NODE) "RTN","LRJSML8",50,0) .; "RTN","LRJSML8",51,0) .;New Location "RTN","LRJSML8",52,0) .I $P(LRXN,"^",1)'["CURRENT",$P(LRXN,"^",1)'["PREVIOUS" DO "RTN","LRJSML8",53,0) ..; "RTN","LRJSML8",54,0) ..;Set Paramater array (New) "RTN","LRJSML8",55,0) ..S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG "RTN","LRJSML8",56,0) ..D SETNPARM^LRJSML3(LRVALST,.LRPARAM) "RTN","LRJSML8",57,0) ..S LRPARAM("XN")=LRXN "RTN","LRJSML8",58,0) ..S LRPARAM("LRLOC")=LRLOC "RTN","LRJSML8",59,0) ..;; "RTN","LRJSML8",60,0) ..D:LROUTPT="DISPLAY" MMDISPN^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) "RTN","LRJSML8",61,0) ..D:LROUTPT="MAIL" MMDISPN^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) "RTN","LRJSML8",62,0) ..; "RTN","LRJSML8",63,0) ..;Reset array params "RTN","LRJSML8",64,0) ..S LRLOC=LRPARAM("LRLOC") "RTN","LRJSML8",65,0) ..S LRRM=LRPARAM("LRRM") "RTN","LRJSML8",66,0) ..S LROBED=LRPARAM("LROBED") "RTN","LRJSML8",67,0) ..S LRHD=LRPARAM("LRHD") "RTN","LRJSML8",68,0) ..S LRFSTLNE=LRPARAM("LRFSTLNE") "RTN","LRJSML8",69,0) .; "RTN","LRJSML8",70,0) .;Edited location "RTN","LRJSML8",71,0) .I $P(LRXN,"^",1)["CURRENT" DO "RTN","LRJSML8",72,0) ..; "RTN","LRJSML8",73,0) ..;Output last New rec "RTN","LRJSML8",74,0) ..I LRLOC'="" DO "RTN","LRJSML8",75,0) ...; "RTN","LRJSML8",76,0) ...;Set Param array (New) "RTN","LRJSML8",77,0) ...S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG "RTN","LRJSML8",78,0) ...D SETNPARM^LRJSML3(LRVALST,.LRPARAM) "RTN","LRJSML8",79,0) ...S LRPARAM("LRLOC")=LRLOC "RTN","LRJSML8",80,0) ...;; "RTN","LRJSML8",81,0) ...D:LROUTPT="DISPLAY" LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC "RTN","LRJSML8",82,0) ...D:LROUTPT="MAIL" LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC "RTN","LRJSML8",83,0) ...; "RTN","LRJSML8",84,0) ...;Reset array param "RTN","LRJSML8",85,0) ...S LRLOC=LRPARAM("LRLOC") "RTN","LRJSML8",86,0) ...S LRRM=LRPARAM("LRRM") "RTN","LRJSML8",87,0) ...S LROBED=LRPARAM("LROBED") "RTN","LRJSML8",88,0) ...S LRHD=LRPARAM("LRHD") "RTN","LRJSML8",89,0) ...S LRFSTLNE=LRPARAM("LRFSTLNE") "RTN","LRJSML8",90,0) ..S LRLOC="" "RTN","LRJSML8",91,0) ..S NODE=NODE+1 "RTN","LRJSML8",92,0) ..S LRXP=@LRHLARY@(NODE) "RTN","LRJSML8",93,0) ..; "RTN","LRJSML8",94,0) ..;Set Param array (Edited) "RTN","LRJSML8",95,0) ..S LRVALST="^"_LRCRM_"^"_LRCBED_"^^"_LRPRM_"^"_LRPBED_"^"_LRFSTLNE_"^"_LRNOTCHG "RTN","LRJSML8",96,0) ..D SETEPARM^LRJSML3(LRVALST,.LRPARAM) "RTN","LRJSML8",97,0) ..; "RTN","LRJSML8",98,0) ..I $P(LRXN,"^",2)="LOCATION" DO "RTN","LRJSML8",99,0) ...S LRCLOC="^^"_$P(LRXN,"^",3,11) "RTN","LRJSML8",100,0) ...S LRPLOC="^^"_$P(LRXP,"^",3,11) "RTN","LRJSML8",101,0) ..S LRPARAM("XN")=LRXN "RTN","LRJSML8",102,0) ..S LRPARAM("XP")=LRXP "RTN","LRJSML8",103,0) ..S LRPARAM("LRCLOC")=LRCLOC "RTN","LRJSML8",104,0) ..S LRPARAM("LRPLOC")=LRPLOC "RTN","LRJSML8",105,0) ..S LRPARAM("LRNEWLOC")=LRNEWLOC "RTN","LRJSML8",106,0) ..;; "RTN","LRJSML8",107,0) ..D:LROUTPT="DISPLAY" MMDISPC^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) "RTN","LRJSML8",108,0) ..D:LROUTPT="MAIL" MMDISPC^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) "RTN","LRJSML8",109,0) ..; "RTN","LRJSML8",110,0) ..;Reset array param "RTN","LRJSML8",111,0) ..S LRCLOC=LRPARAM("LRCLOC") "RTN","LRJSML8",112,0) ..S LRCRM=LRPARAM("LRCRM") "RTN","LRJSML8",113,0) ..S LRCBED=LRPARAM("LRCBED") "RTN","LRJSML8",114,0) ..S LRPLOC=LRPARAM("LRPLOC") "RTN","LRJSML8",115,0) ..S LRPRM=LRPARAM("LRPRM") "RTN","LRJSML8",116,0) ..S LRPBED=LRPARAM("LRPBED") "RTN","LRJSML8",117,0) ..S LRFSTLNE=LRPARAM("LRFSTLNE") "RTN","LRJSML8",118,0) ..S LRNEWLOC=LRPARAM("LRNEWLOC") "RTN","LRJSML8",119,0) I LRLOC'="" DO "RTN","LRJSML8",120,0) .; "RTN","LRJSML8",121,0) .;Set Param array (New) "RTN","LRJSML8",122,0) .S LRVALST="^"_LRRM_"^"_LROBED_"^"_LRHD_"^"_LRFSTLNE_"^"_LRNOTCHG "RTN","LRJSML8",123,0) .D SETNPARM^LRJSML3(LRVALST,.LRPARAM) "RTN","LRJSML8",124,0) .S LRPARAM("LRLOC")=LRLOC "RTN","LRJSML8",125,0) .;; "RTN","LRJSML8",126,0) .D:LROUTPT="DISPLAY" LRNEWOUT^LRJSML3(.VALMCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC "RTN","LRJSML8",127,0) .D:LROUTPT="MAIL" LRNEWOUT^LRJSML3(.LRLNCNT,.LRPARAM,LROUTPT,LRMMARY) ;OUTPUT LAST NEW LOC "RTN","LRJSML8",128,0) .; "RTN","LRJSML8",129,0) .;Reset array params "RTN","LRJSML8",130,0) .S LRLOC=LRPARAM("LRLOC") "RTN","LRJSML8",131,0) .S LRRM=LRPARAM("LRRM") "RTN","LRJSML8",132,0) .S LROBED=LRPARAM("LROBED") "RTN","LRJSML8",133,0) .S LRHD=LRPARAM("LRHD") "RTN","LRJSML8",134,0) .S LRFSTLNE=LRPARAM("LRFSTLNE") "RTN","LRJSML8",135,0) ; "RTN","LRJSML8",136,0) QUIT "RTN","LRJSML8",137,0) ; "RTN","LRJSML8",138,0) XSET(LRINIT,LRFROM,LRTO) ;Set report description (first line listed) "RTN","LRJSML8",139,0) ;INPUT: "RTN","LRJSML8",140,0) ; LRINIT - "RTN","LRJSML8",141,0) ; 1 : Init extract "RTN","LRJSML8",142,0) ; 0 : Not Init extract [Default] "RTN","LRJSML8",143,0) ; LRFROM - Report Beginning date (Passed by Ref) "RTN","LRJSML8",144,0) ; LRTO - Report Ending date (Passed by Ref) "RTN","LRJSML8",145,0) ; "RTN","LRJSML8",146,0) NEW LRX "RTN","LRJSML8",147,0) SET:('LRINIT) LRX=" VistA Hospital Location changes"_$S($D(LRFROM):" from "_$$FMTE^XLFDT(LRFROM),1:"")_$S($D(LRTO):" to "_$$FMTE^XLFDT(LRTO),1:"") "RTN","LRJSML8",148,0) IF +$G(LRINIT)>0 DO "RTN","LRJSML8",149,0) .SET LRX=" VistA Hospital Location Configurations on "_$$FMTE^XLFDT($P($G(^TMP($J,"LRJ SYS",1)),"^",11)) "RTN","LRJSML8",150,0) QUIT LRX "RTN","LRJSML8",151,0) ; "RTN","LRJSML8",152,0) GETDATE(LRFROM,LRTO) ;Return Report dates from ^TMP("LRJ SYS MAP HL MANAGER",$JOB) "RTN","LRJSML8",153,0) ;INPUT: "RTN","LRJSML8",154,0) ; LRFROM - Report Beginning date (Passed by Ref) "RTN","LRJSML8",155,0) ; LRTO - Report Ending date (Passed by Ref) "RTN","LRJSML8",156,0) ; "RTN","LRJSML8",157,0) ;OUTPUT (Passed by Ref): "RTN","LRJSML8",158,0) ; LRFROM - Report Beginning date "RTN","LRJSML8",159,0) ; LRTO - Report Ending date "RTN","LRJSML8",160,0) ; "RTN","LRJSML8",161,0) S LRFROM=$P(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0),"Hospital Location changes",2) "RTN","LRJSML8",162,0) S LRFROM=$P(LRFROM," from ",2) "RTN","LRJSML8",163,0) S LRFROM=$P(LRFROM," to ",1) "RTN","LRJSML8",164,0) S LRTO=$P(^TMP("LRJ SYS MAP HL INIT MGR",$JOB,1,0)," to ",2) "RTN","LRJSML8",165,0) Q "RTN","LRJSML8",166,0) ; "RTN","LRJSML8",167,0) SNDMSG(LRMSUBJ,XQSND,LRMSGARY,LRTASK) ;Send HL changes to requestor "RTN","LRJSML8",168,0) ;INPUT: "RTN","LRJSML8",169,0) ; LRMSUBJ - Subject of msg generated "RTN","LRJSML8",170,0) ; XQSND - User's DUZ, Group Name, or S.server name "RTN","LRJSML8",171,0) ; LRMSGARY - Array containing msg text "RTN","LRJSML8",172,0) ; LRTASK - If defined, indicates called from TASKMAN job "RTN","LRJSML8",173,0) ; "RTN","LRJSML8",174,0) N LRINSTMM,LRTASKMM,LRTOMM,XMERR,XMZ,LRLPCNT,LRTYPE "RTN","LRJSML8",175,0) ; "RTN","LRJSML8",176,0) S:'$D(LRTASK) LRTASK=0 "RTN","LRJSML8",177,0) I 'LRTASK DO "RTN","LRJSML8",178,0) . K XMERR "RTN","LRJSML8",179,0) . S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing "RTN","LRJSML8",180,0) . S LRTYPE="S" "RTN","LRJSML8",181,0) . D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM) "RTN","LRJSML8",182,0) . S LRLPCNT="" "RTN","LRJSML8",183,0) . F S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT="" S LRTOMM(LRLPCNT)="" "RTN","LRJSML8",184,0) ; "RTN","LRJSML8",185,0) I +$G(XMERR)'>0 DO "RTN","LRJSML8",186,0) . S LRTOMM(XQSND)="" "RTN","LRJSML8",187,0) . S LRTOMM("G.LRJ SYS MAP HL TASK REPORT")="" "RTN","LRJSML8",188,0) . S LRINSTMM("FROM")="LAB_HLCSM_USER_ACTION" "RTN","LRJSML8",189,0) . S LRMSUBJ=$E(LRMSUBJ,1,65) "RTN","LRJSML8",190,0) . D SENDMSG^XMXAPI(XQSND,LRMSUBJ,LRMSGARY,.LRTOMM,.LRINSTMM,.LRTASKMM) "RTN","LRJSML8",191,0) ; "RTN","LRJSML8",192,0) K @LRMSGARY,^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG") "RTN","LRJSML8",193,0) Q "RTN","LRJSML8",194,0) ; "RTN","LRJSML8",195,0) SNDEXT(LRMSUBJ,XQSND,LREXTARY) ;Send HL changes Extract to requester "RTN","LRJSML8",196,0) ;INPUT: "RTN","LRJSML8",197,0) ; LRMSUBJ - Subject of message generated "RTN","LRJSML8",198,0) ; XQSND - User's DUZ, Group Name, or S.server name "RTN","LRJSML8",199,0) ; LREXTARY - Array containing msg text "RTN","LRJSML8",200,0) ; "RTN","LRJSML8",201,0) N LRINSTMM,LRINSTVA,LRTASKMM,LRTASKVA,LRTOMM,LRTOVA,XMERR,XMZ,LRLPCNT,LRTYPE "RTN","LRJSML8",202,0) ; "RTN","LRJSML8",203,0) S LRINSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing "RTN","LRJSML8",204,0) S LRTYPE="S" "RTN","LRJSML8",205,0) K XMERR "RTN","LRJSML8",206,0) D TOWHOM^XMXAPIU(DUZ,,LRTYPE,.LRINSTMM) "RTN","LRJSML8",207,0) ; "RTN","LRJSML8",208,0) ;Check Network addresses and mail attachmt "RTN","LRJSML8",209,0) S LRINSTVA("ADDR FLAGS")="R" ;Do not Restrict addressing "RTN","LRJSML8",210,0) S LRINSTVA("FROM")="LAB_HLCSM_USER_ACTION" "RTN","LRJSML8",211,0) S LRMSUBJ=$E(LRMSUBJ,1,65) "RTN","LRJSML8",212,0) S LRLPCNT="" "RTN","LRJSML8",213,0) F S LRLPCNT=$O(^TMP("XMY",$J,LRLPCNT)) Q:LRLPCNT="" S LRTOVA(LRLPCNT)="" "RTN","LRJSML8",214,0) ; "RTN","LRJSML8",215,0) I +$G(XMERR)'>0 DO "RTN","LRJSML8",216,0) .W !," [Creating attachments..." "RTN","LRJSML8",217,0) .D OUTLKARY(LREXTARY,"^TMP($J,""LRNETMSG"")",LRMSUBJ,1) "RTN","LRJSML8",218,0) .D SENDMSG^XMXAPI(XQSND,LRMSUBJ,"^TMP($J,""LRNETMSG"")",.LRTOVA,.LRINSTVA,.LRTASKVA) "RTN","LRJSML8",219,0) ; "RTN","LRJSML8",220,0) K ^TMP("XMY",$J),^TMP("XMY0",$J),^TMP($J,"LRNETMSG") "RTN","LRJSML8",221,0) Q "RTN","LRJSML8",222,0) ; "RTN","LRJSML8",223,0) OUTLKARY(LRHLARY,LRHLOTLK,LRMSUBJ,LRRT) ;Create attachmts array "RTN","LRJSML8",224,0) ;INPUT: "RTN","LRJSML8",225,0) ; LRHLARY - Array containing raw message text "RTN","LRJSML8",226,0) ; LRHLOTLK - Array containing message text for network addresses "RTN","LRJSML8",227,0) ; LRMSUBJ - Message subject "RTN","LRJSML8",228,0) ; LRRT - Real Time processing from UI "RTN","LRJSML8",229,0) ; "RTN","LRJSML8",230,0) N LRFILNM1,LRFILNM2,LRDTTM,LRCRLF,LRSTR,LRNODE,LROUTNOD,LRNODATA,LRCHAR "RTN","LRJSML8",231,0) S:+$G(LRRT)=0 LRRT=0 "RTN","LRJSML8",232,0) S:+$G(LRRT) LRCHAR=0 "RTN","LRJSML8",233,0) S LRSTR="" "RTN","LRJSML8",234,0) S LRNODATA=0 "RTN","LRJSML8",235,0) S LRCRLF=$C(13,10) "RTN","LRJSML8",236,0) K @LRHLOTLK "RTN","LRJSML8",237,0) S @LRHLOTLK@(1)="Extract Message Generated......: "_$$FMTE^XLFDT($$NOW^XLFDT)_LRCRLF "RTN","LRJSML8",238,0) S @LRHLOTLK@(2)=" " "RTN","LRJSML8",239,0) S @LRHLOTLK@(3)="Extract Requested......: "_LRMSUBJ_LRCRLF "RTN","LRJSML8",240,0) S @LRHLOTLK@(4)=" " "RTN","LRJSML8",241,0) ; "RTN","LRJSML8",242,0) S LRDTTM=$$NOW^XLFDT "RTN","LRJSML8",243,0) S LRFILNM1="HLCSM_EXT_NEW_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".TXT" "RTN","LRJSML8",244,0) S LRFILNM2="HLCSM_EXT_MOD_"_$P(LRDTTM,".",1)_"_"_$P(LRDTTM,".",2)_".TXT" "RTN","LRJSML8",245,0) S @LRHLOTLK@(5)="Attached LMOF NEW Hospital Locations file.....: "_LRFILNM1_LRCRLF "RTN","LRJSML8",246,0) S @LRHLOTLK@(6)=" " "RTN","LRJSML8",247,0) S @LRHLOTLK@(7)="Attached LMOF MODIFIED Hospital Locations file.....: "_LRFILNM2_LRCRLF "RTN","LRJSML8",248,0) S:($O(@LRHLARY@(0))="") LRNODATA=1 "RTN","LRJSML8",249,0) S @LRHLOTLK@(8)=" " "RTN","LRJSML8",250,0) S:(LRNODATA=0) @LRHLOTLK@(9)=" " "RTN","LRJSML8",251,0) S:(LRNODATA=1) @LRHLOTLK@(9)="No data was extracted for date range!!" "RTN","LRJSML8",252,0) ; "RTN","LRJSML8",253,0) ;Begin NEW Hospital Locations file output "RTN","LRJSML8",254,0) S @LRHLOTLK@(10)=$$UUBEGFN(LRFILNM1) "RTN","LRJSML8",255,0) S LRNODE=0 "RTN","LRJSML8",256,0) S LROUTNOD=10 "RTN","LRJSML8",257,0) F S LRNODE=$O(@LRHLARY@(LRNODE)) Q:(LRNODE="") Q:($P($G(@LRHLARY@(LRNODE)),"^",1)="CURRENT") DO "RTN","LRJSML8",258,0) . I +$G(LRRT) D:LRNODE#100=0 HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSML8",259,0) . S LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF "RTN","LRJSML8",260,0) . D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK) "RTN","LRJSML8",261,0) ; "RTN","LRJSML8",262,0) F Q:$L(LRSTR<45) D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK) "RTN","LRJSML8",263,0) S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR) "RTN","LRJSML8",264,0) S @LRHLOTLK@(LROUTNOD+2)=" " "RTN","LRJSML8",265,0) S @LRHLOTLK@(LROUTNOD+3)="end" "RTN","LRJSML8",266,0) ; "RTN","LRJSML8",267,0) ;Begin MODIFIED Hospital Locations file output "RTN","LRJSML8",268,0) S LRSTR="" "RTN","LRJSML8",269,0) S LROUTNOD=LROUTNOD+4 "RTN","LRJSML8",270,0) S @LRHLOTLK@(LROUTNOD)=$$UUBEGFN(LRFILNM2) "RTN","LRJSML8",271,0) I +LRNODE>0 DO "RTN","LRJSML8",272,0) .S LRNODE=LRNODE-1 "RTN","LRJSML8",273,0) .F S LRNODE=$O(@LRHLARY@(LRNODE)) Q:(LRNODE="") DO "RTN","LRJSML8",274,0) ..I +$G(LRRT) D:LRNODE#100=0 HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSML8",275,0) ..S LRSTR=LRSTR_@LRHLARY@(LRNODE)_LRCRLF "RTN","LRJSML8",276,0) ..D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK) "RTN","LRJSML8",277,0) .; "RTN","LRJSML8",278,0) .F Q:$L(LRSTR<45) D ENCODE(.LRSTR,.LROUTNOD,LRHLOTLK) "RTN","LRJSML8",279,0) S:(LRSTR'="") @LRHLOTLK@(LROUTNOD+1)=$$UUEN^LRJSMLU(LRSTR) "RTN","LRJSML8",280,0) S @LRHLOTLK@(LROUTNOD+2)=" " "RTN","LRJSML8",281,0) S @LRHLOTLK@(LROUTNOD+3)="end" "RTN","LRJSML8",282,0) Q "RTN","LRJSML8",283,0) ; "RTN","LRJSML8",284,0) UUBEGFN(LRFILENM) ; Construct uuencode "begin" coding "RTN","LRJSML8",285,0) ; Call with LRFILENM = name of uuencoded file attachmt "RTN","LRJSML8",286,0) ; "RTN","LRJSML8",287,0) ; Returns LRX = string with "begin..."_file name "RTN","LRJSML8",288,0) ; "RTN","LRJSML8",289,0) N LRX "RTN","LRJSML8",290,0) S LRX="begin 644 "_LRFILENM "RTN","LRJSML8",291,0) Q LRX "RTN","LRJSML8",292,0) ; "RTN","LRJSML8",293,0) ENCODE(LRSTR,LRDTANOD,LRHLOTLK) ;Encode a string, keep remainder for next line "RTN","LRJSML8",294,0) ;INPUT: "RTN","LRJSML8",295,0) ; LRSTR - String to send in msg; call by reference, Remainder returned in LRSTR "RTN","LRJSML8",296,0) ; LRDTANOD - Number of next Node to store msg line in array "RTN","LRJSML8",297,0) ; LRHLOTLK - Array containing msg text for network addresses "RTN","LRJSML8",298,0) ; "RTN","LRJSML8",299,0) N LRQUIT,LRLEN,LRX "RTN","LRJSML8",300,0) S LRQUIT=0,LRLEN=$L(LRSTR) "RTN","LRJSML8",301,0) F D Q:LRQUIT "RTN","LRJSML8",302,0) . I $L(LRSTR)<45 S LRQUIT=1 Q "RTN","LRJSML8",303,0) . S LRX=$E(LRSTR,1,45) "RTN","LRJSML8",304,0) . S LRDTANOD=LRDTANOD+1,@LRHLOTLK@(LRDTANOD)=$$UUEN^LRJSMLU(LRX) "RTN","LRJSML8",305,0) . S LRSTR=$E(LRSTR,46,LRLEN) "RTN","LRJSML8",306,0) Q "RTN","LRJSMLA") 0^15^B232140831^n/a "RTN","LRJSMLA",1,0) LRJSMLA ;ALB/PO,GTS Lab Hospital Location Update Notification ;02/24/2010 11:45:51 "RTN","LRJSMLA",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSMLA",3,0) ; "RTN","LRJSMLA",4,0) ; "RTN","LRJSMLA",5,0) ;IA #1380 allows references to ^DG(405.4 "RTN","LRJSMLA",6,0) ; "RTN","LRJSMLA",7,0) BLDREC(LRFR,LRTO,LRES,LRTYPE) ; -- output the HLCMS updates "RTN","LRJSMLA",8,0) ; Input: "RTN","LRJSMLA",9,0) ; LRFR - start time to report the raw data for. "RTN","LRJSMLA",10,0) ; LRTO - end to report the raw data. "RTN","LRJSMLA",11,0) ; LRES - Root for array that defines result data "RTN","LRJSMLA",12,0) ; LRTYPE - report type "RTN","LRJSMLA",13,0) ; 1: do not report records that that have changed "RTN","LRJSMLA",14,0) ; but returned back to its original values (Default) "RTN","LRJSMLA",15,0) ; 2: report all reocrds "RTN","LRJSMLA",16,0) ; Output: "RTN","LRJSMLA",17,0) ; @OUT@(seguence number) - array containing the results "RTN","LRJSMLA",18,0) ; "RTN","LRJSMLA",19,0) NEW NODE,OUT,I,NOFFSET,KEEPHL,KEEPRM,KEEPBED,LRTMP,LAST,CURDATA,PREVDATA,TOTALRM,TOTALBED,LRCHAR "RTN","LRJSMLA",20,0) SET LRTYPE=$G(LRTYPE,1) ; if LRTYPE not defined, default type 1 "RTN","LRJSMLA",21,0) SET OUT=$NAME(@LRES@("OUT")) "RTN","LRJSMLA",22,0) SET LRCHAR=0 "RTN","LRJSMLA",23,0) DO IOXY^XGF(IOSL-1,52) "RTN","LRJSMLA",24,0) WRITE "[Extract HL Changes..." "RTN","LRJSMLA",25,0) DO BLDRAW(LRFR,LRTO,OUT) "RTN","LRJSMLA",26,0) ; "RTN","LRJSMLA",27,0) FOR NOFFSET=1:1 QUIT:$QS(OUT,NOFFSET)="OUT" "RTN","LRJSMLA",28,0) SET LRTMP=$NAME(@LRES@("TMP")) "RTN","LRJSMLA",29,0) SET NODE=$NAME(@OUT@("SORT1RAW")) "RTN","LRJSMLA",30,0) FOR I=1:1 SET NODE=$Q(@NODE) QUIT:$E(NODE,1,$L(OUT)-1)'=$E(OUT,1,$L(OUT)-1) DO "RTN","LRJSMLA",31,0) . D HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSMLA",32,0) . SET:LRTYPE=1 @LRTMP@(I)=@NODE "RTN","LRJSMLA",33,0) . SET:LRTYPE=2 @LRES@(I)=@NODE "RTN","LRJSMLA",34,0) KILL @OUT "RTN","LRJSMLA",35,0) QUIT:LRTYPE=2 "RTN","LRJSMLA",36,0) ; Continue for report type 1 starting from last node and remove BED, ROOM or LOCATION "RTN","LRJSMLA",37,0) ; to remove records that are not changed (actually ones that have changed and returned back "RTN","LRJSMLA",38,0) ; to original values) "RTN","LRJSMLA",39,0) SET LAST=$O(@LRTMP@(""),-1) "RTN","LRJSMLA",40,0) SET TOTALRM=0 "RTN","LRJSMLA",41,0) SET TOTALBED=0 "RTN","LRJSMLA",42,0) SET I=LAST+2 "RTN","LRJSMLA",43,0) FOR SET I=I-2 QUIT:I<2 DO ;I=LAST:-1:1 DO "RTN","LRJSMLA",44,0) . D HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSMLA",45,0) . SET PREVDATA=$G(@LRTMP@(I)) "RTN","LRJSMLA",46,0) . IF (PREVDATA="")!($P(PREVDATA,"^",1)="NEW") SET I=0 QUIT ; got to NEW records, don't care any more "RTN","LRJSMLA",47,0) . SET CURDATA=$G(@LRTMP@(I-1)) "RTN","LRJSMLA",48,0) . IF $P(PREVDATA,"^",1)="PREVIOUS" DO "RTN","LRJSMLA",49,0) . . ; "RTN","LRJSMLA",50,0) . . IF $P(PREVDATA,"^",2)="BED" DO "RTN","LRJSMLA",51,0) . . . IF $P(PREVDATA,"^",8,9)=$P(CURDATA,"^",8,9) DO "RTN","LRJSMLA",52,0) . . . . KILL @LRTMP@(I),@LRTMP@(I-1) "RTN","LRJSMLA",53,0) . . . ELSE SET TOTALBED=TOTALBED+1 "RTN","LRJSMLA",54,0) . . ; "RTN","LRJSMLA",55,0) . . ELSE IF $P(PREVDATA,"^",2)="ROOM" DO "RTN","LRJSMLA",56,0) . . . IF TOTALBED=0 DO "RTN","LRJSMLA",57,0) . . . . KILL @LRTMP@(I),@LRTMP@(I-1) "RTN","LRJSMLA",58,0) . . . ELSE SET TOTALRM=TOTALRM+1 "RTN","LRJSMLA",59,0) . . . SET TOTALBED=0 ; initialize the total number of beds for next room encounter "RTN","LRJSMLA",60,0) . . ELSE IF $P(PREVDATA,"^",2)="LOCATION" DO "RTN","LRJSMLA",61,0) . . . IF TOTALRM=0,$P(PREVDATA,"^",4,9)="^^^^^" DO "RTN","LRJSMLA",62,0) . . . . KILL @LRTMP@(I),@LRTMP@(I-1) "RTN","LRJSMLA",63,0) . . . ELSE SET (TOTALRM,TOTALBED)=0 "RTN","LRJSMLA",64,0) ; "RTN","LRJSMLA",65,0) SET NODE=LRTMP "RTN","LRJSMLA",66,0) FOR I=1:1 SET NODE=$Q(@NODE) QUIT:$E(NODE,1,$L(LRTMP)-1)'=$E(LRTMP,1,$L(LRTMP)-1) SET @LRES@(I)=@NODE "RTN","LRJSMLA",67,0) IF '$D(@LRES@(1)) SET @LRES@(1)=" NO CHANGES FOUND!!" "RTN","LRJSMLA",68,0) KILL @LRTMP "RTN","LRJSMLA",69,0) ; "RTN","LRJSMLA",70,0) QUIT "RTN","LRJSMLA",71,0) ; "RTN","LRJSMLA",72,0) BLDRAW(LRFR,LRTO,OUT) ; -- build raw data for given time interval into @OUT array "RTN","LRJSMLA",73,0) ; Input: "RTN","LRJSMLA",74,0) ; LRFR - start date/time for raw data report "RTN","LRJSMLA",75,0) ; LRTO - end date/time for raw data report "RTN","LRJSMLA",76,0) ; OUT - Name of array holding raw data "RTN","LRJSMLA",77,0) ; Output: "RTN","LRJSMLA",78,0) ; @OUT@ - array in the following format. "RTN","LRJSMLA",79,0) ; @OUT@(sort order, HL ien, 0, "CURRENT" or "PREVIOUS" or "NEW") = CURRENT or PREVIOUS or NEW HL field values "RTN","LRJSMLA",80,0) ; @OUT@(sort order, HL ien,"AAAROOM", room value,-.235681, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW room field values "RTN","LRJSMLA",81,0) ; @OUT@(sort order, HL ien,"AAAROOM", room value, bed value, "CURRENT" or "PREVIOUS" or "NEW")=CURRENT or PREVIOUS or NEW bed field values "RTN","LRJSMLA",82,0) ; e.g. "RTN","LRJSMLA",83,0) ; "RTN","LRJSMLA",84,0) ; @OUT@("SORT2RAW",432,0,"CURRENT")="CURRENT^LOCATION^432^ZZW 100Ar^WARD^ALABAMA^TROY^^^OSTOVARI,PARVIZ^3081208.165853" "RTN","LRJSMLA",85,0) ; @OUT@("SORT2RAW",432,0,"PREVIOUS")="PREVIOUS^LOCATION^432^ZZW 100A^^ALBANY AREA^DEVVLD^^" "RTN","LRJSMLA",86,0) ; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"CURRENT")="CURRENT^ROOM^432^ZZW 100Ar^WARD^ALABAMA^TROY^^" "RTN","LRJSMLA",87,0) ; @OUT@("SORT2RAW",432,"AAAROOM",1001,-.235681,"PREVIOUS")="PREVIOUS^ROOM^432^ZZW 100A^^ALBANY AREA^DEVVLD^1001^" "RTN","LRJSMLA",88,0) ; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","ACUR")="CURRENT^BED^432^ZZW 100Ar^WARD^ALABAMA^TROY^1001^" "RTN","LRJSMLA",89,0) ; @OUT@("SORT2RAW",432,"AAAROOM",1001,"AB","APREV")="PREVIOUS^BED^432^ZZW100A^^ALBANY AREA^DEVVLD^1001^AB" "RTN","LRJSMLA",90,0) ; "RTN","LRJSMLA",91,0) NEW CUR,PREV,MOD,REVNODE,HLIEN,NFLDNUM,RBIEN,NEWIENV,OLDIENV,NEWVAL,OLDVAL,USER,DTR,ENTNM,RBIEN,RMBD,RMBDUNQ,NODE,NARR,CURMBD,FLDNUM,HLSORT "RTN","LRJSMLA",92,0) NEW NEWCUR,OLDBDNM,OLDRMNM,PREVIOUS,ROOMNAME,FLAG,BEDNAME,RMBDLIST,WLIEN,RMBDIEN "RTN","LRJSMLA",93,0) NEW CURTYPE,PREVTYPE,IGNORE,ACTDT,INACTDT,LRCHAR "RTN","LRJSMLA",94,0) SET LRCHAR=0 "RTN","LRJSMLA",95,0) ; "RTN","LRJSMLA",96,0) SET REVNODE=$NAME(@OUT@("REVARR")) "RTN","LRJSMLA",97,0) KILL @OUT,@REVNODE "RTN","LRJSMLA",98,0) ; "RTN","LRJSMLA",99,0) ; "RTN","LRJSMLA",100,0) ; sort audit records; reverse HL and room-bed changes. "RTN","LRJSMLA",101,0) DO SRTCHG^LRJSMLA1(LRFR,LRTO,REVNODE) "RTN","LRJSMLA",102,0) ; "RTN","LRJSMLA",103,0) ; for each HL ien, check to see if the entry is new or modified. "RTN","LRJSMLA",104,0) SET HLIEN=0 "RTN","LRJSMLA",105,0) FOR SET HLIEN=$O(@REVNODE@("N",HLIEN)) Q:'HLIEN I $D(^SC(HLIEN)) DO "RTN","LRJSMLA",106,0) . D HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSMLA",107,0) . KILL ARR,MOD,NARR,CUR,PREV,RMBD,RMBDUNQ "RTN","LRJSMLA",108,0) . SET (ACTDT,INACTDT)="" "RTN","LRJSMLA",109,0) . ; get the current values for this HL "RTN","LRJSMLA",110,0) . DO GHL(HLIEN,.CUR) ;Returns current Hosp Loc fields from file 44 "RTN","LRJSMLA",111,0) . ; "RTN","LRJSMLA",112,0) . ; get the changes for this HL into NARR "RTN","LRJSMLA",113,0) . MERGE NARR=@REVNODE@("N",HLIEN) "RTN","LRJSMLA",114,0) . ; "RTN","LRJSMLA",115,0) . ;CUR - current values of HL fields "RTN","LRJSMLA",116,0) . DO ROLLUP(HLIEN,.CUR,.NARR,LRTO) ;Roll back current HL values from current time to "TO" time "RTN","LRJSMLA",117,0) . DO CLNUP^LRJSMLA1(.NARR) ;*Remove Room-Bed edits made before RM-BD added to Ward-Location "RTN","LRJSMLA",118,0) . ; "RTN","LRJSMLA",119,0) . SET CUR("HL","FLAG")="CURRENT" ; HL record flag "RTN","LRJSMLA",120,0) . SET CUR("HL","NAME")="LOCATION" ; HL record type "RTN","LRJSMLA",121,0) . ; "RTN","LRJSMLA",122,0) . ; find out which node is new and which one is current. "RTN","LRJSMLA",123,0) . SET NODE="NARR" "RTN","LRJSMLA",124,0) . FOR SET NODE=$Q(@NODE) QUIT:NODE="" DO "RTN","LRJSMLA",125,0) . . SET DTR=$P(@NODE,"^",6) ; Date/Time Recorded "RTN","LRJSMLA",126,0) . . QUIT:DTR>LRTO ; quit if Date/time recorded is in future. "RTN","LRJSMLA",127,0) . . SET NFLDNUM=$QS(NODE,4) ; field number "RTN","LRJSMLA",128,0) . . SET RBIEN=$QS(NODE,3) ; room-bed ien "RTN","LRJSMLA",129,0) . . SET NEWIENV=$P(@NODE,"^",1) ; New IEN value "RTN","LRJSMLA",130,0) . . SET OLDIENV=$P(@NODE,"^",2) ; Old IEN value "RTN","LRJSMLA",131,0) . . SET NEWVAL=$P(@NODE,"^",3) ; New value "RTN","LRJSMLA",132,0) . . SET OLDVAL=$P(@NODE,"^",4) ; Old value "RTN","LRJSMLA",133,0) . . SET:DTR'="" CUR("HL","DTR")=DTR ; date/time recorded. Last date/time changed for any fields. "RTN","LRJSMLA",134,0) . . SET USER=$P(@NODE,"^",5) ; Accessed by (USER) "RTN","LRJSMLA",135,0) . . SET:USER'="" CUR("HL","USER")=USER ; accessed by (USER). Last user who changed any field. "RTN","LRJSMLA",136,0) . . SET ENTNM=$P(@NODE,"^",7) ; Entry Name From Audit File "RTN","LRJSMLA",137,0) . . ; "RTN","LRJSMLA",138,0) . . ; if change is to HL or Ward Loaction (room-bed ien is 0) "RTN","LRJSMLA",139,0) . . IF RBIEN=0 DO "RTN","LRJSMLA",140,0) . . . ;if HL change is to .01 field with no previous value "RTN","LRJSMLA",141,0) . . . IF NFLDNUM=.01 DO "RTN","LRJSMLA",142,0) . . . . IF OLDVAL="" DO "RTN","LRJSMLA",143,0) . . . . . SET CUR("HL","FLAG")="NEW" ; HL record flag "RTN","LRJSMLA",144,0) . . . ; "RTN","LRJSMLA",145,0) . . . ; if current flag not new, keep track and store the old value data in MOD array "RTN","LRJSMLA",146,0) . . . IF $G(CUR("HL","FLAG"))'="NEW" DO "RTN","LRJSMLA",147,0) . . . . ; store the old value only for the oldest changes for the given field "RTN","LRJSMLA",148,0) . . . . IF '$D(MOD("HL",NFLDNUM)) DO "RTN","LRJSMLA",149,0) . . . . . SET MOD("HL",NFLDNUM)=OLDVAL ; Old value "RTN","LRJSMLA",150,0) . . . ; "RTN","LRJSMLA",151,0) . . . ; if type is modified "RTN","LRJSMLA",152,0) . . . IF NFLDNUM="2" DO "RTN","LRJSMLA",153,0) . . . . ; if type changed from other to clinic/ward/operating room "RTN","LRJSMLA",154,0) . . . . IF OLDVAL'="","CLINIC^WARD^OPERATING ROOM"'[OLDVAL,"CLINIC^WARD^OPERATING ROOM"[NEWVAL SET ACTDT=DTR "RTN","LRJSMLA",155,0) . . . . ; "RTN","LRJSMLA",156,0) . . . . ; if type changed from clinic/ward/operating room to other. "RTN","LRJSMLA",157,0) . . . . IF "CLINIC^WARD^OPERATING ROOM"[OLDVAL,"CLINIC^WARD^OPERATING ROOM"'[NEWVAL SET INACTDT=DTR "RTN","LRJSMLA",158,0) . . ; "RTN","LRJSMLA",159,0) . . ; if this is for Room-bed changes (Note: nodes sorted by date/time from lowest to highest) "RTN","LRJSMLA",160,0) . . ; node value is in the format of: "RTN","LRJSMLA",161,0) . . ; new room-bed ien ^ New Value ^ Old ien ^ Old Value ^ Current Value "RTN","LRJSMLA",162,0) . . IF RBIEN'=0 DO "RTN","LRJSMLA",163,0) . . . SET CURMBD=$P($G(^DG(405.4,+RBIEN,0)),"^") ;room bed current value "RTN","LRJSMLA",164,0) . . . ; Check room-bed .01 field to see if room bed is new or not "RTN","LRJSMLA",165,0) . . . IF (NFLDNUM=".01") DO "RTN","LRJSMLA",166,0) . . . . IF OLDVAL="" DO "RTN","LRJSMLA",167,0) . . . . . KILL RMBDUNQ(+RBIEN,"CHANGE") ; Make sure "CHANGED node does not exist" "RTN","LRJSMLA",168,0) . . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; If already deleted verify DELETED100 node does not exist" "RTN","LRJSMLA",169,0) . . . . . SET RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_NEWVAL_"^^^"_$$CURRMBED("NARR",RBIEN) "RTN","LRJSMLA",170,0) . . . . ELSE DO "RTN","LRJSMLA",171,0) . . . . . KILL RMBDUNQ(+RBIEN,"NEW") ; Make sure "CHANGED node does not exist" "RTN","LRJSMLA",172,0) . . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; If it was already deleted make sure DELETED100 node does not exist" "RTN","LRJSMLA",173,0) . . . . . ; only store the first change "RTN","LRJSMLA",174,0) . . . . . SET:'$D(RMBDUNQ(+RBIEN,"CHANGE"))#2 RMBDUNQ(+RBIEN,"CHANGE")=(+RBIEN)_"^"_NEWVAL_"^"_(+RBIEN)_"^"_OLDVAL_"^"_$$CURRMBED("NARR",RBIEN) "RTN","LRJSMLA",175,0) . . . ; "RTN","LRJSMLA",176,0) . . . ; ward location is added/removed to/from the room-bed "RTN","LRJSMLA",177,0) . . . IF (NFLDNUM="100,.01") DO "RTN","LRJSMLA",178,0) . . . . ; if ward location is added to the room-bed. "RTN","LRJSMLA",179,0) . . . . IF OLDVAL="" DO "RTN","LRJSMLA",180,0) . . . . . SET:'$D(RMBDUNQ(+RBIEN,"CHANGE")) RMBDUNQ(+RBIEN,"NEW")=(+RBIEN)_"^"_CURMBD_"^^^"_CURMBD "RTN","LRJSMLA",181,0) . . . . . KILL RMBDUNQ(+RBIEN,"DELETED100") ; if deleted, verify DELETED100 node does not exist. "RTN","LRJSMLA",182,0) . . . . .; "RTN","LRJSMLA",183,0) . . . . ; if the the ward location is deleted from the room-bed, make sure not newed. "RTN","LRJSMLA",184,0) . . . . IF NEWVAL="" DO "RTN","LRJSMLA",185,0) . . . . . KILL RMBDUNQ(+RBIEN,"NEW") "RTN","LRJSMLA",186,0) . . . . . SET RMBDUNQ(+RBIEN,"DELETED100")="^^"_(+RBIEN)_"^"_ENTNM_"^"_CURMBD ; report Entry Name (ENTNM) from audit file "RTN","LRJSMLA",187,0) . . . ; "RTN","LRJSMLA",188,0) . ; "RTN","LRJSMLA",189,0) . ; Store results for current HL file entry in CUR and PREV arrays "RTN","LRJSMLA",190,0) . IF $D(CUR("HL","FLAG")),CUR("HL","FLAG")'="NEW" DO "RTN","LRJSMLA",191,0) . . MERGE PREV=CUR "RTN","LRJSMLA",192,0) . . SET CUR("HL","FLAG")="CURRENT" "RTN","LRJSMLA",193,0) . . SET PREV("HL","FLAG")="PREVIOUS" "RTN","LRJSMLA",194,0) . ; modify the PREV array from MOD array to record changes for HL file "RTN","LRJSMLA",195,0) . IF $G(CUR("HL","FLAG"))="" SET CUR("HL","FLAG")="CURRENT",PREV("HL","FLAG")="PREVIOUS",CUR("HL",.001)=HLIEN,PREV("HL",.001)=HLIEN,MOD("HL",.001)=HLIEN "RTN","LRJSMLA",196,0) . SET FLDNUM=0 FOR SET FLDNUM=$O(MOD("HL",FLDNUM)) QUIT:'FLDNUM SET PREV("HL",FLDNUM)=MOD("HL",FLDNUM) "RTN","LRJSMLA",197,0) . SET FLDNUM=0 FOR SET FLDNUM=$O(PREV("HL",FLDNUM)) QUIT:'FLDNUM SET:(FLDNUM'=.001)&(PREV("HL",FLDNUM)=$G(CUR("HL",FLDNUM))) PREV("HL",FLDNUM)="" "RTN","LRJSMLA",198,0) . ; "RTN","LRJSMLA",199,0) . ;determine if this HL was reactivated or inactivated. "RTN","LRJSMLA",200,0) . IF ACTDT'="",ACTDT>INACTDT S CUR("HL",2506)=ACTDT ; current reactivate date "RTN","LRJSMLA",201,0) . IF INACTDT'="",INACTDT>ACTDT S CUR("HL",2505)=INACTDT ; current inactivate date "RTN","LRJSMLA",202,0) . IF ACTDT'="",ACTDTTO) "RTN","LRJSMLA",327,0) . SET NFLDNUM=$QS(NODE,4) ; field number "RTN","LRJSMLA",328,0) . SET RBIEN=$QS(NODE,3) ; room-bed ien "RTN","LRJSMLA",329,0) . SET OLDVAL=$P(@NODE,"^",4) ; Old value (from last audit after "TO" date/time "RTN","LRJSMLA",330,0) . ; if change HL or Ward Location (room-bed ien is 0) "RTN","LRJSMLA",331,0) . ; rollback the current value to old value. "RTN","LRJSMLA",332,0) . IF RBIEN=0 DO "RTN","LRJSMLA",333,0) . . SET CUR("HL",NFLDNUM)=OLDVAL "RTN","LRJSMLA",334,0) Q "RTN","LRJSMLA",335,0) ; "RTN","LRJSMLA",336,0) GHL(HLIEN,CUR) ; get the fields that are to be reported for given HL into CUR array "RTN","LRJSMLA",337,0) ; Input: "RTN","LRJSMLA",338,0) ; HLIEN - Hosp Loc ien. "RTN","LRJSMLA",339,0) ; Output: "RTN","LRJSMLA",340,0) ; CUR - array containing hosiptal location data. "RTN","LRJSMLA",341,0) NEW ARR,FILENUM "RTN","LRJSMLA",342,0) SET FILENUM=44 "RTN","LRJSMLA",343,0) SET HLIEN=+HLIEN "RTN","LRJSMLA",344,0) ; "RTN","LRJSMLA",345,0) ;IA #10040 for Fileman ref (GETS^DIQ) into file 44 (Hospital Location) "RTN","LRJSMLA",346,0) DO GETS^DIQ(FILENUM,HLIEN_",",$$GRPTLST^LRJSMLA1(FILENUM,2),"IE","ARR") "RTN","LRJSMLA",347,0) SET CUR("HL",.001)=HLIEN ; ien "RTN","LRJSMLA",348,0) SET CUR("HL",.01)=ARR(44,HLIEN_",",.01,"E") ; HL name "RTN","LRJSMLA",349,0) SET CUR("HL",2)=ARR(44,HLIEN_",",2,"E") ; type "RTN","LRJSMLA",350,0) SET CUR("HL",3)=ARR(44,HLIEN_",",3,"E") ; institution "RTN","LRJSMLA",351,0) SET CUR("HL",3.5)=ARR(44,HLIEN_",",3.5,"E") ; division "RTN","LRJSMLA",352,0) SET CUR("HL",2505)=ARR(44,HLIEN_",",2505,"E") ; inactivation date "RTN","LRJSMLA",353,0) SET CUR("HL",2506)=ARR(44,HLIEN_",",2506,"E") ; reactivation date "RTN","LRJSMLA",354,0) SET CUR("HL","NAME")="LOCATION" "RTN","LRJSMLA",355,0) QUIT "RTN","LRJSMLA",356,0) ; "RTN","LRJSMLA",357,0) CURRMBED(LRARRY,RBIEN) ; Find value of Room-Bed after last change before End-Date "RTN","LRJSMLA",358,0) ;INPUT: "RTN","LRJSMLA",359,0) ; LRARRY - "NARR" Array name for local array with form: "RTN","LRJSMLA",360,0) ; NARR(date time recorded, Ward Location ien, room-bed ien and ward(s) sub-file, field number, audit file ien) "RTN","LRJSMLA",361,0) ; Node data = new internal value (NULL) ^ old internal value (NULL) ^ new value ^ old value ^ user ^ data time recorded ^ audit file entry name "RTN","LRJSMLA",362,0) ; "RTN","LRJSMLA",363,0) ; RBIEN - Room-Bed IEN "RTN","LRJSMLA",364,0) ; "RTN","LRJSMLA",365,0) ;OUTPUT: "RTN","LRJSMLA",366,0) ; LRRMBD - Current Room-Bed just prior to Change Report "End Date" "RTN","LRJSMLA",367,0) ; "RTN","LRJSMLA",368,0) NEW LRWLN,LRRBWN,LRFN,LRAUDN,LRLASTDT "RTN","LRJSMLA",369,0) ; "RTN","LRJSMLA",370,0) ;[Two Room-Bed Audit records will not have the same dt/tm] "RTN","LRJSMLA",371,0) SET (LRLASTDT,LRWLN,LRRBWN)="" "RTN","LRJSMLA",372,0) FOR SET LRRBWN=$$RBIENCK(.LRLASTDT,.LRWLN,LRARRY) Q:LRRBWN=RBIEN "RTN","LRJSMLA",373,0) ; "RTN","LRJSMLA",374,0) SET LRFN=$O(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,"")) ;Get field number "RTN","LRJSMLA",375,0) ; "RTN","LRJSMLA",376,0) ; Find last audit file ien subscript "RTN","LRJSMLA",377,0) SET LRAUDN=$O(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,""),-1) "RTN","LRJSMLA",378,0) QUIT $P(@LRARRY@(LRLASTDT,LRWLN,LRRBWN,LRFN,LRAUDN),"^",3) ;Return "Changed to" Rm-Bed for last entry "RTN","LRJSMLA",379,0) ; "RTN","LRJSMLA",380,0) RBIENCK(LRLSTDT,LRWLN,LRARRY) ; Check for correct Room-Bed IEN "RTN","LRJSMLA",381,0) ;INPUT: "RTN","LRJSMLA",382,0) ; LRLSTDT - Date of Last Change being processed [Passed by Reference] "RTN","LRJSMLA",383,0) ; LRWLN - IEN for Ward-Location being processed [Passed by Reference] "RTN","LRJSMLA",384,0) ; LRARRY - "NARR" Array name for local array [Passed from CURRMBED] "RTN","LRJSMLA",385,0) ; "RTN","LRJSMLA",386,0) ;OUTPUT: "RTN","LRJSMLA",387,0) ; Room-Bed IEN and Ward(s) sub-file just prior to "End Date" being processed "RTN","LRJSMLA",388,0) ; "RTN","LRJSMLA",389,0) SET LRLSTDT=$O(@LRARRY@(LRLSTDT),-1) ;Get last date "RTN","LRJSMLA",390,0) ; "RTN","LRJSMLA",391,0) SET LRWLN=$O(@LRARRY@(LRLSTDT,"")) ;Get Ward Location ien "RTN","LRJSMLA",392,0) ; "RTN","LRJSMLA",393,0) QUIT $O(@LRARRY@(LRLSTDT,LRWLN,"")) ;Return Room-Bed IEN and Ward(s) sub-file "RTN","LRJSMLA1") 0^16^B94292187^n/a "RTN","LRJSMLA1",1,0) LRJSMLA1 ;ALB/PO,GTS Lab Hospital Location Update Notification ;02/19/2010 12:01:53 "RTN","LRJSMLA1",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSMLA1",3,0) ; "RTN","LRJSMLA1",4,0) ; IAs : 10040, 10039, 1380 & 5611 "RTN","LRJSMLA1",5,0) ; "RTN","LRJSMLA1",6,0) SRTCHG(LRFR,LRTO,REVNODE) ; sort and reverse the relation room-bed to hospital location "RTN","LRJSMLA1",7,0) ; Input: "RTN","LRJSMLA1",8,0) ; LRFR - start time to report the raw data "RTN","LRJSMLA1",9,0) ; LRTO - end time to report the raw data. "RTN","LRJSMLA1",10,0) ; Output: "RTN","LRJSMLA1",11,0) ; @REVNODE@- array in the following format. "RTN","LRJSMLA1",12,0) ; "RTN","LRJSMLA1",13,0) ;@REVNODE@("N",HLIEN,LRDT,WLIEN,LRIEN,LRFLNUM,LRD0)=@NODE "RTN","LRJSMLA1",14,0) ;where : "RTN","LRJSMLA1",15,0) ; HLIEN = hospital location ien "RTN","LRJSMLA1",16,0) ; LRDT = date/time recorded "RTN","LRJSMLA1",17,0) ; WLIEN = Ward Location "RTN","LRJSMLA1",18,0) ; LRIEN = Room-bed ien or {Room-bed ien, ward(s). sub-file} "RTN","LRJSMLA1",19,0) ; LRFLNUM = field number "RTN","LRJSMLA1",20,0) ; LRD0 = ien of the audit file "RTN","LRJSMLA1",21,0) ; @REVNODE@("N",hospital location ien, date time recorded, Ward Location ien, room-bed ien and ward(s) sub-file, field number, audit file ien) "RTN","LRJSMLA1",22,0) ; = new internal value ^ old internal value ^ new value ^ old value ^ user ^ data time recorded ^ entry name from audit file "RTN","LRJSMLA1",23,0) ; "RTN","LRJSMLA1",24,0) ;@REVNODE@("N",HLIEN,LRDT, 0, 0, LRFLNUM, LRD0)=@NODE for info extracted from Hospital Location "RTN","LRJSMLA1",25,0) ;@REVNODE@("N",HLIEN,LRDT, WLIEN, 0, LRFLNUM, LRD0)=@NODE for info extracted from Ward Location "RTN","LRJSMLA1",26,0) ;@REVNODE@("N",HLIEN,LRDT, WLIEN, LRIEN, LRFLNUM, LRD0)=@NODE for info extracted room-bed info "RTN","LRJSMLA1",27,0) ; "RTN","LRJSMLA1",28,0) NEW OUTNODE,NOFFSET,NODE,FILENUM,LRIEN,LRDT,LRFLNUM,LRD0,HLIEN,RMD0,RMD1,WLIEN,HLIEN,DTR "RTN","LRJSMLA1",29,0) NEW LRCHAR,LRCNT,LRPROC "RTN","LRJSMLA1",30,0) KILL @REVNODE "RTN","LRJSMLA1",31,0) ; "RTN","LRJSMLA1",32,0) SET (LRCNT,LRCHAR)=0 "RTN","LRJSMLA1",33,0) SET OUTNODE=$NAME(@REVNODE@("OUTARR")) "RTN","LRJSMLA1",34,0) FOR NOFFSET=1:1 Q:$QS(OUTNODE,NOFFSET)="OUTARR" "RTN","LRJSMLA1",35,0) SET NODE=OUTNODE "RTN","LRJSMLA1",36,0) ; "RTN","LRJSMLA1",37,0) ; get the audit data for files 42,44 and 405.4 "RTN","LRJSMLA1",38,0) DO EXTRACT(42,LRFR,$$NOW^XLFDT(),NODE) "RTN","LRJSMLA1",39,0) DO EXTRACT(44,LRFR,$$NOW^XLFDT(),NODE) "RTN","LRJSMLA1",40,0) DO EXTRACT(405.4,LRFR,LRTO,NODE) "RTN","LRJSMLA1",41,0) ; "RTN","LRJSMLA1",42,0) FOR SET NODE=$Q(@NODE) QUIT:NODE="" Q:$QS(NODE,NOFFSET)'="OUTARR" DO "RTN","LRJSMLA1",43,0) . SET LRCNT=LRCNT+1 "RTN","LRJSMLA1",44,0) . IF LRCNT#150=0 DO "RTN","LRJSMLA1",45,0) . . D HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSMLA1",46,0) . . S LRCNT=0 "RTN","LRJSMLA1",47,0) .; "RTN","LRJSMLA1",48,0) .;NOTE: 1st subscript of NODE must be $J for this to work "RTN","LRJSMLA1",49,0) . SET LRPROC=$QS(NODE,1) "RTN","LRJSMLA1",50,0) . I LRPROC=$J DO "RTN","LRJSMLA1",51,0) . . SET FILENUM=$QS(NODE,NOFFSET+1) "RTN","LRJSMLA1",52,0) . . SET LRIEN=$QS(NODE,NOFFSET+2) "RTN","LRJSMLA1",53,0) . . SET LRDT=$QS(NODE,NOFFSET+3) "RTN","LRJSMLA1",54,0) . . SET LRFLNUM=$QS(NODE,NOFFSET+4) "RTN","LRJSMLA1",55,0) . . SET LRD0=$QS(NODE,NOFFSET+5) "RTN","LRJSMLA1",56,0) . . ; "RTN","LRJSMLA1",57,0) . . IF FILENUM="44" D "RTN","LRJSMLA1",58,0) . . . SET HLIEN=LRIEN "RTN","LRJSMLA1",59,0) . . . SET @REVNODE@("N",HLIEN,LRDT,0,0,LRFLNUM,LRD0)=@NODE "RTN","LRJSMLA1",60,0) . . ; "RTN","LRJSMLA1",61,0) . . IF FILENUM="42" DO "RTN","LRJSMLA1",62,0) . . . SET HLIEN=$$WLTOHL(LRIEN) ;Hospital Location ien "RTN","LRJSMLA1",63,0) . . . SET @REVNODE@("N",HLIEN,LRDT,LRIEN,0,LRFLNUM,LRD0)=@NODE "RTN","LRJSMLA1",64,0) . . ; "RTN","LRJSMLA1",65,0) . . IF FILENUM="405.4" D "RTN","LRJSMLA1",66,0) . . . SET RMD0=+LRIEN "RTN","LRJSMLA1",67,0) . . . ; if room's name changed or new room created or deleted "RTN","LRJSMLA1",68,0) . . . IF LRFLNUM=".01" D "RTN","LRJSMLA1",69,0) . . . . SET RMD1=0 "RTN","LRJSMLA1",70,0) . . . . FOR SET RMD1=$O(^DG(405.4,RMD0,"W",RMD1)) Q:'RMD1 D "RTN","LRJSMLA1",71,0) . . . . . SET WLIEN=+$P($G(^DG(405.4,RMD0,"W",RMD1,0)),"^",1) "RTN","LRJSMLA1",72,0) . . . . . SET HLIEN=$$WLTOHL(WLIEN) ;Hospital Location ien "RTN","LRJSMLA1",73,0) . . . . . SET @REVNODE@("N",HLIEN,LRDT,WLIEN,LRIEN,LRFLNUM,LRD0)=@NODE "RTN","LRJSMLA1",74,0) . . . ; "RTN","LRJSMLA1",75,0) . . . IF LRFLNUM="100,.01" DO ; if the field number is 100,.01 "RTN","LRJSMLA1",76,0) . . . . SET WLIEN=$P(LRIEN,",",2) ; Ward Location ien "RTN","LRJSMLA1",77,0) . . . . SET HLIEN=$$WLTOHL(WLIEN) ; Hospital Location ien "RTN","LRJSMLA1",78,0) . . . . SET @REVNODE@("N",HLIEN,LRDT,WLIEN,LRIEN,LRFLNUM,LRD0)=@NODE "RTN","LRJSMLA1",79,0) KILL @OUTNODE "RTN","LRJSMLA1",80,0) ; "RTN","LRJSMLA1",81,0) ;*Remove any HL activity that has nothing to report for entered date range "RTN","LRJSMLA1",82,0) SET HLIEN=0 "RTN","LRJSMLA1",83,0) FOR SET HLIEN=$O(@REVNODE@("N",HLIEN)) Q:'HLIEN DO "RTN","LRJSMLA1",84,0) .S DTR="" "RTN","LRJSMLA1",85,0) .FOR SET DTR=$O(@REVNODE@("N",HLIEN,DTR)) Q:'DTR Q:DTRLRTO @REVNODE@("N",HLIEN,DTR) "RTN","LRJSMLA1",87,0) ; "RTN","LRJSMLA1",88,0) QUIT "RTN","LRJSMLA1",89,0) ; "RTN","LRJSMLA1",90,0) EXTRACT(FILENUM,LRFR,LRTO,LRAUD) ; extract data from audit file for given file and date/time interval "RTN","LRJSMLA1",91,0) ; Input: "RTN","LRJSMLA1",92,0) ; FILENUM - file number for which to get audit data "RTN","LRJSMLA1",93,0) ; LRFR - start time for which to get the audit data "RTN","LRJSMLA1",94,0) ; LRTO - end time for which to get the audit data "RTN","LRJSMLA1",95,0) ; Output: "RTN","LRJSMLA1",96,0) ; @LRAUD@ - array in the following format. "RTN","LRJSMLA1",97,0) ; "RTN","LRJSMLA1",98,0) ; @LRAUD@(FILENUM,LRIEN,LRDT,LRFLNUM,LRD0)=LRNEWIEN_"^"_LROLDIEN_"^"_LRNEW_"^"_LROLD_"^"_LRUSER_"^"_LRDT_"^"_LRENTNM "RTN","LRJSMLA1",99,0) ; @LRAUD@(file num, record ien, date time recorded, field number, audit file ien)= "RTN","LRJSMLA1",100,0) ; = new internal value ^ old internal value ^ new value ^ old value ^ user ^ data time recorded ^ entry name from audit file "RTN","LRJSMLA1",101,0) ; "RTN","LRJSMLA1",102,0) NEW LRDATA,LRD0,LRDT,LRFLDNM,LRFLNUM,LRIEN,LRNEW,LRNEWIEN,LROLD,LROLDIEN,LRUSER,LRENTNM,LRCHAR "RTN","LRJSMLA1",103,0) SET LRCHAR=0 "RTN","LRJSMLA1",104,0) SET LRAUD=$G(LRAUD) "RTN","LRJSMLA1",105,0) SET LRDATA=$NAME(@LRAUD@("LRDATA")) "RTN","LRJSMLA1",106,0) KILL @LRDATA "RTN","LRJSMLA1",107,0) ; extract the audit data for given file number for given time interval. "RTN","LRJSMLA1",108,0) DO GAUDATA(FILENUM,LRFR,LRTO,.LRDATA) "RTN","LRJSMLA1",109,0) ; "RTN","LRJSMLA1",110,0) SET LRD0=0 "RTN","LRJSMLA1",111,0) FOR SET LRD0=$O(@LRDATA@(LRD0)) QUIT:'LRD0 DO "RTN","LRJSMLA1",112,0) . ; quit if audited field is not to be monitored "RTN","LRJSMLA1",113,0) . QUIT:'((";"_$$GMONLST(FILENUM,2)_";")[(";"_@LRDATA@(LRD0,.03)_";")) "RTN","LRJSMLA1",114,0) . SET LRDT=@LRDATA@(LRD0,".02") ;date/time recorded "RTN","LRJSMLA1",115,0) . QUIT:(LRDTLRTO) ;make sure date time recorded is within range "RTN","LRJSMLA1",116,0) . SET LRENTNM=@LRDATA@(LRD0,1) ;entry name from audit File "RTN","LRJSMLA1",117,0) . SET LRFLDNM=@LRDATA@(LRD0,1.1) ;field name "RTN","LRJSMLA1",118,0) . SET LRFLNUM=@LRDATA@(LRD0,.03) ;field number "RTN","LRJSMLA1",119,0) . SET LRIEN=@LRDATA@(LRD0,.01) ;file entry ien "RTN","LRJSMLA1",120,0) . SET LRNEW=@LRDATA@(LRD0,3) ;new value "RTN","LRJSMLA1",121,0) . SET LRNEWIEN=@LRDATA@(LRD0,3.1) ;new internal value "RTN","LRJSMLA1",122,0) . SET LROLD=@LRDATA@(LRD0,2) ;old value "RTN","LRJSMLA1",123,0) . SET LROLDIEN=@LRDATA@(LRD0,2.1) ;old internal value "RTN","LRJSMLA1",124,0) . SET LRUSER=@LRDATA@(LRD0,.04) ;user name "RTN","LRJSMLA1",125,0) . SET @LRAUD@(FILENUM,LRIEN,LRDT,LRFLNUM,LRD0)=LRNEWIEN_"^"_LROLDIEN_"^"_LRNEW_"^"_LROLD_"^"_LRUSER_"^"_LRDT_"^"_LRENTNM "RTN","LRJSMLA1",126,0) KILL @LRDATA "RTN","LRJSMLA1",127,0) QUIT "RTN","LRJSMLA1",128,0) ; "RTN","LRJSMLA1",129,0) GAUDATA(FILENUM,LRFR,LRTO,LRDATA) ; -- Get audited data change for the given file changes "RTN","LRJSMLA1",130,0) ; Input: "RTN","LRJSMLA1",131,0) ; FILENUM - file number for which to get audit data "RTN","LRJSMLA1",132,0) ; LRFR - start time for which to get the audit data ( SEE NOTE) "RTN","LRJSMLA1",133,0) ; LRTO - end time for which to get the audit data (SEE NOTE "RTN","LRJSMLA1",134,0) ; Output: "RTN","LRJSMLA1",135,0) ; @LRDATA@ - array containing data to get from audit file "RTN","LRJSMLA1",136,0) ; "RTN","LRJSMLA1",137,0) ; NOTE: print template seems that returns all the data and "RTN","LRJSMLA1",138,0) ; does not screen against given date range (FR and TO) "RTN","LRJSMLA1",139,0) ; "RTN","LRJSMLA1",140,0) ; set up parameters to run the print template to a null device and store the "RTN","LRJSMLA1",141,0) ; results in @LRDATA array "RTN","LRJSMLA1",142,0) ; in case there is no null defined, print template with IOP of ";;99999" still "RTN","LRJSMLA1",143,0) ; will store the results in LRDATA "RTN","LRJSMLA1",144,0) ; "RTN","LRJSMLA1",145,0) NEW DIC,BY,FLDS,LRDEV,FR,TO,DIA,D0,DISYS,DILOCKTM,X1,IOP "RTN","LRJSMLA1",146,0) NEW LRDT,LRFLDNM,LRFLNUM,LRIEN,LRNEW,LROLD,LRUSER,LRX "RTN","LRJSMLA1",147,0) DO:'$D(U) DT^DICRW "RTN","LRJSMLA1",148,0) SET DIC="^DIA("_FILENUM_"," "RTN","LRJSMLA1",149,0) SET BY="DATE/TIME RECORDED" "RTN","LRJSMLA1",150,0) SET FR=LRFR "RTN","LRJSMLA1",151,0) SET TO=LRTO "RTN","LRJSMLA1",152,0) SET FLDS="[LRJ SYS GET INDIRECT AUDIT]" ; make sure LRDATA is set to array or temp global name before the print template gets called. "RTN","LRJSMLA1",153,0) ; "RTN","LRJSMLA1",154,0) FOR LRDEV="NULL DEVICE","NULL" SET IOP=$$GIOP(LRDEV) QUIT:IOP'="" "RTN","LRJSMLA1",155,0) IF IOP="" SET IOP=";;99999" ; if no IOP then set the number of lines per page to maximum "RTN","LRJSMLA1",156,0) DO EN1^DIP "RTN","LRJSMLA1",157,0) QUIT "RTN","LRJSMLA1",158,0) ; "RTN","LRJSMLA1",159,0) GIOP(DEVICE) ; -- return the device if exists and it is not FORCED to queue, otherwise return "" "RTN","LRJSMLA1",160,0) ;Input "RTN","LRJSMLA1",161,0) ; DEVICE - Device to lookup "RTN","LRJSMLA1",162,0) ; "RTN","LRJSMLA1",163,0) ;Output "RTN","LRJSMLA1",164,0) ; DEVICE - Device Characteristics "RTN","LRJSMLA1",165,0) ; or "RTN","LRJSMLA1",166,0) ; "" : Device doesn't exist "RTN","LRJSMLA1",167,0) ; "RTN","LRJSMLA1",168,0) ; "RTN","LRJSMLA1",169,0) NEW IOP,%ZIS,POP,IO "RTN","LRJSMLA1",170,0) SET IOP=DEVICE "RTN","LRJSMLA1",171,0) SET %ZIS="NQ" ; ^%ZIS call does not open the device & allows QUEUING. Replaces: %ZIS="N" "RTN","LRJSMLA1",172,0) DO ^%ZIS ; retrun the characteristics of the device. "RTN","LRJSMLA1",173,0) IF POP=1 DO ; does the device exist? "RTN","LRJSMLA1",174,0) .SET DEVICE="" "RTN","LRJSMLA1",175,0) ELSE DO "RTN","LRJSMLA1",176,0) . ; is queuing forced for this device? {%ZIS["Q" & QUEUING field = FORCED; returns IO("Q")=1} "RTN","LRJSMLA1",177,0) . IF $D(IO("Q"))=1 SET DEVICE="" ;;Replaces: IF $P(^%ZIS(1,IOS,0),"^",12)=1 SET DEVICE="" "RTN","LRJSMLA1",178,0) ; "RTN","LRJSMLA1",179,0) DO ^%ZISC ; restore the device variables "RTN","LRJSMLA1",180,0) QUIT DEVICE "RTN","LRJSMLA1",181,0) ; "RTN","LRJSMLA1",182,0) WLTOHL(WLIEN) ; -- get associated hospital location from ward location "RTN","LRJSMLA1",183,0) ;IA #10039 allows reference to ^DIC(42 "RTN","LRJSMLA1",184,0) Q +$G(^DIC(42,WLIEN,44)) "RTN","LRJSMLA1",185,0) ; "RTN","LRJSMLA1",186,0) HLTOWL(HLIEN) ; get associated ward location from hospital location "RTN","LRJSMLA1",187,0) ;IA #10040 allows reference to ^SC( "RTN","LRJSMLA1",188,0) Q +$G(^SC(HLIEN,42)) "RTN","LRJSMLA1",189,0) ; "RTN","LRJSMLA1",190,0) KEEPBED(RMBDIEN,BEDNODE) ;* Check for existence of Room-Bed when Ward is reactivated "RTN","LRJSMLA1",191,0) ; "RTN","LRJSMLA1",192,0) ;Input: "RTN","LRJSMLA1",193,0) ; RMBDIEN - IEN of Room-Bed record to check "RTN","LRJSMLA1",194,0) ; BEDNODE - Reverse Location Array for report [$NAME(@OUT@("REVARR","N",HLIEN)) from LRJSMLA] "RTN","LRJSMLA1",195,0) ; "RTN","LRJSMLA1",196,0) ;Output: "RTN","LRJSMLA1",197,0) ; RMBDXST : "RTN","LRJSMLA1",198,0) ; 0 - Room-Bed did not exist when reactivated "RTN","LRJSMLA1",199,0) ; 1 - Room-Bed existed when reactivated "RTN","LRJSMLA1",200,0) ; "RTN","LRJSMLA1",201,0) NEW RMBDXST,LRDT,WLIEN,LRIEN,LRCHAR "RTN","LRJSMLA1",202,0) SET LRDT="" "RTN","LRJSMLA1",203,0) SET RMBDXST=0 "RTN","LRJSMLA1",204,0) SET LRCHAR=0 "RTN","LRJSMLA1",205,0) FOR SET LRDT=$O(@BEDNODE@(LRDT)) QUIT:LRDT="" QUIT:RMBDXST=1 DO "RTN","LRJSMLA1",206,0) .D HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSMLA1",207,0) .SET WLIEN="" "RTN","LRJSMLA1",208,0) .FOR SET WLIEN=$O(@BEDNODE@(LRDT,WLIEN)) QUIT:WLIEN="" QUIT:RMBDXST=1 DO "RTN","LRJSMLA1",209,0) ..SET LRIEN="" "RTN","LRJSMLA1",210,0) ..FOR SET LRIEN=$O(@BEDNODE@(LRDT,WLIEN,LRIEN)) QUIT:LRIEN="" QUIT:RMBDXST=1 DO "RTN","LRJSMLA1",211,0) ...SET:LRIEN[$P(RMBDIEN,",") RMBDXST=1 "RTN","LRJSMLA1",212,0) QUIT RMBDXST "RTN","LRJSMLA1",213,0) ; "RTN","LRJSMLA1",214,0) CLNUP(NODE) ;* Check for date of RM-BD change against when it was added to Location "RTN","LRJSMLA1",215,0) ; "RTN","LRJSMLA1",216,0) ;Input: "RTN","LRJSMLA1",217,0) ; NODE - Value of previous node [@OUT@(HLSORT,HLIEN,0,"PREVIOUS")] "RTN","LRJSMLA1",218,0) ; "RTN","LRJSMLA1",219,0) ;Output: "RTN","LRJSMLA1",220,0) ; NODE - Room/Bed nodes with edits prior to addition of new Ward Location removed "RTN","LRJSMLA1",221,0) ; "RTN","LRJSMLA1",222,0) NEW LRDT,WLIEN,RMBDIEN,LRFLDNM,RMBDARY,LRCHAR "RTN","LRJSMLA1",223,0) ; "RTN","LRJSMLA1",224,0) SET LRDT="" "RTN","LRJSMLA1",225,0) SET LRCHAR=0 "RTN","LRJSMLA1",226,0) FOR SET LRDT=$O(NODE(LRDT)) QUIT:LRDT="" DO "RTN","LRJSMLA1",227,0) .D HANGCHAR^LRJSMLU(.LRCHAR) "RTN","LRJSMLA1",228,0) .SET WLIEN="" "RTN","LRJSMLA1",229,0) .FOR SET WLIEN=$O(NODE(LRDT,WLIEN)) QUIT:WLIEN="" DO "RTN","LRJSMLA1",230,0) ..SET RMBDIEN="" "RTN","LRJSMLA1",231,0) ..FOR SET RMBDIEN=$O(NODE(LRDT,WLIEN,RMBDIEN)) QUIT:RMBDIEN="" DO "RTN","LRJSMLA1",232,0) ...SET LRFLDNM="" "RTN","LRJSMLA1",233,0) ...FOR SET LRFLDNM=$O(NODE(LRDT,WLIEN,RMBDIEN,LRFLDNM)) QUIT:LRFLDNM="" DO "RTN","LRJSMLA1",234,0) ....IF LRFLDNM[".01",$P(LRFLDNM,".",2)="01" DO "RTN","LRJSMLA1",235,0) .....SET:(LRFLDNM'["100") $P(RMBDARY(WLIEN,$P(RMBDIEN,","),LRFLDNM),"^")=LRDT ;Dt/Tm edited Rm-Bd name "RTN","LRJSMLA1",236,0) .....SET:(LRFLDNM'["100") $P(RMBDARY(WLIEN,$P(RMBDIEN,","),LRFLDNM),"^",3)=$O(NODE(LRDT,WLIEN,RMBDIEN,LRFLDNM,"")) ;IEN of Edited Rm-Bd "RTN","LRJSMLA1",237,0) .....SET:(LRFLDNM["100") $P(RMBDARY(WLIEN,$P(RMBDIEN,","),$P(LRFLDNM,",",2)),"^",2)=LRDT ;Dt/Tm added Rm-Bd to Ward-Loc "RTN","LRJSMLA1",238,0) ; "RTN","LRJSMLA1",239,0) ;Check RMBDARY for Room-Beds that were edited before adding to Ward-Location "RTN","LRJSMLA1",240,0) ; If found, remove changes prior to addition to Ward-Location "RTN","LRJSMLA1",241,0) ; "RTN","LRJSMLA1",242,0) ; RMBDARY()= "RTN","LRJSMLA1",243,0) ; Date/Time RM-BD edited ^ Date/Time RM-BD added to Ward-Loc ^ Last Subscript of RM-BD Edit NODE "RTN","LRJSMLA1",244,0) SET WLIEN="" "RTN","LRJSMLA1",245,0) FOR SET WLIEN=$O(RMBDARY(WLIEN)) QUIT:WLIEN="" DO "RTN","LRJSMLA1",246,0) .SET RMBDIEN="" "RTN","LRJSMLA1",247,0) .FOR SET RMBDIEN=$O(RMBDARY(WLIEN,RMBDIEN)) QUIT:RMBDIEN="" DO "RTN","LRJSMLA1",248,0) ..SET LRFLDNM="" "RTN","LRJSMLA1",249,0) ..FOR SET LRFLDNM=$O(RMBDARY(WLIEN,RMBDIEN,LRFLDNM)) QUIT:LRFLDNM="" DO "RTN","LRJSMLA1",250,0) ...IF $P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^")<$P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^",2) DO "RTN","LRJSMLA1",251,0) ....; If PREVIOUS defines change but must report no change when the Rm-Bed is added during the "RTN","LRJSMLA1",252,0) ....; date range, then KILL NODE if 2nd piece of NODE data is not Null "RTN","LRJSMLA1",253,0) ....KILL:(+$P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^")>0) NODE($P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^",1),WLIEN,RMBDIEN,LRFLDNM,$P(RMBDARY(WLIEN,RMBDIEN,LRFLDNM),"^",3)) "RTN","LRJSMLA1",254,0) QUIT "RTN","LRJSMLA1",255,0) ; "RTN","LRJSMLA1",256,0) ;-------------------------------------------------------------------------- "RTN","LRJSMLA1",257,0) GRPTLST(FILENUM,PIECE) ; -- get the list of fields to be reported for given file Num "RTN","LRJSMLA1",258,0) QUIT $$GFLDS(FILENUM,"RPTLST",PIECE) "RTN","LRJSMLA1",259,0) ; "RTN","LRJSMLA1",260,0) GMONLST(FILENUM,PIECE) ; -- get the list of audited fields for given file number "RTN","LRJSMLA1",261,0) QUIT $$GFLDS(FILENUM,"MONLST",PIECE) "RTN","LRJSMLA1",262,0) ; "RTN","LRJSMLA1",263,0) RPTLST ; -- list of files and fields to be reported "RTN","LRJSMLA1",264,0) ;;44^.01;2;3;3.5;2505;2506^44,.01;44,2;44,3;44,3.5;44,2505;44,2506 "RTN","LRJSMLA1",265,0) ;;42^.01;.015;44^42,.01;42,.015;42,44 "RTN","LRJSMLA1",266,0) ;;405.4^**^405.4,.01;405.41,.01 "RTN","LRJSMLA1",267,0) ; End of List - do not change or remove this comment "RTN","LRJSMLA1",268,0) ; "RTN","LRJSMLA1",269,0) MONLST ; -- list of audited file numbers and fields to be monitored "RTN","LRJSMLA1",270,0) ;;44^.01;2;3;3.5;2505;2506 "RTN","LRJSMLA1",271,0) ;;42^.01;.015;44 "RTN","LRJSMLA1",272,0) ;;405.4^.01;100,.01 "RTN","LRJSMLA1",273,0) ; End of List - do not change or remove this comment "RTN","LRJSMLA1",274,0) ; "RTN","LRJSMLA1",275,0) GFLDS(FILENUM,TAGRTN,PIECE) ; search in the given tag for FileNum and get list of fields "RTN","LRJSMLA1",276,0) NEW TAG,RTN,I,LIST,FLDS "RTN","LRJSMLA1",277,0) SET TAG=$P(TAGRTN,"^",1) "RTN","LRJSMLA1",278,0) SET RTN=$P(TAGRTN,"^",2) "RTN","LRJSMLA1",279,0) SET:'$D(PIECE) PIECE=2 "RTN","LRJSMLA1",280,0) SET:RTN="" RTN=$T(+0) "RTN","LRJSMLA1",281,0) SET LIST="",FLDS="" "RTN","LRJSMLA1",282,0) FOR I=1:1 DO QUIT:LIST="" "RTN","LRJSMLA1",283,0) .SET LIST=$P($TEXT(@TAG+I^@RTN),";;",2) "RTN","LRJSMLA1",284,0) .IF FILENUM=+LIST SET FLDS=$P(LIST,"^",PIECE),LIST="" "RTN","LRJSMLA1",285,0) QUIT FLDS "RTN","LRJSMLA1",286,0) ; "RTN","LRJSMLA1",287,0) ;---------------------------- "RTN","LRJSMLA1",288,0) ; "RTN","LRJSMLA1",289,0) AUDSET ; -- enable audit some fields for Hospital Location, Ward Location and Room-Bed "RTN","LRJSMLA1",290,0) ; This API not executed by Lab system. "RTN","LRJSMLA1",291,0) ; PURPOSE: Execute from programmer mode, IF Fileman Auditing required for HLCMS accidentally turned off. "RTN","LRJSMLA1",292,0) ; "RTN","LRJSMLA1",293,0) NEW LRI,LRAFLDS "RTN","LRJSMLA1",294,0) FOR LRI=1:1 SET LRAFLDS=$P($TEXT(AFLDS+LRI),";;",2) QUIT:LRAFLDS="" DO "RTN","LRJSMLA1",295,0) . DO TURNON^DIAUTL(+LRAFLDS,$P(LRAFLDS,"^",2)) ;IA #5611 allows audit in HL files "RTN","LRJSMLA1",296,0) . W !,"Turning on audit for file/Subfile ",+LRAFLDS,?44,"for fields ",$P(LRAFLDS,"^",2) "RTN","LRJSMLA1",297,0) QUIT "RTN","LRJSMLA1",298,0) ; "RTN","LRJSMLA1",299,0) AFLDS ; --- file^fields for which to turn on the audit "RTN","LRJSMLA1",300,0) ;;44^.01;2;3;3.5;2505;2506 "RTN","LRJSMLA1",301,0) ;;42^.01;.015;44 "RTN","LRJSMLA1",302,0) ;;405.4^.01 "RTN","LRJSMLA1",303,0) ;;405.41^.01 "RTN","LRJSMLA1",304,0) ; End of List - do not change or remove this comment "RTN","LRJSMLA1",305,0) ; "RTN","LRJSMLA1",306,0) ;---------------------------- "RTN","LRJSMLU") 0^5^B39493848^n/a "RTN","LRJSMLU",1,0) LRJSMLU ;ALBOI/GTS - Lab VistA LRJ DATA SERVER UTILITY ;OCT 2, 2010 "RTN","LRJSMLU",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJSMLU",3,0) ; "RTN","LRJSMLU",4,0) ; "RTN","LRJSMLU",5,0) ADD(VALMCNT,MSG,LRBOLD) ; -- add line to build display "RTN","LRJSMLU",6,0) SET VALMCNT=VALMCNT+1 "RTN","LRJSMLU",7,0) DO SET^VALM10(VALMCNT,MSG) "RTN","LRJSMLU",8,0) IF $GET(LRBOLD) DO CNTRL^VALM10(VALMCNT,1,79,IOINHI,IOINORM) "RTN","LRJSMLU",9,0) QUIT "RTN","LRJSMLU",10,0) ; "RTN","LRJSMLU",11,0) STARTDTM(LRDEF) ; Prompt for Date and Time to schedule task "RTN","LRJSMLU",12,0) ; Called from SCHDBCKG^LRJSML6 "RTN","LRJSMLU",13,0) ; "RTN","LRJSMLU",14,0) ; Input: "RTN","LRJSMLU",15,0) ; LRDEF - Default Date/Time "RTN","LRJSMLU",16,0) ; "RTN","LRJSMLU",17,0) ; Output: "RTN","LRJSMLU",18,0) ; LROK^LRSTDTM^LRY where - "RTN","LRJSMLU",19,0) ; "RTN","LRJSMLU",20,0) ; LROK : 1 - User did not time out or enter ^ to exit "RTN","LRJSMLU",21,0) ; 0 - User timed out or entered ^ to exit "RTN","LRJSMLU",22,0) ; "RTN","LRJSMLU",23,0) ; LRSTDTM : Fileman formatted Date/Time "RTN","LRJSMLU",24,0) ; or "RTN","LRJSMLU",25,0) ; Null when Date/Time not entered "RTN","LRJSMLU",26,0) ; "RTN","LRJSMLU",27,0) ; LRY : Y returned from %DT "RTN","LRJSMLU",28,0) ; "RTN","LRJSMLU",29,0) NEW LRY,LROK,LRSTDTM "RTN","LRJSMLU",30,0) WRITE !!,"This is the date/time you want this option to be started by TaskMan.",! "RTN","LRJSMLU",31,0) SET LRSTDTM="" "RTN","LRJSMLU",32,0) SET LROK=1 "RTN","LRJSMLU",33,0) SET DIR(0)="FAO^^D BJITT^LRJSML6" "RTN","LRJSMLU",34,0) SET DIR("A")="QUEUED TO RUN AT WHAT TIME: " "RTN","LRJSMLU",35,0) SET:$G(LRDEF)'="" DIR("B")=LRDEF "RTN","LRJSMLU",36,0) SET DIR("?")="^D ITTHELP^LRJSMLU(X)" "RTN","LRJSMLU",37,0) DO ^DIR "RTN","LRJSMLU",38,0) SET LRY=X "RTN","LRJSMLU",39,0) SET:($D(DTOUT)!(X["^")!((Y']"")&(X'="@"))) LROK=0 "RTN","LRJSMLU",40,0) KILL DIR,X,Y,%DT "RTN","LRJSMLU",41,0) SET %DT="FR" "RTN","LRJSMLU",42,0) SET X=LRY "RTN","LRJSMLU",43,0) DO ^%DT "RTN","LRJSMLU",44,0) SET:Y>0 LRSTDTM=Y ;Date/Time to start background task "RTN","LRJSMLU",45,0) KILL DIR,X,Y,DTOUT,DIRUT,DUOUT,%DT "RTN","LRJSMLU",46,0) SET LROK=LROK_"^"_LRSTDTM_"^"_LRY "RTN","LRJSMLU",47,0) QUIT LROK "RTN","LRJSMLU",48,0) ; "RTN","LRJSMLU",49,0) ITTHELP(LRX) ; Display Help for Queued Start Time prompt "RTN","LRJSMLU",50,0) IF LRX="?" DO "RTN","LRJSMLU",51,0) .NEW DIR,X,Y,DTOUT,DIRUT,DUOUT "RTN","LRJSMLU",52,0) .WRITE !,"Time must be at least 2 minutes in the future." "RTN","LRJSMLU",53,0) .WRITE !,"Changing or deleting this date/time field will re-queue or un-queue the Option." "RTN","LRJSMLU",54,0) .WRITE ! "RTN","LRJSMLU",55,0) .WRITE !," Examples of Valid Dates:" "RTN","LRJSMLU",56,0) .WRITE !," JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057" "RTN","LRJSMLU",57,0) .WRITE !," T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc." "RTN","LRJSMLU",58,0) IF LRX="??" DO "RTN","LRJSMLU",59,0) .NEW DIR,LRCONT "RTN","LRJSMLU",60,0) .SET LRCONT=1 "RTN","LRJSMLU",61,0) .WRITE !,"Changing or deleting this date/time field will re-queue or un-queue the Option." "RTN","LRJSMLU",62,0) .WRITE !!,"If this field has a value, the Task Manager will try to run this OPTION" "RTN","LRJSMLU",63,0) .WRITE !,"on or after the date/time entered. This field should NOT have a" "RTN","LRJSMLU",64,0) .WRITE !,"value if the OPTION TYPE is MENU, INQUIRY, or EDIT, since it doesn't" "RTN","LRJSMLU",65,0) .WRITE !,"make sense to start up automatically a process that requires user" "RTN","LRJSMLU",66,0) .WRITE !,"terminal input." "RTN","LRJSMLU",67,0) .WRITE !!," Examples of Valid Dates:" "RTN","LRJSMLU",68,0) .WRITE !," JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057" "RTN","LRJSMLU",69,0) .WRITE !," T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc." "RTN","LRJSMLU",70,0) .WRITE !!," If the year is omitted, the computer uses CURRENT YEAR. Two digit year" "RTN","LRJSMLU",71,0) .WRITE !," assumes no more than 20 years in the future, or 80 years in the past.",! "RTN","LRJSMLU",72,0) QUIT "RTN","LRJSMLU",73,0) ; "RTN","LRJSMLU",74,0) BJITS ;input transform for background job re-sch freq "RTN","LRJSMLU",75,0) ; Also called from SCHDBCKG^LRJSML6 "RTN","LRJSMLU",76,0) ; "RTN","LRJSMLU",77,0) IF $$ENTCHK^LRJSML6(X) QUIT "RTN","LRJSMLU",78,0) DO ITSHELP("?") "RTN","LRJSMLU",79,0) KILL X "RTN","LRJSMLU",80,0) QUIT "RTN","LRJSMLU",81,0) ; "RTN","LRJSMLU",82,0) ITSHELP(LRX) ; Display Help for Schedule Freq prompt "RTN","LRJSMLU",83,0) ; Also called from SCHDBCKG^LRJSML6 "RTN","LRJSMLU",84,0) ; "RTN","LRJSMLU",85,0) IF LRX="?" DO "RTN","LRJSMLU",86,0) .WRITE !,"FOR AUTOMATIC RE-QUEUING, ANSWER WITH INCREMENT OF HOURS, DAYS, OR MONTHS" "RTN","LRJSMLU",87,0) .WRITE !," with codes from 2 - 15 characters." "RTN","LRJSMLU",88,0) IF (LRX="?")!(LRX="??")!(LRX="???") DO "RTN","LRJSMLU",89,0) .WRITE !,"Examples:" "RTN","LRJSMLU",90,0) .WRITE !," 120S = job will be re-run every two minutes" "RTN","LRJSMLU",91,0) .WRITE !," 1H = job will be rerun every hour" "RTN","LRJSMLU",92,0) .WRITE !," 7D = job will be re-run every week" "RTN","LRJSMLU",93,0) .WRITE !," 3M = job will be run once a quarter" "RTN","LRJSMLU",94,0) IF LRX="??"!(LRX="???") DO "RTN","LRJSMLU",95,0) .NEW DIR,LRCONT "RTN","LRJSMLU",96,0) .SET LRCONT=1 "RTN","LRJSMLU",97,0) .WRITE !!,"This field has a value only if the OPTION is to be re-queued automatically" "RTN","LRJSMLU",98,0) .WRITE !,"for a subsequent run every time it is run by the TaskManager." "RTN","LRJSMLU",99,0) .WRITE !!,"Valid codes are:" "RTN","LRJSMLU",100,0) .WRITE !," Every n seconds nS" "RTN","LRJSMLU",101,0) .WRITE !," Every n hours nH" "RTN","LRJSMLU",102,0) .WRITE !," Every n days nD" "RTN","LRJSMLU",103,0) .WRITE !," Every n months nM" "RTN","LRJSMLU",104,0) .WRITE !," Day of Week day[@time]" "RTN","LRJSMLU",105,0) .WRITE !," weekday D[@time]" "RTN","LRJSMLU",106,0) .WRITE !," weekend day E[@time] (saturday, sunday)" "RTN","LRJSMLU",107,0) .WRITE !," Different days in month nM(sch...)" "RTN","LRJSMLU",108,0) .WRITE !," sch: dd[@time] day of month ie: 15" "RTN","LRJSMLU",109,0) .WRITE !," nDay[@time] day of week in month" "RTN","LRJSMLU",110,0) .WRITE !," ie: 1W,3W first and third wednesday" "RTN","LRJSMLU",111,0) .WRITE !," L last",! "RTN","LRJSMLU",112,0) .SET DIR(0)="E" "RTN","LRJSMLU",113,0) .DO ^DIR "RTN","LRJSMLU",114,0) .SET LRCONT=+Y "RTN","LRJSMLU",115,0) .IF LRCONT DO "RTN","LRJSMLU",116,0) ..WRITE !!," day:= M monday" "RTN","LRJSMLU",117,0) ..WRITE !," T tuesday" "RTN","LRJSMLU",118,0) ..WRITE !," W wednesday" "RTN","LRJSMLU",119,0) ..WRITE !," R thursday" "RTN","LRJSMLU",120,0) ..WRITE !," F friday" "RTN","LRJSMLU",121,0) ..WRITE !," S saturday" "RTN","LRJSMLU",122,0) ..WRITE !," U sunday" "RTN","LRJSMLU",123,0) ..WRITE !!," Examples:" "RTN","LRJSMLU",124,0) ..WRITE !," 1M(1,15) The first and 15th of the month." "RTN","LRJSMLU",125,0) ..WRITE !," 1M(L) The last day of the month." "RTN","LRJSMLU",126,0) ..WRITE !," 1M(LS) The last saturday of the month." "RTN","LRJSMLU",127,0) ..WRITE !," D Each weekday",! "RTN","LRJSMLU",128,0) QUIT "RTN","LRJSMLU",129,0) ; "RTN","LRJSMLU",130,0) HANGCHAR(LRCHAR) ; Display Hang Characters "RTN","LRJSMLU",131,0) NEW LRBS,LRD,LRS "RTN","LRJSMLU",132,0) SET:'$D(LRCHAR) LRCHAR=0 "RTN","LRJSMLU",133,0) SET LRD="- ]" "RTN","LRJSMLU",134,0) SET LRS="\ ]" "RTN","LRJSMLU",135,0) SET LRBS="/ ]" "RTN","LRJSMLU",136,0) NEW LRRESET,LRY "RTN","LRJSMLU",137,0) SET LRY=$Y "RTN","LRJSMLU",138,0) DO IOXY^XGF(IOSL-1,75) ;IA #3173 "RTN","LRJSMLU",139,0) SET LRRESET=0 "RTN","LRJSMLU",140,0) SET:LRCHAR=0 LRCHAR=LRBS "RTN","LRJSMLU",141,0) IF 'LRRESET,LRCHAR=LRD SET LRCHAR=LRS SET LRRESET=1 "RTN","LRJSMLU",142,0) IF 'LRRESET,LRCHAR=LRS SET LRCHAR=LRBS SET LRRESET=1 "RTN","LRJSMLU",143,0) IF 'LRRESET,LRCHAR=LRBS SET LRCHAR=LRD SET LRRESET=1 "RTN","LRJSMLU",144,0) WRITE LRCHAR "RTN","LRJSMLU",145,0) IF 1 ;Needed for ^DIC screen calls "RTN","LRJSMLU",146,0) Q "RTN","LRJSMLU",147,0) ; "RTN","LRJSMLU",148,0) UUEN(STR) ; Uuencode string passed in. "RTN","LRJSMLU",149,0) N J,K,LEN,LRI,LRX,S,TMP,X,Y "RTN","LRJSMLU",150,0) S TMP="",LEN=$L(STR) "RTN","LRJSMLU",151,0) F LRI=1:3:LEN D "RTN","LRJSMLU",152,0) . S LRX=$E(STR,LRI,LRI+2) "RTN","LRJSMLU",153,0) . I $L(LRX)<3 S LRX=LRX_$E(" ",1,3-$L(LRX)) "RTN","LRJSMLU",154,0) . S S=$A(LRX,1)*256+$A(LRX,2)*256+$A(LRX,3),Y="" "RTN","LRJSMLU",155,0) . F K=0:1:23 S Y=(S\(2**K)#2)_Y "RTN","LRJSMLU",156,0) . F K=1:6:24 D "RTN","LRJSMLU",157,0) . . S J=$$DEC^XLFUTL($E(Y,K,K+5),2) "RTN","LRJSMLU",158,0) . . S TMP=TMP_$C(J+32) "RTN","LRJSMLU",159,0) S TMP=$C(LEN+32)_TMP "RTN","LRJSMLU",160,0) Q TMP "RTN","LRJSMLU",161,0) ; "RTN","LRJSMLU",162,0) BLDNUM() ; -- returns the build number "RTN","LRJSMLU",163,0) QUIT +$PIECE($PIECE($TEXT(LRJSMLU+1),";",7),"Build ",2) "RTN","LRJSMLU",164,0) ; "RTN","LRJSMLU",165,0) VERNUM() ; -- returns the version number for this build "RTN","LRJSMLU",166,0) QUIT +$PIECE($TEXT(LRJSMLU+1),";",3) "RTN","LRJSMLU",167,0) ; "RTN","LRJSMLU",168,0) MGRCHK() ; -- does DUZ have LRJ HL TOOLS MGR key "RTN","LRJSMLU",169,0) N LRSEC "RTN","LRJSMLU",170,0) D OWNSKEY^XUSRB(.LRSEC,"LRJ HL TOOLS MGR") "RTN","LRJSMLU",171,0) Q +$G(LRSEC(0)) "RTN","LRJUTL3") 0^21^B817310^n/a "RTN","LRJUTL3",1,0) LRJUTL3 ;ALB/TMK - Topography/Collection sample/Etiology inactivate dates and file 60 audit utilities ;09/15/2010 10:42:52 "RTN","LRJUTL3",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRJUTL3",3,0) ; "RTN","LRJUTL3",4,0) Q "RTN","LRJUTL3",5,0) ACTV61(LRIEN,LRDT) ; Return active status of entry in file 61 as of date in LRDT "RTN","LRJUTL3",6,0) ; Returns 1 if active, 0 if not active "RTN","LRJUTL3",7,0) I '$G(LRDT) S LRDT=DT ; assume current date if no date passed "RTN","LRJUTL3",8,0) Q $S($P($G(^LAB(61,LRIEN,64.91)),U,3):$P(^(64.91),U,3)>LRDT,1:1) "RTN","LRJUTL3",9,0) ; "RTN","LRJUTL3",10,0) ACTV62(LRIEN,LRDT) ; Return active status of entry in file 62 as of date in LRDT "RTN","LRJUTL3",11,0) ; Returns 1 if active, 0 if not active "RTN","LRJUTL3",12,0) I '$G(LRDT) S LRDT=DT ; assume current date if no date passed "RTN","LRJUTL3",13,0) Q $S($P($G(^LAB(62,LRIEN,64.91)),U,1):$P(^(64.91),U,1)>LRDT,1:1) "RTN","LRJUTL3",14,0) ; "RTN","LRSRVR6") 0^4^B37731233^B34119485 "RTN","LRSRVR6",1,0) LRSRVR6 ;DALOI/JMC,TMK - LAB DATA SERVER CONT'D SNOMED EXTRACT ; 17 Apr 2013 2:03 PM "RTN","LRSRVR6",2,0) ;;5.2;LAB SERVICE;**346,378,350,425**;Sep 27, 1994;Build 30 "RTN","LRSRVR6",3,0) ; "RTN","LRSRVR6",4,0) ; Produces SNOMED extract via LRLABSERVER option "RTN","LRSRVR6",5,0) ; "RTN","LRSRVR6",6,0) ; **** NOTE: if record format is changed then update corresponding extract record building in LRERT *** "RTN","LRSRVR6",7,0) Q "RTN","LRSRVR6",8,0) ; "RTN","LRSRVR6",9,0) ; "RTN","LRSRVR6",10,0) SERVER ; Server entry Point "RTN","LRSRVR6",11,0) N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY "RTN","LRSRVR6",12,0) D BUILD "RTN","LRSRVR6",13,0) S LRMSUBJ=LRST_" "_LRSTN_" SNOMED EXTRACT "_$$HTE^XLFDT($H,"1M") "RTN","LRSRVR6",14,0) D MAILSEND(LRMSUBJ) "RTN","LRSRVR6",15,0) D CLEAN "RTN","LRSRVR6",16,0) Q "RTN","LRSRVR6",17,0) ; "RTN","LRSRVR6",18,0) ; "RTN","LRSRVR6",19,0) BUILD ; Build extract "RTN","LRSRVR6",20,0) ; "RTN","LRSRVR6",21,0) N I,J,LRCNT,LRCRLF,LRETIME,LRFN,LRLEX,LRNAME,LRNODE,LRQUIT,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSPEC,LRSTIME,LRSTR,LRVAL,LRVUID,LRX,LRY,X,Y "RTN","LRSRVR6",22,0) ; "RTN","LRSRVR6",23,0) ;ZEXCEPT: LRST,LRSTN "RTN","LRSRVR6",24,0) ; "RTN","LRSRVR6",25,0) S LRSTIME=$$NOW^XLFDT,LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2),LRSCTVER="" "RTN","LRSRVR6",26,0) I LRST="" S LRST="???" "RTN","LRSRVR6",27,0) K ^TMP($J,"LRDATA") "RTN","LRSRVR6",28,0) S (LRCNT,LRCNT("SCT"),LRCNT("SCT","EC"))=0,LRCRLF=$C(13,10),LRSTR="" "RTN","LRSRVR6",29,0) F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 S (LRCNT(I),LRCNT(I,"SCT"),LRCNT(I,"SCT","EC"))=0 "RTN","LRSRVR6",30,0) D HDR "RTN","LRSRVR6",31,0) ; "RTN","LRSRVR6",32,0) ; Flag to indicate if SNOMED CT is available from LEXICON. "RTN","LRSRVR6",33,0) S LRLEX=0 "RTN","LRSRVR6",34,0) I $T(CODE^LEXTRAN)'="" S LRLEX=1 "RTN","LRSRVR6",35,0) ; "RTN","LRSRVR6",36,0) F LRFN=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D "RTN","LRSRVR6",37,0) . S LRROOT="^LAB("_LRFN_",""B"")" "RTN","LRSRVR6",38,0) . D FILE "RTN","LRSRVR6",39,0) ; "RTN","LRSRVR6",40,0) S LRETIME=$$NOW^XLFDT "RTN","LRSRVR6",41,0) ; Set the final info into the ^TMP message global "RTN","LRSRVR6",42,0) S LRNODE=$O(^TMP($J,"LRDATA",""),-1) "RTN","LRSRVR6",43,0) I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR) "RTN","LRSRVR6",44,0) S ^TMP($J,"LRDATA",LRNODE+1)=" " "RTN","LRSRVR6",45,0) S ^TMP($J,"LRDATA",LRNODE+2)="end" "RTN","LRSRVR6",46,0) ; "RTN","LRSRVR6",47,0) S ^TMP($J,"LRDATA",1)=^TMP($J,"LRDATA",1)_" (Run time:"_$$FMDIFF^XLFDT(LRETIME,LRSTIME,3)_")" "RTN","LRSRVR6",48,0) S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "_LRSCTVER "RTN","LRSRVR6",49,0) S J=6 "RTN","LRSRVR6",50,0) S ^TMP($J,"LRDATA",J)="Number of records per file:" "RTN","LRSRVR6",51,0) F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D "RTN","LRSRVR6",52,0) . S J=J+1 "RTN","LRSRVR6",53,0) . S ^TMP($J,"LRDATA",J)=" "_$$LJ^XLFSTR($$GET1^DID(I,"","","NAME")_" File (#"_I_")",32,".")_": "_$J(LRCNT(I),5)_" ("_LRCNT(I,"SCT")_" mapped)" "RTN","LRSRVR6",54,0) . I LRCNT(I,"SCT","EC") S ^TMP($J,"LRDATA",J)=^TMP($J,"LRDATA",J)_" ("_LRCNT(I,"SCT","EC")_" exceptions)" "RTN","LRSRVR6",55,0) S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)_" ("_LRCNT("SCT")_" mapped)" "RTN","LRSRVR6",56,0) I LRCNT("SCT","EC") S ^TMP($J,"LRDATA",J+1)=^TMP($J,"LRDATA",J+1)_" ("_LRCNT("SCT","EC")_" exceptions)" "RTN","LRSRVR6",57,0) ; "RTN","LRSRVR6",58,0) Q "RTN","LRSRVR6",59,0) ; "RTN","LRSRVR6",60,0) ; "RTN","LRSRVR6",61,0) CLEAN ; "RTN","LRSRVR6",62,0) ; "RTN","LRSRVR6",63,0) ;ZEXCEPT: LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN "RTN","LRSRVR6",64,0) ; "RTN","LRSRVR6",65,0) K ^TMP($J,"LR61") "RTN","LRSRVR6",66,0) K LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN "RTN","LRSRVR6",67,0) D CLEAN^LRSRVR "RTN","LRSRVR6",68,0) D ^%ZISC "RTN","LRSRVR6",69,0) Q "RTN","LRSRVR6",70,0) ; "RTN","LRSRVR6",71,0) ; "RTN","LRSRVR6",72,0) FILE ; Search file entry and build record. "RTN","LRSRVR6",73,0) ; "RTN","LRSRVR6",74,0) N LRNAME,LRVFLD,X "RTN","LRSRVR6",75,0) ; "RTN","LRSRVR6",76,0) ;ZEXCEPT: LRCNT,LRFN,LRIEN,LRLEX,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSNM,LRSPEC,LRSPECN,LRST,LRSTR,LRVUID,LRX "RTN","LRSRVR6",77,0) ; "RTN","LRSRVR6",78,0) ; "RTN","LRSRVR6",79,0) S LRVFLD(21)=$$VFIELD^DILFD(LRFN,21) "RTN","LRSRVR6",80,0) F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D "RTN","LRSRVR6",81,0) . Q:$G(@LRROOT) "RTN","LRSRVR6",82,0) . S LRIEN=$QS(LRROOT,4),LRSPEC="" "RTN","LRSRVR6",83,0) . S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^") ;,LRNAME=$$TRIM^XLFSTR(LRNAME,"RL"," ") "RTN","LRSRVR6",84,0) . S X=$P($G(^LAB(LRFN,LRIEN,0)),"^",2) "RTN","LRSRVR6",85,0) . S LRSNM=$S(LRFN'=62:X,1:"") "RTN","LRSRVR6",86,0) . I LRFN=62 S LRSPEC=X "RTN","LRSRVR6",87,0) . I LRSNM'="",LRFN>60.9,LRFN<61.61 S LRX=((LRFN*10)#610)+1,LRSNM=$E("TMEFDPJ",LRX)_"-"_LRSNM "RTN","LRSRVR6",88,0) . S LRSCT=$P($G(^LAB(LRFN,LRIEN,"SCT")),"^"),(LRSCTEC,LRSCTX,LRVUID)="" "RTN","LRSRVR6",89,0) . I LRLEX,LRSCT'="" D "RTN","LRSRVR6",90,0) . . N LRLEXARR "RTN","LRSRVR6",91,0) . . S LRLEXARR=$$CODE^LRSCT(LRSCT,"SCT",DT,"LRLEXARR") "RTN","LRSRVR6",92,0) . . S LRSCTX=$G(LRLEXARR("F")),LRSCTEC=$S(LRLEXARR<1:$P(LRLEXARR,"^",2),1:"") "RTN","LRSRVR6",93,0) . . I LRSCTVER="",LRLEXARR>0 S LRSCTVER=$P($G(LRLEXARR(0)),"^",3) "RTN","LRSRVR6",94,0) . S LRSTR=LRSTR_LRST_"-"_LRFN_"-"_LRIEN_"|"_LRNAME_"|"_LRSNM_"|"_LRVUID_"|"_LRSCT_"|"_LRSCTX_"|"_LRSCTEC_"|" "RTN","LRSRVR6",95,0) . S LRSPECN="|" "RTN","LRSRVR6",96,0) . I LRFN=62,LRSPEC D "RTN","LRSRVR6",97,0) . . S LRSPECN=$P($G(^LAB(61,LRSPEC,0)),"^") "RTN","LRSRVR6",98,0) . . S LRSPECN=LRSPECN_"|"_LRST_"-61-"_LRSPEC "RTN","LRSRVR6",99,0) . S LRSTR=LRSTR_LRSPECN_"|1.2|" "RTN","LRSRVR6",100,0) . I LRVFLD(21) S LRSTR=LRSTR_$$GET1^DIQ(LRFN,LRIEN_",",21,"I") "RTN","LRSRVR6",101,0) . S LRSTR=LRSTR_"|" "RTN","LRSRVR6",102,0) . I LRFN=61!(LRFN=62) D ; Inactive date "RTN","LRSRVR6",103,0) .. I LRFN=61 S LRSTR=LRSTR_$TR($$FMTE^XLFDT($$GET1^DIQ(LRFN,LRIEN_",",64.9103,"I"),"1D")," ,","/") "RTN","LRSRVR6",104,0) .. I LRFN=62 S LRSTR=LRSTR_$TR($$FMTE^XLFDT($$GET1^DIQ(LRFN,LRIEN_",",64.9101,"I"),"1D")," ,","/") "RTN","LRSRVR6",105,0) .. S LRSTR=LRSTR_"|" "RTN","LRSRVR6",106,0) . S LRCNT=LRCNT+1,LRCNT(LRFN)=LRCNT(LRFN)+1 "RTN","LRSRVR6",107,0) . I LRSCT D "RTN","LRSRVR6",108,0) . . S LRCNT("SCT")=LRCNT("SCT")+1,LRCNT(LRFN,"SCT")=LRCNT(LRFN,"SCT")+1 "RTN","LRSRVR6",109,0) . . I LRSCTEC'="" S LRCNT("SCT","EC")=LRCNT("SCT","EC")+1,LRCNT(LRFN,"SCT","EC")=LRCNT(LRFN,"SCT","EC")+1 "RTN","LRSRVR6",110,0) . D SETDATA "RTN","LRSRVR6",111,0) Q "RTN","LRSRVR6",112,0) ; "RTN","LRSRVR6",113,0) ; "RTN","LRSRVR6",114,0) SETDATA ; Set data into report structure "RTN","LRSRVR6",115,0) ; "RTN","LRSRVR6",116,0) ;ZEXCEPT: LRCRLF,LRNODE,LRSTR "RTN","LRSRVR6",117,0) ; "RTN","LRSRVR6",118,0) S LRSTR=LRSTR_LRCRLF "RTN","LRSRVR6",119,0) S LRNODE=$O(^TMP($J,"LRDATA",""),-1) "RTN","LRSRVR6",120,0) D ENCODE^LRSRVR4(.LRSTR) "RTN","LRSRVR6",121,0) Q "RTN","LRSRVR6",122,0) ; "RTN","LRSRVR6",123,0) ; "RTN","LRSRVR6",124,0) HDR ; Set the header information "RTN","LRSRVR6",125,0) N I,LRFILENM,X "RTN","LRSRVR6",126,0) ; "RTN","LRSRVR6",127,0) ;ZEXCEPT: LRSCTVER,LRSTIME,LRSTN,LRSUB "RTN","LRSRVR6",128,0) ; "RTN","LRSRVR6",129,0) S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT(LRSTIME),"-")_".TXT" "RTN","LRSRVR6",130,0) S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT(LRSTIME)_" at "_LRSTN "RTN","LRSRVR6",131,0) S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB "RTN","LRSRVR6",132,0) S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "_LRSCTVER "RTN","LRSRVR6",133,0) S ^TMP($J,"LRDATA",4)="Extract version........: "_$$VER() "RTN","LRSRVR6",134,0) F I=5,15,16,18,23 S ^TMP($J,"LRDATA",I)=" " "RTN","LRSRVR6",135,0) S ^TMP($J,"LRDATA",17)="Attached file..........: "_LRFILENM "RTN","LRSRVR6",136,0) S ^TMP($J,"LRDATA",19)="Legend:" "RTN","LRSRVR6",137,0) S X="Station #-File #-IEN|Entry Name|SNOMED I|VUID|SNOMED CT|SNOMED CT TERM|Mapping Exception|Related Specimen|Related Specimen ID|Extract Ver|Term Status|Inactive Date|" "RTN","LRSRVR6",138,0) S ^TMP($J,"LRDATA",20)=X "RTN","LRSRVR6",139,0) S X=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 |" "RTN","LRSRVR6",140,0) S ^TMP($J,"LRDATA",21)=X "RTN","LRSRVR6",141,0) S ^TMP($J,"LRDATA",22)=$$REPEAT^XLFSTR("-",$L(X)) "RTN","LRSRVR6",142,0) S ^TMP($J,"LRDATA",24)=$$UUBEGFN^LRSRVR2A(LRFILENM) "RTN","LRSRVR6",143,0) Q "RTN","LRSRVR6",144,0) ; "RTN","LRSRVR6",145,0) ; "RTN","LRSRVR6",146,0) VER() ; Extract version "RTN","LRSRVR6",147,0) Q "1.2" "RTN","LRSRVR6",148,0) ; "RTN","LRSRVR6",149,0) ; "RTN","LRSRVR6",150,0) MAILSEND(LRMSUBJ) ; Send extract back to requestor. "RTN","LRSRVR6",151,0) ; "RTN","LRSRVR6",152,0) N LRINSTR,LRTASK,LRTO,XMERR,XMZ "RTN","LRSRVR6",153,0) ; "RTN","LRSRVR6",154,0) ;ZEXCEPT: XQSND "RTN","LRSRVR6",155,0) ; "RTN","LRSRVR6",156,0) S LRTO(XQSND)="" "RTN","LRSRVR6",157,0) S LRINSTR("ADDR FLAGS")="R" "RTN","LRSRVR6",158,0) S LRINSTR("FROM")="LAB_PACKAGE" "RTN","LRSRVR6",159,0) S LRMSUBJ=$E(LRMSUBJ,1,65) "RTN","LRSRVR6",160,0) D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK) "RTN","LRSRVR6",161,0) Q "RTN","LRXREF1") 0^3^B13794855^B10149956 "RTN","LRXREF1",1,0) LRXREF1 ;SLC/RWA,ALB/TMK - CONTINUE BUILD X-REF FOR RE-INDEX ;09/15/2010 10:42:09 "RTN","LRXREF1",2,0) ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30 "RTN","LRXREF1",3,0) ; "RTN","LRXREF1",4,0) AT ;^LRO(69,"AT" CROSS REFERENCE "RTN","LRXREF1",5,0) I DA,DA(1),DA(2),$D(^LRO(69,DA(2),1,DA(1),2,DA,0)) D AT1 "RTN","LRXREF1",6,0) Q "RTN","LRXREF1",7,0) AT1 S ATX=+^LRO(69,DA(2),1,DA(1),0),ATX(1)=DA(2),ATX(2)=+^(2,DA,0) "RTN","LRXREF1",8,0) I $D(^LRO(69,DA(2),1,DA(1),4,1,0)) S ATX(3)=+^LRO(69,DA(2),1,DA(1),4,1,0) I ATX,ATX(1),ATX(2),ATX(3) S ^LRO(69,"AT",ATX,ATX(2),ATX(3),ATX(1))="",^(-ATX(1))="" "RTN","LRXREF1",9,0) K ATX "RTN","LRXREF1",10,0) Q "RTN","LRXREF1",11,0) ATD ;KILL FOR ^LRO(69,"AT" CROSS REFERENCE "RTN","LRXREF1",12,0) I DA,DA(1),DA(2),$D(^LRO(69,DA(2),1,DA(1),2,DA,0)) S ATX=+^LRO(69,DA(2),1,DA(1),0),ATX(1)=DA(2),ATX(2)=+^(2,DA,0) "RTN","LRXREF1",13,0) I $D(^LRO(69,DA(2),1,DA(1),4,1,0)) S ATX(3)=+^LRO(69,DA(2),1,DA(1),4,1,0) I ATX,ATX(1),ATX(2),ATX(3) K ^LRO(69,"AT",ATX,ATX(2),ATX(3),ATX(1)),^(-ATX(1)) "RTN","LRXREF1",14,0) K ATX "RTN","LRXREF1",15,0) Q "RTN","LRXREF1",16,0) AC ;BUILD "AC" CROSS-REFERENCE IN FILE 68 "RTN","LRXREF1",17,0) S LRTN=0,LRTEST="" "RTN","LRXREF1",18,0) F I=0:0 S LRTN=$O(^LRO(68,DA(2),1,DA(1),1,DA,4,LRTN)) Q:LRTN<1 S LRGTN=LRTN S:LRTEST'="" LRTEST=LRTEST_"^"_LRTN S:LRTEST="" LRTEST=LRTN "RTN","LRXREF1",19,0) D ^LREXPD G:'$D(LRORD) SET F I=1:1:LRTSTS S LRGTN=LRORD(I) D SET "RTN","LRXREF1",20,0) END K LRTEST,LRTSTS,^TMP("LR",$J),LRTN,LRGTN Q "RTN","LRXREF1",21,0) SET I $D(LRGTN) I $D(^LAB(60,LRGTN,.2)) I $P(^LAB(60,LRGTN,0),U,3)'["N" I $P(^(0),U,3)'["I" S ^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2))="" Q "RTN","LRXREF1",22,0) G:'$D(LRORD) END Q "RTN","LRXREF1",23,0) AC1 ;KILL "AC" CROSS-REFERENCE IN FILE 68 "RTN","LRXREF1",24,0) S LRTN=0,LRTEST="" "RTN","LRXREF1",25,0) F I=0:0 S LRTN=$O(^LRO(68,DA(2),1,DA(1),1,DA,4,LRTN)) Q:LRTN<1 S LRGTN=LRTN S:LRTEST'="" LRTEST=LRTEST_"^"_LRTN S:LRTEST="" LRTEST=LRTN "RTN","LRXREF1",26,0) D ^LREXPD G:'$D(LRORD) KILL F I=1:1:LRTSTS S LRGTN=LRORD(I) D KILL "RTN","LRXREF1",27,0) K LRTEST,LRTSTS,^TMP("LR",$J),LRTN,LRGTN Q "RTN","LRXREF1",28,0) KILL I $D(^LAB(60,LRGTN,.2)) I $D(^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2))) K ^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2)) "RTN","LRXREF1",29,0) Q "RTN","LRXREF1",30,0) A65 ;Rebuild "A" x-ref in file 65 for 65.15,.08 for Re-index utility "RTN","LRXREF1",31,0) F LR=0:0 S LR=$O(^LRD(65,DA,15,LR)) Q:'LR S LR(1)=$P(^(LR,0),"^",8) S:LR(1) ^LRD(65,"A",LR(1),DA)="" "RTN","LRXREF1",32,0) Q "RTN","LRXREF1",33,0) A658 ;build "A" x-ref in file 65 for 65,.05 for Re-index utility "RTN","LRXREF1",34,0) S LR=$P(^LRD(65,DA(1),0),"^",5) S:LR ^LRD(65,"A",LR,DA(1))="" Q "RTN","LRXREF1",35,0) C ;build "C" x-ref in file 69 "RTN","LRXREF1",36,0) I '$D(DIU(0)) S ^LRO(69,"C",+X,DA(1),DA)="" Q "RTN","LRXREF1",37,0) I $D(DIU(0)),$D(^LRO(69,DA(1),1,DA,2)) S ^LRO(69,"C",+X,DA(1),DA)="" "RTN","LRXREF1",38,0) Q "RTN","LRXREF1",39,0) A6599 ;Rebuild Archive "A" x-ref in file 65.9999 for 65.999915,.08 for Re-index utility "RTN","LRXREF1",40,0) F LR=0:0 S LR=$O(^LRD(65.9999,DA,15,LR)) Q:'LR S LR(1)=$P(^(LR,0),"^",8) S:LR(1) ^LRD(65.9999,"A",LR(1),DA)="" "RTN","LRXREF1",41,0) Q "RTN","LRXREF1",42,0) A65899 ;build Archive "A" x-ref in file 65.9999 for 65.9999,.05 for Re-index utility "RTN","LRXREF1",43,0) S LR=$P(^LRD(65.9999,DA(1),0),"^",5) S:LR ^LRD(65.9999,"A",LR,DA(1))="" Q "RTN","LRXREF1",44,0) ; "RTN","LRXREF1",45,0) IT600101(DA,DINUM,X) ; "RTN","LRXREF1",46,0) ; Input Transform for Sub-File #60.01 field #.01 SITE/SPECIMEN "RTN","LRXREF1",47,0) ; Expects X (#61 IEN of SITE/SPECIMEN being added to the test) and DA array -- DA(1)=^LAB(60,DA(1)) DA=^LAB(60,DA(1),1,DA) "RTN","LRXREF1",48,0) ; Kills X if invalid selection "RTN","LRXREF1",49,0) ; Sets DINUM if valid selection "RTN","LRXREF1",50,0) N LRA "RTN","LRXREF1",51,0) S LRA=$P(^LAB(60,DA(1),0),U,5) "RTN","LRXREF1",52,0) I LRA="" K X Q "RTN","LRXREF1",53,0) S LRA=$O(^LAB(60,"C",LRA,0)) "RTN","LRXREF1",54,0) I LRA'=DA(1) D EN^DDIOL("Site/specimens may only be added for "_$P(^LAB(60,LRA,0),U,1),"","!") K X Q "RTN","LRXREF1",55,0) ; Make sure entry from file 61 is not inactive as of the current date "RTN","LRXREF1",56,0) I '$$ACTV61^LRJUTL3(X,DT) D EN^DDIOL("Site/Specimen "_$P(^LAB(61,X,0),U,1)_" is inactive","","!") K X Q "RTN","LRXREF1",57,0) S DINUM=X "RTN","LRXREF1",58,0) Q "RTN","LRXREF1",59,0) ; "RTN","LRXREF1",60,0) IT600301(DA,X) ; "RTN","LRXREF1",61,0) ; Input Transform for Sub-File #60.03 field #.01 COLLECTION SAMPLE "RTN","LRXREF1",62,0) ; Expects X (#62 IEN of COLLECTION SAMPLE being added to the test) and DA array -- DA(1)=^LAB(60,DA(1)) DA=^LAB(60,DA(1),1,DA) "RTN","LRXREF1",63,0) ; Kills X if invalid selection "RTN","LRXREF1",64,0) I $P(^LAB(60,DA(1),0),U,8),$O(^(3,0))>0 D EN^DDIOL("ONLY ONE UNIQUE COLLECTION SAMPLE","","?0") K X Q "RTN","LRXREF1",65,0) ; Make sure entry from file 62 is not inactive as of the current date "RTN","LRXREF1",66,0) I '$$ACTV62^LRJUTL3(X,DT) D EN^DDIOL("Collection Sample "_$P(^LAB(62,X,0),U,1)_" is inactive","","!") K X Q "RTN","LRXREF1",67,0) Q "RTN","LRXREF1",68,0) ; "UP",60,60.01,-1) 60^1 "UP",60,60.01,0) 60.01 "UP",60,60.03,-1) 60^3 "UP",60,60.03,0) 60.03 "VER") 8.0^22.0 "^DD",60,60,9,0) LAB COLLECTION SAMPLE^*P62'X^LAB(62,^0;9^S DIC("S")="I $$ACTV62^LRJUTL3(Y,DT)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",60,60,9,3) Collection sample must be active. "^DD",60,60,9,12) Select an active collection sample. "^DD",60,60,9,12.1) S DIC("S")="I $$ACTV62^LRJUTL3(Y,DT)" "^DD",60,60,9,21,0) ^.001^3^3^3101206^^^^ "^DD",60,60,9,21,1,0) This entry, for the given Laboratory Test, is THE collection sample brought "^DD",60,60,9,21,2,0) back on routine phlebotomy collection by the lab when they make rounds "^DD",60,60,9,21,3,0) on the wards. If blank, the test CANNOT be ordered for routine collection. "^DD",60,60,9,"AUDIT") n "^DD",60,60,9,"DT") 3121018 "^DD",60,60,100,0) SITE/SPECIMEN^60.01P^^1;0 "^DD",60,60,100,21,0) ^.001^4^4^3120511^^^^ "^DD",60,60,100,21,1,0) Processing specimen type for each entry in the Lab Collection Sample field. "^DD",60,60,100,21,2,0) Example: Sodium can be determined on serum and urine. Entries in "^DD",60,60,100,21,3,0) this field are not appropriate (or even used) if the test is a panel of "^DD",60,60,100,21,4,0) tests. "^DD",60,60,300,0) COLLECTION SAMPLE^60.03IPA^^3;0 "^DD",60,60,300,21,0) ^.001^3^3^3120106^^^^ "^DD",60,60,300,21,1,0) Enter the appropriate collection sample(s) for standard processing in the "^DD",60,60,300,21,2,0) lab. These are the common names that the phlebotomists and ward personnel "^DD",60,60,300,21,3,0) would recognize. The first entry is the "default" collection sample. "^DD",60,60.01,0) SITE/SPECIMEN SUB-FIELD^NL^7.1^17 "^DD",60,60.01,0,"NM","SITE/SPECIMEN") "^DD",60,60.01,.01,0) SITE/SPECIMEN^MP61'Xa^LAB(61,^0;1^D IT600101^LRXREF1(.DA,.DINUM,.X) "^DD",60,60.01,.01,1,0) ^.1 "^DD",60,60.01,.01,1,1,0) 60.01^B "^DD",60,60.01,.01,1,1,1) S ^LAB(60,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",60,60.01,.01,1,1,2) K ^LAB(60,DA(1),1,"B",$E(X,1,30),DA) "^DD",60,60.01,.01,3) To enter a Site/specimen, a Data name must be entered and Site/specimen must be active. "^DD",60,60.01,.01,21,0) ^.001^3^3^3120511^^^^ "^DD",60,60.01,.01,21,1,0) Processing specimen type for each entry in the Lab Collection Sample field. "^DD",60,60.01,.01,21,2,0) Example: Sodium can be determined on serum and urine. "^DD",60,60.01,.01,21,3,0) To enter a Site/specimen, a Data name must be entered. "^DD",60,60.01,.01,"AUDIT") y "^DD",60,60.01,.01,"DT") 3121016 "^DD",60,60.03,0) COLLECTION SAMPLE SUB-FIELD^NL^500^10 "^DD",60,60.03,0,"NM","COLLECTION SAMPLE") "^DD",60,60.03,.01,0) COLLECTION SAMPLE^P62'Xa^LAB(62,^0;1^D IT600301^LRXREF1(.DA,.X) "^DD",60,60.03,.01,1,0) ^.1^^-1 "^DD",60,60.03,.01,1,1,0) ^^TRIGGER^60.03^2 "^DD",60,60.03,.01,1,1,1) K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^LAB(60,D0,3,D1,0)):^(0),1:"") S X=$P(Y(1),U,3) S DIU=X K Y X ^DD(60.03,.01,1,1,1.1) X ^DD(60.03,.01,1,1,1.4) "^DD",60,60.03,.01,1,1,1.1) S Y(1)=$S($D(D0):D0,1:""),D0=DIV S:'$D(^LAB(62,+D0,0)) D0=-1 S Y(101)=$S($D(^LAB(62,D0,0)):^(0),1:"") S X=$P(Y(101),U,3) S D0=Y(1) "^DD",60,60.03,.01,1,1,1.4) S DIH=$S($D(^LAB(60,DIV(0),3,DIV(1),0)):^(0),1:""),DIV=X X "F %=0:0 Q:$L($P(DIH,U,2,99)) S DIH=DIH_U" S %=$P(DIH,U,4,999),^(0)=$P(DIH,U,1,2)_U_DIV_$S(%]"":U_%,1:""),DIH=60.03,DIG=2 D ^DICR:$O(^DD(DIH,DIG,1,0))>0 "^DD",60,60.03,.01,1,1,2) K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^LAB(60,D0,3,D1,0)):^(0),1:"") S X=$P(Y(1),U,3) S DIU=X K Y X ^DD(60.03,.01,1,1,2.1) X ^DD(60.03,.01,1,1,2.4) "^DD",60,60.03,.01,1,1,2.1) S Y(1)=$S($D(D0):D0,1:""),D0=DIV S:'$D(^LAB(62,+D0,0)) D0=-1 S Y(101)=$S($D(^LAB(62,D0,0)):^(0),1:"") S X=$P(Y(101),U,3) S D0=Y(1) "^DD",60,60.03,.01,1,1,2.4) S DIH=$S($D(^LAB(60,DIV(0),3,DIV(1),0)):^(0),1:""),DIV=X X "F %=0:0 Q:$L($P(DIH,U,2,99)) S DIH=DIH_U" S %=$P(DIH,U,4,999),^(0)=$P(DIH,U,1,2)_U_DIV_$S(%]"":U_%,1:""),DIH=60.03,DIG=2 D ^DICR:$O(^DD(DIH,DIG,1,0))>0 "^DD",60,60.03,.01,1,1,"%D",0) ^^2^2^3080828^ "^DD",60,60.03,.01,1,1,"%D",1,0) This cross reference uses the COLLECTION SAMPLE field to navigate to the COLLECTION SAMPLE file "^DD",60,60.03,.01,1,1,"%D",2,0) and retrieve the TUBE TOP COLOR field value and store in CONTAINER field (#2). "^DD",60,60.03,.01,1,1,"CREATE VALUE") COLLECTION SAMPLE:TUBE TOP COLOR "^DD",60,60.03,.01,1,1,"DELETE VALUE") COLLECTION SAMPLE:TUBE TOP COLOR "^DD",60,60.03,.01,1,1,"FIELD") CONTAINER "^DD",60,60.03,.01,1,3,0) 60.03^B "^DD",60,60.03,.01,1,3,1) S ^LAB(60,DA(1),3,"B",$E(X,1,30),DA)="" "^DD",60,60.03,.01,1,3,2) K ^LAB(60,DA(1),3,"B",$E(X,1,30),DA) "^DD",60,60.03,.01,3) Enter the appropriate collection sample for standard processing in the lab. Collection sample must be active. "^DD",60,60.03,.01,21,0) ^.001^2^2^3120106^^^^ "^DD",60,60.03,.01,21,1,0) Enter the appropriate collection sample(s) for standard processing in the lab. These are the common names the phlebotomists and ward personnel use and would recognize. The first entry will be the "default "^DD",60,60.03,.01,21,2,0) " collection sample. Points to the COLLECTION SAMPLE file. "^DD",60,60.03,.01,"AUDIT") y "^DD",60,60.03,.01,"DT") 3121016 "^DD",61,61,64.9103,0) INACTIVE DATE^D^^64.91;3^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",61,61,64.9103,3) Enter the date this TOPOGRAPHY entry should no longer be considered available. "^DD",61,61,64.9103,21,0) ^.001^3^3^3130522^^^^ "^DD",61,61,64.9103,21,1,0) This is the date on or after which the entry will no longer be active. "^DD",61,61,64.9103,21,2,0) Inactive entries will not be available for selection in CPRS nor be able "^DD",61,61,64.9103,21,3,0) to be associated with a test in the LABORATORY TEST file (#60). "^DD",61,61,64.9103,"DT") 3120131 "^DD",62,62,64.9101,0) INACTIVE DATE^D^^64.91;1^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",62,62,64.9101,3) Enter the date this Collection Sample entry should no longer be considered available "^DD",62,62,64.9101,21,0) ^.001^5^5^3130522^^^^ "^DD",62,62,64.9101,21,1,0) This is the date on or after which the entry "^DD",62,62,64.9101,21,2,0) will no longer be active. Inactive entries "^DD",62,62,64.9101,21,3,0) will not be available for selection "^DD",62,62,64.9101,21,4,0) in CPRS nor be able to be associated with a "^DD",62,62,64.9101,21,5,0) test in the LABORATORY TEST file (#60). "^DD",62,62,64.9101,"DT") 3120131 "^DD",64.9178,64.9178,0) FIELD^^1^2 "^DD",64.9178,64.9178,0,"DDA") N "^DD",64.9178,64.9178,0,"DT") 3130522 "^DD",64.9178,64.9178,0,"IX","B",64.9178,.01) "^DD",64.9178,64.9178,0,"NM","LSRP AUDIT CONFIG") "^DD",64.9178,64.9178,0,"VRPK") LR "^DD",64.9178,64.9178,.01,0) AUDIT FILE NAME^RP1'^DIC(^0;1^Q "^DD",64.9178,64.9178,.01,.1) "^DD",64.9178,64.9178,.01,1,0) ^.1 "^DD",64.9178,64.9178,.01,1,1,0) 64.9178^B "^DD",64.9178,64.9178,.01,1,1,1) S ^LABAUD(64.9178,"B",$E(X,1,30),DA)="" "^DD",64.9178,64.9178,.01,1,1,2) K ^LABAUD(64.9178,"B",$E(X,1,30),DA) "^DD",64.9178,64.9178,.01,3) Select the file to be audited. "^DD",64.9178,64.9178,.01,21,0) ^.001^1^1^3130522^^ "^DD",64.9178,64.9178,.01,21,1,0) The file that can be audited through the Lab audit tool. "^DD",64.9178,64.9178,.01,"DT") 3130522 "^DD",64.9178,64.9178,1,0) AUDIT FIELDS^64.9278^^1;0 "^DD",64.9178,64.9178,1,21,0) ^.001^1^1^3130522^^^ "^DD",64.9178,64.9178,1,21,1,0) These are the field numbers to be audited in the associated file. "^DD",64.9178,64.9278,0) AUDIT FIELDS SUB-FIELD^^.01^1 "^DD",64.9178,64.9278,0,"DT") 3130522 "^DD",64.9178,64.9278,0,"IX","B",64.9278,.01) "^DD",64.9178,64.9278,0,"NM","AUDIT FIELDS") "^DD",64.9178,64.9278,0,"UP") 64.9178 "^DD",64.9178,64.9278,.01,0) FIELD NUMBER^MNJ21,8^^0;1^K:+X'=X!(X>999999999999)!(X<0)!(X?.E1"."9N.N) X "^DD",64.9178,64.9278,.01,1,0) ^.1 "^DD",64.9178,64.9278,.01,1,1,0) 64.9278^B "^DD",64.9178,64.9278,.01,1,1,1) S ^LABAUD(64.9178,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",64.9178,64.9278,.01,1,1,2) K ^LABAUD(64.9178,DA(1),1,"B",$E(X,1,30),DA) "^DD",64.9178,64.9278,.01,3) Type a number between 0 and 999999999999, up to 8 decimal digits. "^DD",64.9178,64.9278,.01,21,0) ^.001^2^2^3130522^^^^ "^DD",64.9178,64.9278,.01,21,1,0) The number of the field in the associated file that has been designated "^DD",64.9178,64.9278,.01,21,2,0) to be audited. "^DD",64.9178,64.9278,.01,"DT") 3130522 "^DD",69.9,69.9,64.913,0) LAST IEN PROCESSED^NJ6,0^^64.9103;1^K:+X'=X!(X>100000)!(X<1)!(X?.E1"."1N.N) X "^DD",69.9,69.9,64.913,3) Enter the last IEN processed, from 1-999999. "^DD",69.9,69.9,64.913,21,0) ^.001^6^6^3130805^^^ "^DD",69.9,69.9,64.913,21,1,0) This is the last IEN processed by the TaskMan "^DD",69.9,69.9,64.913,21,2,0) job that monitors the LABORATORY TEST (#60) "^DD",69.9,69.9,64.913,21,3,0) file for changes that might require quick order "^DD",69.9,69.9,64.913,21,4,0) updates. This field is updated by a TaskMan "^DD",69.9,69.9,64.913,21,5,0) job so it is recommended you DO NOT edit this "^DD",69.9,69.9,64.913,21,6,0) field manually. "^DD",69.9,69.9,64.913,"DT") 3130522 "^DD",69.9,69.9,64.914,0) LAST DATE PROCESSED^D^^64.9103;2^S %DT="ETX" D ^%DT S X=Y K:Y<1 X "^DD",69.9,69.9,64.914,3) Enter the last date/time processed by the background monitor of the LABORATORY TEST file (#60). "^DD",69.9,69.9,64.914,21,0) ^.001^5^5^3130805^^^^ "^DD",69.9,69.9,64.914,21,1,0) This is the last date/time processed by the TaskMan "^DD",69.9,69.9,64.914,21,2,0) job that monitors the LABORATORY TEST (#60) "^DD",69.9,69.9,64.914,21,3,0) file for changes that might require quick order "^DD",69.9,69.9,64.914,21,4,0) updates. This field is updated by a TaskMan job so "^DD",69.9,69.9,64.914,21,5,0) it is recommended you DO NOT edit this field manually. "^DD",69.9,69.9,64.914,"DT") 3130801 "^DIC",64.9178,64.9178,0) LSRP AUDIT CONFIG^64.9178 "^DIC",64.9178,64.9178,0,"GL") ^LABAUD(64.9178, "^DIC",64.9178,64.9178,"%",0) ^1.005^^0 "^DIC",64.9178,64.9178,"%D",0) ^1.001^4^4^3121017^^ "^DIC",64.9178,64.9178,"%D",1,0) This file contains the fields that are audited in LAB. "^DIC",64.9178,64.9178,"%D",2,0) "^DIC",64.9178,64.9178,"%D",3,0) Fields listed in this file will show up on various audit reports and "^DIC",64.9178,64.9178,"%D",4,0) extracts within the LAB software. "^DIC",64.9178,"B","LSRP AUDIT CONFIG",64.9178) "BLD",9067,6) ^341 **END** **END**