Released XU*8*440 SEQ #391 Extracted from mail message **KIDS**:XU*8.0*440^ **INSTALL NAME** XU*8.0*440 "BLD",983,0) XU*8.0*440^KERNEL^0^3080303^y "BLD",983,1,0) ^^2^2^3070607^ "BLD",983,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "BLD",983,1,2,0) XU*8*440 Modifications for mixed VMS/Linux. "BLD",983,4,0) ^9.64PA^3.5^2 "BLD",983,4,3.5,0) 3.5 "BLD",983,4,3.5,2,0) ^9.641^3.5^1 "BLD",983,4,3.5,2,3.5,0) DEVICE (File-top level) "BLD",983,4,3.5,2,3.5,1,0) ^9.6411^36^2 "BLD",983,4,3.5,2,3.5,1,36,0) GLOBAL LOCK "BLD",983,4,3.5,2,3.5,1,52,0) SECONDARY $I "BLD",983,4,3.5,222) y^y^p^^^^n^^n "BLD",983,4,3.5,224) "BLD",983,4,8989.3,0) 8989.3 "BLD",983,4,8989.3,2,0) ^9.641^8989.3^1 "BLD",983,4,8989.3,2,8989.3,0) KERNEL SYSTEM PARAMETERS (File-top level) "BLD",983,4,8989.3,2,8989.3,1,0) ^9.6411^505^5 "BLD",983,4,8989.3,2,8989.3,1,.05,0) MIXED OS "BLD",983,4,8989.3,2,8989.3,1,320,0) PRIMARY HFS DIRECTORY "BLD",983,4,8989.3,2,8989.3,1,320.2,0) SECONDARY HFS DIRECTORY "BLD",983,4,8989.3,2,8989.3,1,504,0) LOGICAL DISK NAME "BLD",983,4,8989.3,2,8989.3,1,505,0) PHYSICAL DISK "BLD",983,4,8989.3,222) y^n^p^^^^n^^n "BLD",983,4,8989.3,224) "BLD",983,4,"APDD",3.5,3.5) "BLD",983,4,"APDD",3.5,3.5,36) "BLD",983,4,"APDD",3.5,3.5,52) "BLD",983,4,"APDD",8989.3,8989.3) "BLD",983,4,"APDD",8989.3,8989.3,.05) "BLD",983,4,"APDD",8989.3,8989.3,320) "BLD",983,4,"APDD",8989.3,8989.3,320.2) "BLD",983,4,"APDD",8989.3,8989.3,504) "BLD",983,4,"APDD",8989.3,8989.3,505) "BLD",983,4,"B",3.5,3.5) "BLD",983,4,"B",8989.3,8989.3) "BLD",983,6.3) 13 "BLD",983,"INIT") POST^XU8P440 "BLD",983,"KRN",0) ^9.67PA^779.2^20 "BLD",983,"KRN",.4,0) .4 "BLD",983,"KRN",.401,0) .401 "BLD",983,"KRN",.402,0) .402 "BLD",983,"KRN",.403,0) .403 "BLD",983,"KRN",.403,"NM",0) ^9.68A^5^5 "BLD",983,"KRN",.403,"NM",1,0) XUSITEPARM FILE #8989.3^8989.3^0 "BLD",983,"KRN",.403,"NM",2,0) XUDEVICE TRM FILE #3.5^3.5^0 "BLD",983,"KRN",.403,"NM",3,0) XUDEVICE HFS FILE #3.5^3.5^0 "BLD",983,"KRN",.403,"NM",4,0) XUDEVICE RES FILE #3.5^3.5^0 "BLD",983,"KRN",.403,"NM",5,0) XUDEVICE LPD FILE #3.5^3.5^0 "BLD",983,"KRN",.403,"NM","B","XUDEVICE HFS FILE #3.5",3) "BLD",983,"KRN",.403,"NM","B","XUDEVICE LPD FILE #3.5",5) "BLD",983,"KRN",.403,"NM","B","XUDEVICE RES FILE #3.5",4) "BLD",983,"KRN",.403,"NM","B","XUDEVICE TRM FILE #3.5",2) "BLD",983,"KRN",.403,"NM","B","XUSITEPARM FILE #8989.3",1) "BLD",983,"KRN",.5,0) .5 "BLD",983,"KRN",.84,0) .84 "BLD",983,"KRN",3.6,0) 3.6 "BLD",983,"KRN",3.8,0) 3.8 "BLD",983,"KRN",9.2,0) 9.2 "BLD",983,"KRN",9.8,0) 9.8 "BLD",983,"KRN",9.8,"NM",0) ^9.68A^16^14 "BLD",983,"KRN",9.8,"NM",1,0) ZIS^^0^B20530056 "BLD",983,"KRN",9.8,"NM",4,0) ZIS2^^0^B20845932 "BLD",983,"KRN",9.8,"NM",5,0) ZISHONT^^0^B60012686 "BLD",983,"KRN",9.8,"NM",6,0) ZISEDIT^^0^B2624513 "BLD",983,"KRN",9.8,"NM",7,0) ZTLOAD4^^0^B11458324 "BLD",983,"KRN",9.8,"NM",8,0) ZOSVONT^^0^B22002850 "BLD",983,"KRN",9.8,"NM",9,0) ZIS4GTM^^0^B19862476 "BLD",983,"KRN",9.8,"NM",10,0) ZISS1^^0^B15833338 "BLD",983,"KRN",9.8,"NM",11,0) ZISC^^0^B22332594 "BLD",983,"KRN",9.8,"NM",12,0) ZIS4ONT^^0^B27677822 "BLD",983,"KRN",9.8,"NM",13,0) ZIS3^^0^B13908684 "BLD",983,"KRN",9.8,"NM",14,0) ZIS1^^0^B24679317 "BLD",983,"KRN",9.8,"NM",15,0) XUPROD^^0^B5031849 "BLD",983,"KRN",9.8,"NM",16,0) ZIS6^^0^B20359601 "BLD",983,"KRN",9.8,"NM","B","XUPROD",15) "BLD",983,"KRN",9.8,"NM","B","ZIS",1) "BLD",983,"KRN",9.8,"NM","B","ZIS1",14) "BLD",983,"KRN",9.8,"NM","B","ZIS2",4) "BLD",983,"KRN",9.8,"NM","B","ZIS3",13) "BLD",983,"KRN",9.8,"NM","B","ZIS4GTM",9) "BLD",983,"KRN",9.8,"NM","B","ZIS4ONT",12) "BLD",983,"KRN",9.8,"NM","B","ZIS6",16) "BLD",983,"KRN",9.8,"NM","B","ZISC",11) "BLD",983,"KRN",9.8,"NM","B","ZISEDIT",6) "BLD",983,"KRN",9.8,"NM","B","ZISHONT",5) "BLD",983,"KRN",9.8,"NM","B","ZISS1",10) "BLD",983,"KRN",9.8,"NM","B","ZOSVONT",8) "BLD",983,"KRN",9.8,"NM","B","ZTLOAD4",7) "BLD",983,"KRN",19,0) 19 "BLD",983,"KRN",19,"NM",0) ^9.68A^9^9 "BLD",983,"KRN",19,"NM",1,0) XUDEVEDIT^^0 "BLD",983,"KRN",19,"NM",2,0) XUDEVEDITSDP^^1^ "BLD",983,"KRN",19,"NM",3,0) XUDEVEDITHFS^^0 "BLD",983,"KRN",19,"NM",4,0) XUDEVEDITRES^^0 "BLD",983,"KRN",19,"NM",5,0) XUDEVEDITTRM^^0 "BLD",983,"KRN",19,"NM",6,0) XUDEVEDITSPL^^0 "BLD",983,"KRN",19,"NM",7,0) XUDEVEDITALL^^0 "BLD",983,"KRN",19,"NM",8,0) XUKERNEL^^2 "BLD",983,"KRN",19,"NM",9,0) XU SID EDIT^^0 "BLD",983,"KRN",19,"NM","B","XU SID EDIT",9) "BLD",983,"KRN",19,"NM","B","XUDEVEDIT",1) "BLD",983,"KRN",19,"NM","B","XUDEVEDITALL",7) "BLD",983,"KRN",19,"NM","B","XUDEVEDITHFS",3) "BLD",983,"KRN",19,"NM","B","XUDEVEDITRES",4) "BLD",983,"KRN",19,"NM","B","XUDEVEDITSDP",2) "BLD",983,"KRN",19,"NM","B","XUDEVEDITSPL",6) "BLD",983,"KRN",19,"NM","B","XUDEVEDITTRM",5) "BLD",983,"KRN",19,"NM","B","XUKERNEL",8) "BLD",983,"KRN",19.1,0) 19.1 "BLD",983,"KRN",101,0) 101 "BLD",983,"KRN",409.61,0) 409.61 "BLD",983,"KRN",771,0) 771 "BLD",983,"KRN",779.2,0) 779.2 "BLD",983,"KRN",870,0) 870 "BLD",983,"KRN",8989.51,0) 8989.51 "BLD",983,"KRN",8989.52,0) 8989.52 "BLD",983,"KRN",8994,0) 8994 "BLD",983,"KRN","B",.4,.4) "BLD",983,"KRN","B",.401,.401) "BLD",983,"KRN","B",.402,.402) "BLD",983,"KRN","B",.403,.403) "BLD",983,"KRN","B",.5,.5) "BLD",983,"KRN","B",.84,.84) "BLD",983,"KRN","B",3.6,3.6) "BLD",983,"KRN","B",3.8,3.8) "BLD",983,"KRN","B",9.2,9.2) "BLD",983,"KRN","B",9.8,9.8) "BLD",983,"KRN","B",19,19) "BLD",983,"KRN","B",19.1,19.1) "BLD",983,"KRN","B",101,101) "BLD",983,"KRN","B",409.61,409.61) "BLD",983,"KRN","B",771,771) "BLD",983,"KRN","B",779.2,779.2) "BLD",983,"KRN","B",870,870) "BLD",983,"KRN","B",8989.51,8989.51) "BLD",983,"KRN","B",8989.52,8989.52) "BLD",983,"KRN","B",8994,8994) "BLD",983,"QDEF") ^^^^YES^^^^NO^^NO "BLD",983,"QUES",0) ^9.62^^ "BLD",983,"REQB",0) ^9.611^4^4 "BLD",983,"REQB",1,0) XU*8.0*241^2 "BLD",983,"REQB",2,0) XU*8.0*278^2 "BLD",983,"REQB",3,0) XU*8.0*363^2 "BLD",983,"REQB",4,0) XU*8.0*391^2 "BLD",983,"REQB","B","XU*8.0*241",1) "BLD",983,"REQB","B","XU*8.0*278",2) "BLD",983,"REQB","B","XU*8.0*363",3) "BLD",983,"REQB","B","XU*8.0*391",4) "FIA",3.5) DEVICE "FIA",3.5,0) ^%ZIS(1, "FIA",3.5,0,0) 3.5Is "FIA",3.5,0,1) y^y^p^^^^n^^n "FIA",3.5,0,10) "FIA",3.5,0,11) "FIA",3.5,0,"RLRO") "FIA",3.5,0,"VR") 8.0^XU "FIA",3.5,3.5) 1 "FIA",3.5,3.5,36) "FIA",3.5,3.5,52) "FIA",8989.3) KERNEL SYSTEM PARAMETERS "FIA",8989.3,0) ^XTV(8989.3, "FIA",8989.3,0,0) 8989.3P "FIA",8989.3,0,1) y^n^p^^^^n^^n "FIA",8989.3,0,10) "FIA",8989.3,0,11) "FIA",8989.3,0,"RLRO") "FIA",8989.3,0,"VR") 8.0^XU "FIA",8989.3,8989.3) 1 "FIA",8989.3,8989.3,.05) "FIA",8989.3,8989.3,320) "FIA",8989.3,8989.3,320.2) "FIA",8989.3,8989.3,504) "FIA",8989.3,8989.3,505) "INIT") POST^XU8P440 "KRN",.403,7,-1) 0^3 "KRN",.403,7,0) XUDEVICE HFS^^^^2921019^^^3.5^0^0^1 "KRN",.403,7,40,0) ^.4031I^1^1 "KRN",.403,7,40,1,0) 1^XUDEVICE HFS HDR^1,1 "KRN",.403,7,40,1,1) Page 1 of 1 "KRN",.403,7,40,1,40,0) ^.4032PI^37^1 "KRN",.403,7,40,1,40,37,0) XUDEVICE HFS^1^2,1^e "KRN",.403,12,-1) 0^1 "KRN",.403,12,0) XUSITEPARM^^^^2941116^^^8989.3^0^0^1 "KRN",.403,12,40,0) ^.4031I^5^5 "KRN",.403,12,40,1,0) 1^^1,1^2 "KRN",.403,12,40,1,1) Page 1 "KRN",.403,12,40,1,40,0) ^.4032IP^52^2 "KRN",.403,12,40,1,40,51,0) XUSITEPARM 0^1^1,1^d "KRN",.403,12,40,1,40,52,0) XUSITEPARM 1^2^2,1^e "KRN",.403,12,40,2,0) 3^^1,1^4^2 "KRN",.403,12,40,2,1) Page 3 "KRN",.403,12,40,2,40,0) ^.4032IP^53^2 "KRN",.403,12,40,2,40,51,0) XUSITEPARM 0^1^1,1^d "KRN",.403,12,40,2,40,53,0) XUSITEPARM 3^2^4,1^e "KRN",.403,12,40,3,0) 2^^1,1^3^1 "KRN",.403,12,40,3,1) Page 2 "KRN",.403,12,40,3,40,0) ^.4032IP^56^4 "KRN",.403,12,40,3,40,51,0) XUSITEPARM 0^1^1,1^d "KRN",.403,12,40,3,40,54,0) XUSITEPARM 2^2^4,1^e "KRN",.403,12,40,3,40,55,0) XUSITEPARM 2.1^3^5,12^e "KRN",.403,12,40,3,40,55,2) 4^^^^ "KRN",.403,12,40,3,40,56,0) XUSITEPARM 2.2^4^12,12^e "KRN",.403,12,40,3,40,56,2) 4 "KRN",.403,12,40,4,0) 4^^1,1^5^3 "KRN",.403,12,40,4,1) Page 4 "KRN",.403,12,40,4,40,0) ^.4032IP^61^6 "KRN",.403,12,40,4,40,51,0) XUSITEPARM 0^1^1,1^d "KRN",.403,12,40,4,40,57,0) XUSITEPARM 4^2^4,1^e "KRN",.403,12,40,4,40,58,0) XUSITEPARM 4.1^3^8,4^e "KRN",.403,12,40,4,40,58,2) 4 "KRN",.403,12,40,4,40,59,0) XUSITEPARM 4.2^4^8,43^e "KRN",.403,12,40,4,40,59,2) 4 "KRN",.403,12,40,4,40,60,0) XUSITEPARM 4.4^6^13,43^e "KRN",.403,12,40,4,40,60,2) 4 "KRN",.403,12,40,4,40,61,0) XUSITEPARM 4.3^5^13,4^e "KRN",.403,12,40,4,40,61,2) 4 "KRN",.403,12,40,5,0) 5^^1,1^1^4 "KRN",.403,12,40,5,1) Page 5 "KRN",.403,12,40,5,40,0) ^.4032IP^181^2 "KRN",.403,12,40,5,40,51,0) XUSITEPARM 0^1^1,1^d "KRN",.403,12,40,5,40,181,0) XUSITEPARM 5^2^4,1^e "KRN",.403,41,-1) 0^5 "KRN",.403,41,0) XUDEVICE LPD^@^@^^3030722.1401^^^3.5^0^0^1 "KRN",.403,41,40,0) ^.4031I^1^1 "KRN",.403,41,40,1,0) 1^^1,1 "KRN",.403,41,40,1,1) Page 1 "KRN",.403,41,40,1,40,0) ^.4032IP^187^1 "KRN",.403,41,40,1,40,187,0) XUDEVICE LPD^1^1,1^e "KRN",.403,42,-1) 0^2 "KRN",.403,42,0) XUDEVICE TRM^@^@^^3030722.1427^^^3.5^0^0^1 "KRN",.403,42,40,0) ^.4031I^1^1 "KRN",.403,42,40,1,0) 1^^1,1 "KRN",.403,42,40,1,1) Page 1 "KRN",.403,42,40,1,40,0) ^.4032IP^188^1 "KRN",.403,42,40,1,40,188,0) XUDEVICE TRM^1^1,1^e "KRN",.403,50,-1) 0^4 "KRN",.403,50,0) XUDEVICE RES^@^@^^3070524.173^^^3.5^0^0^1 "KRN",.403,50,40,0) ^.4031I^1^1 "KRN",.403,50,40,1,0) 1^^1,1 "KRN",.403,50,40,1,1) Page 1 "KRN",.403,50,40,1,40,0) ^.4032IP^217^2 "KRN",.403,50,40,1,40,216,0) XUDEVICE RES^1^1,1^e "KRN",.403,50,40,1,40,217,0) XUDEVICE SLOTS^2^6,1^e "KRN",.403,50,40,1,40,217,1) $I;L "KRN",.404,37,0) XUDEVICE HFS^3.5 "KRN",.404,37,11) D UNED^DDSUTL("Alt $I",,,'$P(^XTV(8989.3,1,0),U,5)) "KRN",.404,37,40,0) ^.4044I^23^17 "KRN",.404,37,40,1,0) 2^NAME^3 "KRN",.404,37,40,1,1) .01 "KRN",.404,37,40,1,2) 2,10^30^2,4 "KRN",.404,37,40,2,0) 3^LOCATION^3 "KRN",.404,37,40,2,1) .02 "KRN",.404,37,40,2,2) 2,56^20^2,46 "KRN",.404,37,40,3,0) 4^$I^3 "KRN",.404,37,40,3,1) 1 "KRN",.404,37,40,3,2) 4,10^40^4,6 "KRN",.404,37,40,4,0) 14^VOLUME SET(CPU)^3 "KRN",.404,37,40,4,1) 1.9 "KRN",.404,37,40,4,2) 10,59^20^10,42 "KRN",.404,37,40,7,0) 7^SUBTYPE^3 "KRN",.404,37,40,7,1) 3 "KRN",.404,37,40,7,2) 6,10^25^6,1 "KRN",.404,37,40,10,0) 10^MARGIN WIDTH^3 "KRN",.404,37,40,10,1) 9 "KRN",.404,37,40,10,2) 8,59^3^8,45 "KRN",.404,37,40,11,0) 12^PAGE LENGTH^3 "KRN",.404,37,40,11,1) 11 "KRN",.404,37,40,11,2) 9,59^6^9,46 "KRN",.404,37,40,13,0) 8^ASK PARAMETERS^3 "KRN",.404,37,40,13,1) 5 "KRN",.404,37,40,13,2) 8,24^3^8,8 "KRN",.404,37,40,14,0) 13^OPEN PARAMETERS^3 "KRN",.404,37,40,14,1) 19 "KRN",.404,37,40,14,2) 12,21^57^12,4 "KRN",.404,37,40,15,0) 9^ASK HOST FILE^3 "KRN",.404,37,40,15,1) 5.1 "KRN",.404,37,40,15,2) 9,24^3^9,9 "KRN",.404,37,40,16,0) 11^ASK HFS I/O OPERATION^3 "KRN",.404,37,40,16,1) 5.2 "KRN",.404,37,40,16,2) 10,24^3^10,1 "KRN",.404,37,40,18,0) 5^Alt $I^3 "KRN",.404,37,40,18,1) 52 "KRN",.404,37,40,18,2) 5,10^40^5,2 "KRN",.404,37,40,18,4) ^^^1 "KRN",.404,37,40,19,0) 15^PRE-OPEN EXECUTE^3 "KRN",.404,37,40,19,1) 19.7 "KRN",.404,37,40,19,2) 14,21^57^14,3 "KRN",.404,37,40,20,0) 16^POST-CLOSE EXECUTE^3 "KRN",.404,37,40,20,1) 19.8 "KRN",.404,37,40,20,2) 15,21^57^15,1 "KRN",.404,37,40,21,0) 17^QUEUING^3 "KRN",.404,37,40,21,1) 5.5 "KRN",.404,37,40,21,2) 16,21^11^16,12 "KRN",.404,37,40,22,0) 18^SUPPRESS FORM FEED^3 "KRN",.404,37,40,22,1) 11.2 "KRN",.404,37,40,22,2) 16,59^3^16,39 "KRN",.404,37,40,23,0) 19^CLOSE PARAMETERS^3 "KRN",.404,37,40,23,1) 19.3 "KRN",.404,37,40,23,2) 13,21^57^13,3 "KRN",.404,40,0) XUDEVICE HFS HDR^3.5 "KRN",.404,40,40,0) ^.4044I^1^1 "KRN",.404,40,40,1,0) 1^EDIT A HOST FILE SERVER DEVICE^1^ "KRN",.404,40,40,1,2) ^^1,23 "KRN",.404,51,0) XUSITEPARM 0^8989.3^ "KRN",.404,51,40,0) ^.4044I^3^2 "KRN",.404,51,40,2,0) 2^Kernel Site Parameter edit^1 "KRN",.404,51,40,2,2) ^^1,24^1 "KRN",.404,51,40,3,0) 1^DOMAIN^3 "KRN",.404,51,40,3,1) .01 "KRN",.404,51,40,3,2) 2,20^42^2,13 "KRN",.404,52,0) XUSITEPARM 1^8989.3 "KRN",.404,52,40,0) ^.4044I^20^18 "KRN",.404,52,40,1,0) 1^DEFAULT # OF ATTEMPTS^3 "KRN",.404,52,40,1,1) 202 "KRN",.404,52,40,1,2) 3,31^3^3,8 "KRN",.404,52,40,1,3) 5 "KRN",.404,52,40,2,0) 3^DEFAULT LOCK-OUT TIME^3 "KRN",.404,52,40,2,1) 203 "KRN",.404,52,40,2,2) 4,31^4^4,8 "KRN",.404,52,40,2,3) 30 "KRN",.404,52,40,3,0) 4^DEFAULT MULTIPLE SIGN-ON^3 "KRN",.404,52,40,3,1) 204 "KRN",.404,52,40,3,2) 5,31^8^5,5 "KRN",.404,52,40,3,3) YES "KRN",.404,52,40,3,11) D EN^DDIOL("If you select 'Only one IP' be sure to put a value into the MULTIPLE SIGN-ON LIMIT field so users can sign-on at least once.") "KRN",.404,52,40,4,0) 15^ASK DEVICE TYPE AT SIGN-ON^3 "KRN",.404,52,40,4,1) 205 "KRN",.404,52,40,4,2) 12,69^3^12,41 "KRN",.404,52,40,4,3) ASK "KRN",.404,52,40,5,0) 6^DEFAULT AUTO-MENU^3 "KRN",.404,52,40,5,1) 206 "KRN",.404,52,40,5,2) 6,31^3^6,12 "KRN",.404,52,40,5,3) NO "KRN",.404,52,40,6,0) 9^DEFAULT TYPE-AHEAD^3 "KRN",.404,52,40,6,1) 209 "KRN",.404,52,40,6,2) 8,31^3^8,11 "KRN",.404,52,40,6,3) YES "KRN",.404,52,40,7,0) 10^DEFAULT TIMED-READ (SECONDS)^3 "KRN",.404,52,40,7,1) 210 "KRN",.404,52,40,7,2) 9,31^5^9,1 "KRN",.404,52,40,7,3) 300 "KRN",.404,52,40,8,0) 12^BYPASS DEVICE LOCK-OUT^3 "KRN",.404,52,40,8,1) 211 "KRN",.404,52,40,8,2) 11,31^3^11,7 "KRN",.404,52,40,9,0) 14^LIFETIME OF VERIFY CODE^3 "KRN",.404,52,40,9,1) 214 "KRN",.404,52,40,9,2) 12,31^3^12,6 "KRN",.404,52,40,9,3) 90 "KRN",.404,52,40,11,0) 8^DEFAULT LANGUAGE^3 "KRN",.404,52,40,11,1) 207 "KRN",.404,52,40,11,2) 7,31^10^7,13 "KRN",.404,52,40,12,0) 16^DEFAULT INSTITUTION^3 "KRN",.404,52,40,12,1) 217 "KRN",.404,52,40,12,2) 13,31^30^13,10 "KRN",.404,52,40,13,0) 17^AUTO-GENERATE ACCESS CODES^3 "KRN",.404,52,40,13,1) 11 "KRN",.404,52,40,13,2) 14,31^3^14,3 "KRN",.404,52,40,14,0) 2^AGENCY CODE^3 "KRN",.404,52,40,14,1) 9 "KRN",.404,52,40,14,2) 3,66^9^3,53 "KRN",.404,52,40,14,3) VA "KRN",.404,52,40,16,0) 7^DEFAULT AUTO SIGN-ON^3 "KRN",.404,52,40,16,1) 218 "KRN",.404,52,40,16,2) 6,66^8^6,44 "KRN",.404,52,40,17,0) 11^BROKER TIMEOUT^3 "KRN",.404,52,40,17,1) 230 "KRN",.404,52,40,17,2) 9,66^5^9,50 "KRN",.404,52,40,17,3) 180 "KRN",.404,52,40,18,0) 5^MULTIPLE SIGN-ON LIMIT^3 "KRN",.404,52,40,18,1) 219 "KRN",.404,52,40,18,2) 5,66^3^5,42 "KRN",.404,52,40,19,0) 18^AUTO-GENERATE VERIFY CODES^3 "KRN",.404,52,40,19,1) 11.2 "KRN",.404,52,40,19,2) 15,31^3^15,3 "KRN",.404,52,40,20,0) 13^CCOW TOKEN TIMEOUT^3 "KRN",.404,52,40,20,1) 30.1 "KRN",.404,52,40,20,2) 11,66^5^11,46 "KRN",.404,53,0) XUSITEPARM 3^8989.3 "KRN",.404,53,40,0) ^.4044I^9^8 "KRN",.404,53,40,1,0) 1^MAX SPOOL LINES PER USER^3 "KRN",.404,53,40,1,1) 31.1 "KRN",.404,53,40,1,2) 1,31^7^1,5 "KRN",.404,53,40,2,0) 2^MAX SPOOL DOCUMENTS PER USER^3 "KRN",.404,53,40,2,1) 31.2 "KRN",.404,53,40,2,2) 2,31^3^2,1 "KRN",.404,53,40,3,0) 3^MAX SPOOL DOCUMENT LIFE-SPAN^3 "KRN",.404,53,40,3,1) 31.3 "KRN",.404,53,40,3,2) 3,31^3^3,1 "KRN",.404,53,40,5,0) 8^NEW PERSON IDENTIFIERS^3 "KRN",.404,53,40,5,1) 21 "KRN",.404,53,40,5,2) 14,4^65^13,1 "KRN",.404,53,40,6,0) 5^DEFAULT DIRECTORY FOR HFS^3 "KRN",.404,53,40,6,1) 320 "KRN",.404,53,40,6,2) 7,28^50^7,1 "KRN",.404,53,40,6,4) 1 "KRN",.404,53,40,7,0) 7^DNS IP^3 "KRN",.404,53,40,7,1) 51 "KRN",.404,53,40,7,2) 11,9^60^11,1 "KRN",.404,53,40,7,4) 1 "KRN",.404,53,40,8,0) 4^MIXED OS^3 "KRN",.404,53,40,8,1) .05 "KRN",.404,53,40,8,2) 6,28^9^6,18 "KRN",.404,53,40,8,3) No "KRN",.404,53,40,8,12) D UNED^DDSUTL(6,,,$S($$GET^DDSVAL(8989.3,1,.05):0,1:1)),REQ^DDSUTL(6,,,$$GET^DDSVAL(8989.3,1,.05)) "KRN",.404,53,40,8,13) I '$$GET^DDSVAL(8989.3,1,.05) D PUT^DDSVAL(DIE,.DA,320.2,"",,"I") "KRN",.404,53,40,9,0) 6^SECONDARY HFS DIRECTORY^3 "KRN",.404,53,40,9,1) 320.2 "KRN",.404,53,40,9,2) 8,28^49^8,3 "KRN",.404,53,40,9,4) 1 "KRN",.404,53,40,9,11) D UNED^DDSUTL(6,,,$S($$GET^DDSVAL(8989.3,1,.05):0,1:1)) "KRN",.404,54,0) XUSITEPARM 2^8989.3 "KRN",.404,54,40,0) ^.4044I^3^3 "KRN",.404,54,40,1,0) 1^Vol Set Max Sign-ons Log RT?^1 "KRN",.404,54,40,1,2) ^^1,12^1 "KRN",.404,54,40,2,0) 2^ROUTINE MONITORING^3 "KRN",.404,54,40,2,1) 9.8 "KRN",.404,54,40,2,2) 8,22^8^8,2 "KRN",.404,54,40,3,0) 3^Routine Namespace's^1 "KRN",.404,54,40,3,2) ^^9,12^1 "KRN",.404,55,0) XUSITEPARM 2.1^8989.304 "KRN",.404,55,40,0) ^.4044I^3^3 "KRN",.404,55,40,1,0) 1^^3 "KRN",.404,55,40,1,1) .01 "KRN",.404,55,40,1,2) 1,1^9 "KRN",.404,55,40,2,0) 2^^3 "KRN",.404,55,40,2,1) 2 "KRN",.404,55,40,2,2) 1,14^4 "KRN",.404,55,40,3,0) 3^^3 "KRN",.404,55,40,3,1) 6 "KRN",.404,55,40,3,2) 1,33^3 "KRN",.404,56,0) XUSITEPARM 2.2^8989.309 "KRN",.404,56,40,0) ^.4044I^1^1 "KRN",.404,56,40,1,0) 1^^3 "KRN",.404,56,40,1,1) .01 "KRN",.404,56,40,1,2) 2,5^8 "KRN",.404,57,0) XUSITEPARM 4^8989.3 "KRN",.404,57,40,0) ^.4044I^8^8 "KRN",.404,57,40,1,0) 1^OPTION AUDIT^3 "KRN",.404,57,40,1,1) 19 "KRN",.404,57,40,1,2) 1,15^24^1,1 "KRN",.404,57,40,2,0) 2^INITIATE AUDIT^3 "KRN",.404,57,40,2,1) 19.4 "KRN",.404,57,40,2,2) 2,20^17^2,4 "KRN",.404,57,40,3,0) 3^TERMINATE AUDIT^3 "KRN",.404,57,40,3,1) 19.5 "KRN",.404,57,40,3,2) 2,60^17^2,43 "KRN",.404,57,40,4,0) 4^Option to audit^1 "KRN",.404,57,40,4,2) ^^4,4^1 "KRN",.404,57,40,5,0) 5^Namespace to audit^1 "KRN",.404,57,40,5,2) ^^4,43^1 "KRN",.404,57,40,6,0) 6^User to audit^1 "KRN",.404,57,40,6,2) ^^9,4^1 "KRN",.404,57,40,7,0) 7^Device to audit^1 "KRN",.404,57,40,7,2) ^^9,43 "KRN",.404,57,40,8,0) 8^FAILED ACCESS ATTEMPTS^3 "KRN",.404,57,40,8,1) 212.5 "KRN",.404,57,40,8,2) 1,67^8^1,43 "KRN",.404,58,0) XUSITEPARM 4.1^8989.36 "KRN",.404,58,40,0) ^.4044I^1^1 "KRN",.404,58,40,1,0) 1^^3 "KRN",.404,58,40,1,1) .01 "KRN",.404,58,40,1,2) 1,1^30 "KRN",.404,59,0) XUSITEPARM 4.2^8989.35 "KRN",.404,59,40,0) ^.4044I^1^1 "KRN",.404,59,40,1,0) 1^^3 "KRN",.404,59,40,1,1) .01 "KRN",.404,59,40,1,2) 1,1^5 "KRN",.404,60,0) XUSITEPARM 4.4^8989.33 "KRN",.404,60,40,0) ^.4044I^1^1 "KRN",.404,60,40,1,0) 1^^3 "KRN",.404,60,40,1,1) .01 "KRN",.404,60,40,1,2) 1,1^20 "KRN",.404,61,0) XUSITEPARM 4.3^8989.34 "KRN",.404,61,40,0) ^.4044I^1^1 "KRN",.404,61,40,1,0) 1^^3 "KRN",.404,61,40,1,1) .01 "KRN",.404,61,40,1,2) 1,1^30 "KRN",.404,181,0) XUSITEPARM 5^8989.3 "KRN",.404,181,40,0) ^.4044I^3^3 "KRN",.404,181,40,1,0) 1^IRM MAIL GROUP^3 "KRN",.404,181,40,1,1) .02 "KRN",.404,181,40,1,2) 1,27^50^1,11 "KRN",.404,181,40,2,0) 2^AFTER HOURS MAIL GROUP^3 "KRN",.404,181,40,2,1) .03 "KRN",.404,181,40,2,2) 3,27^50^3,3 "KRN",.404,181,40,3,0) 3^LOG RESOURCE USAGE?^3 "KRN",.404,181,40,3,1) 300 "KRN",.404,181,40,3,2) 5,27^3^5,6 "KRN",.404,187,0) XUDEVICE LPD^3.5 "KRN",.404,187,40,0) ^.4044I^15^13 "KRN",.404,187,40,1,0) 1^EDIT A LDP DEVICE^1 "KRN",.404,187,40,1,2) ^^1,26 "KRN",.404,187,40,2,0) 2^NAME^3 "KRN",.404,187,40,2,1) .01 "KRN",.404,187,40,2,2) 2,7^30^2,1 "KRN",.404,187,40,3,0) 3^PAGE 1 OF 1^1 "KRN",.404,187,40,3,2) ^^2,64 "KRN",.404,187,40,4,0) 4^$I^3 "KRN",.404,187,40,4,1) 1 "KRN",.404,187,40,4,2) 4,7^32^4,3 "KRN",.404,187,40,4,3) _TNA "KRN",.404,187,40,4,11) D HLP^DDSUTL("To work this must be a _TNA device.") "KRN",.404,187,40,5,0) 5^LOCATION OF TERMINAL^3 "KRN",.404,187,40,5,1) .02 "KRN",.404,187,40,5,2) 4,64^16^4,42 "KRN",.404,187,40,6,0) 6^TYPE^3 "KRN",.404,187,40,6,1) 2 "KRN",.404,187,40,6,2) 5,7^20^5,1 "KRN",.404,187,40,7,0) 9^SUBTYPE^3 "KRN",.404,187,40,7,1) 3 "KRN",.404,187,40,7,2) 7,10^29^7,1 "KRN",.404,187,40,10,0) 12^TELNET PORT^3 "KRN",.404,187,40,10,1) 66 "KRN",.404,187,40,10,2) 11,32^4^11,19 "KRN",.404,187,40,11,0) 13^REMOTE PRINTER NAME^3 "KRN",.404,187,40,11,1) 67 "KRN",.404,187,40,11,2) 12,32^45^12,11 "KRN",.404,187,40,12,0) 8^MARGIN WIDTH^3 "KRN",.404,187,40,12,1) 9 "KRN",.404,187,40,12,2) 6,64^3^6,50 "KRN",.404,187,40,12,11) D HLP^DDSUTL("Only fill this in if you wish to override the subtype.") "KRN",.404,187,40,13,0) 10^PAGE LENGTH^3 "KRN",.404,187,40,13,1) 11 "KRN",.404,187,40,13,2) 7,64^5^7,51 "KRN",.404,187,40,13,11) D HLP^DDSUTL("Only fill this in if you wish to override the subtype.") "KRN",.404,187,40,14,0) 7^VOLUME SET(CPU)^3 "KRN",.404,187,40,14,1) 1.9 "KRN",.404,187,40,14,2) 5,64^16^5,47 "KRN",.404,187,40,15,0) 11^PRINT SERVER NAME OR ADDRESS^3 "KRN",.404,187,40,15,1) 65 "KRN",.404,187,40,15,2) 10,32^39^10,2 "KRN",.404,188,0) XUDEVICE TRM^3.5 "KRN",.404,188,11) D UNED^DDSUTL("Alt $I",,,'$P(^XTV(8989.3,1,0),U,5)) "KRN",.404,188,40,0) ^.4044I^15^15 "KRN",.404,188,40,1,0) 1^Edit a TRM or VTRM device^1 "KRN",.404,188,40,1,2) ^^1,22 "KRN",.404,188,40,2,0) 2^NAME^3 "KRN",.404,188,40,2,1) .01 "KRN",.404,188,40,2,2) 3,7^30^3,1 "KRN",.404,188,40,3,0) 3^LOCATION^3 "KRN",.404,188,40,3,1) .02 "KRN",.404,188,40,3,2) 3,59^20^3,49 "KRN",.404,188,40,4,0) 4^$I^3 "KRN",.404,188,40,4,1) 1 "KRN",.404,188,40,4,2) 5,10^40^5,6 "KRN",.404,188,40,5,0) 9^VOLUME SET(CPU)^3 "KRN",.404,188,40,5,1) 1.9 "KRN",.404,188,40,5,2) 11,60^15^11,43 "KRN",.404,188,40,6,0) 6^TYPE^3 "KRN",.404,188,40,6,1) 2 "KRN",.404,188,40,6,2) 7,10^20^7,4 "KRN",.404,188,40,7,0) 8^SIGN-ON/SYSTEM DEVICE^3 "KRN",.404,188,40,7,1) 1.95 "KRN",.404,188,40,7,2) 10,60^3^10,37 "KRN",.404,188,40,7,3) No "KRN",.404,188,40,8,0) 7^SUBTYPE^3 "KRN",.404,188,40,8,1) 3 "KRN",.404,188,40,8,2) 8,10^30^8,1 "KRN",.404,188,40,9,0) 11^MARGIN WIDTH^3 "KRN",.404,188,40,9,1) 9 "KRN",.404,188,40,9,2) 13,60^3^13,46 "KRN",.404,188,40,9,11) D HLP^DDSUTL("Only fill this in if you wish to override the subtype.") "KRN",.404,188,40,10,0) 13^PAGE LENGTH^3 "KRN",.404,188,40,10,1) 11 "KRN",.404,188,40,10,2) 14,60^5^14,47 "KRN",.404,188,40,10,11) D HLP^DDSUTL("Only fill this in if you wish to override the subtype.") "KRN",.404,188,40,11,0) 10^ASK DEVICE^3 "KRN",.404,188,40,11,1) 4 "KRN",.404,188,40,11,2) 13,17^3^13,5 "KRN",.404,188,40,12,0) 12^ASK PARAMETERS^3 "KRN",.404,188,40,12,1) 5 "KRN",.404,188,40,12,2) 14,17^3^14,1 "KRN",.404,188,40,12,3) No "KRN",.404,188,40,13,0) 5^Alt $I^3 "KRN",.404,188,40,13,1) 52 "KRN",.404,188,40,13,2) 6,10^40^6,2 "KRN",.404,188,40,14,0) 14^QUEUING^3 "KRN",.404,188,40,14,1) 5.5 "KRN",.404,188,40,14,2) 16,17^11^16,8 "KRN",.404,188,40,15,0) 15^SUPPRESS FORM FEED^3 "KRN",.404,188,40,15,1) 11.2 "KRN",.404,188,40,15,2) 16,60^3^16,40 "KRN",.404,216,0) XUDEVICE RES^3.5 "KRN",.404,216,40,0) ^.4044I^5^5 "KRN",.404,216,40,1,0) 1^Edit a Resource Device^1 "KRN",.404,216,40,1,2) ^^1,25 "KRN",.404,216,40,2,0) 2^Device Name^3 "KRN",.404,216,40,2,1) .01 "KRN",.404,216,40,2,2) 3,19^30^3,6 "KRN",.404,216,40,3,0) 5^Resource Slots^3 "KRN",.404,216,40,3,1) 35 "KRN",.404,216,40,3,2) 6,19^3^6,3 "KRN",.404,216,40,4,0) 4^$I^3 "KRN",.404,216,40,4,1) 1 "KRN",.404,216,40,4,2) 5,19^40^5,15 "KRN",.404,216,40,5,0) 3^Location^3 "KRN",.404,216,40,5,1) .02 "KRN",.404,216,40,5,2) 4,19^35^4,9 "KRN",.404,217,0) XUDEVICE SLOTS^3.54 "KRN",.404,217,40,0) ^.4044I^3^3 "KRN",.404,217,40,1,0) 1^Resource Name^3 "KRN",.404,217,40,1,1) .01 "KRN",.404,217,40,1,2) 3,19^30^3,4 "KRN",.404,217,40,2,0) 2^Available Slots^3 "KRN",.404,217,40,2,1) 1 "KRN",.404,217,40,2,2) 4,19^3^4,2 "KRN",.404,217,40,3,0) 3^Slots Used^4 "KRN",.404,217,40,3,2) 5,19^2^5,7 "KRN",.404,217,40,3,30) N I S Y=0 F I=0:0 S I=$O(^%ZISL(3.54,DA,1,I)) Q:'I S Y=Y+1 "KRN",19,149,-1) 2^8 "KRN",19,149,0) XUKERNEL^Kernel Management Menu^^M^.5^^^^^^^^y "KRN",19,149,10,0) ^19.01IP^12^12 "KRN",19,149,10,12,0) 1297 "KRN",19,149,10,12,"^") XU SID EDIT "KRN",19,149,"U") KERNEL MANAGEMENT MENU "KRN",19,181,-1) 0^6 "KRN",19,181,0) XUDEVEDITSPL^Spool Device Edit^^R^^^^^^^^ "KRN",19,181,1,0) ^19.06^1^1^3070607^^ "KRN",19,181,1,1,0) This is a ScreenMan oriented edit option for editing spool devices. "KRN",19,181,25) SPL^ZISEDIT "KRN",19,181,"U") SPOOL DEVICE EDIT "KRN",19,182,-1) 0^3 "KRN",19,182,0) XUDEVEDITHFS^Host File Server Device Edit^^R^^^^^^^^ "KRN",19,182,1,0) ^^1^1^2921023^ "KRN",19,182,1,1,0) This is a ScreenMan oriented edit option for editing host file devices. "KRN",19,182,25) HFS^ZISEDIT "KRN",19,182,"U") HOST FILE SERVER DEVICE EDIT "KRN",19,183,-1) 0^1 "KRN",19,183,0) XUDEVEDIT^Device Edit^^M^^^^^^^^^y "KRN",19,183,1,0) ^^2^2^3070607^ "KRN",19,183,1,1,0) This is a menu option for editing specific types of device using ScreenMan. "KRN",19,183,1,2,0) Or to edit all Device fields. "KRN",19,183,10,0) ^19.01IP^9^9 "KRN",19,183,10,2,0) 180^SDP "KRN",19,183,10,2,"^") XUDEVEDITSDP "KRN",19,183,10,3,0) 181^SPL "KRN",19,183,10,3,"^") XUDEVEDITSPL "KRN",19,183,10,4,0) 182^HFS "KRN",19,183,10,4,"^") XUDEVEDITHFS "KRN",19,183,10,6,0) 184^RES "KRN",19,183,10,6,"^") XUDEVEDITRES "KRN",19,183,10,7,0) 944^TRM "KRN",19,183,10,7,"^") XUDEVEDITTRM "KRN",19,183,10,9,0) 1252^ALL "KRN",19,183,10,9,"^") XUDEVEDITALL "KRN",19,183,99) 60788,55451 "KRN",19,183,"U") DEVICE EDIT "KRN",19,184,-1) 0^4 "KRN",19,184,0) XUDEVEDITRES^Resource Device Edit^^R^^^^^^^^^y "KRN",19,184,1,0) ^^1^1^3070607^ "KRN",19,184,1,1,0) This is a ScreenMan oriented edit option for editing resource devices. "KRN",19,184,25) RES^ZISEDIT "KRN",19,184,"U") RESOURCE DEVICE EDIT "KRN",19,944,-1) 0^5 "KRN",19,944,0) XUDEVEDITTRM^TRM or VTRM Device Edit^^R^^^^^^^^KERNEL^y "KRN",19,944,1,0) ^19.06^1^1^3070607^^^ "KRN",19,944,1,1,0) This option calls a screenman form to edit a TRM or VTRM device. "KRN",19,944,25) TRM^ZISEDIT "KRN",19,944,"U") TRM OR VTRM DEVICE EDIT "KRN",19,1252,-1) 0^7 "KRN",19,1252,0) XUDEVEDITALL^Edit All Device Fields^^E^^^^^^^^KERNEL^n "KRN",19,1252,1,0) ^19.06^1^1^3070607^^ "KRN",19,1252,1,1,0) This option will allow the editing of all the fields in the device file. "KRN",19,1252,30) %ZIS(1, "KRN",19,1252,31) AEQML "KRN",19,1252,50) 3.5 "KRN",19,1252,51) .01:9999 "KRN",19,1252,"U") EDIT ALL DEVICE FIELDS "KRN",19,1297,-1) 0^9 "KRN",19,1297,0) XU SID EDIT^Edit Logical/Physical Mapping^^R^^^^^^^^KERNEL^y "KRN",19,1297,1,0) ^^3^3^3070823^ "KRN",19,1297,1,1,0) This option lets you edit the two fields that are used in the SID code to "KRN",19,1297,1,2,0) map a logical name in the Cache cpf file to the Physical name that is "KRN",19,1297,1,3,0) returned by a $ZU(12,"") call. "KRN",19,1297,25) EDIT^XUPROD "KRN",19,1297,"U") EDIT LOGICAL/PHYSICAL MAPPING "KRN",19,1363,-1) 1^2 "KRN",19,1363,0) XUDEVEDITSDP "MBREQ") 0 "ORD",8,.403) .403;8;;;EDEOUT^DIFROMSO(.403,DA,"",XPDA);FPRE^DIFROMSI(.403,"",XPDA);EPRE^DIFROMSI(.403,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.403,DA,"",XPDA);DEL^DIFROMSK(.403,"",%) "ORD",8,.403,0) FORM "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",3,-1) 1^1 "PKG",3,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",3,20,0) ^9.402P^^0 "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 8.0^3051215^2970507^.5 "PKG",3,22,1,"PAH",1,0) 440^3080303 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3080303 "PKG",3,22,1,"PAH",1,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "PKG",3,22,1,"PAH",1,1,2,0) XU*8*440 Modifications for mixed VMS/Linux. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") 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") 15 "RTN","XU8P440") 0^^B1835580^n/a "RTN","XU8P440",1,0) XU8P440 ;ISF/RWF - Post-INIT for XU*8*440. ;01/17/2008 "RTN","XU8P440",2,0) ;;8.0;KERNEL;**440**;Jul 10, 1995;Build 13 "RTN","XU8P440",3,0) Q "RTN","XU8P440",4,0) POST ;Post-INIT "RTN","XU8P440",5,0) D DD35,DD32,DDGBL,DD8989 "RTN","XU8P440",6,0) D RELOAD^ZTMGRSET "RTN","XU8P440",7,0) Q "RTN","XU8P440",8,0) DD35 ;Remove old HUNT GROUP field #29. OLDXY is in p463 "RTN","XU8P440",9,0) N %,DA,DIK "RTN","XU8P440",10,0) I $E($G(^DD(3.5,29,0)),1)="*" D "RTN","XU8P440",11,0) . F DA=0:0 S DA=$O(^%ZIS(1,DA)) Q:'DA S %=$G(^(DA,0)) I $L($P(%,U,10)) S $P(^(0),U,10)="" "RTN","XU8P440",12,0) . S DIK="^DD(3.5,",DA=29,DA(1)=3.5 D ^DIK "RTN","XU8P440",13,0) Q "RTN","XU8P440",14,0) ; "RTN","XU8P440",15,0) DD32 ; "RTN","XU8P440",16,0) N DA,DIK "RTN","XU8P440",17,0) I $E($G(^DD(3.2,408,0)),1)="*" D "RTN","XU8P440",18,0) . F DA=0:0 S DA=$O(^%ZIS(2,DA)) Q:'DA K ^%ZIS(2,DA,408),^%ZIS(2,DA,409) "RTN","XU8P440",19,0) . S DIK="^DD(3.2,",DA=408,DA(1)=3.2 D ^DIK "RTN","XU8P440",20,0) . Q "RTN","XU8P440",21,0) I $E($G(^DD(3.2,409,0)),1)="*" D "RTN","XU8P440",22,0) . S DIK="^DD(3.2,",DA=409,DA(1)=3.2 D ^DIK "RTN","XU8P440",23,0) . Q "RTN","XU8P440",24,0) Q "RTN","XU8P440",25,0) ; "RTN","XU8P440",26,0) DD8989 ;See that MIXED OS is a 0 or 1 "RTN","XU8P440",27,0) N X "RTN","XU8P440",28,0) S X=$P($G(^XTV(8989.3,1,0)),"^",5) "RTN","XU8P440",29,0) S $P(^XTV(8989.3,1,0),"^",5)=+X "RTN","XU8P440",30,0) Q "RTN","XU8P440",31,0) ; "RTN","XU8P440",32,0) DDGBL ;Convert any data in the 'GBL' node to match new DD. "RTN","XU8P440",33,0) N DA,X,CNT "RTN","XU8P440",34,0) S DA=0,CNT=0 "RTN","XU8P440",35,0) F S DA=$O(^%ZIS(1,DA)) Q:'DA I $D(^(DA,"GBL")) D "RTN","XU8P440",36,0) . S X=^%ZIS(1,DA,"GBL") "RTN","XU8P440",37,0) . S:$L(X) ^%ZIS(1,DA,"GBL")=1,CNT=CNT+1 "RTN","XU8P440",38,0) . Q "RTN","XU8P440",39,0) W !,?5,CNT," 'GBL' nodes converted." "RTN","XU8P440",40,0) Q "RTN","XUPROD") 0^15^B5031849^B3450271 "RTN","XUPROD",1,0) XUPROD ;ISF/RWF - Is this a PROD account. ;8/23/07 16:47 "RTN","XUPROD",2,0) ;;8.0;KERNEL;**284,440**;Jul 10, 1995;Build 13 "RTN","XUPROD",3,0) ; "RTN","XUPROD",4,0) ;IA# 4440 "RTN","XUPROD",5,0) PROD(FORCE) ;Return 1 if this is a production account "RTN","XUPROD",6,0) ;A non-zero flag will force a real check "RTN","XUPROD",7,0) ;This call just checks a flag in the KSP, Other code will compair "RTN","XUPROD",8,0) ;with registered ID. "RTN","XUPROD",9,0) N LC,SID "RTN","XUPROD",10,0) S SID=$G(^XTV(8989.3,1,"SID")) "RTN","XUPROD",11,0) I '$L($P(SID,"^",3))!($P(SID,"^",3)'=$G(DT))!$G(FORCE) D "RTN","XUPROD",12,0) . D CHECK S SID=$G(^XTV(8989.3,1,"SID")) "RTN","XUPROD",13,0) Q +$P(SID,"^",1) "RTN","XUPROD",14,0) ; "RTN","XUPROD",15,0) CHECK ;Check if SID matched stored value, Set field 501 "RTN","XUPROD",16,0) N CSID,SSID,FDA "RTN","XUPROD",17,0) L +^XTV(8989.3,1,"SID"):2 "RTN","XUPROD",18,0) S CSID=$$SID^%ZOSV,SSID=$P($G(^XTV(8989.3,1,"SID")),"^",2) "RTN","XUPROD",19,0) S FDA(8989.3,"1,",501)=(CSID=SSID),FDA(8989.3,"1,",503)=$$DT^XLFDT "RTN","XUPROD",20,0) D FILE^DIE("","FDA") "RTN","XUPROD",21,0) L -^XTV(8989.3,1,"SID") "RTN","XUPROD",22,0) Q "RTN","XUPROD",23,0) ; "RTN","XUPROD",24,0) SSID(SID) ;Set the SID into KSP. "RTN","XUPROD",25,0) N FDA "RTN","XUPROD",26,0) S FDA(8989.3,"1,",502)=SID,FDA(8989.3,"1,",503)="@" "RTN","XUPROD",27,0) L +^XTV(8989.3,1,"SID"):2 "RTN","XUPROD",28,0) D FILE^DIE("","FDA") "RTN","XUPROD",29,0) L -^XTV(8989.3,1,"SID") "RTN","XUPROD",30,0) Q "RTN","XUPROD",31,0) ASK ;Ask user if this is prod. "RTN","XUPROD",32,0) N DIR,P S P=$$PROD "RTN","XUPROD",33,0) S DIR(0)="YO",DIR("A")="Is this a Production Account",DIR("B")="No" "RTN","XUPROD",34,0) S DIR("A",1)="" "RTN","XUPROD",35,0) S DIR("A",2)="This is now a "_$S(P:"PRODUCTION",1:"TEST")_" account." "RTN","XUPROD",36,0) S DIR("A",3)=" " "RTN","XUPROD",37,0) S DIR("A",4)="Only answer YES if this is the full time Production Account." "RTN","XUPROD",38,0) S DIR("A",5)="Answer No for all other accounts." "RTN","XUPROD",39,0) D ^DIR Q:$D(DIRUT) "RTN","XUPROD",40,0) I Y=1 D SSID($$SID^%ZOSV) "RTN","XUPROD",41,0) E D SSID("2~TEST~999") "RTN","XUPROD",42,0) S P=$$PROD "RTN","XUPROD",43,0) W:P !!,"This is now a PRODUCTION account.",! W:'P !!,"This is now a TEST account.",! "RTN","XUPROD",44,0) Q "RTN","XUPROD",45,0) ; "RTN","XUPROD",46,0) EDIT ;Edit Logical - Physical fields "RTN","XUPROD",47,0) N DIE,DA,DR "RTN","XUPROD",48,0) W !!,"This is only valid in a Cache v5.2 client/server configuration." "RTN","XUPROD",49,0) W !,"This lets you edit the fields that support the" "RTN","XUPROD",50,0) W !,"LOGICAL to PHYSICAL translation for the System ID.",!! "RTN","XUPROD",51,0) S DA=1,DIE="^XTV(8989.3,",DR="504;505" D ^DIE "RTN","XUPROD",52,0) Q "RTN","ZIS") 0^1^B20530056^B17316797 "RTN","ZIS",1,0) %ZIS ;SFISC/AC,RWF -- DEVICE HANDLER ;1/24/08 16:06 "RTN","ZIS",2,0) ;;8.0;KERNEL;**18,23,69,112,199,191,275,363,440**;JUL 10, 1995;Build 13 "RTN","ZIS",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS",4,0) N %ZISOS,%ZISV "RTN","ZIS",5,0) S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^%ZOSF("VOL")) "RTN","ZIS",6,0) ;Check SPOOLER special case first "RTN","ZIS",7,0) INIT I $D(ZTQUEUED),$G(IOT)="SPL",$D(IO)#2,$D(IO(0))#2,IO]"",IO=IO(0),$D(IO(1,IO))#2,%ZISOS["VAX DSM"!(%ZISOS["M/VX"),$G(IOP)[ION!(IOP[IO) K %ZIS,%IS,IOP Q "RTN","ZIS",8,0) ; "RTN","ZIS",9,0) I '$D(%ZIS),$D(%IS) M %ZIS=%IS "RTN","ZIS",10,0) S:'($D(%ZIS)#2) %ZIS="M" M %IS=%ZIS ;update %IS for now "RTN","ZIS",11,0) I '$D(^XUTL("XQ",$J,"MIXED OS")) S ^XUTL("XQ",$J,"MIXED OS")=$$PRI^%ZOSV "RTN","ZIS",12,0) S %ZIS("PRI")=$G(^XUTL("XQ",$J,"MIXED OS"),1) "RTN","ZIS",13,0) ; "RTN","ZIS",14,0) I $D(ZTQUEUED) D I '$D(IOP) S POP=1 G EXIT^%ZIS1 "RTN","ZIS",15,0) .I $D(ZTIO)#2,ZTIO="" S:%IS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" "RTN","ZIS",16,0) I '$D(ZTQUEUED),%IS["T",$P($G(IOP),";")="Q" S POP=1 G EXIT^%ZIS1 "RTN","ZIS",17,0) N %,%A,%E,%H,%I,%X,%XX,%Y,%Z,%Z1,%Z2,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE "RTN","ZIS",18,0) N %ZHFN,%ZISOLD,DTOUT,DUOUT "RTN","ZIS",19,0) ;Save symbols to restore if don't open a device "RTN","ZIS",20,0) D SYMBOL^%ZISUTL(0,$NA(%ZISOLD)) "RTN","ZIS",21,0) A D CLEAN ;(p363) K IO("CLOSE"),IO("HFSIO") "RTN","ZIS",22,0) K IO("P"),IO("Q"),IO("S"),IO("T") "RTN","ZIS",23,0) K2 D K2^%ZIS1 "RTN","ZIS",24,0) S %ZISB=%ZIS'["N",(%E,%H,POP)=0,%Y="" S:'$D(IO(0)) IO(0)=$I "RTN","ZIS",25,0) I %ZISOS["VAX DSM",$I["SYS$INPUT:.;" S:%ZIS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" "RTN","ZIS",26,0) ;I %IS["T"&(%IS["0") S (%H,%E)=0 G ^%ZIS1 "RTN","ZIS",27,0) I $D(IOP),IOP=$I!(IOP="HOME")!(0[IOP),$D(^XUTL("XQ",$J,"IO")) D HOME K %IS,%Y,%ZIS,%ZISB,%ZISV,IOP Q "RTN","ZIS",28,0) ;Don't worry about HOME if %ZIS[0 "RTN","ZIS",29,0) D:%ZIS'[0 GETHOME G EXIT^%ZIS1:POP,^%ZIS1 ;Jump to next part "RTN","ZIS",30,0) ; "RTN","ZIS",31,0) GETHOME I $D(IO("HOME")),$P(IO("HOME"),"^",2)=IO(0) S (%E,%H)=+IO("HOME") Q "RTN","ZIS",32,0) I $D(^XUTL("XQ",$J,"IOS")),$D(^("IO")),IO(0)=^("IO") S (%E,%H)=^("IOS") Q "RTN","ZIS",33,0) ;CALL LINEPORT CODE HERE--- "RTN","ZIS",34,0) S %=$$LINEPORT^%ZISUTL I % S (%E,%H)=% Q "RTN","ZIS",35,0) S %ZISVT=$I D VTLKUP I '%E S %ZISVT=$I D VIRTUAL "RTN","ZIS",36,0) I %ZISVT=""!(%E'>0) I %IS'[0 O IO(0)::0 I $T U IO(0) W !,"HOME DEVICE ("_$I_") DOES NOT EXIST IN THE DEVICE FILE",!,"PLEASE CONTACT YOUR SYSTEM MANAGER!",*7 "RTN","ZIS",37,0) S %H=%E S:'%H&(%IS'[0) POP=1 S:(%H>0)&('$D(IO("HOME"))) IO("HOME")=%H_"^"_$I "RTN","ZIS",38,0) Q "RTN","ZIS",39,0) VIRTUAL ;See if a Virtual Terminal (LAT, TELNET) "RTN","ZIS",40,0) ;Change the MSM check for telnet to work with v4.4 "RTN","ZIS",41,0) I %ZISOS["MSM" X "I $P($ZV,""Version "",2)'<3 S %ZISVT=$ZDE(+%ZISVT) I %ZISVT?.E1""~""4.5N.E S %ZISVT=""TELNET""" "RTN","ZIS",42,0) F %ZISI=$L(%ZISVT):-1:0 D:$D(^%ZIS(1,"C",%ZISVT)) Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0) S %ZISVT=$E(%ZISVT,1,%ZISI) "RTN","ZIS",43,0) .D VTLKUP Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0) "RTN","ZIS",44,0) .S %X=0 F %ZISX=%ZISV,"" Q:%X>0 S %X=0 F S %E=+$O(^%ZIS(1,"CPU",%ZISX_"."_%ZISVT,%X)) S %X=%E Q:%E'>0 I $G(^%ZIS(1,+%E,"TYPE"))="VTRM" Q "RTN","ZIS",45,0) Q "RTN","ZIS",46,0) VTLKUP F %ZISX=%ZISV,"" S %E=+$O(^%ZIS(1,"G","SYS."_%ZISX_"."_%ZISVT,0)) Q:%E S %E=+$O(^%ZIS(1,"CPU",%ZISX_"."_%ZISVT,0)) Q:%E "RTN","ZIS",47,0) Q "RTN","ZIS",48,0) ; "RTN","ZIS",49,0) CURRENT N POP,%ZIS,%IS,%E,%H "RTN","ZIS",50,0) S FF="#",SL=24,BS="*8",RM=80,(SUB,XY)="",%IS=0,%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")),POP=0 "RTN","ZIS",51,0) D GETHOME K %E,%IS,%ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX Q:POP "RTN","ZIS",52,0) I $D(^%ZIS(1,%H,"SUBTYPE")) S SUB=+^("SUBTYPE") K %H "RTN","ZIS",53,0) I $D(SUB),SUB,$D(^%ZIS(2,SUB,1)) S SUB=$S($D(^(0)):$P(^(0),"^"),1:""),FF=$P(^(1),"^",2),SL=$P(^(1),"^",3),BS=$P(^(1),"^",4),XY=$P(^(1),"^",5),RM=+^(1) "RTN","ZIS",54,0) E S SUB="" "RTN","ZIS",55,0) I $D(^%ZOSF("RM")) N X S X=RM X ^("RM") K %A "RTN","ZIS",56,0) Q "RTN","ZIS",57,0) HOME ;Entry point to establish IO* variables for home device. "RTN","ZIS",58,0) D CLEAN ;(p363) "RTN","ZIS",59,0) N X I '$D(^XUTL("XQ",$J,"IO")) S IOP="HOME" D ^%ZIS Q "RTN","ZIS",60,0) D RESETVAR "RTN","ZIS",61,0) I '$D(IO("C")),$G(IOM),IO=$I,$D(IO(1,IO)),$D(^%ZOSF("RM")) S X=+IOM X ^("RM") "RTN","ZIS",62,0) Q "RTN","ZIS",63,0) ;IO("Q") is checked by many routines after a call to ^%ZISC, so only clean on call to %ZIS. "RTN","ZIS",64,0) CLEAN ;Cleanup env. Called from %ZISC also. "RTN","ZIS",65,0) I $G(IOT)'="SPL" K IO("DOC"),IO("SPOOL") ;(p446) "RTN","ZIS",66,0) I $G(IOT)'="HFS" K IO("HFSIO") ;p446 "RTN","ZIS",67,0) S (IOPAR,IOUPAR)="" "RTN","ZIS",68,0) Q "RTN","ZIS",69,0) ; "RTN","ZIS",70,0) RESETVAR ;Reset home IO* variables. "RTN","ZIS",71,0) I '$D(^XUTL("XQ",$J,"IO")) Q "RTN","ZIS",72,0) N % "RTN","ZIS",73,0) F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%) "RTN","ZIS",74,0) F %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%) "RTN","ZIS",75,0) S POP=0,IO(0)=IO "RTN","ZIS",76,0) Q "RTN","ZIS",77,0) SAVEVAR ;Save home IO* variables, called from XUS1,%ZTMS3 "RTN","ZIS",78,0) N % "RTN","ZIS",79,0) F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR" I $D(@%) S ^XUTL("XQ",$J,%)=@% "RTN","ZIS",80,0) F %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")" I $D(@%) S ^XUTL("XQ",$J,%)=@% "RTN","ZIS",81,0) Q "RTN","ZIS",82,0) ZISLPC Q ;No longer called in Kernel v8. "RTN","ZIS",83,0) ; "RTN","ZIS",84,0) HLP1 G EN1^%ZIS7 "RTN","ZIS",85,0) HLP2 N %E,%H,%X,%ZISV,X S %ZISV=$S($D(^%ZOSF("VOL")):^("VOL"),1:"") G EN2^%ZIS7 "RTN","ZIS",86,0) ; "RTN","ZIS",87,0) REWIND(IO2,IOT,IOPAR) ;Rewind Device "RTN","ZIS",88,0) N %,X,Y,$ES,$ET S $ET="D REWERR^%ZIS Q 0" "RTN","ZIS",89,0) S %=$I "RTN","ZIS",90,0) I '($D(IO2)#2)!'$D(IOT)!'$D(IOPAR) Q 0 "RTN","ZIS",91,0) I "MT^SDP^HFS"'[IOT Q 0 "RTN","ZIS",92,0) S @("Y=$$REW"_IOT_"^%ZIS4(IO2,IOPAR)") "RTN","ZIS",93,0) U % "RTN","ZIS",94,0) Q Y "RTN","ZIS",95,0) REWERR ;Error encountered "RTN","ZIS",96,0) S IO("ERROR")=$EC "RTN","ZIS",97,0) S $EC="",$ET="Q:$ES>1 S $EC="""" Q 0" S $EC=",U1," "RTN","ZIS",98,0) Q 0 "RTN","ZIS",99,0) ; "RTN","ZIS1") 0^14^B24679317^B23639948 "RTN","ZIS1",1,0) %ZIS1 ;SFISC/AC,RWF -- DEVICE HANDLER (DEVICE INPUT) ;1/24/08 16:06 "RTN","ZIS1",2,0) ;;8.0;KERNEL;**18,49,69,104,112,199,391,440**;JUL 10, 1995;Build 13 "RTN","ZIS1",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS1",4,0) MAIN ;Called from %ZIS with a GO "RTN","ZIS1",5,0) I '$D(IOP),$D(^%ZIS(1,%E,0)),'$P(^(0),"^",3) S %A=%H,%Z=^(0) D L2^%ZIS2 G EXIT "RTN","ZIS1",6,0) L1 ;Main Loop "RTN","ZIS1",7,0) I '$D(IOP),$D(IO("Q")),POP D AQUE^%ZIS3 K:%=2 IO("Q") S:%=2 %ZISB=$S(%IS'["N":2,1:0) I %=-1 S POP=1 G EXIT "RTN","ZIS1",8,0) S %E=%H,POP=0,%IS=%ZIS ;Reset %IS from %ZIS "RTN","ZIS1",9,0) I %IS'["Q",$D(XQNOGO) S POP=1 W:'$D(IOP) !,$C(7),"OUTPUT IS NEVER ALLOWED FOR THIS OPTION" G EXIT "RTN","ZIS1",10,0) D IOP:$D(IOP),R:'$D(IOP) "RTN","ZIS1",11,0) G EXIT:$D(DTOUT)!$D(DUOUT)!(POP&$D(IOP)),L1:POP&'$D(IOP) "RTN","ZIS1",12,0) D LKUP I %A'>0 S POP=1 D:'$D(DUOUT) MSG1 K DUOUT "RTN","ZIS1",13,0) I '$D(^%ZIS(1,%A,0)) D MSG1 K %ZISIOS S POP=1 "RTN","ZIS1",14,0) I POP G EXIT:$D(IOP),L1:'$D(IOP) "RTN","ZIS1",15,0) S %E=%A,%Z=^%ZIS(1,%A,0),%Z1=$G(^(1)) "RTN","ZIS1",16,0) I $D(%ZIS("S")) N Y S Y=%E D XS^ZISX S:'$T POP=1 G G:POP "RTN","ZIS1",17,0) W:'$D(IOP)&($P(%Z,"^",2)'=$I)&($P(%Z1,"^")]"") " ",$P(%Z1,"^") "RTN","ZIS1",18,0) D L2^%ZIS2 ;Call "RTN","ZIS1",19,0) G G L1:POP&'$D(IOP)&'($D(DTOUT)!$D(DUOUT)) ;Didn't get it "RTN","ZIS1",20,0) ; "RTN","ZIS1",21,0) EXIT ; "RTN","ZIS1",22,0) I POP G EX2 ;Did not get the device. "RTN","ZIS1",23,0) ;For type[TRM reset $X & $Y "RTN","ZIS1",24,0) I %ZTYPE["TRM",IO]"",$D(IO(1,IO)) U IO S:'(IO=IO(0)&'$D(IO("S"))&'$D(ZTQUEUED)) $X=0,$Y=0 "RTN","ZIS1",25,0) ;Do count of number of times device opened. Field 51. "RTN","ZIS1",26,0) I $L($G(IO)),$D(IO(1,IO))#2,$G(%ZISIOS) D "RTN","ZIS1",27,0) . S $P(^(5),"^",1)=$P($G(^%ZIS(1,%ZISIOS,5)),"^",1)+1 "RTN","ZIS1",28,0) I %ZIS["H" S IO(0)=IO,IO("HOME")=%ZISIOS_"^"_IO ;Make home device "RTN","ZIS1",29,0) I '$D(IO("Q")),$D(%ZISLOCK) S ^XUTL("XQ",$J,"lock",%ZISIOS)=%ZISLOCK "RTN","ZIS1",30,0) I $D(IO)#2,IO]"",$D(IO(1,IO))#2,$D(%Z1),$P(%Z1,"^",11) S IO(1,IO,"NOFF")=1 "RTN","ZIS1",31,0) EX2 ; "RTN","ZIS1",32,0) I %IS'[0,$G(IO(0))]"" U IO(0) ;Make sure return with home active "RTN","ZIS1",33,0) G SETVAR:'POP!(%IS["T"),KILVAR "RTN","ZIS1",34,0) ; "RTN","ZIS1",35,0) IOP ;Request with IOP set "RTN","ZIS1",36,0) S (%ZISVT,%X)=IOP S:%X'?1.UNP %X=$$UP(%X) I %X'="Q" D SETQ Q "RTN","ZIS1",37,0) S %IS=%IS_%X K IOP W %X D SETQ Q "RTN","ZIS1",38,0) ;Get ready to ask user for device "RTN","ZIS1",39,0) R I %IS["Q",$D(XQNOGO) W !,$C(7),"AT THIS TIME, OUTPUT MUST BE QUEUED" "RTN","ZIS1",40,0) S %A=$S($D(%IS("B")):%IS("B"),1:"HOME") ;Setup default "RTN","ZIS1",41,0) I %IS["P",%A="HOME",$D(^%ZIS(1,%E,99)),$D(^%ZIS(1,+^(99),0)) S %A=$P(^(0),"^",1) "RTN","ZIS1",42,0) RD W !,$S($D(%IS("A")):%IS("A"),1:"DEVICE: ") W:%A]"" %A,"// " D SBR S:%X="" %X=%A S %ZISVT=%X "RTN","ZIS1",43,0) I %X?2"?".E D EN2^%ZIS7 G R "RTN","ZIS1",44,0) I %X?1"?".E D EN1^%ZIS7 G R "RTN","ZIS1",45,0) I $D(DTOUT)!$D(DUOUT)!(%X'?.ANP)!($L($P(%X,";"))>31) S:%IS["T" IO="" S POP=1 Q "RTN","ZIS1",46,0) S:%X'?1.UNP %X=$$UP(%X) D SETQ G R:$T Q "RTN","ZIS1",47,0) SETQ S %Y=$P(%X,";",2,9),%X=$P(%X,";",1) S:$L(";"_%Y,";/")=2 IO("P")=$P(";"_%Y,";/",2) "RTN","ZIS1",48,0) I %IS["Q",%X="Q" S %X=%Y,%ZISVT=$P(%ZISVT,";",2,9),%ZISB=0,IO("Q")=1,%IS("A")="DEVICE: " S:$D(IOP) %Y=$P(%X,";",2,9),%X=$P(%X,";",1) "RTN","ZIS1",49,0) I $T,'$D(IOP) W "UEUE TO PRINT ON" Q ; Return $T value "RTN","ZIS1",50,0) Q "RTN","ZIS1",51,0) LKUP S %ZISMY=$P(%ZISVT,";",2,999),%ZISVT=$P(%ZISVT,";") "RTN","ZIS1",52,0) I %X="H" W:'$D(IOP) "ome" S %X=0 "RTN","ZIS1",53,0) I 0[%X!(%X="HOME")!(%X=$I) S %A=%H Q "RTN","ZIS1",54,0) I $E(%ZISVT)="`",$D(IOP) S %A=+$E(%ZISVT,2,999) I $G(^%ZIS(1,%A,0))]"" Q "RTN","ZIS1",55,0) S %A=0 I "P"[%X Q:$D(IOP)&('$D(^%ZIS(1,%E,99))) I $D(^%ZIS(1,%E,99)) S %A=+^(99) Q "RTN","ZIS1",56,0) I %X=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS(1,")) S %A=^("^%ZIS(1,") Q "RTN","ZIS1",57,0) S %A=+$O(^%ZIS(1,"B",%ZISVT,0)) Q:%A>0 ;mixed case lookup "RTN","ZIS1",58,0) I %X'=%ZISVT S %A=+$O(^%ZIS(1,"B",%X,0)) Q:%A>0 ;uppercase lookup "RTN","ZIS1",59,0) D VTLKUP^%ZIS S %A=%E Q:%A>0 ;mixed case lookup "RTN","ZIS1",60,0) I %X'=%ZISVT S %ZISVT=%X D VTLKUP^%ZIS S %A=%E Q:%A>0 ;uppercase lookup "RTN","ZIS1",61,0) N %XX,%YY S %XX=%X D 1^%ZIS5 S %A=+%YY Q "RTN","ZIS1",62,0) SBR K DFOUT,DTOUT,DUOUT R %X:$S($D(DTIME)#2:DTIME,1:300) E W $C(7) S DTOUT=1 Q "RTN","ZIS1",63,0) S:%X="."!(%X="^") DUOUT=1,%X="" Q "RTN","ZIS1",64,0) LC S %X=$$UP(%X) "RTN","ZIS1",65,0) Q "RTN","ZIS1",66,0) LOW(%) Q $TR(%,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") "RTN","ZIS1",67,0) UP(%) Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","ZIS1",68,0) ; "RTN","ZIS1",69,0) ;Call/Return % = 1 (yes), 2 (no) -1 (^) "RTN","ZIS1",70,0) YN W "? ",$P("Yes// ^No// ",U,%) "RTN","ZIS1",71,0) RYN R %X:$S($D(DTIME):DTIME,$D(%ZISDTIM):%ZISDTIM,1:300) E S DTOUT=1,%X=U W $C(7) "RTN","ZIS1",72,0) S:%X]""!'% %=$A(%X),%=$S(%=89:1,%=121:1,%=78:2,%=110:2,%=94:-1,1:0) "RTN","ZIS1",73,0) I '%,%X'?."?" W $C(7),"??",!?4,"ANSWER 'Yes' OR 'No': " G RYN "RTN","ZIS1",74,0) W:$X>73 ! W $P(" (Yes)^ (No)",U,%) "RTN","ZIS1",75,0) Q "RTN","ZIS1",76,0) MSG1 I '$D(IOP) W ?20,$C(7)," [DEVICE DOES NOT EXIST]" "RTN","ZIS1",77,0) Q "RTN","ZIS1",78,0) SETVAR ;Come here to setup the variables for the selected device "RTN","ZIS1",79,0) S:$D(IO)[0 IO="" G KILVAR:%IS["T"&(IO="") "RTN","ZIS1",80,0) I $G(%Z)="" S ION="Unknown device",POP=1 G KILVAR "RTN","ZIS1",81,0) S:IO'=IO(0)&($D(DUZ)#2) ^DISV(+DUZ,"^%ZIS(1,")=%E "RTN","ZIS1",82,0) S ION=$P(%Z,"^",1),IOM=+%Z91,IOF=$P(%Z91,"^",2),IOSL=$P(%Z91,"^",3),IOBS=$P(%Z91,"^",4),IOXY=$P(%Z91,"^",5) "RTN","ZIS1",83,0) I IOSL>65530 S IOSL=65530 ;Cache rolls $Y at 65535 "RTN","ZIS1",84,0) S IOT=%ZTYPE,IOST(0)=%ZISIOST(0),IOST=%ZISIOST,IOPAR=%ZISOPAR,IOUPAR=%ZISUPAR,IOHG=%ZISHG "RTN","ZIS1",85,0) S:IOF="" IOF="#" ;See that IOF has something "RTN","ZIS1",86,0) K IOCPU S:$D(%ZISCPU) IOCPU=%ZISCPU "RTN","ZIS1",87,0) G KIL "RTN","ZIS1",88,0) ; "RTN","ZIS1",89,0) KILVAR ;Come here to restore the calling variables "RTN","ZIS1",90,0) D SYMBOL^%ZISUTL(1,"%ZISOLD") "RTN","ZIS1",91,0) S:'$L($G(IOF)) IOF="#" S:'$D(IOST(0)) IOST(0)=0 "RTN","ZIS1",92,0) ;See that all standard variables are defined "RTN","ZIS1",93,0) F %I="IO","ION","IOM","IOBS","IOSL","IOST" S:$D(@%I)[0 @%I="" "RTN","ZIS1",94,0) K IO("HFSIO"),IO("OPEN") I $D(%ZISCPU) S:'$D(IOCPU) IOCPU=%ZISCPU "RTN","ZIS1",95,0) KIL ;Final exit cleanup "RTN","ZIS1",96,0) S:'POP IOS=%ZISIOS I POP K:%IS'["T" %ZISIOS I %IS["T" K IOS S:$D(%ZISIOS) IOS=%ZISIOS "RTN","ZIS1",97,0) S:%IS["T" IO("T")=1 K %ZIS,%IS,%A,%E,%H,%ZISOS,%ZISV,IOP "RTN","ZIS1",98,0) K2 K %I,%X,%Y,%Z,%Z1,%Z91,%Z95,%ZTYPE,%ZTIME "RTN","ZIS1",99,0) K %ZISCHK,%ZISCPU,%ZISI,%ZISR,%ZISVT,%ZISB,%ZISX,ZISI,%ZISHGL,%ZISHP,%ZISIO,%ZISIOS,%ZISIOM "RTN","ZIS1",100,0) K %ZISIOF,%ZISIOSL,%ZISIOBS,%ZISIOST,%ZISIOST(0),%ZISTO,%ZISTP,%ZISHG,%ZISSIO,%ZISOPEN,%ZISOPAR,%ZISUPAR "RTN","ZIS1",101,0) K %ZISMY,%ZISQUIT,%ZISLOCK "RTN","ZIS1",102,0) Q "RTN","ZIS2") 0^4^B20845932^B19355855 "RTN","ZIS2",1,0) %ZIS2 ;SFISC/AC,RWF -- DEVICE HANDLER (CHECKS) ;1/24/08 16:07 "RTN","ZIS2",2,0) ;;8.0;KERNEL;**69,104,112,118,136,241,440**;JUL 10, 1995;Build 13 "RTN","ZIS2",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS2",4,0) HUNT S:'$D(%ZISHP) %ZISHP=%E,%ZISHGL=0 S %E=0 "RTN","ZIS2",5,0) F S %ZISHGL=$O(^%ZIS(1,%ZISHG(0),"HG",%ZISHGL)) Q:%ZISHGL'>0 D Q:%E "RTN","ZIS2",6,0) . N %1,%2 S %1=$G(^%ZIS(1,%ZISHG(0),"HG",+%ZISHGL,0)),%2=$G(^%ZIS(1,+%1,0)) "RTN","ZIS2",7,0) . ;Check that HG device is on same VOL. "RTN","ZIS2",8,0) . I $P(%2,"^",9)=%ZISV!($P(%2,"^",9)="") S %E=+$P(^%ZIS(1,%ZISHG(0),"HG",+%ZISHGL,0),"^") "RTN","ZIS2",9,0) . Q "RTN","ZIS2",10,0) G L2:%ZISHGL>0 S %ZISHPOP=1,%E=%ZISHP "RTN","ZIS2",11,0) ; "RTN","ZIS2",12,0) L2 ;Entry point from %ZIS1 "RTN","ZIS2",13,0) I $D(DTOUT)!$D(DUOUT) K %ZISHP,%ZISHPOP Q "RTN","ZIS2",14,0) CHECK ;Get IO check for secondary $I "RTN","ZIS2",15,0) K %ZISCPU N %Z2 "RTN","ZIS2",16,0) S POP=0,%Z=^%ZIS(1,%E,0),%Z2=$S(%ZIS("PRI")=1:"",1:$G(^%ZIS(1,%E,2))) ;Get Primary and secondary IO. "RTN","ZIS2",17,0) S IO=$S(%ZIS("PRI")=1:$P(%Z,"^",2),$L($P(%Z2,"^")):$P(%Z2,"^"),1:$P(%Z,"^",2)) ; "RTN","ZIS2",18,0) S:%IS["Q"&'$D(ZTQUEUED)&($P(%Z,"^",12)=1!$D(XQNOGO)) %ZISB=0,IO("Q")=1 ;Forced Queueing "RTN","ZIS2",19,0) I $P(%Z,"^",12)=2 S %IS=$TR(%IS,"Q") I $D(IO("Q")) D Q "RTN","ZIS2",20,0) . I '$D(IOP) W !,"Queuing NOT ALLOWED on this device" "RTN","ZIS2",21,0) . S POP=1 K:$D(IOP) IO("Q") Q "RTN","ZIS2",22,0) S %Z90=$G(^(90)),%Z95=$G(^(95)),%ZTIME=$G(^("TIME")),%ZTYPE=$G(^("TYPE")),%ZISHG=$O(^%ZIS(1,"AHG",%E,0)) "RTN","ZIS2",23,0) I %ZISHG,$D(^%ZIS(1,+%ZISHG,0)) S:'$D(%ZISHG(0)) %ZISHG(0)=+%ZISHG S %ZISHG=$P(^(0),"^",1) "RTN","ZIS2",24,0) E S %ZISHG="" "RTN","ZIS2",25,0) I %ZTYPE="HG" D OTHCPU("HUNT GROUP") G T:$D(%ZISHG(0))!POP "RTN","ZIS2",26,0) I %ZTYPE="RES" S %ZISRL=+$P(%Z1,"^",10) G T "RTN","ZIS2",27,0) VTRM I %ZTYPE="VTRM",'('$D(IO("Q"))&(%A=%H)) W:'$D(IOP)&'$D(%ZISHP) *7," [YOU CAN NOT SELECT A VIRTUAL TERMINAL]" S POP=1 ;Virtual Terminal Check "RTN","ZIS2",28,0) S:%ZTYPE="VTRM"&'$D(IO("Q"))&(%A=%H) IO=$I "RTN","ZIS2",29,0) ; "RTN","ZIS2",30,0) SLAVE I $D(IO("Q")),$P(%Z,"^",2)=0,$P(%Z,"^",8)']"" W:'$D(IOP) *7,!?10," [SLAVE device NOT set up for queuing]" S POP=1 G T "RTN","ZIS2",31,0) OCPU D OTHCPU("DEVICE") "RTN","ZIS2",32,0) ; "RTN","ZIS2",33,0) OOS G T:POP I %Z90,$D(DT)#2,%Z90'>DT S POP=1 ;Out Of Service Check "RTN","ZIS2",34,0) I $T,'$D(IOP),'$D(%ZISHP) W *7," [Out of Service]" ;I 'POP W " ..OK" S %=2,U="^" D YN^%ZIS1 G:%=0 OOS S:%'=1 POP=1 "RTN","ZIS2",35,0) ; "RTN","ZIS2",36,0) PTIME G T:POP!(IO=$I)!(IO=0) "RTN","ZIS2",37,0) ;Prohibitted Time Check "RTN","ZIS2",38,0) S %A=$P(%ZTIME,"^") I %ZISB,$L(%A) D I POP,'$D(IOP),'$D(%ZISHP) W *7," [ACCESS PROHIBITED "_%A_"]" ;AT THIS TIME]" "RTN","ZIS2",39,0) . N %C,%L,%H ;%C is current time, %L is lower limit, %H is upper limit "RTN","ZIS2",40,0) . S %C=$P($H,",",2),%C=%C\60#60+(%C\3600*100),%H=$P(%A,"-",2),%L=+%A "RTN","ZIS2",41,0) . I $S(%H'<%L:(%C'>%H&(%C'<%L)),1:(%C'<%L!(%C'>%H))) S POP=1 "RTN","ZIS2",42,0) . Q "RTN","ZIS2",43,0) DUZ I 'POP D SEC ;Security Check "RTN","ZIS2",44,0) ; "RTN","ZIS2",45,0) T I POP,$D(%ZISHG(0)),%IS'["D",'$D(%ZISHPOP),%ZISB G HUNT "RTN","ZIS2",46,0) I POP D HGBSY:$D(%ZISHPOP) ;G T2:%IS["T" "RTN","ZIS2",47,0) ; "RTN","ZIS2",48,0) TMPVAR K IO("S") S %ZISIOS=%E S:IO=0 IO=$I,IO("S")=%H "RTN","ZIS2",49,0) S %ZISOPAR=$$IOPAR(%E,"IOPAR") "RTN","ZIS2",50,0) S %ZISUPAR=$$IOPAR(%E,"IOUPAR"),%ZISTO=+$P(%ZTIME,"^",2) "RTN","ZIS2",51,0) I $D(IO("S")) D I POP Q "RTN","ZIS2",52,0) . S IO=$S(%IS["S":$P($G(^%ZIS(1,+$P(%Z,"^",8),0)),"^",2),1:IO) "RTN","ZIS2",53,0) . I %IS["S",IO]"" S %H=+$P(%Z,"^",8),IO("S")=%H,IO(0)=IO "RTN","ZIS2",54,0) . S IO("S")=$S($G(^XUTL("XQ",$J,"IOST(0)")):^("IOST(0)"),1:$G(^%ZIS(1,%H,"SUBTYPE"))) "RTN","ZIS2",55,0) . S:IO="" POP=1 "RTN","ZIS2",56,0) . Q "RTN","ZIS2",57,0) S %A=+$G(^%ZIS(1,%E,"SUBTYPE")),%ZISTP=0 ;%A is pointer to subtype "RTN","ZIS2",58,0) I %E=%H,%ZTYPE["TRM" D I 1 "RTN","ZIS2",59,0) . I $D(^XUTL("XQ",$J,"IOST(0)")) D ;Use home "RTN","ZIS2",60,0) . . S %A=+^XUTL("XQ",$J,"IOST(0)"),%Z91="",%ZISTP=1 "RTN","ZIS2",61,0) . . F %ZISI="IOM","IOF","IOSL","IOBS","IOXY" S %Z91=%Z91_$G(^XUTL("XQ",$J,%ZISI))_"^" "RTN","ZIS2",62,0) . E S %=$$LNPRTSUB^%ZISUTL I %>0 S %A=%,%Z91="" "RTN","ZIS2",63,0) E S %Z91=$P($G(^%ZIS(2,%A,1)),"^",1,4),$P(%Z91,"^",5)=$G(^("XY")) "RTN","ZIS2",64,0) ;I $D(%Z91),%Z91'?1.4"^" ;$P(%Z91,"^")]"",$P(%Z91,"^",2)]"",$P(%Z91,"^",3),$P(%Z91,"^",4)]"" "RTN","ZIS2",65,0) D ST^%ZIS3(%ZISTP) S:%IS["U" USIO=$P(%Z91,"^",1,4) "RTN","ZIS2",66,0) T2 I POP S:%IS'["T" IO="" Q "RTN","ZIS2",67,0) G ^%ZIS3:"^MTRM^VTRM^TRM^SPL^MT^SDP^HFS^RES^OTH^BAR^HG^IMPC^CHAN^"[("^"_%ZTYPE_"^") ;Jump to next part "RTN","ZIS2",68,0) S POP=1 Q "RTN","ZIS2",69,0) ; "RTN","ZIS2",70,0) HGBSY S POP=1 S:%IS'["T" IO="" K %ZISHP,%ZISHPOP Q:$D(IOP) "RTN","ZIS2",71,0) W:$X>38 !,?5 W *7," All devices in hunt group "_%ZISHG_" are busy!" Q "RTN","ZIS2",72,0) ; "RTN","ZIS2",73,0) OTHCPU(%1) ;%1 should be either DEVICE or HUNT GROUP "RTN","ZIS2",74,0) N %2,X,Y,%ZISMSG S %ZISMSG=0 "RTN","ZIS2",75,0) F %2="CPU","VOLUME SET" D "RTN","ZIS2",76,0) .I %2="VOLUME SET" S X=$P($P(%Z,"^",9),":"),Y=%ZISV "RTN","ZIS2",77,0) .E D GETENV^%ZOSV S X=$P($P(%Z,"^",9),":",2),Y=$P($P(Y,"^",4),":",2) "RTN","ZIS2",78,0) .I X=Y!(X="") Q:%1="DEVICE" D Q ;Other Vol Set/Cpu Check "RTN","ZIS2",79,0) ..S %ZISHG(0)=%E,%ZISHG=$P(%Z,"^") "RTN","ZIS2",80,0) ..I %ZISB S POP=1 "RTN","ZIS2",81,0) ..E S IO=" " "RTN","ZIS2",82,0) .I %2="VOLUME SET" S $P(%ZISCPU,":")=X "RTN","ZIS2",83,0) .E S $P(%ZISCPU,":",2)=X "RTN","ZIS2",84,0) .I %1="HUNT GROUP" K %ZISHG(0) "RTN","ZIS2",85,0) .I %IS["Q" S IO("Q")=1,%ZISB=0 S:%1="HUNT GROUP" IO=" " "RTN","ZIS2",86,0) .E I %ZISB&(%ZTYPE="TRM"&($D(%ZISHG(0))&(%IS'["D"))) S POP=1 "RTN","ZIS2",87,0) .E W:'$D(IOP)&'%ZISMSG *7," ["_%1_" is on another "_%2_" ('"_X_"')]",! S POP=1,%ZISMSG=1 "RTN","ZIS2",88,0) Q "RTN","ZIS2",89,0) IOPAR(%DA,%N) ;Return I/O parameters "RTN","ZIS2",90,0) Q $S($G(%ZIS(%N))]"":%ZIS(%N),1:$G(^%ZIS(1,%DA,%N))) "RTN","ZIS2",91,0) ; "RTN","ZIS2",92,0) SEC I %Z95]"" S %X=$G(DUZ(0)) I %X'="@" S POP=1 F %A=1:1:$L(%X) I %Z95[$E(%X,%A) S POP=0 Q "RTN","ZIS2",93,0) I POP,'$D(IOP),'$D(%ZISHP) W *7," [Access Prohibited]" "RTN","ZIS2",94,0) Q "RTN","ZIS3") 0^13^B13908684^B12189703 "RTN","ZIS3",1,0) %ZIS3 ;SFISC/AC,RWF -- DEVICE HANDLER(DEVICE TYPES & PARAMETERS) ;1/24/08 13:18 "RTN","ZIS3",2,0) ;;8.0;KERNEL;**18,36,69,104,391,440**;JUL 10, 1995;Build 13 "RTN","ZIS3",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS3",4,0) ;Call with a Go from ^%ZIS2 "RTN","ZIS3",5,0) I %ZIS'["T",$G(^%ZIS(1,+%E,"POX"))]"" D XPOX^ZISX(%E) ;Pre-Open "RTN","ZIS3",6,0) I $D(%ZISQUIT) S POP=1 K %ZISQUIT "RTN","ZIS3",7,0) S %ZISCHK=1 "RTN","ZIS3",8,0) ;I 'POP&(%ZISB)&(%ZTYPE'="RES")&(%ZTYPE'="OTH")&(%ZTYPE'="SDP")&(IO'["::") D DEVOK "RTN","ZIS3",9,0) ;See if need to lock. "RTN","ZIS3",10,0) K %ZISLOCK "RTN","ZIS3",11,0) I %ZIS'["T",+$G(^%ZIS(1,+%E,"GBL")) S %ZISLOCK=$NA(^%ZIS("lock",IO)) "RTN","ZIS3",12,0) ; "RTN","ZIS3",13,0) I 'POP G TRM:(%ZTYPE["TRM"),@(%ZTYPE_"^%ZIS6") ;Jump to next part "RTN","ZIS3",14,0) ; "RTN","ZIS3",15,0) Q ;%ZIS6 Returns here "RTN","ZIS3",16,0) ;See if need to un-lock. "RTN","ZIS3",17,0) I $D(%ZISUOUT) K %ZISUOUT,%ZISHP,%ZISHPOP Q "RTN","ZIS3",18,0) I $D(%ZISHPOP)&$S(IO="":1,1:'$D(IO(1,IO))) D HGBSY^%ZIS2 Q "RTN","ZIS3",19,0) I POP S:%ZIS'["T" IO="" I $D(%ZISHG(0)),%ZIS'["D",'$D(%ZISHPOP) G HUNT^%ZIS2 "RTN","ZIS3",20,0) Q ;Return to %ZIS1 "RTN","ZIS3",21,0) ; "RTN","ZIS3",22,0) VTRM ;Virtual terminal type "RTN","ZIS3",23,0) TRM ;D OPEN^%ZIS4:'POP&(%ZISB&(%ZIS'["T")),MARGN:'POP,SETPAR:'POP ;Terminal type "RTN","ZIS3",24,0) D MARGN:'POP,SETPAR:'POP ;Terminal type// TEST CHANGE "RTN","ZIS3",25,0) I 'POP,%ZIS'["T",%ZISB=1,'$D(IOP),IO'=IO(0),'$D(IO("Q")),%ZIS["Q" D AQUE "RTN","ZIS3",26,0) W:'$D(IOP) ! "RTN","ZIS3",27,0) I '$D(IO("Q")),'POP,%ZISB,%ZIS'["T" D O^%ZIS4 "RTN","ZIS3",28,0) G Q "RTN","ZIS3",29,0) DEVOK N X,Y,X1 ;Not sure this is needed "RTN","ZIS3",30,0) S X=IO,X1=%ZTYPE "RTN","ZIS3",31,0) D DEVOK^%ZOSV I Y=-99!(Y=0)!(Y=$J) Q "RTN","ZIS3",32,0) I Y>0 S POP=1 W:'$D(IOP)&('$D(%ZISHG(0))!(%IS["D")) !,$C(7),"[Device Unavailable]" Q "RTN","ZIS3",33,0) I Y=-1 S IO="",POP=1 W:'$D(IOP)&('$D(ZISHG(0))!(%IS["D")) !,$C(7),"[Device does not Exist or Unavailable]" Q "RTN","ZIS3",34,0) Q "RTN","ZIS3",35,0) ; "RTN","ZIS3",36,0) MARGN ;Get the margin and page length "RTN","ZIS3",37,0) S %A=$P(%Y,";",1) "RTN","ZIS3",38,0) I %A?1A.ANP D SUBIEN(.%A,1) I $D(^%ZIS(2,%A,1)) K %Z91 D ST(1) S %Y=$P(%Y,";",2,9),%ZISMY=$P(%ZISMY,";",2,9) G MARGN "RTN","ZIS3",39,0) I %A>3 S $P(%Z91,"^")=$S(%A>255:255,1:+%A) "RTN","ZIS3",40,0) I $P(%Y,";",2) S $P(%Z91,"^",3)=+$S($P(%Y,";",2)>65530:65530,1:$P(%Y,";",2)) ;Cache fix for $Y#65535 wrap "RTN","ZIS3",41,0) ; "RTN","ZIS3",42,0) ALTP I '$D(IO("P")) Q:%A>3 G ASKMAR:%ZTYPE["TRM" Q "RTN","ZIS3",43,0) S %X=$F(IO("P"),"M") I %X S %A=+$E(IO("P"),%X,99),$P(%Z91,"^")=$S(%A>255:255,1:%A) "RTN","ZIS3",44,0) S %X=$F(IO("P"),"L") I %X S $P(%Z91,"^",3)=+$E(IO("P"),%X,99) "RTN","ZIS3",45,0) Q:%A>3!(%ZTYPE'["TRM") "RTN","ZIS3",46,0) ASKMAR I %IS["M",'$D(IOP),$S(%E=%H:+$P(%Z,"^",3),1:1),$P(%Z,"^",4) W " Right Margin: " W:$P(%Z91,"^")]"" +%Z91,"// " "RTN","ZIS3",47,0) E Q "RTN","ZIS3",48,0) D SBR^%ZIS1 I '$D(DTOUT)&'$D(DUOUT) S:%X=""&($P(%Z91,"^")]"") %X=+%Z91 G ASKMAR:%X'?1.N S $P(%Z91,"^")=$S(%X>255:255,1:%X) Q "RTN","ZIS3",49,0) S POP=1 I %ZISB&(%ZTYPE["TRM")&(IO'=IO(0)) C IO K IO(1,IO) Q "RTN","ZIS3",50,0) Q "RTN","ZIS3",51,0) SETPAR S:$L(%ZISOPAR)&($E(%ZISOPAR)'="(") %ZISOPAR="("_%ZISOPAR_")" "RTN","ZIS3",52,0) Q "RTN","ZIS3",53,0) AQUE ;Ask about Queueing "RTN","ZIS3",54,0) W ! S %=$S($D(IO("Q")):1,1:2),U="^",%ZISDTIM=60 "RTN","ZIS3",55,0) I $D(IO("Q")) W !,"Previously, you have selected queueing." "RTN","ZIS3",56,0) W !,"Do you "_$S($D(IO("Q")):"STILL ",1:"")_"want your output QUEUED" "RTN","ZIS3",57,0) D YN^%ZIS1 K %ZISDTIM G AQUE:%=0 Q:$D(IO("Q")) "RTN","ZIS3",58,0) I %=-1 S POP=1,%ZISHPOP=1,%ZISUOUT=1 C IO K IO(1,IO) Q "RTN","ZIS3",59,0) I %=1 S IO("Q")=1 C IO K IO(1,IO) Q "RTN","ZIS3",60,0) ;I %=2 K IO("Q") "RTN","ZIS3",61,0) Q "RTN","ZIS3",62,0) ST(%ZISTP) ; "RTN","ZIS3",63,0) S %ZISIOST(0)=%A,%ZISIOST=$P($G(^%ZIS(2,%A,0)),"^") "RTN","ZIS3",64,0) S:'$D(%Z91) %Z91=$P($G(^%ZIS(2,%A,1),"132^#^60^$C(8)"),"^",1,4),$P(%Z91,"^",5)=$G(^("XY")) "RTN","ZIS3",65,0) Q:%ZISTP "RTN","ZIS3",66,0) STP N %B ;%E is a pointer to the Device file "RTN","ZIS3",67,0) S %B=$G(^%ZIS(1,%E,91)) "RTN","ZIS3",68,0) S:$P(%B,"^")]"" $P(%Z91,"^")=+%B S:$P(%B,"^",3)]"" $P(%Z91,"^",3)=$P(%B,"^",3) ;S $P(%Z91,"^",5)=$G(^%ZIS(2,%ZISIOST(0),"XY")) "RTN","ZIS3",69,0) Q "RTN","ZIS3",70,0) SUBIEN(%1,%) ;Return Subtype ien. %1 is call by Ref. "RTN","ZIS3",71,0) N %XX,%YY "RTN","ZIS3",72,0) I $D(^%ZIS(2,"B",%1))>9 S %1=+$O(^%ZIS(2,"B",%1,0)) Q "RTN","ZIS3",73,0) I '$G(%) S X="" Q "RTN","ZIS3",74,0) S %XX=%1 D 2^%ZIS5 S %1=+%YY "RTN","ZIS3",75,0) Q "RTN","ZIS3",76,0) SUBTYPE(%A) ;Called from %ZISH "RTN","ZIS3",77,0) N %ZISIOST,%Z91 "RTN","ZIS3",78,0) S:$G(%A)="" %A="P-OTHER" "RTN","ZIS3",79,0) D SUBIEN(.%A),ST(1) "RTN","ZIS3",80,0) S IOM=$P(%Z91,U,1),IOF=$P(%Z91,U,2),IOSL=$P(%Z91,U,3),IOST=%ZISIOST,IOST(0)=%ZISIOST(0),IOBS="$C(8)" "RTN","ZIS3",81,0) S:IOST="" IOST="P-OTHER",IOST(0)=0 "RTN","ZIS3",82,0) Q "RTN","ZIS4GTM") 0^9^B19862476^B20959123 "RTN","ZIS4GTM",1,0) %ZIS4 ;ISF/RWF,DW - DEVICE HANDLER SPECIFIC CODE (GT.M for Unix/VMS) ;1/24/08 16:08 "RTN","ZIS4GTM",2,0) ;;8.0;KERNEL;**275,425,440**;Jul 10, 1995;Build 13 "RTN","ZIS4GTM",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS4GTM",4,0) OPEN ;From %ZIS3 for TRM "RTN","ZIS4GTM",5,0) G OPN2:$D(IO(1,IO)) "RTN","ZIS4GTM",6,0) S POP=0 D OP1 G NOPEN:'$D(IO(1,IO)) "RTN","ZIS4GTM",7,0) OPN2 ; "RTN","ZIS4GTM",8,0) I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") "RTN","ZIS4GTM",9,0) Q "RTN","ZIS4GTM",10,0) NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q "RTN","ZIS4GTM",11,0) I '$D(IOP) W *7," [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 "RTN","ZIS4GTM",12,0) S POP=1 Q "RTN","ZIS4GTM",13,0) Q "RTN","ZIS4GTM",14,0) ;Why no open paraneters??? "RTN","ZIS4GTM",15,0) OP1 N $ET S $ET="G OPNERR^%ZIS4" "RTN","ZIS4GTM",16,0) I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q "RTN","ZIS4GTM",17,0) O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1 "RTN","ZIS4GTM",18,0) Q "RTN","ZIS4GTM",19,0) OPNERR ;Open Error "RTN","ZIS4GTM",20,0) S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$$EC^%ZOSV,$EC="" "RTN","ZIS4GTM",21,0) Q "RTN","ZIS4GTM",22,0) ; "RTN","ZIS4GTM",23,0) O ;From %ZIS6 for all types. "RTN","ZIS4GTM",24,0) D:%IS["L" ZIO "RTN","ZIS4GTM",25,0) I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer Port "RTN","ZIS4GTM",26,0) OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR") "RTN","ZIS4GTM",27,0) I %ZTYPE="CHAN" D TCPIP Q:POP G OXECUTE^%ZIS6 "RTN","ZIS4GTM",28,0) S %A=%ZISOPAR_$S(%ZISOPAR["):":"",1:":"_%ZISTO) "RTN","ZIS4GTM",29,0) N % S %(IO)="",%=$P($P($NA(%(IO)),"(",2),")") "RTN","ZIS4GTM",30,0) S %A=%_$E(":",%A]"")_%A "RTN","ZIS4GTM",31,0) D O1 I POP D Q "RTN","ZIS4GTM",32,0) .I %ZTYPE="HFS",'$D(IOP),$G(IO("ERROR"))["file not found" W !,?5,*7,"[File Not Found]" Q "RTN","ZIS4GTM",33,0) .W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q "RTN","ZIS4GTM",34,0) ;S IO(1,IO)="" U IO S:'(IO=IO(0)&'$D(IO("S"))&'$D(ZTQUEUED)) $X=0,$Y=0 I %ZTYPE["TRM" U IO:(WIDTH=+%Z91) "RTN","ZIS4GTM",35,0) U IO S $X=0,$Y=0 I %ZTYPE["TRM" U IO:(WIDTH=+%Z91) "RTN","ZIS4GTM",36,0) I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1 "RTN","ZIS4GTM",37,0) ;U:%IS'[0 IO(0) "RTN","ZIS4GTM",38,0) G OXECUTE^%ZIS6 "RTN","ZIS4GTM",39,0) ; "RTN","ZIS4GTM",40,0) O1 N $ES,$ET S $ET="G OPNERR^%ZIS4" "RTN","ZIS4GTM",41,0) I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q "RTN","ZIS4GTM",42,0) O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)="" "RTN","ZIS4GTM",43,0) S IO("ERROR")="" Q "RTN","ZIS4GTM",44,0) ; "RTN","ZIS4GTM",45,0) ;Need to find out how to get IP address "RTN","ZIS4GTM",46,0) ZIO N %,%1 S (%,%1)=$ZIO "RTN","ZIS4GTM",47,0) I $ZV["VMS",%["_TNA" D "RTN","ZIS4GTM",48,0) . S (%,%1)=$ZGETDVI($I,"TT_ACCPORNAM") "RTN","ZIS4GTM",49,0) . S %=$S(%["Host:":$P($P(%,"Host: ",2)," ")_":"_$P(%,"Port: ",2),1:%) S:%[" " %=$TR(%," ") "RTN","ZIS4GTM",50,0) I $ZV'["VMS" D "RTN","ZIS4GTM",51,0) . S (%,%1)=$ZTRNLNM("REMOTEHOST") S:$L(%) %1="Host:"_% S:'$L(%) %=$ZIO "RTN","ZIS4GTM",52,0) S IO("ZIO")=% S:(%1["Host:")&'$D(IO("IP")) IO("IP")=$P(%,":") "RTN","ZIS4GTM",53,0) Q "RTN","ZIS4GTM",54,0) ; "RTN","ZIS4GTM",55,0) TCPIP ;For TCP/IP devices, should use ^%ZISTCP "RTN","ZIS4GTM",56,0) N %S "RTN","ZIS4GTM",57,0) S %ZISTO=$G(%ZISTO,3) "RTN","ZIS4GTM",58,0) S %A="IO:"_$S($E(%ZISOPAR)="(":"",1:"(")_%ZISOPAR_$S($E(%ZISOPAR,$L(%ZISOPAR))=")":"",1:")")_":%ZISTO:""SOCKET""" "RTN","ZIS4GTM",59,0) ;U $P W !,"%A=",%A "RTN","ZIS4GTM",60,0) O @%A I '$T S POP=1 Q ;D O1 ;Do the open. "RTN","ZIS4GTM",61,0) U IO:(WIDTH=512:NOWRAP:EXCEPT="G OPNERR^%ZIS4") S %S=$KEY "RTN","ZIS4GTM",62,0) U $P ;W !,"$KEY=",%S "RTN","ZIS4GTM",63,0) Q "RTN","ZIS4GTM",64,0) ; "RTN","ZIS4GTM",65,0) SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name. "RTN","ZIS4GTM",66,0) I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N "RTN","ZIS4GTM",67,0) I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G N "RTN","ZIS4GTM",68,0) R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0 "RTN","ZIS4GTM",69,0) S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q")) "RTN","ZIS4GTM",70,0) G:'%ZISB OK I '$P(%ZY,"^",3),$L(%ZFN) O %ZFN:(append:nowrap):2 G DOC "RTN","ZIS4GTM",71,0) S %ZFN=IO_"SPOOL_no_"_%ZDA_".TMP" D SPL2 G:%ZFN']"" N S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" "RTN","ZIS4GTM",72,0) DOC S IO=%ZFN,IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#" "RTN","ZIS4GTM",73,0) I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS "RTN","ZIS4GTM",74,0) OK K %ZDA,%ZFN Q "RTN","ZIS4GTM",75,0) N K %ZDA,%ZFN,IO("DOC") S POP=1 Q "RTN","ZIS4GTM",76,0) ; "RTN","ZIS4GTM",77,0) SPL2 ;Open for write "RTN","ZIS4GTM",78,0) O %ZFN:(newversion:noreadonly:nowrap:exception="G SPL4"):2 G:$ZA<0 SPL4 S IO(1,%ZFN)="" Q "RTN","ZIS4GTM",79,0) ; "RTN","ZIS4GTM",80,0) SPL3 ;Open for Read "RTN","ZIS4GTM",81,0) O %ZFN:(readonly:exception="G SPL4"):2 S:'$T ZISPLQ=1 G:'$T SPL4 S IO(1,%ZFN)="" Q "RTN","ZIS4GTM",82,0) SPL4 W:'$D(IOP)&'$D(ZTQUEUED) !?5,*7,"Couldn't open the spool file." S %ZFN="" Q "RTN","ZIS4GTM",83,0) ; "RTN","ZIS4GTM",84,0) CLOSE ;Close out the spool "RTN","ZIS4GTM",85,0) N %,%1,%Z1,%ZFN,%ZS,%ZDA,XS,%Y,%X "RTN","ZIS4GTM",86,0) I $L(IO) C IO K IO(1,IO) "RTN","ZIS4GTM",87,0) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q "RTN","ZIS4GTM",88,0) S %ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN']"" S %ZCR=$C(13),%Y="" "RTN","ZIS4GTM",89,0) S %Z1=+$G(^XTV(8989.3,1,"SPL")),%=0 "RTN","ZIS4GTM",90,0) U %ZFN F R %X#255:5 Q:$ZEOF S %2=%X D CL2 Q:%Z1<% "RTN","ZIS4GTM",91,0) SPLEX C %ZFN:(DELETE) K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q "RTN","ZIS4GTM",92,0) ; "RTN","ZIS4GTM",93,0) CL2 S %=%+1 I %Z1<% S ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q "RTN","ZIS4GTM",94,0) I %2[$C(12) S ^XMBS(3.519,XS,2,%,0)="|TOP|" Q "RTN","ZIS4GTM",95,0) S ^XMBS(3.519,XS,2,%,0)=%2 Q "RTN","ZIS4GTM",96,0) ; "RTN","ZIS4GTM",97,0) HFS G HFS^%ZISF "RTN","ZIS4GTM",98,0) REWMT(IO,IOPAR) ;Rewind Magtape "RTN","ZIS4GTM",99,0) S X="REWERR^%ZIS4",@^%ZOSF("TRAP") "RTN","ZIS4GTM",100,0) U IO W *5 "RTN","ZIS4GTM",101,0) Q 1 "RTN","ZIS4GTM",102,0) REWSDP(IO,IOPAR) ;Rewind SDP "RTN","ZIS4GTM",103,0) G REW1 "RTN","ZIS4GTM",104,0) REWHFS(IO,IOPAR) ;Rewind Host File. "RTN","ZIS4GTM",105,0) REW1 S X="REWERR^%ZIS4",@^%ZOSF("TRAP") "RTN","ZIS4GTM",106,0) U IO:(REWIND) "RTN","ZIS4GTM",107,0) Q 1 "RTN","ZIS4GTM",108,0) REWERR ;Error encountered "RTN","ZIS4GTM",109,0) Q 0 "RTN","ZIS4ONT") 0^12^B27677822^B26749275 "RTN","ZIS4ONT",1,0) %ZIS4 ;SFISC/RWF,AC - DEVICE HANDLER SPOOL SPECIFIC CODE (Cache) ;1/24/08 16:08 "RTN","ZIS4ONT",2,0) ;;8.0;KERNEL;**34,59,69,191,278,293,440**;Jul 10, 1995;Build 13 "RTN","ZIS4ONT",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS4ONT",4,0) OPEN ;Called for TRM devices "RTN","ZIS4ONT",5,0) G OPN2:$D(IO(1,IO)) "RTN","ZIS4ONT",6,0) S POP=0 D OP1 G NOPEN:'$D(IO(1,IO)) "RTN","ZIS4ONT",7,0) OPN2 ; "RTN","ZIS4ONT",8,0) I $D(%ZISHP),'$D(IOP) W !,$C(7)_" Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") "RTN","ZIS4ONT",9,0) Q "RTN","ZIS4ONT",10,0) NOPEN ; "RTN","ZIS4ONT",11,0) I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q "RTN","ZIS4ONT",12,0) I '$D(IOP) W $C(7)_" [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 "RTN","ZIS4ONT",13,0) S POP=1 Q "RTN","ZIS4ONT",14,0) Q "RTN","ZIS4ONT",15,0) OP1 N $ET S $ET="G OPNERR^%ZIS4" "RTN","ZIS4ONT",16,0) I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q "RTN","ZIS4ONT",17,0) O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1 "RTN","ZIS4ONT",18,0) Q "RTN","ZIS4ONT",19,0) OPNERR S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ZE,$EC="" "RTN","ZIS4ONT",20,0) Q "RTN","ZIS4ONT",21,0) ; "RTN","ZIS4ONT",22,0) O ;Gets called for all devices "RTN","ZIS4ONT",23,0) N X,%A1 "RTN","ZIS4ONT",24,0) D:%ZIS["L" ZIO "RTN","ZIS4ONT",25,0) I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer port "RTN","ZIS4ONT",26,0) OPAR I $D(IOP),%ZTYPE="HFS",$D(%ZIS("HFSIO")),$D(%ZIS("IOPAR")),%ZIS("HFSIO")]"" S IO=%ZIS("HFSIO"),%ZISOPAR=%ZIS("IOPAR") "RTN","ZIS4ONT",27,0) S %A=$S($L(%ZISOPAR):%ZISOPAR,%ZTYPE'["TRM":"",$E(%ZISIOST,1)="C":"("_+%Z91_":""C"")",$E(%ZISIOST,1,2)="PK":"("_+%Z91_":""P"")",1:+%Z91) "RTN","ZIS4ONT",28,0) S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A "RTN","ZIS4ONT",29,0) D O1 I POP W:'$D(IOP) !,?5,$C(7)_"[Device is BUSY]" Q "RTN","ZIS4ONT",30,0) ;I %ZTYPE="HFS" U IO S X=IO,IO=IO_";"_$P($ZIO,";",2),IO(1,IO)="" K IO(1,X) "RTN","ZIS4ONT",31,0) U IO S $X=0,$Y=0 "RTN","ZIS4ONT",32,0) I $L(%ZISUPAR) S %A1=""""_IO_""":"_%ZISUPAR U @%A1 "RTN","ZIS4ONT",33,0) ;U:%IS'[0 IO(0) "RTN","ZIS4ONT",34,0) G OXECUTE^%ZIS6 "RTN","ZIS4ONT",35,0) ; "RTN","ZIS4ONT",36,0) O1 N $ET S $ET="G OPNERR^%ZIS4" "RTN","ZIS4ONT",37,0) I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q "RTN","ZIS4ONT",38,0) O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)="" "RTN","ZIS4ONT",39,0) S IO("ERROR")="" "RTN","ZIS4ONT",40,0) Q "RTN","ZIS4ONT",41,0) ;Version 3 used ip/port, Version 4 has ip:port|xx "RTN","ZIS4ONT",42,0) ZIO N %,%1 S %=$ZIO,%1=$$VERSION^%ZOSV "RTN","ZIS4ONT",43,0) S IO("ZIO")=$S(%1<4:$I,1:$ZIO),%1=$S(%["/":"/",1:":") "RTN","ZIS4ONT",44,0) ;Drop prefix "RTN","ZIS4ONT",45,0) S:%["|TNT|" %=$E(%,6,999) S:%["|TNA|" %=$E(%,6,999) "RTN","ZIS4ONT",46,0) ;Get IP name or number "RTN","ZIS4ONT",47,0) I '$D(IO("IP")) D "RTN","ZIS4ONT",48,0) . S:$P(%,%1)["." IO("IP")=$P(%,%1) "RTN","ZIS4ONT",49,0) Q "RTN","ZIS4ONT",50,0) ; "RTN","ZIS4ONT",51,0) SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file Num/Name. "RTN","ZIS4ONT",52,0) N %ZOS S %ZOS=$$OS^%ZOSV "RTN","ZIS4ONT",53,0) I '$D(^XMB(3.51,0)) W:'$D(IOP) !?5,"The spooler files are not setup in this account." G NO "RTN","ZIS4ONT",54,0) I $D(ZISDA) W:'$D(IOP) !?5,$C(7)_"You may not Spool the printing of a Spool document" G NO "RTN","ZIS4ONT",55,0) I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G NO "RTN","ZIS4ONT",56,0) ;Get entry in Spool Doc file "RTN","ZIS4ONT",57,0) R S %ZY=-1 D NEWDOC^ZISPL1:$D(DUZ)=11 G NO:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q")) "RTN","ZIS4ONT",58,0) G:'%ZISB OK I '$P(%ZY,"^",3),%ZFN]"" D SPL3 G NO:%ZFN<0,DOC "RTN","ZIS4ONT",59,0) I %ZOS="NT" D G:%ZFN>255 NO "RTN","ZIS4ONT",60,0) . F %ZFN=1:1:260 I '$D(^XMB(3.51,"C",%ZFN))!$D(^(%ZFN,%ZDA)) Q:%ZFN<256 W:'$D(IOP) $C(7)_" DELETE SOME OTHER DOCUMENT!" Q "RTN","ZIS4ONT",61,0) . Q:%ZFN>255 D SPL2 S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" "RTN","ZIS4ONT",62,0) I %ZOS="VMS" D G:%ZFN=-1 NO "RTN","ZIS4ONT",63,0) . S %ZFN=IO_"SPOOL_no_"_%ZDA_".TMP" D SPL2 Q:%ZFN=-1 S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="",IO=%ZFN "RTN","ZIS4ONT",64,0) DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA "RTN","ZIS4ONT",65,0) I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS "RTN","ZIS4ONT",66,0) OK K %ZDA,%ZFN Q "RTN","ZIS4ONT",67,0) NO K %ZDA,%ZFN,IO("DOC") S POP=1 Q "RTN","ZIS4ONT",68,0) ; "RTN","ZIS4ONT",69,0) SPL2 I %ZOS="NT" O IO:(%ZFN:0) S IO(1,IO)="",^SPOOL(0,IO("DOC"),%ZFN)="",^SPOOL(%ZFN,0)=IO("DOC")_"{"_$H Q "RTN","ZIS4ONT",70,0) ;VMS "RTN","ZIS4ONT",71,0) O %ZFN:("WNS"):2 G:'$T SPL4 S IO(1,%ZFN)="" Q "RTN","ZIS4ONT",72,0) ; "RTN","ZIS4ONT",73,0) SPL3 I %ZOS="NT" G SPL4:'$D(^SPOOL(%ZFN,2147483647)) O IO:(%ZFN:$P(^(2147483647),"{",3)):1 S:'$T ZISPLQ=1 K ^(2147483647) S IO(1,IO)="" Q "RTN","ZIS4ONT",74,0) ;VMS "RTN","ZIS4ONT",75,0) N $ETRAP S $ETRAP="S $EC="""" G SPL4^%ZIS4" "RTN","ZIS4ONT",76,0) O %ZFN:"RV":1 S:'$T ZISPLQ=1 G:$ZA<0!('$T) SPL4 S IO(1,%ZFN)="" Q "RTN","ZIS4ONT",77,0) ; "RTN","ZIS4ONT",78,0) SPL4 W:'$D(IOP) !,"Spool file already open" S %ZFN=-1 Q "RTN","ZIS4ONT",79,0) ; "RTN","ZIS4ONT",80,0) CLOSE N %ZOS,%Z1,%ZCR,%2,%3,%X,%Y,ZTSK,%ZFN S %ZOS=$$OS^%ZOSV "RTN","ZIS4ONT",81,0) I %ZOS="NT",IO=2,$D(IO(1,IO)) K IO(1,IO) C IO "RTN","ZIS4ONT",82,0) I %ZOS="VMS",IO]"",$D(IO(1,IO)) U IO S %ZFN=$ZIO C IO K IO(1,IO) "RTN","ZIS4ONT",83,0) ;See that ZTSK is set so we will move to the global now. "RTN","ZIS4ONT",84,0) S ZTSK=$G(ZTSK,1) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q "RTN","ZIS4ONT",85,0) G:%ZOS="VMS" CLVMS "RTN","ZIS4ONT",86,0) S %ZFN=$P(%ZS,"^",2),%ZCR=$C(13),%Y="",%=0,%3=$P(^SPOOL(%ZFN,2147483647),"{",3) "RTN","ZIS4ONT",87,0) S %Z1=+$G(^XTV(8989.3,1,"SPL")) "RTN","ZIS4ONT",88,0) F %2=1:1:%3 Q:'$D(^SPOOL(%ZFN,%2)) S %X=^SPOOL(%ZFN,%2) D "RTN","ZIS4ONT",89,0) . I %Z1<% D LIMIT S %2=%3 Q "RTN","ZIS4ONT",90,0) . I %X[$C(13,12) D:$L($P(%X,$C(13))) ADD($P(%X,$C(13))) D ADD("|TOP|") Q "RTN","ZIS4ONT",91,0) . D ADD($P(%X,$C(13),1)) "RTN","ZIS4ONT",92,0) K ^SPOOL(%ZFN),^SPOOL(0,$P(%ZS,U,1)),%Y,%X,%1,%2,%3 D CLOSE^ZISPL1 "RTN","ZIS4ONT",93,0) Q "RTN","ZIS4ONT",94,0) ADD(L) S %=%+1,^XMBS(3.519,XS,2,%,0)=L Q "RTN","ZIS4ONT",95,0) LIMIT D ADD("*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***") S $P(^XMB(3.51,%ZDA,0),"^",11)=1 "RTN","ZIS4ONT",96,0) Q "RTN","ZIS4ONT",97,0) CLVMS ;Close for Cache VMS "RTN","ZIS4ONT",98,0) N $ES,$ET S $ET="D:$EC'[""ENDOF"" ^%ZTER,UNWIND^%ZTER S $EC="""" D SPLEX^%ZIS4,UNWIND^%ZTER" "RTN","ZIS4ONT",99,0) S %ZA=$ZU(68,40,1) ;Work like DSM "RTN","ZIS4ONT",100,0) ;%ZFN Could be set at the top "RTN","ZIS4ONT",101,0) S %ZFN=$S($G(%ZFN)]"":%ZFN,1:$P(%ZS,"^",2)) D SPL3 Q:%ZFN']"" U %ZFN S %ZCR=$C(13),%Y="" "RTN","ZIS4ONT",102,0) S %Z1=+$G(^XTV(8989.3,1,"SPL")),%=0 "RTN","ZIS4ONT",103,0) F R %X#255:5 Q:$ZEOF<0 D G:%Z1<% SPLEX "RTN","ZIS4ONT",104,0) . I %Z1<% D LIMIT Q "RTN","ZIS4ONT",105,0) . I %X[$C(12) D Q "RTN","ZIS4ONT",106,0) . . S %Y=$P(%X,$C(12)) D:$L(%Y) ADD(%Y),ADD("|TOP|") "RTN","ZIS4ONT",107,0) . . S %Y=$P(%X,$C(12),2) D:$L(%Y) ADD(%Y) "RTN","ZIS4ONT",108,0) . . Q "RTN","ZIS4ONT",109,0) . D ADD(%X) "RTN","ZIS4ONT",110,0) . Q "RTN","ZIS4ONT",111,0) SPLEX C %ZFN:"D" K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q "RTN","ZIS4ONT",112,0) ; "RTN","ZIS4ONT",113,0) ; "RTN","ZIS4ONT",114,0) HFS G HFS^%ZISF "RTN","ZIS4ONT",115,0) REWMT(IO2,IOPAR) ;Rewind Magtape "RTN","ZIS4ONT",116,0) N $ETRAP S $ET="G REWERR^%ZIS4" "RTN","ZIS4ONT",117,0) U IO2 W *5 "RTN","ZIS4ONT",118,0) Q 1 "RTN","ZIS4ONT",119,0) REWSDP(IO2,IOPAR) ;Rewind SDP "RTN","ZIS4ONT",120,0) G REW1 "RTN","ZIS4ONT",121,0) REWHFS(IO2,IOPAR) ;Rewind Host File. "RTN","ZIS4ONT",122,0) REW1 ;ZIS set % to the current $I so need to update % if = IO "RTN","ZIS4ONT",123,0) N NIO,OP,$ETRAP "RTN","ZIS4ONT",124,0) S $ET="G REWERR^%ZIS4" "RTN","ZIS4ONT",125,0) C IO2 ;You do a rewind to read the file. "RTN","ZIS4ONT",126,0) S OP=$S($ZV["VMS":"RV",1:"RS") "RTN","ZIS4ONT",127,0) O IO2:(OP):1 S IO(1,IO2)="" "RTN","ZIS4ONT",128,0) Q 1 "RTN","ZIS4ONT",129,0) REWERR ;Error encountered "RTN","ZIS4ONT",130,0) S IO("ERROR")=$EC,$ECODE="" "RTN","ZIS4ONT",131,0) Q 0 "RTN","ZIS6") 0^16^B20359601^B20992086 "RTN","ZIS6",1,0) %ZIS6 ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;1/24/08 16:09 "RTN","ZIS6",2,0) ;;8.0;KERNEL;**24,49,69,118,127,136,440**;JUL 10, 1995;Build 13 "RTN","ZIS6",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS6",4,0) ;Expect that IO is current device "RTN","ZIS6",5,0) OXECUTE ;Open Execute "RTN","ZIS6",6,0) I $D(^%ZIS(2,%ZISIOST(0),2))=1 S %Y=^(2) D 2 "RTN","ZIS6",7,0) ANSBAK ;Answer Back "RTN","ZIS6",8,0) I $D(^%ZIS(2,%ZISIOST(0),102)) S %Y=^(102) D 2 E S POP=1 D:'$D(IOP) SAY($C(7)_"[NOT ON LINE]") C:%ZISB IO K IO(1,IO) G QUIT "RTN","ZIS6",9,0) I $D(%ZISMTR) X ^%ZOSF("MAGTAPE") U IO W:$D(%MT("REW")) @%MT("REW") U IO(0) K %MT "RTN","ZIS6",10,0) G QUIT:'$D(IO("P")) "RTN","ZIS6",11,0) I $F(IO("P"),"B"),$D(^%ZIS(2,%ZISIOST(0),7)) S %Y=$P(^(7),"^",1) I %Y]"" W @%Y "RTN","ZIS6",12,0) S %Y=$F(IO("P"),"P") G QLTY:'%Y S %Y=+$E(IO("P"),%Y,99),%X=$S(%Y=16:12.1,%Y=10!(%Y=12):5,1:"") G QLTY:'%X "RTN","ZIS6",13,0) S %Y=$S($D(^%ZIS(2,%ZISIOST(0),%X)):$P(^(%X),"^",$S(%Y=12:2,1:1)),1:"") "RTN","ZIS6",14,0) I %Y]"" W @%Y "RTN","ZIS6",15,0) QLTY S %Y=$F(IO("P"),"Q") Q:'%Y S %Y=+$E(IO("P"),%Y,99),%X=$S(%Y<0!(%Y>2):0,1:%Y+1) "RTN","ZIS6",16,0) I %X S %Y=$S($D(^%ZIS(2,%ZISIOST(0),12.2)):$P(^(12.2),"^",%X),1:"") I %Y]"" W @%Y "RTN","ZIS6",17,0) QUIT U:%IS'[0 IO(0) "RTN","ZIS6",18,0) Q "RTN","ZIS6",19,0) 2 Q:%Y="" I %IS'[0,$D(^%ZIS(1,+%H,"TYPE")),^("TYPE")["TRM" D OH Q:POP "RTN","ZIS6",20,0) S %X=$T U IO D %Y^ZISX ;Q:'%X U IO(0) "RTN","ZIS6",21,0) Q "RTN","ZIS6",22,0) OH Q:$S($G(IO(0))]"":$D(IO(1,IO(0))),1:0) "RTN","ZIS6",23,0) N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") "RTN","ZIS6",24,0) O IO(0)::0 S IO(1,IO(0))="" Q ;See that HOME DEVICE is open. "RTN","ZIS6",25,0) ; "RTN","ZIS6",26,0) SAY(%SAY) ; "RTN","ZIS6",27,0) Q:%IS[0 U IO(0) W %SAY U IO "RTN","ZIS6",28,0) Q "RTN","ZIS6",29,0) RES1 ;Allocate a resource slot, Release in %ZISC. "RTN","ZIS6",30,0) N A,L,X,%ZISD0 "RTN","ZIS6",31,0) S %ZISD0=$O(^%ZISL(3.54,"B",IO,0)) "RTN","ZIS6",32,0) I '%ZISD0 S %ZISD0=$$RADD(IO) ;New one "RTN","ZIS6",33,0) L +^%ZISL(3.54,%ZISD0,0):2 I '$T S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX "RTN","ZIS6",34,0) RES2 S X=$P(^%ZISL(3.54,%ZISD0,0),"^",2) "RTN","ZIS6",35,0) I X<1 S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX "RTN","ZIS6",36,0) S X=$S(X>0:X-1,1:0),$P(^%ZISL(3.54,%ZISD0,0),"^",2)=X "RTN","ZIS6",37,0) ; "RTN","ZIS6",38,0) R1 ;Grab a slot "RTN","ZIS6",39,0) S IO(1,IO)="RES",A=$G(^%ZISL(3.54,%ZISD0,1,0),"^3.542^^") "RTN","ZIS6",40,0) F L=1:1:%ZISRL I '$D(^%ZISL(3.54,%ZISD0,1,L,0)) Q "RTN","ZIS6",41,0) I '$T K IO(1,IO) G RES2 ;No free slots "RTN","ZIS6",42,0) S ^%ZISL(3.54,%ZISD0,1,L,0)=L_"^"_%ZISV_"^"_$J_"^"_$G(ZTSK)_"^"_$H,^%ZISL(3.54,"AJ",$J,%ZISD0,L)="",^%ZISL(3.54,%ZISD0,1,"B",L,L)="" "RTN","ZIS6",43,0) S $P(A,"^",3,4)=L_U_($P(A,U,4)+1),^%ZISL(3.54,%ZISD0,1,0)=A "RTN","ZIS6",44,0) RESX L -^%ZISL(3.54,%ZISD0,0) Q "RTN","ZIS6",45,0) ; "RTN","ZIS6",46,0) RADD(X) ;Add Resource "RTN","ZIS6",47,0) N %1,%2 "RTN","ZIS6",48,0) S %1=$G(^%ZISL(3.54,0),"RESOURCE^3.54^^"),%2=$P(%1,U,3) "RTN","ZIS6",49,0) F %2=%2:1 Q:'$D(^%ZISL(3.54,%2,0)) "RTN","ZIS6",50,0) S $P(^%ZISL(3.54,0),U,3,4)=%2_U_($P(%1,U,4)+1),^%ZISL(3.54,%2,0)=X_"^"_$G(%ZISRL,1),^%ZISL(3.54,"B",X,%2)="" "RTN","ZIS6",51,0) Q %2 "RTN","ZIS6",52,0) ; "RTN","ZIS6",53,0) RESOK ;DEVOK check for RES devices, for all OS's. "RTN","ZIS6",54,0) N %ZISD0,%ZISD1 "RTN","ZIS6",55,0) S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0)) "RTN","ZIS6",56,0) I '%ZISD0 S Y=-1,%ZISD0=$O(^%ZIS(1,"C",X,0)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q "RTN","ZIS6",57,0) S X1=$G(^%ZISL(3.54,+%ZISD0,0)) "RTN","ZIS6",58,0) I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q "RTN","ZIS6",59,0) S Y=999 F %ZISD1=0:0 S %ZISD1=$O(^%ZISL(3.54,%ZISD0,1,%ZISD1)) Q:%ZISD1'>0 I $D(^(%ZISD1,0)) S Y=$P(^(0),"^",3) Q "RTN","ZIS6",60,0) Q "RTN","ZIS6",61,0) ; "RTN","ZIS6",62,0) Q G Q^%ZIS3 "RTN","ZIS6",63,0) HG ; "RTN","ZIS6",64,0) Q "RTN","ZIS6",65,0) SPL ;Spool type "RTN","ZIS6",66,0) N %E,%Z D MARGN^%ZIS3 W:'$D(IOP) ! D SPOOL^%ZIS4:%IS'["T" "RTN","ZIS6",67,0) G Q "RTN","ZIS6",68,0) MT D MARGN^%ZIS3,ASKPAR,AMTREW:'POP&'$D(IOP)&%ZISB W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Magtape type "RTN","ZIS6",69,0) G Q "RTN","ZIS6",70,0) SDP ;Sequential disk processor type "RTN","ZIS6",71,0) D MARGN^%ZIS3,ASKPAR W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) "RTN","ZIS6",72,0) G Q "RTN","ZIS6",73,0) HFS ;Host File Server type "RTN","ZIS6",74,0) D MARGN^%ZIS3,HFS^%ZIS4 W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) "RTN","ZIS6",75,0) G Q "RTN","ZIS6",76,0) RES ;Resources "RTN","ZIS6",77,0) G Q:%IS["T" N X,X1 I %IS'["R"!'$D(IOP) S POP=1 W:'$D(IOP) *7," [NOT AVAILABLE]" Q "RTN","ZIS6",78,0) G Q:$D(IO(1,IO)) I %IS["T" S X=IO,X1="RES" D DEVOK^%ZIS3 S:Y POP=1 G Q:POP "RTN","ZIS6",79,0) D:%ZISB RES1 G Q "RTN","ZIS6",80,0) CHAN ;Network Channel type devices -- DecNet or TCP/IP devices. "RTN","ZIS6",81,0) I IO="SYS$NET",$I="SYS$INPUT:;" S IO(0)=IO U IO ;DECNET Server Device "RTN","ZIS6",82,0) D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) "RTN","ZIS6",83,0) G Q "RTN","ZIS6",84,0) IMPC ;Imaging Work Station "RTN","ZIS6",85,0) BAR ;Bar Code "RTN","ZIS6",86,0) OTH ;Other Device type "RTN","ZIS6",87,0) D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) "RTN","ZIS6",88,0) G Q "RTN","ZIS6",89,0) ; "RTN","ZIS6",90,0) ASKPAR ;Ask Parameters "RTN","ZIS6",91,0) G SETPAR^%ZIS3:$D(IOP),SETPAR^%ZIS3:'$P(^%ZIS(1,%E,0),"^",4) W " ADDRESS/PARAMETERS: " W:%ZISOPAR]"" %ZISOPAR_"// " D SBR^%ZIS1 D MSG1:%X="?" G ASKPAR:%X="?" S:%X]"" %ZISOPAR=%X I $D(DTOUT)!$D(DUOUT) S POP=1 "RTN","ZIS6",92,0) I POP,%ZISB&(%ZTYPE["TRM") C IO K IO(1,IO) Q "RTN","ZIS6",93,0) Q:POP G SETPAR^%ZIS3 "RTN","ZIS6",94,0) ; "RTN","ZIS6",95,0) AMTREW ;Mag Tape Rewind "RTN","ZIS6",96,0) I %ZISB,%ZTYPE="MT",'$D(IOP) W " REWIND" S %=2,U="^",%ZISDTIM=60 D YN^%ZIS1 K %ZISDTIM G AMTREW:%=0 I %=-1 S POP=1 Q "RTN","ZIS6",97,0) S:%=1 %ZISMTR=1 "RTN","ZIS6",98,0) Q "RTN","ZIS6",99,0) MSG1 W !?5,"Enter the desired parameters needed to open the selected device.",!?25 "RTN","ZIS6",100,0) Q "RTN","ZIS6",101,0) ; "RTN","ZISC") 0^11^B22332594^B22818610 "RTN","ZISC",1,0) %ZISC ;SFISC/GFT,AC,MUS - CLOSE LOGIC FOR DEVICES ;1/24/08 16:09 "RTN","ZISC",2,0) ;;8.0;KERNEL;**24,36,49,69,199,216,275,409,440**;JUL 10, 1995;Build 13 "RTN","ZISC",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZISC",4,0) C0 ; "RTN","ZISC",5,0) N %,%E,%H,%ZISI,%ZISOS,%ZISX,%ZISV "RTN","ZISC",6,0) ;Clear IO var we will use for reporting "RTN","ZISC",7,0) K IO("ERROR"),IO("LASTERR"),IO("CLOSE") "RTN","ZISC",8,0) ;Protect ourself from calls with incomplete setup. "RTN","ZISC",9,0) S:$D(IO)[0 IO=$I S:'$D(IO(0)) IO(0)=$P "RTN","ZISC",10,0) S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")) "RTN","ZISC",11,0) ;S %=$S(+$G(IOS):IOS,$L($G(ION)):ION,1:IO) "RTN","ZISC",12,0) S %=$S($L($G(ION)):ION,1:IO) ;p409 "RTN","ZISC",13,0) I (%="")!(IO="") G SETIO:IO(0)]"",END "RTN","ZISC",14,0) I $G(IOT)="RES" D RES G SETIO ;Handle a resource device "RTN","ZISC",15,0) ; "RTN","ZISC",16,0) ;Define subtype info if not already defined. "RTN","ZISC",17,0) D SUBTYPE "RTN","ZISC",18,0) ; "RTN","ZISC",19,0) ;perform close execute "RTN","ZISC",20,0) I $G(IOST(0))>0 D "RTN","ZISC",21,0) . I $G(^%ZIS(2,+IOST(0),3))]"",$D(IO(1,IO)) D "RTN","ZISC",22,0) . . U IO S:$X $X=1 D X3^ZISX:'$D(IO("T")) "RTN","ZISC",23,0) ; "RTN","ZISC",24,0) ;Incase the Close execute changed IO, Open IO("HOME") or NULL. "RTN","ZISC",25,0) I '$L($G(IO)) D Q "RTN","ZISC",26,0) . S IOP=$S($L($G(IO("HOME"))):"`"_(+IO("HOME")),1:"NULL") D ^%ZIS "RTN","ZISC",27,0) . Q "RTN","ZISC",28,0) ; "RTN","ZISC",29,0) ;Perform the following if the device is open. "RTN","ZISC",30,0) I $D(IO(1,IO)) D "RTN","ZISC",31,0) . I $G(IO("P"))["B" D ;Return to normal intensity "RTN","ZISC",32,0) . . S %=$P($G(^%ZIS(2,+IOST(0),7)),"^",3) I %]"" W @% "RTN","ZISC",33,0) . I $G(IO("P"))["P" D ;Return to default pitch "RTN","ZISC",34,0) . . S %=$G(^%ZIS(2,+IOST(0),12.11)) I %]"" W @% "RTN","ZISC",35,0) . ; "RTN","ZISC",36,0) . W:$$FF @IOF ;Issue form feed at close "RTN","ZISC",37,0) . I $$CLOSPP D X11^ZISX:'$D(IO("T")) K IO("S") ;Close printer port "RTN","ZISC",38,0) . Q "RTN","ZISC",39,0) ; "RTN","ZISC",40,0) ;Don't use IOCPU as we now use IO(1,IO) "RTN","ZISC",41,0) I (IO'=IO(0)!$D(IO("C"))),$D(IO(1,IO)) D "RTN","ZISC",42,0) . U:$S($D(ZTQUEUED):0,'$L($G(IO(0))):0,$D(IO(1,IO(0)))#2:1,1:0) IO(0) "RTN","ZISC",43,0) . C IO K IO(1,IO) S IO("CLOSE")=IO ;close device "RTN","ZISC",44,0) ;Unlock global used to control access. "RTN","ZISC",45,0) S %=$G(^XUTL("XQ",$J,"lock",+$G(IOS))) I $L(%) L -@% K ^XUTL("XQ",$J,"lock",IOS) "RTN","ZISC",46,0) ; "RTN","ZISC",47,0) I $D(IO("SPOOL")) D CLOSE^%ZIS4 ;Special close for spool device "RTN","ZISC",48,0) ; "RTN","ZISC",49,0) SETIO ; "RTN","ZISC",50,0) ;See if old device has PCX code "RTN","ZISC",51,0) I $G(IOS),$G(^%ZIS(1,+IOS,"PCX"))]"" S %ZISPCX=^("PCX") "RTN","ZISC",52,0) ;Setup the IO(0) device, should be the home device "RTN","ZISC",53,0) S IO=IO(0),(IOPAR,IOUPAR)="" K IO("T") D CIOS(IO(0)) "RTN","ZISC",54,0) I 'IOS S IOT="TRM" G END "RTN","ZISC",55,0) S ION=$P(^%ZIS(1,IOS,0),"^",1),IOT=$G(^("TYPE")),IOST(0)=$S(IOT["TRM"&($D(^XUTL("XQ",$J,"IOST(0)"))):^("IOST(0)"),1:$G(^%ZIS(1,IOS,"SUBTYPE"))) "RTN","ZISC",56,0) I IOT["TRM",$D(^XUTL("XQ",$J,"IO")) D HOME^%ZIS G END "RTN","ZISC",57,0) S %="Y" "RTN","ZISC",58,0) I IOST(0),$D(^%ZIS(2,IOST(0),1)) S %=^(1),IOM=+%,IOF=$P(%,"^",2),IOSL=$P(%,"^",3),IOBS=$P(%,"^",4) "RTN","ZISC",59,0) I $D(^%ZIS(1,IOS,91)) S %=^%ZIS(1,IOS,91) S:+% IOM=+% S:$P(%,"^",3) IOSL=$P(%,"^",3) "RTN","ZISC",60,0) ;Don't know the subtype so set some defaults "RTN","ZISC",61,0) I %="Y" S IOM=80,IOSL=24,IOF="#",IOST="C-OTHER",IOBS="$C(8)" "RTN","ZISC",62,0) S1 S:IOST(0) IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^"),IOXY=$G(^("XY")) "RTN","ZISC",63,0) I '$D(ZTQUEUED),'$D(IO("C")),IOT["TRM" D RM:$D(IO(1,IO)) "RTN","ZISC",64,0) ;With home device set, Do Post-close execute code of Device closed. "RTN","ZISC",65,0) END I '$D(IO("T")),$G(%ZISPCX)]"" S %Y=%ZISPCX D %Y^ZISX "RTN","ZISC",66,0) ;See that any extra IO variables are cleaned up "RTN","ZISC",67,0) K IO("P"),IO("DOC"),IO("HFSIO"),IO("SPOOL"),IOC,IONOFF "RTN","ZISC",68,0) ;IOCPU should not be changed. "RTN","ZISC",69,0) Q "RTN","ZISC",70,0) ; "RTN","ZISC",71,0) SUBTYPE ;Find a subtype "RTN","ZISC",72,0) N %S "RTN","ZISC",73,0) S IOST=$G(IOST),IOST(0)=+$G(IOST(0)) "RTN","ZISC",74,0) I $L(IOST)&$L(IOST(0)) Q ;Have a subtype "RTN","ZISC",75,0) S %S=$G(^%ZIS(2,+IOST(0),0)) I $L(%S) S IOST=$P(%S,U) Q "RTN","ZISC",76,0) I $L(IOST) S %S=$O(^%ZIS(2,"B",$G(IOST,"X"),0)) I %S>0 S IOST(0)=+%S Q "RTN","ZISC",77,0) S IOST="",IOST(0)=0 D CIOS($I) Q:IOS'>0 "RTN","ZISC",78,0) S IOST(0)=$G(^%ZIS(1,+IOS,"SUBTYPE")),IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^") "RTN","ZISC",79,0) Q "RTN","ZISC",80,0) ; "RTN","ZISC",81,0) CIOS(%I) ;Find a value for IOS (IEN into device file) "RTN","ZISC",82,0) N %ZISVT "RTN","ZISC",83,0) I $D(^XUTL("XQ",$J,"IOS")) S IOS=+^("IOS") Q "RTN","ZISC",84,0) I $D(%ZISV) S %ZISVT=%I D VTLKUP^%ZIS S IOS=+%E "RTN","ZISC",85,0) E S IOS=+$O(^%ZIS(1,"C",%I,0)) "RTN","ZISC",86,0) Q:$G(IOS)>0 "RTN","ZISC",87,0) S %ZISVT=%I D VIRTUAL^%ZIS "RTN","ZISC",88,0) I $D(%ZISVT) S %H=%E I %ZISVT]"",%H>0,$D(^%ZIS(1,%H,0)),$D(^("TYPE")),^("TYPE")="VTRM" S IOS=%H "RTN","ZISC",89,0) Q "RTN","ZISC",90,0) ; "RTN","ZISC",91,0) RM N X S X=+IOM X ^%ZOSF("RM") "RTN","ZISC",92,0) Q "RTN","ZISC",93,0) ; "RTN","ZISC",94,0) RES ;Close resource device. "RTN","ZISC",95,0) Q:'$D(IO(1,IO))&'$D(^%ZISL(3.54,"AJ",$J)) "RTN","ZISC",96,0) N %ZISJOB,%X,%Y,%ZISD0,%ZISD1,%ZISRES,%ZISRL,%ZISY0,%ZTRTN,ZTSAVE,ZTIO "RTN","ZISC",97,0) S %ZISJOB=$J "RTN","ZISC",98,0) ; "RTN","ZISC",99,0) RES1 G RQ:'$D(IOS),RQ:'$D(^%ZIS(1,+IOS,1)) S %ZISRL=+$P(^(1),"^",10),%ZISRL=$S(%ZISRL:%ZISRL,1:1) "RTN","ZISC",100,0) S %X=$O(^%ZISL(3.54,"B",IO,0)) G RQ:'%X "RTN","ZISC",101,0) G RQ:'$D(^%ZISL(3.54,+%X,0)) S %ZISD0=+%X,%ZISY0=^(0) "RTN","ZISC",102,0) S %X=$O(^%ZISL(3.54,"AJ",%ZISJOB,%ZISD0,0)) S %ZISD1=%X G RQ:'%X "RTN","ZISC",103,0) S %Y=$G(^%ZISL(3.54,%ZISD0,1,+%ZISD1,0)) G RQ:$P(%Y,"^",3)'=%ZISJOB "RTN","ZISC",104,0) D KILLRES(+%ZISD0,+%ZISD1) "RTN","ZISC",105,0) RQ K IO(1,IO) "RTN","ZISC",106,0) Q "RTN","ZISC",107,0) ; "RTN","ZISC",108,0) KILLRES(D0,D1) ;Kill one resource use "RTN","ZISC",109,0) Q:(D0'>0)!(D1'>0) "RTN","ZISC",110,0) N %X,%Y,%J,%ZISRL "RTN","ZISC",111,0) L +^%ZISL(3.54,D0,0) "RTN","ZISC",112,0) S %Y=$G(^%ZISL(3.54,D0,0)) G KRX:%Y="" "RTN","ZISC",113,0) S %X=$G(^%ZISL(3.54,D0,1,D1,0)),%J=$P(%X,"^",3) S:%J="" %J=" " "RTN","ZISC",114,0) K ^%ZISL(3.54,D0,1,D1,0),^%ZISL(3.54,D0,1,"B",D1,D1),^%ZISL(3.54,"AJ",%J,D0,D1) "RTN","ZISC",115,0) S %X=$P(%Y,"^",2)+1,$P(^%ZISL(3.54,D0,0),"^",2)=%X "RTN","ZISC",116,0) ;I '$D(^%ZISL(3.54,%ZISD0,1,0)) S ^(0)="^3.542A^^" G RQ "RTN","ZISC",117,0) S %Y=$G(^%ZISL(3.54,D0,1,0)),%X=$P(%Y,"^",4),$P(^%ZISL(3.54,D0,1,0),"^",3,4)="^"_$S(%X>0:(%X-1),1:0) "RTN","ZISC",118,0) KRX L -^%ZISL(3.54,D0,0) "RTN","ZISC",119,0) Q "RTN","ZISC",120,0) ; "RTN","ZISC",121,0) DQCRES ;Tasked entry point to close resource device. "RTN","ZISC",122,0) S IO=%ZISRES G RES1 "RTN","ZISC",123,0) ; "RTN","ZISC",124,0) FF() ;Issue form feed "RTN","ZISC",125,0) I $E(IOST,1,2)'["C-",$D(IO(1,IO)),$G(IOT)="TRM"!($G(IOT)="SPL"),'$D(IO("T"))&$Y&'$D(IONOFF)&'$D(IO(1,IO,"NOFF")) Q 1 "RTN","ZISC",126,0) Q 0 "RTN","ZISC",127,0) ; "RTN","ZISC",128,0) CLOSPP() ;Close printer port "RTN","ZISC",129,0) I $D(IO("S")),$D(^%ZIS(2,+IO("S"),11))&$D(IO(1,IO)) Q 1 "RTN","ZISC",130,0) Q 0 "RTN","ZISEDIT") 0^6^B2624513^B1953846 "RTN","ZISEDIT",1,0) ZISEDIT ;ISF/AC - DEVICE EDIT ;01/17/2008 "RTN","ZISEDIT",2,0) ;;8.0;KERNEL;**440**;Jul 10, 1995;Build 13 "RTN","ZISEDIT",3,0) ; "RTN","ZISEDIT",4,0) TRM ;TRM or VTRM "RTN","ZISEDIT",5,0) D EDIT("TRM",,"Select Terminal/Printer Device: ") "RTN","ZISEDIT",6,0) Q "RTN","ZISEDIT",7,0) ; "RTN","ZISEDIT",8,0) LPD ;LPD fields of a TRM device "RTN","ZISEDIT",9,0) D EDIT("LPD","TRM","Select LPD (Terminal/Printer) Device: ") "RTN","ZISEDIT",10,0) Q "RTN","ZISEDIT",11,0) ; "RTN","ZISEDIT",12,0) MT ;Mag Tape "RTN","ZISEDIT",13,0) D EDIT("MT",,"Select Magtape Device: ") "RTN","ZISEDIT",14,0) Q "RTN","ZISEDIT",15,0) ; "RTN","ZISEDIT",16,0) SDP ; "RTN","ZISEDIT",17,0) D EDIT("SDP",,"Select SDP Device: ") "RTN","ZISEDIT",18,0) Q "RTN","ZISEDIT",19,0) ; "RTN","ZISEDIT",20,0) SPL ;Spool "RTN","ZISEDIT",21,0) D EDIT("SPL",,"Select Spool Device: ") "RTN","ZISEDIT",22,0) Q "RTN","ZISEDIT",23,0) ; "RTN","ZISEDIT",24,0) HFS ;Host file "RTN","ZISEDIT",25,0) D EDIT("HFS",,"Select Host File Device: ") "RTN","ZISEDIT",26,0) Q "RTN","ZISEDIT",27,0) ; "RTN","ZISEDIT",28,0) CHAN ;Network "RTN","ZISEDIT",29,0) D EDIT("CHAN",,"Select Network Channel: ") "RTN","ZISEDIT",30,0) Q "RTN","ZISEDIT",31,0) ; "RTN","ZISEDIT",32,0) RES ;Resource "RTN","ZISEDIT",33,0) D EDIT("RES",,"Select Resource Device: ") "RTN","ZISEDIT",34,0) Q "RTN","ZISEDIT",35,0) ; "RTN","ZISEDIT",36,0) EDIT(ZISTYPE,ZISSCR,DICA) ; "RTN","ZISEDIT",37,0) N Y,DA,DIC,DIE,DR,DDSFILE "RTN","ZISEDIT",38,0) ED2 S DIC("A")=DICA,ZISSCR=$G(ZISSCR,ZISTYPE) "RTN","ZISEDIT",39,0) S DIC=3.5,DIC(0)="AEMQZL",DIC("S")="I $G(^(""TYPE""))["_""""_ZISSCR_"""" D ^DIC "RTN","ZISEDIT",40,0) Q:Y'>0 "RTN","ZISEDIT",41,0) S DA=+Y "RTN","ZISEDIT",42,0) I $P(Y,"^",3) D "RTN","ZISEDIT",43,0) . N DIE,DR "RTN","ZISEDIT",44,0) . S DIE=DIC,DR="2///"_ZISTYPE_$S(ZISTYPE["TRM":"",1:";1.95///N") "RTN","ZISEDIT",45,0) . D ^DIE "RTN","ZISEDIT",46,0) . Q "RTN","ZISEDIT",47,0) S DR="[XUDEVICE "_ZISTYPE_"]",DDSFILE=3.5 D ^DDS "RTN","ZISEDIT",48,0) G ED2 "RTN","ZISEDIT",49,0) Q "RTN","ZISHONT") 0^5^B60012686^B45855984 "RTN","ZISHONT",1,0) %ZISH ;IHS/PR,SFISC/AC - Host File Control for Cache for VMS/NT/UNIX ;1/24/08 16:11 "RTN","ZISHONT",2,0) ;;8.0;KERNEL;**34,65,84,104,191,306,385,440**;JUL 10, 1995;Build 13 "RTN","ZISHONT",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZISHONT",4,0) ; **MODIFIED VERSION FOR CACHE/VMS -- 9/7/01** "RTN","ZISHONT",5,0) ; "RTN","ZISHONT",6,0) OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open Host File "RTN","ZISHONT",7,0) ;X1=handle name "RTN","ZISHONT",8,0) ;X2=directory name \dir\ "RTN","ZISHONT",9,0) ;X3=file name "RTN","ZISHONT",10,0) ;X4=file access mode e.g.: W for write, R for read, A for append. "RTN","ZISHONT",11,0) ;X5=Max record size for a new file, X6=Subtype "RTN","ZISHONT",12,0) N %,%1,%2,%I,%ZOS,%T,%ZA,%ZISHIO,$ET "RTN","ZISHONT",13,0) S $ET="D OPNERR^%ZISH" "RTN","ZISHONT",14,0) S U="^",%I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%ZOS=$$OS^%ZOSV M %ZISHIO=IO "RTN","ZISHONT",15,0) I %ZOS'="VMS" S %1=$S(X4["A":"AW",X4["W":"WN",1:"R")_$S(X4["B":"U",1:"S") ;NT & Unix "RTN","ZISHONT",16,0) I %ZOS="VMS" S %1=$S(X4["A":"AW",X4["W":"WN",1:"RH")_$S(X4["B":"U",1:"S") "RTN","ZISHONT",17,0) ;The next line eliminates the error for sequential files for the current process. "RTN","ZISHONT",18,0) S %ZA=$ZUTIL(68,40,1) ;Work like DSM "RTN","ZISHONT",19,0) S %=X2_X3 O %:(%1):2 I '$T S POP=1 Q "RTN","ZISHONT",20,0) ;U % S %ZA=$ZA ;Comment out, $ZA is for READ status "RTN","ZISHONT",21,0) ;I %ZA=-1 U:%I]"" %I C % S POP=1 Q "RTN","ZISHONT",22,0) S IO=%,IO(1,IO)="",IOT="HFS",IOM=80,IOSL=60,POP=0 D SUBTYPE^%ZIS3($G(X6,"P-OTHER")) "RTN","ZISHONT",23,0) I $G(X1)]"" D SAVDEV^%ZISUTL(X1) "RTN","ZISHONT",24,0) U $S(%I]"":%I,1:$P) "RTN","ZISHONT",25,0) Q "RTN","ZISHONT",26,0) ; "RTN","ZISHONT",27,0) OPNERR ;Handle open error "RTN","ZISHONT",28,0) S POP=1,$ECODE="" "RTN","ZISHONT",29,0) U:$P]"" $P "RTN","ZISHONT",30,0) Q "RTN","ZISHONT",31,0) ; "RTN","ZISHONT",32,0) CLOSE(X) ;SR. Close HFS device not opened by %ZIS. "RTN","ZISHONT",33,0) ;X=HANDLE NAME "RTN","ZISHONT",34,0) ;IO=Device "RTN","ZISHONT",35,0) N % "RTN","ZISHONT",36,0) I $G(IO)]"" C IO K IO(1,IO) "RTN","ZISHONT",37,0) I $G(X)]"" D RMDEV^%ZISUTL(X) "RTN","ZISHONT",38,0) ;Only reset home if one setup. "RTN","ZISHONT",39,0) I $D(IO("HOME"))!$D(^XUTL("XQ",$J,"IOS")) D HOME^%ZIS "RTN","ZISHONT",40,0) Q "RTN","ZISHONT",41,0) ; "RTN","ZISHONT",42,0) OPENERR ; "RTN","ZISHONT",43,0) Q 0 "RTN","ZISHONT",44,0) ; "RTN","ZISHONT",45,0) DEL(%ZX1,%ZX2) ;ef,SR. Del files, return 1 if deleted all requested. "RTN","ZISHONT",46,0) ;S Y=$$DEL^%ZISH("dir path",$NA(array)) "RTN","ZISHONT",47,0) ; will invoke an OS command to delete file(s) "RTN","ZISHONT",48,0) ; UNIX: rm -f filespec[ ...] "RTN","ZISHONT",49,0) ; VMS: del filespec[,...] "RTN","ZISHONT",50,0) N %ZARG,%ZXDEL,%ZOS,%ZDELIM,%ZCOMND,%ZLIST "RTN","ZISHONT",51,0) S %ZARG="",%ZXDEL=1 "RTN","ZISHONT",52,0) S %ZX1=$$DEFDIR($G(%ZX1)) "RTN","ZISHONT",53,0) S %ZOS=$$OS^%ZOSV "RTN","ZISHONT",54,0) S %ZDELIM=$S(%ZOS="UNIX":" ",1:",") "RTN","ZISHONT",55,0) S %ZCOMND=$S(%ZOS="UNIX":"rm -f ",1:"del ") "RTN","ZISHONT",56,0) D "RTN","ZISHONT",57,0) . N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH" "RTN","ZISHONT",58,0) . N %,%ZI,%ZISH,%ZX,%ZFOUND S %ZISH="" "RTN","ZISHONT",59,0) . F %ZI=1:1 S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D "RTN","ZISHONT",60,0) . . N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH" "RTN","ZISHONT",61,0) . . I %ZISH["*" S %ZXDEL=0 Q ; Wild card not allowed. "RTN","ZISHONT",62,0) . . S %ZX=$S(%ZISH[%ZX1:%ZISH,1:%ZX1_%ZISH) ; prepend directory path "RTN","ZISHONT",63,0) . . I %ZOS="VMS",%ZX'[";" S %ZX=%ZX_";*" "RTN","ZISHONT",64,0) . . S %ZFOUND=$ZSEARCH(%ZX)]"" ; File exists "RTN","ZISHONT",65,0) . . S:%ZFOUND %ZARG=$S(%ZARG="":%ZX,1:%ZARG_%ZDELIM_%ZX) ; join files "RTN","ZISHONT",66,0) . . I $L(%ZARG)>2000 S %=$ZF(-1,%ZCOMND_%ZARG),%ZARG="" H 1 ; delete files at a time "RTN","ZISHONT",67,0) . ; "RTN","ZISHONT",68,0) . I $L(%ZARG) S %=$ZF(-1,%ZCOMND_%ZARG) ; delete remaining files "RTN","ZISHONT",69,0) ; "RTN","ZISHONT",70,0) I %ZXDEL S %ZXDEL='$$LIST(%ZX1,%ZX2,"%ZLIST") "RTN","ZISHONT",71,0) Q %ZXDEL "RTN","ZISHONT",72,0) ; "RTN","ZISHONT",73,0) DELERR ;Trap any $ETRAP error, unwind and return. "RTN","ZISHONT",74,0) S $ETRAP="D UNWIND^%ZTER" "RTN","ZISHONT",75,0) S %ZXDEL=0,%ZARG="" "RTN","ZISHONT",76,0) D UNWIND^%ZTER "RTN","ZISHONT",77,0) Q "RTN","ZISHONT",78,0) ; "RTN","ZISHONT",79,0) DEL1(%ZX3) ;ef,SR. Delete one file "RTN","ZISHONT",80,0) N %ZI1,%ZI2 "RTN","ZISHONT",81,0) D SPLIT(%ZX3,.%ZI1,.%ZI2) S %ZI2(%ZI2)="" "RTN","ZISHONT",82,0) Q $$DEL(%ZI1,$NA(%ZI2)) "RTN","ZISHONT",83,0) ; "RTN","ZISHONT",84,0) SPLIT(%I,%O1,%O2) ;Split to path,file "RTN","ZISHONT",85,0) N %ZOS,%D,D S %ZOS=$$OS^%ZOSV "RTN","ZISHONT",86,0) I %ZOS["VMS" D Q "RTN","ZISHONT",87,0) . S D=$S(%I["]":"]",1:":") "RTN","ZISHONT",88,0) . S %O1=$P(%I,D,1)_D,%O2=$P(%I,D,2) "RTN","ZISHONT",89,0) . Q "RTN","ZISHONT",90,0) S %D=$S(%ZOS="UNIX":"/",%ZOS="NT":"\",1:""),%O1="",%O2="" Q:%D="" "RTN","ZISHONT",91,0) S D=$L(%I,%D),%O1=$P(%I,%D,1,D-1),%O2=$P(%I,%D,D) "RTN","ZISHONT",92,0) Q "RTN","ZISHONT",93,0) ; "RTN","ZISHONT",94,0) FEXIST(%PATH,%FL) ;Check if files exsist. "RTN","ZISHONT",95,0) ;S Y=$$DTEST("/usr/var",$NA(array)) "RTN","ZISHONT",96,0) N %ZISH,%ZISHY "RTN","ZISHONT",97,0) S %ZISH=$$LIST(%PATH,%FL,"%ZISHY") "RTN","ZISHONT",98,0) Q %ZISH "RTN","ZISHONT",99,0) ; "RTN","ZISHONT",100,0) LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding file names "RTN","ZISHONT",101,0) ;S Y=$$LIST^%ZISH("\dir\",$NA(array),$NA(return array)) Return 1 if found anything "RTN","ZISHONT",102,0) ; "RTN","ZISHONT",103,0) N %ZISH,%ZISHN,%ZX,%ZISHY,%ZY,%ZOS "RTN","ZISHONT",104,0) S %ZX1=$$DEFDIR($G(%ZX1)),%ZOS=$$OS^%ZOSV "RTN","ZISHONT",105,0) ;S %ZX1=$$TRNLNM(%ZX1) "RTN","ZISHONT",106,0) ;Get fls to act on "RTN","ZISHONT",107,0) S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D "RTN","ZISHONT",108,0) . S %ZISHY=$P(%ZISH,"*") "RTN","ZISHONT",109,0) . I %ZOS="VMS",%ZISH'["." S %ZISH=%ZISH_".*" ;Allways upper "RTN","ZISHONT",110,0) . ;NT, display case, ignore for lookup "RTN","ZISHONT",111,0) . S %ZX=%ZX1_%ZISH "RTN","ZISHONT",112,0) . F %ZISHN=0:1 D Q:(%ZX="") "RTN","ZISHONT",113,0) . . S %ZX=$ZSEARCH($S(%ZISHN:"",1:%ZX)) "RTN","ZISHONT",114,0) . . ;Q:(%ZX="")!($$UP^XLFSTR(%ZX)'[%ZISHY)!(%ZX?.E1.2".") "RTN","ZISHONT",115,0) . . Q:(%ZX="")!(%ZX?.E1.2".") "RTN","ZISHONT",116,0) . . I %ZOS="VMS" S %ZX=$P(%ZX,"]",2),@%ZX3@(%ZX)="" "RTN","ZISHONT",117,0) . . I %ZOS="NT" S %ZY=$P(%ZX,"\",$L(%ZX,"\")),@%ZX3@(%ZY)="" "RTN","ZISHONT",118,0) . . I %ZOS="UNIX" S %ZY=$P(%ZX,"/",$L(%ZX,"/")) Q:%ZX'[%ZISHY S @%ZX3@(%ZY)="" "RTN","ZISHONT",119,0) . . Q "RTN","ZISHONT",120,0) Q $O(@%ZX3@(""))]"" "RTN","ZISHONT",121,0) ; "RTN","ZISHONT",122,0) MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl "RTN","ZISHONT",123,0) ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") "RTN","ZISHONT",124,0) ;Unix use mv, NT/VMS use COPY and DEL "RTN","ZISHONT",125,0) N %,X,Y,%ZOS,%ZISHX S %ZOS=$$OS^%ZOSV "RTN","ZISHONT",126,0) S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) "RTN","ZISHONT",127,0) S X=$ZSEARCH(X1_X2),Y=Y1_Y2 ;move X to Y "RTN","ZISHONT",128,0) I X="" Q 0 "RTN","ZISHONT",129,0) S %=$ZF(-1,$S(%ZOS="UNIX":"mv ",1:"copy ")_X_" "_Y) ;Use NT/VMS copy "RTN","ZISHONT",130,0) I %ZOS'="UNIX" D "RTN","ZISHONT",131,0) . S X2=$P(X,X1,2),%ZISHX(X2)="" "RTN","ZISHONT",132,0) . S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) "RTN","ZISHONT",133,0) Q 1 "RTN","ZISHONT",134,0) ; "RTN","ZISHONT",135,0) PWD() ;ef,SR. Print working directory "RTN","ZISHONT",136,0) N Y,%ZOS "RTN","ZISHONT",137,0) S Y=$$DEFDIR(""),%ZOS=$$OS^%ZOSV "RTN","ZISHONT",138,0) I Y="" S Y=$ZSEARCH("*") "RTN","ZISHONT",139,0) Q $S(%ZOS["VMS":Y,1:$P(Y,".",1)) "RTN","ZISHONT",140,0) ; "RTN","ZISHONT",141,0) TRNLNM(PATH) ;ef. Expand logical path "RTN","ZISHONT",142,0) N %ZOS,P1,P2 "RTN","ZISHONT",143,0) S %ZOS=$$OS^%ZOSV,PATH=$G(PATH) "RTN","ZISHONT",144,0) I %ZOS="VMS" D Q PATH "RTN","ZISHONT",145,0) . S P1=PATH_$S(PATH[":":"*.*",1:":*.*") "RTN","ZISHONT",146,0) . S P2=$ZSEARCH(P1) "RTN","ZISHONT",147,0) . S:$L(P2) PATH=$S(P2["]":$P(P2,"]",1)_"]",1:$P(P2,":",1)_":") "RTN","ZISHONT",148,0) . Q "RTN","ZISHONT",149,0) I %ZOS="NT" D Q PATH "RTN","ZISHONT",150,0) . S P1=PATH_$S($E(PATH,$L(PATH))'="\":"\*",1:"*"),P2=$ZSEARCH(P1) "RTN","ZISHONT",151,0) . S:$L(P2) PATH=$P(P2,"\",1,$L(P2,"\")-1)_"\" "RTN","ZISHONT",152,0) . Q "RTN","ZISHONT",153,0) I %ZOS="UNIX" D Q PATH "RTN","ZISHONT",154,0) . S P1=PATH_$S($E(PATH,$L(PATH))'="/":"/*",1:"*"),P2=$ZSEARCH(P1) "RTN","ZISHONT",155,0) . S:$L(P2) PATH=$P(P2,"/",1,$L(P2,"/")-1)_"/" "RTN","ZISHONT",156,0) . Q "RTN","ZISHONT",157,0) Q PATH "RTN","ZISHONT",158,0) ; "RTN","ZISHONT",159,0) DEFDIR(DF) ;ef. Default Dir and frmt "RTN","ZISHONT",160,0) ;Need to handle NT, VMS and Linux "RTN","ZISHONT",161,0) N %ZOS,P1,P2 S %ZOS=$$OS^%ZOSV,DF=$G(DF) "RTN","ZISHONT",162,0) Q:DF="." "" ;Special way to get current dir. "RTN","ZISHONT",163,0) S:DF="" DF=$G(^XTV(8989.3,1,"DEV")),DF=$P(DF,"^",$S($$PRI^%ZOSV<2:1,1:2)) "RTN","ZISHONT",164,0) Q:DF="" "" "RTN","ZISHONT",165,0) ;Check syntax, VMS needs disk:[dir] or logical: "RTN","ZISHONT",166,0) I %ZOS="VMS" D "RTN","ZISHONT",167,0) . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2) "RTN","ZISHONT",168,0) . E S P1="",P2=DF "RTN","ZISHONT",169,0) . I P1="",P2["$" S P1=P2,P2="" ;Could be a logical "RTN","ZISHONT",170,0) . I $L(P2) S:P2'["[" P2="["_P2 S:P2'["]" P2=P2_"]" "RTN","ZISHONT",171,0) . S DF=P1_P2 S:DF'[":" DF=DF_":" "RTN","ZISHONT",172,0) . Q "RTN","ZISHONT",173,0) ;Check syntax, Unix needs /mnt/fl, ./fl, ~/fl $HOME/fl "RTN","ZISHONT",174,0) I %ZOS="UNIX" D "RTN","ZISHONT",175,0) . S DF=$TR(DF,"\","/") "RTN","ZISHONT",176,0) . S:$E(DF,$L(DF))'="/" DF=DF_"/" "RTN","ZISHONT",177,0) . Q "RTN","ZISHONT",178,0) ;Check syntax, NT needs c:\dir\ "RTN","ZISHONT",179,0) I %ZOS="NT" D "RTN","ZISHONT",180,0) . N P1,P2 "RTN","ZISHONT",181,0) . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2) "RTN","ZISHONT",182,0) . E S P1="",P2=DF "RTN","ZISHONT",183,0) . S P2=$TR(P2,"/","\") "RTN","ZISHONT",184,0) . I $L(P2) S:".\"'[$E(P2,1) P2="\"_P2 S:$E(P2,$L(P2))'="\" P2=P2_"\" "RTN","ZISHONT",185,0) . S DF=P1_P2 "RTN","ZISHONT",186,0) . Q "RTN","ZISHONT",187,0) S DF=$$TRNLNM(DF) ;Resolve logicals "RTN","ZISHONT",188,0) Q DF "RTN","ZISHONT",189,0) ; "RTN","ZISHONT",190,0) FL(X) ;Fl len "RTN","ZISHONT",191,0) N ZOSHP1,ZOSHP2 "RTN","ZISHONT",192,0) S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) "RTN","ZISHONT",193,0) I $L(ZOSHP1)>8 S X=4 Q "RTN","ZISHONT",194,0) I $L(ZOSHP2)>3 S X=4 Q "RTN","ZISHONT",195,0) Q "RTN","ZISHONT",196,0) ; "RTN","ZISHONT",197,0) STATUS() ;ef,SR. Return EOF status "RTN","ZISHONT",198,0) U $I "RTN","ZISHONT",199,0) Q $$EOF($ZEOF) "RTN","ZISHONT",200,0) ; "RTN","ZISHONT",201,0) EOF(X) ;Eof flag, pass in $ZEOF "RTN","ZISHONT",202,0) Q (X=-1) "RTN","ZISHONT",203,0) ; "RTN","ZISHONT",204,0) MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. "RTN","ZISHONT",205,0) ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB "RTN","ZISHONT",206,0) N I,F,MX "RTN","ZISHONT",207,0) S OVF=$G(OVF,"%ZISHOF") "RTN","ZISHONT",208,0) S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; "RTN","ZISHONT",209,0) S F=$NA(@HF,IX-1) ;Get first part "RTN","ZISHONT",210,0) I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 "RTN","ZISHONT",211,0) I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root "RTN","ZISHONT",212,0) S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow "RTN","ZISHONT",213,0) F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) "RTN","ZISHONT",214,0) S %ZISHF=%ZISHF_")" "RTN","ZISHONT",215,0) Q "RTN","ZISHONT",216,0) ; "RTN","ZISHONT",217,0) READNXT(REC) ;Read any sized record into array. %ZB has terminator "RTN","ZISHONT",218,0) N %,I,X,$ES,$ET S REC="",$ET="D READNX^%ZISH Q" "RTN","ZISHONT",219,0) U IO R X:5 S %ZB=$A($ZB),REC=$E(X,1,255) "RTN","ZISHONT",220,0) Q:$L(X)<256 "RTN","ZISHONT",221,0) S %=256 F I=1:1 Q:$L(X)<% S REC(I)=$E(X,%,%+254),%=%+255 "RTN","ZISHONT",222,0) Q "RTN","ZISHONT",223,0) READNX ;Check for EOF "RTN","ZISHONT",224,0) I $ZE["ENDOFFILE" S %ZA=-1 "RTN","ZISHONT",225,0) S $EC="" "RTN","ZISHONT",226,0) Q "RTN","ZISHONT",227,0) ; "RTN","ZISHONT",228,0) FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global "RTN","ZISHONT",229,0) ;p1=hostf file directory "RTN","ZISHONT",230,0) ;p2=host file name "RTN","ZISHONT",231,0) ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT "RTN","ZISHONT",232,0) ;p4=INCREMENT SUBSCRIPT "RTN","ZISHONT",233,0) ;p5=Overflow subscript, defaults to "OVF" "RTN","ZISHONT",234,0) N %ZA,%ZB,%ZC,X,%OVFCNT,%ZISHF,%ZISHO,POP,%ZISUB,$ES,$ET "RTN","ZISHONT",235,0) N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY "RTN","ZISHONT",236,0) S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") "RTN","ZISHONT",237,0) D MAKEREF(%ZX3,%ZX4,"%ZISHOF") "RTN","ZISHONT",238,0) D OPEN^%ZISH(,%ZX1,%ZX2,"R") "RTN","ZISHONT",239,0) I POP Q 0 "RTN","ZISHONT",240,0) S %ZC=1,%ZA=0,$ET="S %ZC=0,%ZA=-1,$EC="""" Q" "RTN","ZISHONT",241,0) U IO F K %XX D READNXT(.%XX) Q:$$EOF($ZEOF)!%ZA D "RTN","ZISHONT",242,0) . S @%ZISHF=%XX "RTN","ZISHONT",243,0) . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) "RTN","ZISHONT",244,0) . S %ZISHI=%ZISHI+1 "RTN","ZISHONT",245,0) . Q "RTN","ZISHONT",246,0) D CLOSE() ;Normal exit "RTN","ZISHONT",247,0) Q %ZC "RTN","ZISHONT",248,0) ; "RTN","ZISHONT",249,0) GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. "RTN","ZISHONT",250,0) ;p1=$NAME of global reference "RTN","ZISHONT",251,0) ;p2=incrementing subscript "RTN","ZISHONT",252,0) ;p3=host file directory "RTN","ZISHONT",253,0) ;p4=host file name "RTN","ZISHONT",254,0) N %ZISHY,%ZISHOX "RTN","ZISHONT",255,0) S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"W") "RTN","ZISHONT",256,0) Q %ZISHY "RTN","ZISHONT",257,0) ; "RTN","ZISHONT",258,0) GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. "RTN","ZISHONT",259,0) ; "RTN","ZISHONT",260,0) ;p1=$NAME of global reference "RTN","ZISHONT",261,0) ;p2=incrementing subscript "RTN","ZISHONT",262,0) ;p3=host file directory "RTN","ZISHONT",263,0) ;p4=host file name "RTN","ZISHONT",264,0) N %ZISHY "RTN","ZISHONT",265,0) S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"A") "RTN","ZISHONT",266,0) Q %ZISHY "RTN","ZISHONT",267,0) ; "RTN","ZISHONT",268,0) MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; "RTN","ZISHONT",269,0) ;p1=$NAME of global reference "RTN","ZISHONT",270,0) ;p2=incrementing subscript "RTN","ZISHONT",271,0) ;p3=host file directory "RTN","ZISHONT",272,0) ;p4=host file name "RTN","ZISHONT",273,0) N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y,%ZC "RTN","ZISHONT",274,0) D MAKEREF(%ZX1,%ZX2) "RTN","ZISHONT",275,0) D OPEN^%ZISH(,$G(%ZX3),%ZX4,%ZX5) ;Default dir set in open "RTN","ZISHONT",276,0) I POP Q 0 "RTN","ZISHONT",277,0) N $ETRAP S $ETRAP="S $EC="""" D CLOSE^%ZISH() Q 0" "RTN","ZISHONT",278,0) F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! "RTN","ZISHONT",279,0) D CLOSE() "RTN","ZISHONT",280,0) Q 1 "RTN","ZISHONT",281,0) ; "RTN","ZISS1") 0^10^B15833338^B13994274 "RTN","ZISS1",1,0) %ZISS1 ;AC/SFISC - Collect screen parameters 5/29/88 2:02 PM ;1/24/08 16:10 "RTN","ZISS1",2,0) ;;8.0;KERNEL;**69,440**;JUL 10, 1995;Build 13 "RTN","ZISS1",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZISS1",4,0) VALID ; "RTN","ZISS1",5,0) N %ZISI,%ZISNP,ZISCH,ZISEND,ZISNUM,ZISQ,ZISXL,ZISXLN ;p440 "RTN","ZISS1",6,0) D L "RTN","ZISS1",7,0) Q "RTN","ZISS1",8,0) ; "RTN","ZISS1",9,0) SET2 ; "RTN","ZISS1",10,0) S %ZISFN="" F %ZISZ=0:0 S %ZISFN=$O(%ZISZ(%ZISFN)) Q:%ZISFN="" I $D(%ZISZ(%ZISFN))#2 S %ZISXX=%ZISZ(%ZISFN) D INDCK "RTN","ZISS1",11,0) Q "RTN","ZISS1",12,0) INDCK ; "RTN","ZISS1",13,0) S %ZISY="" "RTN","ZISS1",14,0) I "IOEFLD^IOSTBM"[%ZISFN S @%ZISFN=%ZISXX Q "RTN","ZISS1",15,0) I %ZISXX]"" S @("%ZISY="_%ZISXX) "RTN","ZISS1",16,0) ;E S @("%ZISY="_"""""") "RTN","ZISS1",17,0) I $E(%ZISFN,1,2)="IO" S @%ZISFN=%ZISY "RTN","ZISS1",18,0) E S @("IO"_$E(%ZISFN,1,6))=%ZISY "RTN","ZISS1",19,0) Q:'$D(%ZIS)#2 Q:%ZIS'["I" Q:'$D(%ZISZ(%ZISFN,1)) "RTN","ZISS1",20,0) ; "RTN","ZISS1",21,0) SRAY ; "RTN","ZISS1",22,0) S %=%ZISY,%ZISY=$A($E(%ZISY,1)) "RTN","ZISS1",23,0) F %1=2:1:$L(%) S %ZISY=%ZISY_$S($A(%,%1)<32:$A(%,%1),$A(%,%1)=127:127,1:$E(%,%1)) "RTN","ZISS1",24,0) S IOIS(%ZISY)=%ZISFN "RTN","ZISS1",25,0) Q "RTN","ZISS1",26,0) CHECK ;Entry point called from input transforms of fields in DEV/TT files. "RTN","ZISS1",27,0) N %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN ;p440 "RTN","ZISS1",28,0) S %ZISXX=X D L S X=%ZISYY "RTN","ZISS1",29,0) Q "RTN","ZISS1",30,0) CHECK1 ;Entry point called from input transforms of fields in DEV/TT files. "RTN","ZISS1",31,0) N %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN ;p440 "RTN","ZISS1",32,0) S %ZISXX=$S(X?1"W ".E:$E(X,3,$L(X)),1:X) "RTN","ZISS1",33,0) D L S X=$S(X?1"W ".E:"W "_%ZISYY,1:%ZISYY) "RTN","ZISS1",34,0) Q "RTN","ZISS1",35,0) FORM ;Entry point called from input transforms of fields in DEV/TT files. "RTN","ZISS1",36,0) Q:$L(X,"_")'>1 "RTN","ZISS1",37,0) N %ZISSI,%ZISSY ;p440 "RTN","ZISS1",38,0) ;F %ZISSI=1:1:$L(X,"_") S %ZISX1=$P(X,"_",%ZISSI) I %ZISX1]"","#?!"[$E(%ZISX1) S X=$S(%ZISSI=1:"",1:$P(X,"_",1,%ZISSI-1)_",")_%ZISX1_$S(%ZISSI<$L(X,"_"):","_$P(X,"_",%ZISSI+1,255),1:"") W !,%ZISSI_"==>"_X "RTN","ZISS1",39,0) S %ZISSY="" "RTN","ZISS1",40,0) F %ZISSI=1:1:$L(X,"_") S %ZISSY=%ZISSY_$P(X,"_",%ZISSI)_$S($P(X,"_",%ZISSI+1)="":"","#?!"[$E($P(X,"_",%ZISSI+1)):",","#?!"[$E($P(X,"_",%ZISSI)):",",1:"_") "RTN","ZISS1",41,0) S X=%ZISSY "RTN","ZISS1",42,0) Q "RTN","ZISS1",43,0) ; "RTN","ZISS1",44,0) L S ZISQ="""",%ZISNP=0,ZISXLN=$L(%ZISXX) I 'ZISXLN S %ZISYY="" Q "RTN","ZISS1",45,0) S ZISXL=0,%ZISYY="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) D L1 Q:ZISXL'2,%ZISYY[")_$C(" S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX Q "RTN","ZISS1",47,0) S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX "RTN","ZISS1",48,0) Q "RTN","ZISS1",49,0) L1 I ZISCH="_"!(ZISCH=",") S %ZISYY=%ZISYY_"_" Q "RTN","ZISS1",50,0) I ZISCH=ZISQ D QUOTE Q "RTN","ZISS1",51,0) I ZISCH="$" D DOLR Q "RTN","ZISS1",52,0) I ZISCH="*" D STAR Q "RTN","ZISS1",53,0) I ZISCH="(" D PAREN Q "RTN","ZISS1",54,0) S %ZISYY=%ZISYY_ZISCH "RTN","ZISS1",55,0) Q "RTN","ZISS1",56,0) L2 ;Find $C(x)_$C(y) and merge "RTN","ZISS1",57,0) N I ;p440 "RTN","ZISS1",58,0) F I=1:1:$L(%ZISXX,"_") S %ZISX1=$P(%ZISXX,"_",I),%ZISX2=$P(%ZISXX,"_",I+1) I $E(%ZISX1,1,3)="$C(",$E(%ZISX2,1,3)="$C(" D S2 "RTN","ZISS1",59,0) Q "RTN","ZISS1",60,0) L3 ; "RTN","ZISS1",61,0) N I "RTN","ZISS1",62,0) F I=1:1:$L(%ZISXX,"_") I $P(%ZISXX,"_",I)["+","$("'[$E($P(%ZISXX,"_",I)),")"'[$E($P(%ZISXX,"_",I),$L($P(%ZISXX,"_",I))) S $P(%ZISXX,"_",I)="("_$P(%ZISXX,"_",I)_")" "RTN","ZISS1",63,0) Q "RTN","ZISS1",64,0) STAR ;S ZISNUM="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) S:ZISCH?1N ZISNUM=ZISNUM_ZISCH I ZISCH=""!(ZISCH=",") S %ZISYY=%ZISYY_"$C("_+ZISNUM_")",ZISXL=ZISXL-1 Q "RTN","ZISS1",65,0) S ZISNUM="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) S:ZISCH'=""&(ZISCH'=",") ZISNUM=ZISNUM_ZISCH I ZISCH=""!(ZISCH=",") S %ZISYY=%ZISYY_"$C("_ZISNUM_")",ZISXL=ZISXL-1 Q "RTN","ZISS1",66,0) Q "RTN","ZISS1",67,0) QUOTE S %ZISYY=%ZISYY_ZISCH F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL),%ZISYY=%ZISYY_ZISCH I ZISCH=ZISQ!(ZISXL'9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR "RTN","ZOSVONT",85,0) S Y="%" F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y="" "RTN","ZOSVONT",86,0) Q "RTN","ZOSVONT",87,0) ; "RTN","ZOSVONT",88,0) ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X "RTN","ZOSVONT",89,0) N % "RTN","ZOSVONT",90,0) S (Y,%)=$P(Y,"*",1) ;I $D(@Y)=0 F S Y=$O(@Y) Q:Y=""!(Y[Y1) "RTN","ZOSVONT",91,0) Q:Y="" "RTN","ZOSVONT",92,0) ;S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR "RTN","ZOSVONT",93,0) ;F S Y=$O(@Y) Q:Y=""!(Y'[Y1) S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR "RTN","ZOSVONT",94,0) F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""!(Y'[%) "RTN","ZOSVONT",95,0) Q "RTN","ZOSVONT",96,0) ; "RTN","ZOSVONT",97,0) PARSIZ ;Old and not used. "RTN","ZOSVONT",98,0) S X=3 "RTN","ZOSVONT",99,0) Q "RTN","ZOSVONT",100,0) ; "RTN","ZOSVONT",101,0) DEVOPN ;List of Devices opened, Not used "RTN","ZOSVONT",102,0) ;Returns variable Y. Y=Devices owned separated by a comma "RTN","ZOSVONT",103,0) Q "RTN","ZOSVONT",104,0) ; "RTN","ZOSVONT",105,0) DEVOK ; "RTN","ZOSVONT",106,0) S Y=0,X1=$G(X1) Q:X=2 Q:(X1="HFS")!(X1="SPL")!(X1="MT")!(X1="CHAN") ;Quit w/ OK for HFS, Spool, MT, TCP/IP "RTN","ZOSVONT",107,0) G:X1="RES" RESOK^%ZIS6 "RTN","ZOSVONT",108,0) N $ET S $ET="D OPNERR Q" "RTN","ZOSVONT",109,0) O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 Q ;G NOPN "RTN","ZOSVONT",110,0) S Y=0 I '$D(%ZISCHK)!($G(%ZIS)["T") C X Q "RTN","ZOSVONT",111,0) S:X]"" IO(1,X)="" Q "RTN","ZOSVONT",112,0) Q "RTN","ZOSVONT",113,0) ; "RTN","ZOSVONT",114,0) OPNERR S $EC="",Y=-1 Q "RTN","ZOSVONT",115,0) ; "RTN","ZOSVONT",116,0) GETENV ;Get environment (UCI^VOL^NODE^BOX:VOLUME) "RTN","ZOSVONT",117,0) N %,%1 S %=$$VERSION,%1=$ZU(86),%1=$S(%<3.1:$P(%1,"*",3),1:$P(%1,"*",2)) "RTN","ZOSVONT",118,0) D UCI S Y=$P(Y,",")_"^"_^%ZOSF("VOL")_"^"_$ZU(110)_"^"_^%ZOSF("VOL")_":"_%1 "RTN","ZOSVONT",119,0) Q "RTN","ZOSVONT",120,0) VERSION(X) ;return Cache version, X=1 - return full name "RTN","ZOSVONT",121,0) Q $S($G(X):$P($ZV,")")_")",1:$P($P($ZV,") ",2),"(")) "RTN","ZOSVONT",122,0) ; "RTN","ZOSVONT",123,0) OS() ;Return the OS NT, VMS, Unix "RTN","ZOSVONT",124,0) Q $S($ZV["VMS":"VMS",$ZV["UNIX":"UNIX",$ZV["Linux":"UNIX",$ZV["Windows":"NT",$ZV["NT":"NT",1:"UNK") "RTN","ZOSVONT",125,0) ; "RTN","ZOSVONT",126,0) SETNM(X) ;Set name, Fall into SETENV "RTN","ZOSVONT",127,0) SETENV ;Set environment "RTN","ZOSVONT",128,0) N Q,$ET,$ES S $ET="S $EC="""" Q" "RTN","ZOSVONT",129,0) I $$OS="VMS" S Q=$ZF("SETPRN",$E(X,1,15)) "RTN","ZOSVONT",130,0) Q "RTN","ZOSVONT",131,0) ; "RTN","ZOSVONT",132,0) SID() ;System ID Ver 1 "RTN","ZOSVONT",133,0) N %1,%2,%3,%4,%5,T S T="~" "RTN","ZOSVONT",134,0) S %1=$ZU(5) ;namespace "RTN","ZOSVONT",135,0) S %2=$ZU(12,"") ;directory "RTN","ZOSVONT",136,0) I '$L(%2),$$VERSION'<5.2 S %2=$$defdir^%SYS.GLO(%1) ;remote directory "RTN","ZOSVONT",137,0) S %3=$G(^XTV(8989.3,1,"SID")),%4=$P(%3,"^",4),%5=$P(%3,"^",5) "RTN","ZOSVONT",138,0) I $L(%4),$L(%5),%2[%4 S %2=$P(%2,%4)_%5_$P(%2,%4,2,9) "RTN","ZOSVONT",139,0) S %3=%1_T_%2 ;namespace~directory "RTN","ZOSVONT",140,0) Q "1~"_%3 "RTN","ZOSVONT",141,0) ; "RTN","ZOSVONT",142,0) PRI() ;Check if a mixed OS enviroment. "RTN","ZOSVONT",143,0) ;Default return 1 unless we are on the secondary OS. "RTN","ZOSVONT",144,0) ;Only Cache on a VMS(1)/Linux or NT(2) mix is supported now. "RTN","ZOSVONT",145,0) N % S %=1 "RTN","ZOSVONT",146,0) I $P(^XTV(8989.3,1,0),"^",5),$$OS'="VMS" S %=2 "RTN","ZOSVONT",147,0) Q % "RTN","ZOSVONT",148,0) ; "RTN","ZOSVONT",149,0) HFSREW(IO,IOPAR) ;Rewind Host File. "RTN","ZOSVONT",150,0) S $ZT="HFSRWERR" "RTN","ZOSVONT",151,0) C IO O @(""""_IO_""""_$S(IOPAR]"":":"_IOPAR_":1",1:":1")) I '$T Q 0 "RTN","ZOSVONT",152,0) Q 1 "RTN","ZOSVONT",153,0) HFSRWERR ;Error encountered "RTN","ZOSVONT",154,0) Q 0 "RTN","ZOSVONT",155,0) LOGRSRC(OPT,TYPE,STATUS) ;record resource usage in ^XTMP("KMPR" "RTN","ZOSVONT",156,0) Q:'$G(^%ZTSCH("LOGRSRC")) ; quit if RUM not turned on. "RTN","ZOSVONT",157,0) ; call to RUM routine. "RTN","ZOSVONT",158,0) D RU^%ZOSVKR($G(OPT),$G(TYPE),$G(STATUS)) "RTN","ZOSVONT",159,0) Q "RTN","ZOSVONT",160,0) SETTRM(X) ;Turn on specified terminators. "RTN","ZOSVONT",161,0) U $I:(:"+T":X) "RTN","ZOSVONT",162,0) Q 1 "RTN","ZOSVONT",163,0) ; "RTN","ZOSVONT",164,0) T0 ; start RT clock, obsolete "RTN","ZOSVONT",165,0) ;S XRT0=$H "RTN","ZOSVONT",166,0) Q "RTN","ZOSVONT",167,0) T1 ; store RT datum, obsolete "RTN","ZOSVONT",168,0) ;S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0 "RTN","ZOSVONT",169,0) Q "RTN","ZTLOAD4") 0^7^B11458324^B11756579 "RTN","ZTLOAD4",1,0) %ZTLOAD4 ;SEA/RDS-TaskMan: P I: Is Queued? ;1/24/08 16:15 "RTN","ZTLOAD4",2,0) ;;8.0;KERNEL;**440**;JUL 10, 1995;Build 13 "RTN","ZTLOAD4",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZTLOAD4",4,0) ;Call with ZTSK, [ZTCPU]; Return ZTSK() "RTN","ZTLOAD4",5,0) INPUT ;check input parameters for error conditions "RTN","ZTLOAD4",6,0) N %,$ES,$ET,%ZTVOL,ZTREC,ZTD,ZT1,ZT2,ZT3 "RTN","ZTLOAD4",7,0) I $D(ZTSK)[0 S ZTSK="" "RTN","ZTLOAD4",8,0) I $D(ZTSK)>1 S %=ZTSK K ZTSK S ZTSK=% "RTN","ZTLOAD4",9,0) I ZTSK<1!(ZTSK\1'=ZTSK) S ZTSK="",ZTSK(0)="",ZTSK("E")="IT" G QUIT "RTN","ZTLOAD4",10,0) S ZTSK(0)="",ZTSK("E")="U",$ET="Q:$ES S $EC="""" G QUIT^%ZTLOAD4" "RTN","ZTLOAD4",11,0) S %ZTVOL=^%ZOSF("VOL") "RTN","ZTLOAD4",12,0) I $D(ZTCPU)[0 S ZTCPU=%ZTVOL "RTN","ZTLOAD4",13,0) I ZTCPU="" S ZTCPU=%ZTVOL "RTN","ZTLOAD4",14,0) I ZTCPU'=%ZTVOL G THERE "RTN","ZTLOAD4",15,0) ; "RTN","ZTLOAD4",16,0) HERE ;lookup task's status on current volume set "RTN","ZTLOAD4",17,0) L +^%ZTSK(ZTSK):1 "RTN","ZTLOAD4",18,0) I $D(^%ZTSK(ZTSK,0))[0 S ZTSK("E")="I" G QUIT "RTN","ZTLOAD4",19,0) S ZTREC=^%ZTSK(ZTSK,0),ZTD=$G(^(.04)) "RTN","ZTLOAD4",20,0) S ZTSK("DUZ")=$P(ZTREC,U,3),ZTSK("D")=$P(ZTREC,U,6) ;scheduled $H "RTN","ZTLOAD4",21,0) I ZTD]"",$D(^%ZTSCH(ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",22,0) I ZTD]"",$D(^%ZTSCH("JOB",ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",23,0) ; "RTN","ZTLOAD4",24,0) S ZT1="" F S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",25,0) S ZT1="IO",ZT2="" F S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",26,0) S ZT1="JOB",ZT2="" F S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",27,0) S ZT1="LINK",ZT2="" F S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",28,0) S ZTSK(0)=0 "RTN","ZTLOAD4",29,0) ; "RTN","ZTLOAD4",30,0) QUIT ;cleanup and quit "RTN","ZTLOAD4",31,0) L:ZTSK -^%ZTSK(ZTSK) ;K %ZTCPU,%ZTM,%ZTM1,%ZTM2,%ZTMAST,%ZTVOL,X,Y,ZT,ZT1,ZT2,ZT3,ZTCPU,ZTD,ZTREC "RTN","ZTLOAD4",32,0) I ZTSK(0)]"" K ZTSK("E") Q "RTN","ZTLOAD4",33,0) I ZTSK("E")'="U" Q "RTN","ZTLOAD4",34,0) S ZTSK("E",0)=$$EC^%ZOSV "RTN","ZTLOAD4",35,0) Q "RTN","ZTLOAD4",36,0) ; "RTN","ZTLOAD4",37,0) THERE ;rest of code looks up task's status on some other volume set "RTN","ZTLOAD4",38,0) N %ZTCPU,%ZTM,X,Y "RTN","ZTLOAD4",39,0) ; "RTN","ZTLOAD4",40,0) FILES ;find TaskMan files on the volume set to be searched "RTN","ZTLOAD4",41,0) S %ZTCPU=$O(^%ZIS(14.5,"B",ZTCPU,"")) "RTN","ZTLOAD4",42,0) I %ZTCPU="" S ZTSK("E")="IS" G QUIT "RTN","ZTLOAD4",43,0) S %ZTM=$P(^%ZOSF("MGR"),",") "RTN","ZTLOAD4",44,0) S %ZTM=$S($D(^%ZIS(14.5,%ZTCPU,0))[0:%ZTM,$P(^(0),U,6)="":%ZTM,1:$P(^(0),U,6)) "RTN","ZTLOAD4",45,0) S X=%ZTM,Y=ZTCPU "RTN","ZTLOAD4",46,0) S ZTSK("E")="LS",ZT=$D(^[X,Y]%ZTSK(0)),ZTSK("E")="U" ; check link "RTN","ZTLOAD4",47,0) ; "RTN","ZTLOAD4",48,0) SEARCH ;find out if task is queued on that volume set "RTN","ZTLOAD4",49,0) I $D(^[X,Y]%ZTSK(ZTSK,0))[0 S ZTSK("E")="I" G QUIT "RTN","ZTLOAD4",50,0) S ZTREC=^[X,Y]%ZTSK(ZTSK,0),ZTD=$G(^(.04)) "RTN","ZTLOAD4",51,0) S ZTSK("DUZ")=$P(ZTREC,U,3),ZTSK("D")=$P(ZTREC,U,6) "RTN","ZTLOAD4",52,0) I ZTD]"",$D(^[X,Y]%ZTSCH(ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",53,0) I ZTD]"",$D(^[X,Y]%ZTSCH("JOB",ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",54,0) ; "RTN","ZTLOAD4",55,0) S ZT1="" F S ZT1=$O(^[X,Y]%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",56,0) S ZT1="IO",ZT2="" F S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",57,0) S ZT1="JOB",ZT2="" F S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",58,0) S ZT1="LINK",ZT2="" F S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F S ZT3=$O(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT "RTN","ZTLOAD4",59,0) S ZTSK(0)=0 G QUIT "RTN","ZTLOAD4",60,0) ; "VER") 8.0^22.0 "^DD",3.5,3.5,36,0) GLOBAL LOCK^SO^0:No;1:Yes;^GBL;1^Q "^DD",3.5,3.5,36,2) S Y(0)=Y S Y=Y "^DD",3.5,3.5,36,2.1) S Y=Y "^DD",3.5,3.5,36,3) "^DD",3.5,3.5,36,21,0) ^.001^2^2^3071108^^ "^DD",3.5,3.5,36,21,1,0) This field tells the device handler if it should use a global lock "^DD",3.5,3.5,36,21,2,0) to control access to a device. "^DD",3.5,3.5,36,23,0) ^.001^9^9^3071108^^ "^DD",3.5,3.5,36,23,1,0) This field locks ^%ZIS("lock",IO) in the device handler. "^DD",3.5,3.5,36,23,2,0) It is cleared in %ZISC. "^DD",3.5,3.5,36,23,3,0) It is not limited to CHAN devices anymore. "^DD",3.5,3.5,36,23,4,0) "^DD",3.5,3.5,36,23,5,0) In the past this field held a global to lock but there was no code "^DD",3.5,3.5,36,23,6,0) to support it. "^DD",3.5,3.5,36,23,7,0) Old description: "^DD",3.5,3.5,36,23,8,0) Identify a global to lock/unlock to be used to limit the access to "^DD",3.5,3.5,36,23,9,0) a given channel to one client. "^DD",3.5,3.5,36,"DT") 3071108 "^DD",3.5,3.5,52,0) SECONDARY $I^FX^^2;1^K:$L(X)>40!($L(X)<1) X "^DD",3.5,3.5,52,3) Enter the $IO for the secondary system (1-40 char) "^DD",3.5,3.5,52,21,0) ^^3^3^3061211^ "^DD",3.5,3.5,52,21,1,0) This field holds the $IO value to be used if this is the secondary system "^DD",3.5,3.5,52,21,2,0) in a mixed OS environment. It is not used otherwise. "^DD",3.5,3.5,52,21,3,0) It is only used for output devices. "^DD",3.5,3.5,52,"DT") 3070426 "^DD",8989.3,8989.3,.05,0) MIXED OS^S^0:No;1:VMS/Linux;^0;5^Q "^DD",8989.3,8989.3,.05,.1) Mixed OS "^DD",8989.3,8989.3,.05,21,0) ^^3^3^3070607^^ "^DD",8989.3,8989.3,.05,21,1,0) This field tells Kernel that this is a MIXED OS environment. "^DD",8989.3,8989.3,.05,21,2,0) This is only supported on a Cache ECP client/server setup. "^DD",8989.3,8989.3,.05,21,3,0) The PRIMARY OS is VMS and the SECONDARY OS is non-VMS. "^DD",8989.3,8989.3,.05,23,0) ^^9^9^3070607^ "^DD",8989.3,8989.3,.05,23,1,0) This is used to select which field to use when selecting OS specific "^DD",8989.3,8989.3,.05,23,2,0) data fields in a mixed OS environment. "^DD",8989.3,8989.3,.05,23,3,0) The support is for Cache in a ECP client/server mode with only two OS's "^DD",8989.3,8989.3,.05,23,4,0) at a time. "^DD",8989.3,8989.3,.05,23,5,0) In a mixed environment the primary OS is always VMS, the secondary is not "^DD",8989.3,8989.3,.05,23,6,0) VMS (i.e. Linux or NT) "^DD",8989.3,8989.3,.05,23,7,0) Some of the fields that need mixed values are "^DD",8989.3,8989.3,.05,23,8,0) DEFAULT HFS DIRECTORY/SECONDARY HFS DIRECTORY "^DD",8989.3,8989.3,.05,23,9,0) $IO/SECONDARY $I. "^DD",8989.3,8989.3,.05,"DT") 3070607 "^DD",8989.3,8989.3,320,0) PRIMARY HFS DIRECTORY^F^^DEV;1^K:$L(X)>50!($L(X)<1) X "^DD",8989.3,8989.3,320,3) Enter a directory path for HFS files (1-50 char) "^DD",8989.3,8989.3,320,21,0) ^^7^7^3061211^ "^DD",8989.3,8989.3,320,21,1,0) This field holds a Primary (default) directory path to be used whenever a "^DD",8989.3,8989.3,320,21,2,0) HOST file is referenced and a Directory is not included. "^DD",8989.3,8989.3,320,21,3,0) Example: Cache/VMS might have USER$:[TEMP] "^DD",8989.3,8989.3,320,21,4,0) Cache/NT might have T:\TEMP\ "^DD",8989.3,8989.3,320,21,5,0) Cache/Linux might have /var/tmp/ "^DD",8989.3,8989.3,320,21,6,0) If this field is left blank then HOST files that don't have an explicit "^DD",8989.3,8989.3,320,21,7,0) directory path will go to the current processes working directory. "^DD",8989.3,8989.3,320,"DT") 3061211 "^DD",8989.3,8989.3,320.2,0) SECONDARY HFS DIRECTORY^F^^DEV;2^K:$L(X)>50!($L(X)<1) X "^DD",8989.3,8989.3,320.2,3) Enter a directory path for HFS files (1-50 char) "^DD",8989.3,8989.3,320.2,21,0) ^^1^1^3061211^ "^DD",8989.3,8989.3,320.2,21,1,0) This field holds the secondary HFS directory path. "^DD",8989.3,8989.3,320.2,"DT") 3061211 "^DD",8989.3,8989.3,504,0) LOGICAL DISK NAME^F^^SID;4^K:$L(X)>30!($L(X)<2) X "^DD",8989.3,8989.3,504,3) Answer must be 2-30 characters in length. "^DD",8989.3,8989.3,504,21,0) ^^2^2^3070731^ "^DD",8989.3,8989.3,504,21,1,0) This field holds a logical disk name that is stored in the cache cpf file "^DD",8989.3,8989.3,504,21,2,0) for client system in a ECP client-server setup. "^DD",8989.3,8989.3,504,"DT") 3070731 "^DD",8989.3,8989.3,505,0) PHYSICAL DISK^F^^SID;5^K:$L(X)>30!($L(X)<2) X "^DD",8989.3,8989.3,505,3) Answer must be 2-30 characters in length. "^DD",8989.3,8989.3,505,21,0) ^^2^2^3070731^ "^DD",8989.3,8989.3,505,21,1,0) This field hold the Physical disk name that Cache VMS converts the logical "^DD",8989.3,8989.3,505,21,2,0) name(#504) in to. "^DD",8989.3,8989.3,505,"DT") 3070731 "BLD",983,6) ^391 **END** **END**