Released XU*8*584 SEQ #484 Extracted from mail message **KIDS**:XU*8.0*584^ **INSTALL NAME** XU*8.0*584 "BLD",1380,0) XU*8.0*584^KERNEL^0^3120125^y "BLD",1380,1,0) ^^2^2^3110824^ "BLD",1380,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "BLD",1380,1,2,0) "BLD",1380,4,0) ^9.64PA^^ "BLD",1380,6.3) 6 "BLD",1380,"INID") ^y "BLD",1380,"INIT") POST^XU8P584 "BLD",1380,"KRN",0) ^9.67PA^9002226^21 "BLD",1380,"KRN",.4,0) .4 "BLD",1380,"KRN",.401,0) .401 "BLD",1380,"KRN",.402,0) .402 "BLD",1380,"KRN",.403,0) .403 "BLD",1380,"KRN",.5,0) .5 "BLD",1380,"KRN",.84,0) .84 "BLD",1380,"KRN",3.6,0) 3.6 "BLD",1380,"KRN",3.8,0) 3.8 "BLD",1380,"KRN",9.2,0) 9.2 "BLD",1380,"KRN",9.8,0) 9.8 "BLD",1380,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",1380,"KRN",9.8,"NM",1,0) ZIS4ONT^^0^B34039996 "BLD",1380,"KRN",9.8,"NM",2,0) ZTMGRSET^^0^B53358963 "BLD",1380,"KRN",9.8,"NM",3,0) XUS^^0^B31567708 "BLD",1380,"KRN",9.8,"NM",4,0) ZISS1^^0^B15840610 "BLD",1380,"KRN",9.8,"NM","B","XUS",3) "BLD",1380,"KRN",9.8,"NM","B","ZIS4ONT",1) "BLD",1380,"KRN",9.8,"NM","B","ZISS1",4) "BLD",1380,"KRN",9.8,"NM","B","ZTMGRSET",2) "BLD",1380,"KRN",19,0) 19 "BLD",1380,"KRN",19.1,0) 19.1 "BLD",1380,"KRN",101,0) 101 "BLD",1380,"KRN",409.61,0) 409.61 "BLD",1380,"KRN",771,0) 771 "BLD",1380,"KRN",779.2,0) 779.2 "BLD",1380,"KRN",870,0) 870 "BLD",1380,"KRN",8989.51,0) 8989.51 "BLD",1380,"KRN",8989.52,0) 8989.52 "BLD",1380,"KRN",8994,0) 8994 "BLD",1380,"KRN",9002226,0) 9002226 "BLD",1380,"KRN","B",.4,.4) "BLD",1380,"KRN","B",.401,.401) "BLD",1380,"KRN","B",.402,.402) "BLD",1380,"KRN","B",.403,.403) "BLD",1380,"KRN","B",.5,.5) "BLD",1380,"KRN","B",.84,.84) "BLD",1380,"KRN","B",3.6,3.6) "BLD",1380,"KRN","B",3.8,3.8) "BLD",1380,"KRN","B",9.2,9.2) "BLD",1380,"KRN","B",9.8,9.8) "BLD",1380,"KRN","B",19,19) "BLD",1380,"KRN","B",19.1,19.1) "BLD",1380,"KRN","B",101,101) "BLD",1380,"KRN","B",409.61,409.61) "BLD",1380,"KRN","B",771,771) "BLD",1380,"KRN","B",779.2,779.2) "BLD",1380,"KRN","B",870,870) "BLD",1380,"KRN","B",8989.51,8989.51) "BLD",1380,"KRN","B",8989.52,8989.52) "BLD",1380,"KRN","B",8994,8994) "BLD",1380,"KRN","B",9002226,9002226) "BLD",1380,"QDEF") ^^^^YES^^^^NO^^NO "BLD",1380,"QUES",0) ^9.62^^ "INIT") POST^XU8P584 "MBREQ") 0 "PKG",3,-1) 1^1 "PKG",3,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",3,20,0) ^9.402P^2^2 "PKG",3,20,1,0) 200^^XDRM200N "PKG",3,20,1,1) "PKG",3,20,2,0) 2^^RGDRM03 "PKG",3,20,2,1) "PKG",3,20,"B",2,2) "PKG",3,20,"B",200,1) "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 8.0^3090706^3090706^6 "PKG",3,22,1,"PAH",1,0) 584^3120125^6 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3120125 "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) "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") 5 "RTN","XU8P584") 0^^B31749^n/a "RTN","XU8P584",1,0) XU8P584 ;ISF/RD - Patch XU*8*584 ; "RTN","XU8P584",2,0) ;;8.0;KERNEL;**584**;Jul 10, 1995;Build 6 "RTN","XU8P584",3,0) Q "RTN","XU8P584",4,0) ; "RTN","XU8P584",5,0) POST ;POST-INIT "RTN","XU8P584",6,0) D PATCH^ZTMGRSET(584) "RTN","XU8P584",7,0) Q "RTN","XUS") 0^3^B31587767^B30954416 "RTN","XUS",1,0) XUS ;SFISC/STAFF - SIGNON ;11/29/2011 "RTN","XUS",2,0) ;;8.0;KERNEL;**16,26,49,59,149,180,265,337,419,434,584**;Jul 10, 1995;Build 6 "RTN","XUS",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","XUS",4,0) ;Sign-on message numbers are 30810.51 to 30810.99 "RTN","XUS",5,0) S U="^" D INTRO^XUS1A() "RTN","XUS",6,0) K K ^XUTL("ZISPARAM",$I) "RTN","XUS",7,0) S U="^",XQXFLG("GUI")="^" "RTN","XUS",8,0) W ! S $Y=0 D SET1(1) I POP S XUM=3 G NO ;Sets DUZ("LANG") "RTN","XUS",9,0) S XUSTMP(51)=$$EZBLD^DIALOG(30810.51),XUSTMP(52)=$$EZBLD^DIALOG(30810.52) "RTN","XUS",10,0) W !!,"Volume set: ",$P(XUENV,U,4)," UCI: ",XUCI," Device: ",$I W:$S('$D(IO("ZIO")):0,1:$I'=IO("ZIO")) " (",IO("ZIO"),")" W ! "RTN","XUS",11,0) RESTART ; "RTN","XUS",12,0) S XUM=$$SET2 G:XUM NO "RTN","XUS",13,0) I $P(XU1,U,2)]"" S XUM=$$DEVPAS() I XUM G H:XUM<0,NO "RTN","XUS",14,0) ;S PGM=$P(XOPT,U,8),XUA=$P(PGM,"[",1) I XUA]"" X XUEON G NEXT^XUS1 "RTN","XUS",15,0) A S (XUSER(0),XUSER(1),XQUR)="" "RTN","XUS",16,0) ;Check for locked IP/device. "RTN","XUS",17,0) I $$LKCHECK^XUSTZIP() S XUM=7,XUFAC=$P(XOPT,U,2),XUHALT=1 G NO "RTN","XUS",18,0) ;Auto Sign-on check "RTN","XUS",19,0) S X=$$AUTOXUS^XUS1B() I X>0 S DUZ=X D USER(DUZ) W !!,">> Auto Sign-on: ",$P(XUSER(0),U)," <<<",! G B "RTN","XUS",20,0) X XUEOFF S AV=$$ASKAV() X XUEON I AV="^;^" G H ;Get out "RTN","XUS",21,0) I AV["MAIL-BOX",AV[";XMR" S (XUA,PGM)="XMR",XMCHAN=$P($P(AV,";")," ",2),DUZ=.5 G XMR^XUSCLEAN "RTN","XUS",22,0) S XQUR=$P(AV,";",3) "RTN","XUS",23,0) S DUZ=$$CHECKAV(AV) K AV "RTN","XUS",24,0) S XUM=$$UVALID() G:XUM NO "RTN","XUS",25,0) B K XUF,%1 S XUF=0 X XUEON "RTN","XUS",26,0) I DUZ D USER^XUS1 G:XUM NO "RTN","XUS",27,0) I DUZ D SEC^XUS3:($D(^%ZIS(1,XUDEV,"TIME"))!$D(^(95))) G:XUM NO "RTN","XUS",28,0) G NO:'DUZ "RTN","XUS",29,0) S DTIME=$P(XOPT,U,10),X=$S(DUZ("BUF"):"",1:"NO-")_"TYPE-AHEAD" X:$D(^%ZOSF(X)) ^(X) "RTN","XUS",30,0) D TT^XUS3:$G(XUTT) "RTN","XUS",31,0) D CLRFAC^XUS3($G(IO("IP"))) "RTN","XUS",32,0) PGM ; "RTN","XUS",33,0) S Y=+$G(^%ZIS(1,XUDEV,201)) I Y>0,$$CHK S XQY=Y G OK "RTN","XUS",34,0) S Y=+$G(^VA(200,DUZ,201)) I Y>0,$$CHK S XQY=Y G OK "RTN","XUS",35,0) I $D(DUZ("ASH")) S Y=$O(^DIC(19,"B","XU NOP MENU",0)) I Y>0 S XQY=Y G OK ;rwf 403 "RTN","XUS",36,0) S XUM=16 "RTN","XUS",37,0) G NO "RTN","XUS",38,0) ; "RTN","XUS",39,0) OK D CHEK^XQ83 "RTN","XUS",40,0) S (XUA,PGM)="XQ" "RTN","XUS",41,0) G NEXT^XUS1 "RTN","XUS",42,0) ; "RTN","XUS",43,0) CHK() ;Check that option exeist and LOCK "RTN","XUS",44,0) I $D(^DIC(19,Y,0)),$S($P(^(0),U,6)="":1,1:$D(^XUSEC($P(^(0),U,6),DUZ))) Q 1 "RTN","XUS",45,0) Q 0 "RTN","XUS",46,0) ; "RTN","XUS",47,0) LC S X=$$UP(X) "RTN","XUS",48,0) Q "RTN","XUS",49,0) UP(%) Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","XUS",50,0) ; "RTN","XUS",51,0) FAC ;Failed access "RTN","XUS",52,0) S:'DUZ XUF(.1)=$E(%1) "RTN","XUS",53,0) S:XUF=2 XUF(.2)=XUF(.2)+1,XUF(XUF(.2))=%1 S %1="" Q "RTN","XUS",54,0) Q "RTN","XUS",55,0) NO ;Tell why didn't get on "RTN","XUS",56,0) S X=$$NO^XUS3() G RESTART:'X ;fall into exit "RTN","XUS",57,0) H ;Exit point for all applications "RTN","XUS",58,0) C ;CLOSE "RTN","XUS",59,0) G ^XUSCLEAN "RTN","XUS",60,0) ; "RTN","XUS",61,0) ON X ^%ZOSF("EON") Q "RTN","XUS",62,0) ; "RTN","XUS",63,0) ASKAV(PRE) ;Ask and return Access;Verify code, Turn off echo before calling "RTN","XUS",64,0) N X,Y S PRE=$G(PRE) "RTN","XUS",65,0) F W !,PRE,XUSTMP(51) S X=$$ACCEPT S:X="^" X="^;^" Q:$L(X) "RTN","XUS",66,0) S X=$TR(X,$C(9),";") ;Convert TAB to ; to match GUI. "RTN","XUS",67,0) I $P(X," ")="MAIL-BOX" S X=X_";XMR" "RTN","XUS",68,0) I $E(X,1,7)="~~TOK~~" Q X ;Use CCOW token "RTN","XUS",69,0) I '$L($P(X,";",2)) W !,PRE,XUSTMP(52) S Y=$$ACCEPT S:Y="^" X="^;" S $P(X,";",2)=Y "RTN","XUS",70,0) Q X "RTN","XUS",71,0) ; "RTN","XUS",72,0) ;Timeout used by XUSTZ call. "RTN","XUS",73,0) ACCEPT(TO) ;Read A/V and echo '*' char. "RTN","XUS",74,0) ;Have the Read write to flush the buffer on some systems "RTN","XUS",75,0) N C,A,E K DUOUT S A="",TO=$G(TO,60),E=0 "RTN","XUS",76,0) F D Q:E "RTN","XUS",77,0) . R "",*C:TO S:('$T) DUOUT=1 S:('$T)!(C=94) A="^" "RTN","XUS",78,0) . I (A="^")!(C=13)!($L(A)>60) S E=1 Q "RTN","XUS",79,0) . I C=127 Q:'$L(A) S A=$E(A,1,$L(A)-1) W $C(8,32,8) Q "RTN","XUS",80,0) . S A=A_$C(C) W *42 "RTN","XUS",81,0) . Q "RTN","XUS",82,0) Q A "RTN","XUS",83,0) ; "RTN","XUS",84,0) CHECKAV(X1) ;Check A/V code return DUZ or Zero. (Called from XUSRB) "RTN","XUS",85,0) N %,%1,X,Y,IEN,DA,DIK "RTN","XUS",86,0) S IEN=0 "RTN","XUS",87,0) ;Start CCOW "RTN","XUS",88,0) I $E(X1,1,7)="~~TOK~~" D Q:IEN>0 IEN "RTN","XUS",89,0) . I $E(X1,8,9)="~1" S IEN=$$CHKASH^XUSRB4($E(X1,8,255)) "RTN","XUS",90,0) . I $E(X1,8,9)="~2" S IEN=$$CHKCCOW^XUSRB4($E(X1,8,255)) "RTN","XUS",91,0) . Q "RTN","XUS",92,0) ;End CCOW "RTN","XUS",93,0) S X1=$$UP(X1) S:X1[":" XUTT=1,X1=$TR(X1,":") "RTN","XUS",94,0) S X=$P(X1,";") Q:X="^" -1 S:XUF %1="Access: "_X "RTN","XUS",95,0) Q:X'?1.20ANP 0 "RTN","XUS",96,0) S X=$$EN^ROUTINE(X) I '$D(^VA(200,"A",X)) D LBAV Q 0 "RTN","XUS",97,0) S %1="",IEN=$O(^VA(200,"A",X,0)),XUF(.3)=IEN D USER(IEN) "RTN","XUS",98,0) S X=$P(X1,";",2) S:XUF %1="Verify: "_X S X=$$EN^ROUTINE(X) "RTN","XUS",99,0) I $P(XUSER(1),"^",2)'=X D LBAV Q 0 "RTN","XUS",100,0) I $G(XUFAC(1)) S DIK="^XUSEC(4,",DA=XUFAC(1) D ^DIK "RTN","XUS",101,0) Q IEN "RTN","XUS",102,0) LBAV ;Log Bad AV "RTN","XUS",103,0) D:XUF FAC "RTN","XUS",104,0) I IEN S X=$P($G(^VA(200,IEN,1.1)),U,2)+1,$P(^(1.1),"^",2)=X "RTN","XUS",105,0) Q "RTN","XUS",106,0) ; "RTN","XUS",107,0) USER(IX) ;Build XUSER "RTN","XUS",108,0) S XUSER(0)=$G(^VA(200,+IX,0)),XUSER(1)=$G(^(.1)),XUSER(1.1)=$G(^(1.1)) "RTN","XUS",109,0) Q "RTN","XUS",110,0) ; "RTN","XUS",111,0) XUVOL ;Setup XUENV, XUCI,XQVOL,XUVOL,XUOSVER "RTN","XUS",112,0) S U="^" D GETENV^%ZOSV S XUENV=Y,XUCI=$P(Y,U,1),XQVOL=$P(Y,U,2),XUOSVER=$$VERSION^%ZOSV "RTN","XUS",113,0) S X=$O(^XTV(8989.3,1,4,"B",XQVOL,0)),XUVOL=$S(X>0:^XTV(8989.3,1,4,X,0),1:XQVOL_"^y^1") "RTN","XUS",114,0) Q "RTN","XUS",115,0) ; "RTN","XUS",116,0) XOPT ;Setup initial XOPT "RTN","XUS",117,0) S XOPT=$S($D(^XTV(8989.3,1,"XUS")):^("XUS"),1:"") "RTN","XUS",118,0) F I=2:1:15 I $P(XOPT,U,I)="" S $P(XOPT,U,I)=$P("^5^900^1^1^^^^1^300^^^^N^90",U,I) "RTN","XUS",119,0) Q "RTN","XUS",120,0) ; "RTN","XUS",121,0) SET1(FLAG) ;Setup parameters (also called from XUSRB) "RTN","XUS",122,0) N % "RTN","XUS",123,0) S U="^",XUEON=^%ZOSF("EON"),XUEOFF=^("EOFF") "RTN","XUS",124,0) D XUVOL,XOPT S DUZ("LANG")=$P(XOPT,U,7) ;S:$P(XUVOL,U,6)="y" XRTL=XUCI_","_XQVOL "RTN","XUS",125,0) K ^XUTL("XQ",$J) S XUF=0,XUDEV=0,DUZ=0,DUZ(0)="@",IOS=0,ION="" "RTN","XUS",126,0) I FLAG S %ZIS="L",IOP="HOME" D ^%ZIS Q:POP "RTN","XUS",127,0) S XUDEV=IOS,XUIOP=ION "RTN","XUS",128,0) D GETFAC^XUS3($G(IO("IP"))) "RTN","XUS",129,0) S %=$P(XOPT,U,14) "RTN","XUS",130,0) I "N"'[% D "RTN","XUS",131,0) . S XUF=(%["R")+1,XUF(.1)="",XUF(.2)=0,XUF(.3)=0 "RTN","XUS",132,0) . I %["D" S:$D(^XTV(8989.3,1,4.33,"B",XUDEV))[0 XUF=0 "RTN","XUS",133,0) S DILOCKTM=+$G(^DD("DILOCKTM"),1) ;p434 IA#4909 "RTN","XUS",134,0) Q "RTN","XUS",135,0) SET2() ;EF. Return error code (also called from XUSRB) "RTN","XUS",136,0) N %,X "RTN","XUS",137,0) S XUNOW=$$HTFM^XLFDT($H),DT=$P(XUNOW,".") "RTN","XUS",138,0) K DUZ,XUSER "RTN","XUS",139,0) S (DUZ,DUZ(2))=0,(DUZ(0),DUZ("AG"),XUSER(0),XUSER(1),XUTT,%UCI)="" "RTN","XUS",140,0) S %=$$INHIBIT^XUSRB() I %>0 Q % "RTN","XUS",141,0) S X=$G(^%ZIS(1,XUDEV,"XUS")),XU1=$G(^(1)) "RTN","XUS",142,0) I $L(X) F I=1:1:15 I $L($P(X,U,I)) S $P(XOPT,U,I)=$P(X,U,I) "RTN","XUS",143,0) S DTIME=600 "RTN","XUS",144,0) I '$P(XOPT,U,11),$D(^%ZIS(1,XUDEV,90)),^(90)>2800000,^(90)'>DT Q 8 "RTN","XUS",145,0) Q 0 "RTN","XUS",146,0) ; "RTN","XUS",147,0) UVALID() ;EF. Is it valid for this user to sign on? "RTN","XUS",148,0) I DUZ'>0 Q 4 "RTN","XUS",149,0) I $P(XUSER(1.1),U,5),$P(XUSER(1.1),U,5)>XUNOW S XUM(0)=$$FMTE^XLFDT($P(XUSER(1.1),U,5),"2PM") Q 18 ;User locked until "RTN","XUS",150,0) I $P(XUSER(0),U,11),$P(XUSER(0),U,11)'>DT Q 11 ;Access Terminated "RTN","XUS",151,0) I $D(DUZ("ASH")) Q 0 ;If auto handle, Allow to sign-on p434 "RTN","XUS",152,0) I $P(XUSER(0),U,7) Q 5 ;Disuser flag set "RTN","XUS",153,0) I '$L($P(XUSER(1),U,2)) Q 21 ;p419, p434 "RTN","XUS",154,0) Q 0 "RTN","XUS",155,0) ; "RTN","XUS",156,0) DEVPAS() ;EF. Ask device password "RTN","XUS",157,0) X XUEOFF W !,"DEVICE PASSWORD: " R X:60 X XUEON "RTN","XUS",158,0) S X=$E(X,1,30) S:'$T X="^" D LC Q:X["^" -1 I $P(XU1,U,2)'=X S:XUF %1="Device: "_X D:XUF FAC Q 6 "RTN","XUS",159,0) Q 0 "RTN","XUS",160,0) ; "RTN","ZIS4ONT") 0^1^B34039996^B31901858 "RTN","ZIS4ONT",1,0) %ZIS4 ;SFISC/RWF,AC - DEVICE HANDLER SPOOL SPECIFIC CODE (Cache) ;08/02/10 14:50 "RTN","ZIS4ONT",2,0) ;;8.0;KERNEL;**34,59,69,191,278,293,440,499,524,546,543,584**;Jul 10, 1995;Build 6 "RTN","ZIS4ONT",3,0) ;Per VHA Directive 2004-038, this routine should not be modified "RTN","ZIS4ONT",4,0) ; "RTN","ZIS4ONT",5,0) OPEN ;Called for TRM devices "RTN","ZIS4ONT",6,0) G OPN2:$D(IO(1,IO)) "RTN","ZIS4ONT",7,0) S POP=0 D OP1 G NOPEN:'$D(IO(1,IO)) "RTN","ZIS4ONT",8,0) OPN2 ; "RTN","ZIS4ONT",9,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",10,0) Q "RTN","ZIS4ONT",11,0) NOPEN ; "RTN","ZIS4ONT",12,0) I %ZIS'["D",$D(%ZISHP) S POP=1 Q "RTN","ZIS4ONT",13,0) I '$D(IOP) W $C(7)_" [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 "RTN","ZIS4ONT",14,0) S POP=1 Q "RTN","ZIS4ONT",15,0) Q "RTN","ZIS4ONT",16,0) OP1 N $ET S $ET="G OPNERR^%ZIS4" "RTN","ZIS4ONT",17,0) I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q "RTN","ZIS4ONT",18,0) O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1 "RTN","ZIS4ONT",19,0) Q "RTN","ZIS4ONT",20,0) OPNERR S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ZE,$EC="" "RTN","ZIS4ONT",21,0) Q "RTN","ZIS4ONT",22,0) ; "RTN","ZIS4ONT",23,0) O ;Gets called for all devices "RTN","ZIS4ONT",24,0) N X,%A1 "RTN","ZIS4ONT",25,0) D:%ZIS["L" ZIO "RTN","ZIS4ONT",26,0) I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer port "RTN","ZIS4ONT",27,0) OPAR I $D(IOP),%ZTYPE="HFS",$D(%ZIS("HFSIO")),$D(%ZIS("IOPAR")),%ZIS("HFSIO")]"" S IO=%ZIS("HFSIO"),%ZISOPAR=%ZIS("IOPAR") "RTN","ZIS4ONT",28,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",29,0) S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A "RTN","ZIS4ONT",30,0) D O1 I POP W:'$D(IOP) !,?5,$C(7)_"[Device is BUSY]" Q "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) G OXECUTE^%ZIS6 "RTN","ZIS4ONT",34,0) ; "RTN","ZIS4ONT",35,0) O1 N $ET S $ET="G OPNERR^%ZIS4" "RTN","ZIS4ONT",36,0) I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q "RTN","ZIS4ONT",37,0) O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)="" "RTN","ZIS4ONT",38,0) S IO("ERROR")="" "RTN","ZIS4ONT",39,0) Q "RTN","ZIS4ONT",40,0) ;Version 3 used ip/port, Version 4 has ip:port|xx "RTN","ZIS4ONT",41,0) ZIO I $D(IO("IP")),$D(IO("ZIO")) Q ;p499,p524 "RTN","ZIS4ONT",42,0) 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) S:$P(%,%1)["." IO("IP")=$P(%,%1) "RTN","ZIS4ONT",48,0) I $$OS^%ZOSV="VMS",$G(IO("IP"))="" S IO("IP")=$P($ZF("TRNLNM","SYS$REM_NODE"),":") ;For SSH, p499 "RTN","ZIS4ONT",49,0) I $$OS^%ZOSV="UNIX",$G(IO("IP"))="" S IO("IP")=$P($SYSTEM.Util.GetEnviron("SSH_CLIENT")," ") ;For SSH, p543 "RTN","ZIS4ONT",50,0) S:'$L(IO("ZIO")) IO("ZIO")=$G(IO("IP")) "RTN","ZIS4ONT",51,0) ;If have FQDN keep it in IO("CLNM") and get IP. "RTN","ZIS4ONT",52,0) ;I $L($G(IO("IP"))),IO("IP")'?1.3N1P1.3N1P1.3N1P1.3N S:'$D(IO("CLNM")) IO("CLNM")=IO("IP") S IO("IP")=$P($ZU(54,13,IO("IP")),",") ;p499,p546 "RTN","ZIS4ONT",53,0) I $L($G(IO("IP"))),IO("IP")'?1.3N1P1.3N1P1.3N1P1.3N S:'$D(IO("CLNM")) IO("CLNM")=IO("IP") S IO("IP")=$P(##class(%Library.Function).IPAddresses(IO("IP")),",") ;Cache2010 "RTN","ZIS4ONT",54,0) Q "RTN","ZIS4ONT",55,0) ; "RTN","ZIS4ONT",56,0) SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file Num/Name. "RTN","ZIS4ONT",57,0) N %ZOS S %ZOS=$$OS^%ZOSV "RTN","ZIS4ONT",58,0) I '$D(^XMB(3.51,0)) W:'$D(IOP) !?5,"The spooler files are not setup in this account." G NO "RTN","ZIS4ONT",59,0) I $D(ZISDA) W:'$D(IOP) !?5,$C(7)_"You may not Spool the printing of a Spool document" G NO "RTN","ZIS4ONT",60,0) I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G NO "RTN","ZIS4ONT",61,0) ;Get entry in Spool Doc file "RTN","ZIS4ONT",62,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",63,0) G:'%ZISB OK I '$P(%ZY,"^",3),%ZFN]"" D SPL3 G NO:%ZFN<0,DOC "RTN","ZIS4ONT",64,0) I %ZOS="NT" D G:%ZFN>255 NO "RTN","ZIS4ONT",65,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",66,0) . Q:%ZFN>255 D SPL2 S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" "RTN","ZIS4ONT",67,0) I %ZOS'="NT" D G:%ZFN=-1 NO ;For VMS & UNIT p546 "RTN","ZIS4ONT",68,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",69,0) DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA "RTN","ZIS4ONT",70,0) I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS "RTN","ZIS4ONT",71,0) OK K %ZDA,%ZFN Q "RTN","ZIS4ONT",72,0) NO K %ZDA,%ZFN,IO("DOC") S POP=1 Q "RTN","ZIS4ONT",73,0) ; "RTN","ZIS4ONT",74,0) SPL2 ;Open for output "RTN","ZIS4ONT",75,0) 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",76,0) ;VMS "RTN","ZIS4ONT",77,0) O %ZFN:("WNS"):2 G:'$T SPL4 S IO(1,%ZFN)="" Q "RTN","ZIS4ONT",78,0) ; "RTN","ZIS4ONT",79,0) SPL3 ;Open to read "RTN","ZIS4ONT",80,0) 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",81,0) ;VMS "RTN","ZIS4ONT",82,0) N $ETRAP S $ETRAP="S $EC="""" G SPL4^%ZIS4" "RTN","ZIS4ONT",83,0) O %ZFN:"R":1 S:'$T ZISPLQ=1 G:$ZA<0!('$T) SPL4 S IO(1,%ZFN)="" Q "RTN","ZIS4ONT",84,0) ; "RTN","ZIS4ONT",85,0) SPL4 W:'$D(IOP) !,"Spool file already open" S %ZFN=-1 Q "RTN","ZIS4ONT",86,0) ; "RTN","ZIS4ONT",87,0) CLOSE ;Handle Close and copy to Global "RTN","ZIS4ONT",88,0) N %,%ZOS,%Z1,%ZCR,%2,%3,%X,%Y,ZTSK,%ZFN S %ZOS=$$OS^%ZOSV "RTN","ZIS4ONT",89,0) I %ZOS="NT",IO=2,$D(IO(1,IO)) K IO(1,IO) C IO "RTN","ZIS4ONT",90,0) I %ZOS="VMS",$L(IO),$D(IO(1,IO)) U IO S %ZFN=$ZIO C IO K IO(1,IO) "RTN","ZIS4ONT",91,0) I %ZOS="UNIX",$L(IO),$D(IO(1,IO)) C IO K IO(1,IO) "RTN","ZIS4ONT",92,0) ;See that ZTSK is set so we will move to the global now. "RTN","ZIS4ONT",93,0) S ZTSK=$G(ZTSK,1) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q "RTN","ZIS4ONT",94,0) G:%ZOS'="NT" CLVMS ;p546 "RTN","ZIS4ONT",95,0) S %ZFN=$P(%ZS,"^",2),%ZCR=$C(13),%Y="",%=0,%3=$P(^SPOOL(%ZFN,2147483647),"{",3) "RTN","ZIS4ONT",96,0) S %Z1=+$G(^XTV(8989.3,1,"SPL")) "RTN","ZIS4ONT",97,0) F %2=1:1:%3 Q:'$D(^SPOOL(%ZFN,%2)) S %X=^SPOOL(%ZFN,%2) D "RTN","ZIS4ONT",98,0) . I %Z1<% D LIMIT S %2=%3 Q "RTN","ZIS4ONT",99,0) . I %X[$C(13,12) D:$L($P(%X,$C(13))) ADD($P(%X,$C(13))) D ADD("|TOP|") Q "RTN","ZIS4ONT",100,0) . D ADD($P(%X,$C(13),1)) "RTN","ZIS4ONT",101,0) K ^SPOOL(%ZFN),^SPOOL(0,$P(%ZS,U,1)),%Y,%X,%1,%2,%3 D CLOSE^ZISPL1 "RTN","ZIS4ONT",102,0) Q "RTN","ZIS4ONT",103,0) ADD(L) S %=%+1,^XMBS(3.519,XS,2,%,0)=L "RTN","ZIS4ONT",104,0) Q "RTN","ZIS4ONT",105,0) LIMIT D ADD("*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***") S $P(^XMB(3.51,%ZDA,0),"^",11)=1 "RTN","ZIS4ONT",106,0) Q "RTN","ZIS4ONT",107,0) CLVMS ;Close for Cache VMS & Linux "RTN","ZIS4ONT",108,0) N $ES,$ET S $ET="D:$EC'[""ENDOF"" ^%ZTER,UNWIND^%ZTER S $EC="""" D SPLEX^%ZIS4,UNWIND^%ZTER" "RTN","ZIS4ONT",109,0) ;Check Cache version, if 2008 use $ZU, else use system object "RTN","ZIS4ONT",110,0) I '$G(XUOSVER) N XUOSVER S XUOSVER=$$VERSION^%ZOSV "RTN","ZIS4ONT",111,0) S %ZA=$S(XUOSVER<2010:$ZU(68,40,1),1:##class(%SYSTEM.Process).SetZEOF(1)) ;Handle EOF like DSM "RTN","ZIS4ONT",112,0) ;%ZFN Could be set at the top "RTN","ZIS4ONT",113,0) S %ZFN=$S($G(%ZFN)]"":%ZFN,1:$P(%ZS,"^",2)) D SPL3 Q:%ZFN']"" U %ZFN S %ZCR=$C(13),%Y="" "RTN","ZIS4ONT",114,0) S %Z1=+$G(^XTV(8989.3,1,"SPL")),%=0 "RTN","ZIS4ONT",115,0) F R %X#255:5 Q:$ZEOF<0 D G:%Z1<% SPLEX "RTN","ZIS4ONT",116,0) . I %Z1<% D LIMIT Q "RTN","ZIS4ONT",117,0) . I %X[$C(12) D Q "RTN","ZIS4ONT",118,0) . . S %Y=$P(%X,$C(12)) D:$L(%Y) ADD(%Y),ADD("|TOP|") "RTN","ZIS4ONT",119,0) . . S %Y=$P(%X,$C(12),2) D:$L(%Y) ADD(%Y) "RTN","ZIS4ONT",120,0) . . Q "RTN","ZIS4ONT",121,0) . D ADD(%X) "RTN","ZIS4ONT",122,0) . Q "RTN","ZIS4ONT",123,0) SPLEX C %ZFN:"D" K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q "RTN","ZIS4ONT",124,0) ; "RTN","ZIS4ONT",125,0) ; "RTN","ZIS4ONT",126,0) HFS G HFS^%ZISF "RTN","ZIS4ONT",127,0) REWMT(IO2,IOPAR) ;Rewind Magtape "RTN","ZIS4ONT",128,0) N $ETRAP S $ET="G REWERR^%ZIS4" "RTN","ZIS4ONT",129,0) U IO2 W *5 "RTN","ZIS4ONT",130,0) Q 1 "RTN","ZIS4ONT",131,0) REWSDP(IO2,IOPAR) ;Rewind SDP "RTN","ZIS4ONT",132,0) G REW1 "RTN","ZIS4ONT",133,0) REWHFS(IO2,IOPAR) ;Rewind Host File. "RTN","ZIS4ONT",134,0) REW1 ;ZIS set % to the current $I so need to update % if = IO "RTN","ZIS4ONT",135,0) N NIO,OP,$ETRAP "RTN","ZIS4ONT",136,0) S $ET="G REWERR^%ZIS4" "RTN","ZIS4ONT",137,0) C IO2 ;You do a rewind to read the file. "RTN","ZIS4ONT",138,0) S OP=$S($ZV["VMS":"RV",1:"RS") "RTN","ZIS4ONT",139,0) O IO2:(OP):1 S IO(1,IO2)="" "RTN","ZIS4ONT",140,0) Q 1 "RTN","ZIS4ONT",141,0) REWERR ;Error encountered "RTN","ZIS4ONT",142,0) S IO("ERROR")=$EC,$ECODE="" "RTN","ZIS4ONT",143,0) Q 0 "RTN","ZISS1") 0^4^B15840610^B15833338 "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,584**;JUL 10, 1995;Build 6 "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'0 W !,"OS type not selected. Exiting ZTMGRSET." Q "RTN","ZTMGRSET",15,0) I ZTMODE D I (PCNM<1)!(PCNM>999) W !,"Need a Patch number to load." Q "RTN","ZTMGRSET",16,0) . I ZTMODE<2 R !!,"Patch number to load: ",PCNM:120 Q:(PCNM<1)!(PCNM>999) "RTN","ZTMGRSET",17,0) . S SCR="I $P($T(+2^@X),"";"",5)?.E1P1"_$C(34)_PCNM_$C(34)_"1P.E" "RTN","ZTMGRSET",18,0) ; "RTN","ZTMGRSET",19,0) K ^%ZOSF("MASTER"),^("SIGNOFF") ;Remove old nodes. "RTN","ZTMGRSET",20,0) ; "RTN","ZTMGRSET",21,0) DOIT D MES("I will now rename a group of routines specific to your operating system.",1) "RTN","ZTMGRSET",22,0) D @ZTOS,ALL,GLOBALS:'ZTMODE D MES("ALL DONE",1) "RTN","ZTMGRSET",23,0) Q "RTN","ZTMGRSET",24,0) ;======================================== "RTN","ZTMGRSET",25,0) RELOAD ;Reload any patched routines "RTN","ZTMGRSET",26,0) N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR "RTN","ZTMGRSET",27,0) S ZTMODE=1 G A "RTN","ZTMGRSET",28,0) Q "RTN","ZTMGRSET",29,0) ; "RTN","ZTMGRSET",30,0) PATCH(PCNM) ;Post install Reload any patched routines "RTN","ZTMGRSET",31,0) N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR "RTN","ZTMGRSET",32,0) I (1>PCNM)!(PCNM>999) D MES("PATCH NUMBER OUT OF RANGE",1) Q "RTN","ZTMGRSET",33,0) D MES("Rename the routines in Patch "_PCNM,1) "RTN","ZTMGRSET",34,0) S ZTMODE=2 G A "RTN","ZTMGRSET",35,0) Q "RTN","ZTMGRSET",36,0) ; "RTN","ZTMGRSET",37,0) MES(T,B) ;Write message. "RTN","ZTMGRSET",38,0) S B=$G(B) "RTN","ZTMGRSET",39,0) I $L($T(BMES^XPDUTL)) D BMES^XPDUTL(T):B,MES^XPDUTL(T):'B Q "RTN","ZTMGRSET",40,0) W:B ! W !,T "RTN","ZTMGRSET",41,0) Q "RTN","ZTMGRSET",42,0) ; "RTN","ZTMGRSET",43,0) OS() ;Select the OS "RTN","ZTMGRSET",44,0) N Y,X1,X,OSMAX "RTN","ZTMGRSET",45,0) S U="^",SCR="I 1" F I=1:1:20 S X=$T(@I) Q:X="" S OSMAX=I "RTN","ZTMGRSET",46,0) B S Y=0,ZTOS=0 I $D(^%ZOSF("OS")) D "RTN","ZTMGRSET",47,0) . S X1=$P(^%ZOSF("OS"),U),ZTOS=$$OSNUM W !,"I think you are using ",X1 "RTN","ZTMGRSET",48,0) I ZTMODE=2,ZTOS>0 Q ZTOS "RTN","ZTMGRSET",49,0) W !,"Which MUMPS system should I install?",! "RTN","ZTMGRSET",50,0) F I=1:1:OSMAX W !,I," = ",$P($T(@I),";",3) "RTN","ZTMGRSET",51,0) W !,"System: " W:ZTOS ZTOS,"//" "RTN","ZTMGRSET",52,0) R X:300 S:X="" X=ZTOS "RTN","ZTMGRSET",53,0) I $S(X<1!(X>OSMAX):1,1:$P($T(@X),";",3)="") W !,"NOT A VALID CHOICE" Q:X[U 0 G B "RTN","ZTMGRSET",54,0) Q X "RTN","ZTMGRSET",55,0) ; "RTN","ZTMGRSET",56,0) OSNUM() ;Return the OS number "RTN","ZTMGRSET",57,0) N I,X1,X2,Y S Y=0,X1=$P($G(^%ZOSF("OS")),"^") "RTN","ZTMGRSET",58,0) F I=1:1 S X2=$T(@I) Q:X2="" I X2[X1 S Y=I Q "RTN","ZTMGRSET",59,0) Q Y "RTN","ZTMGRSET",60,0) ; "RTN","ZTMGRSET",61,0) ALL W !!,"Now to load routines common to all systems." "RTN","ZTMGRSET",62,0) D TM,ETRAP,DEV,OTHER,FM "RTN","ZTMGRSET",63,0) I ZTOS=7!(ZTOS=8) D "RTN","ZTMGRSET",64,0) . S ^%ZE="D ^ZE" "RTN","ZTMGRSET",65,0) E D ;With ZLoad, ZSave, ZInsert "RTN","ZTMGRSET",66,0) . W !,"Installing ^%Z editor" "RTN","ZTMGRSET",67,0) . D ^ZTEDIT "RTN","ZTMGRSET",68,0) I 'ZTMODE W !,"Setting ^%ZIS('C')" K ^%ZIS("C") S ^%ZIS("C")="G ^%ZISC" "RTN","ZTMGRSET",69,0) Q "RTN","ZTMGRSET",70,0) ; "RTN","ZTMGRSET",71,0) TM ;Taskman "RTN","ZTMGRSET",72,0) S %S="ZTLOAD^ZTLOAD1^ZTLOAD2^ZTLOAD3^ZTLOAD4^ZTLOAD5^ZTLOAD6^ZTLOAD7" "RTN","ZTMGRSET",73,0) S %D="%ZTLOAD^%ZTLOAD1^%ZTLOAD2^%ZTLOAD3^%ZTLOAD4^%ZTLOAD5^%ZTLOAD6^%ZTLOAD7" "RTN","ZTMGRSET",74,0) D MOVE "RTN","ZTMGRSET",75,0) S %S="ZTM^ZTM0^ZTM1^ZTM2^ZTM3^ZTM4^ZTM5^ZTM6" "RTN","ZTMGRSET",76,0) S %D="%ZTM^%ZTM0^%ZTM1^%ZTM2^%ZTM3^%ZTM4^%ZTM5^%ZTM6" "RTN","ZTMGRSET",77,0) D MOVE "RTN","ZTMGRSET",78,0) S %S="ZTMS^ZTMS0^ZTMS1^ZTMS2^ZTMS3^ZTMS4^ZTMS5^ZTMS7^ZTMSH" "RTN","ZTMGRSET",79,0) S %D="%ZTMS^%ZTMS0^%ZTMS1^%ZTMS2^%ZTMS3^%ZTMS4^%ZTMS5^%ZTMS7^%ZTMSH" "RTN","ZTMGRSET",80,0) D MOVE "RTN","ZTMGRSET",81,0) Q "RTN","ZTMGRSET",82,0) FM ;Rename the FileMan routines "RTN","ZTMGRSET",83,0) I ZTMODE>0 Q ;Only ask on full install "RTN","ZTMGRSET",84,0) R !,"Want to rename the FileMan routines: No//",X:600 Q:"Yy"'[$E(X_"N") "RTN","ZTMGRSET",85,0) S %S="DIDT^DIDTC^DIRCR",%D="%DT^%DTC^%RCR" "RTN","ZTMGRSET",86,0) D MOVE "RTN","ZTMGRSET",87,0) Q "RTN","ZTMGRSET",88,0) ; "RTN","ZTMGRSET",89,0) ETRAP ;Error Trap "RTN","ZTMGRSET",90,0) S %S="ZTER^ZTER1",%D="%ZTER^%ZTER1" "RTN","ZTMGRSET",91,0) D MOVE "RTN","ZTMGRSET",92,0) Q "RTN","ZTMGRSET",93,0) OTHER S %S="ZTPP^ZTP1^ZTPTCH^ZTRDEL^ZTMOVE^ZTBKC" "RTN","ZTMGRSET",94,0) S %D="%ZTPP^%ZTP1^%ZTPTCH^%ZTRDEL^%ZTMOVE^%ZTBKC" "RTN","ZTMGRSET",95,0) D MOVE "RTN","ZTMGRSET",96,0) Q "RTN","ZTMGRSET",97,0) DEV S %S="ZIS^ZIS1^ZIS2^ZIS3^ZIS5^ZIS6^ZIS7^ZISC^ZISP^ZISS^ZISS1^ZISS2^ZISTCP^ZISUTL" "RTN","ZTMGRSET",98,0) S %D="%ZIS^%ZIS1^%ZIS2^%ZIS3^%ZIS5^%ZIS6^%ZIS7^%ZISC^%ZISP^%ZISS^%ZISS1^%ZISS2^%ZISTCP^%ZISUTL" "RTN","ZTMGRSET",99,0) D MOVE "RTN","ZTMGRSET",100,0) Q "RTN","ZTMGRSET",101,0) RUM ;Build the routines for Capacity Management (CM) "RTN","ZTMGRSET",102,0) S %S="" "RTN","ZTMGRSET",103,0) I ZTOS=1 S %S="ZOSVKRV^ZOSVKSVE^ZOSVKSVS^ZOSVKSD" ;DSM "RTN","ZTMGRSET",104,0) I ZTOS=2 S %S="ZOSVKRM^ZOSVKSME^ZOSVKSMS^ZOSVKSD" ;MSM "RTN","ZTMGRSET",105,0) I ZTOS=3 S %S="ZOSVKRO^ZOSVKSOE^ZOSVKSOS^ZOSVKSD" ;OpenM "RTN","ZTMGRSET",106,0) I ZTOS=7!(ZTOS=8) S %S="ZOSVKRG^ZOSVKSGE^ZOSVKSGS^ZOSVKSD" ;GT.M "RTN","ZTMGRSET",107,0) S %D="%ZOSVKR^%ZOSVKSE^%ZOSVKSS^%ZOSVKSD" "RTN","ZTMGRSET",108,0) D MOVE "RTN","ZTMGRSET",109,0) Q "RTN","ZTMGRSET",110,0) ZOSF(X) ; "RTN","ZTMGRSET",111,0) X SCR I $T W ! D @(U_X) W ! "RTN","ZTMGRSET",112,0) Q "RTN","ZTMGRSET",113,0) 1 ;;VAX DSM(V6), VAX DSM(V7) "RTN","ZTMGRSET",114,0) S %S="ZOSVVXD^ZTBKCVXD^ZIS4VXD^ZISFVXD^ZISHVXD^XUCIVXD" "RTN","ZTMGRSET",115,0) D DES,MOVE "RTN","ZTMGRSET",116,0) S %S="ZOSV2VXD^ZTMDCL",%D="%ZOSV2^%ZTMDCL" "RTN","ZTMGRSET",117,0) D MOVE,RUM,ZOSF("ZOSFVXD") "RTN","ZTMGRSET",118,0) Q "RTN","ZTMGRSET",119,0) 2 ;;MSM-PC/PLUS, MSM for NT or UNIX "RTN","ZTMGRSET",120,0) W !,"- Use autostart to do ZTMB don't resave as STUSER." "RTN","ZTMGRSET",121,0) S %S="ZOSVMSM^ZTBKCMSM^ZIS4MSM^ZISFMSM^ZISHMSM^XUCIMSM" "RTN","ZTMGRSET",122,0) D DES,MOVE "RTN","ZTMGRSET",123,0) S %S="ZOSV2MSM",%D="%ZOSV2" "RTN","ZTMGRSET",124,0) D MOVE,RUM,ZOSF("ZOSFMSM") "RTN","ZTMGRSET",125,0) I $$VERSION^%ZOSV(1)["UNIX" S %S="ZISHMSU",%D="%ZISH" D MOVE "RTN","ZTMGRSET",126,0) Q "RTN","ZTMGRSET",127,0) 3 ;;Cache (VMS, NT, Linux), OpenM-NT "RTN","ZTMGRSET",128,0) S %S="ZOSVONT^ZTBKCONT^ZIS4ONT^ZISFONT^ZISHONT^XUCIONT" "RTN","ZTMGRSET",129,0) D DES,MOVE "RTN","ZTMGRSET",130,0) S %S="ZISTCPS^ZTMDCL",%D="%ZISTCPS^%ZTMDCL" "RTN","ZTMGRSET",131,0) D MOVE,RUM,ZOSF("ZOSFONT") "RTN","ZTMGRSET",132,0) Q "RTN","ZTMGRSET",133,0) 4 ;; "RTN","ZTMGRSET",134,0) 5 ;; "RTN","ZTMGRSET",135,0) 6 ;; "RTN","ZTMGRSET",136,0) 7 ;;GT.M (VMS) "RTN","ZTMGRSET",137,0) S %ZE=".M" D init^%RSEL "RTN","ZTMGRSET",138,0) S %S="ZOSVGTM^^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM" "RTN","ZTMGRSET",139,0) D DES,MOVE "RTN","ZTMGRSET",140,0) S %S="ZOSV2GTM^ZISTCPS^ZTMDCL",%D="%ZOSV2^%ZISTCPS^ZTMDCL" "RTN","ZTMGRSET",141,0) D MOVE,ZOSF("ZOSFGTM") "RTN","ZTMGRSET",142,0) Q "RTN","ZTMGRSET",143,0) 8 ;;GT.M (Unix) "RTN","ZTMGRSET",144,0) S %ZE=".m" D init^%RSEL "RTN","ZTMGRSET",145,0) S %S="ZOSVGUX^^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM" "RTN","ZTMGRSET",146,0) D DES,MOVE "RTN","ZTMGRSET",147,0) S %S="ZOSV2GTM^ZISTCPS",%D="%ZOSV2^%ZISTCPS" "RTN","ZTMGRSET",148,0) D MOVE,ZOSF("ZOSFGUX") "RTN","ZTMGRSET",149,0) Q "RTN","ZTMGRSET",150,0) 10 ;;NOT SUPPORTED "RTN","ZTMGRSET",151,0) Q "RTN","ZTMGRSET",152,0) MOVE ; rename % routines "RTN","ZTMGRSET",153,0) N %,X,Y,M "RTN","ZTMGRSET",154,0) F %=1:1:$L(%D,"^") D D MES(M) "RTN","ZTMGRSET",155,0) . S M="",X=$P(%S,U,%) ; from "RTN","ZTMGRSET",156,0) . S Y=$P(%D,U,%) ; to "RTN","ZTMGRSET",157,0) . Q:X="" "RTN","ZTMGRSET",158,0) . S M="Routine: "_$J(X,8) "RTN","ZTMGRSET",159,0) . Q:Y="" I $T(^@X)="" S M=M_" Missing" Q "RTN","ZTMGRSET",160,0) . X SCR Q:'$T "RTN","ZTMGRSET",161,0) . S M=M_" Loaded, " "RTN","ZTMGRSET",162,0) . D COPY(X,Y) "RTN","ZTMGRSET",163,0) . S M=M_"Saved as "_$J(Y,8) "RTN","ZTMGRSET",164,0) Q "RTN","ZTMGRSET",165,0) ; "RTN","ZTMGRSET",166,0) COPY(FROM,TO) ; "RTN","ZTMGRSET",167,0) I ZTOS'=7,ZTOS'=8 X "ZL @FROM ZS @TO" Q "RTN","ZTMGRSET",168,0) ;For GT.M below "RTN","ZTMGRSET",169,0) N PATH,COPY,CMD S PATH=$$R "RTN","ZTMGRSET",170,0) S FROM=PATH_FROM_".m" "RTN","ZTMGRSET",171,0) S TO=PATH_$TR(TO,"%","_")_".m" "RTN","ZTMGRSET",172,0) S COPY=$S(ZTOS=7:"COPY",1:"cp") "RTN","ZTMGRSET",173,0) S CMD=COPY_" "_FROM_" "_TO "RTN","ZTMGRSET",174,0) X "ZSYSTEM CMD" "RTN","ZTMGRSET",175,0) Q "RTN","ZTMGRSET",176,0) ; "RTN","ZTMGRSET",177,0) R() ; routine directory for GT.M "RTN","ZTMGRSET",178,0) N ZRO X "S ZRO=$ZRO" "RTN","ZTMGRSET",179,0) I ZTOS=7 D Q $S(ZRO["(":$P($P(ZRO,"(",2),")"),1:ZRO) "RTN","ZTMGRSET",180,0) . S ZRO=$P(ZRO,",") "RTN","ZTMGRSET",181,0) . I ZRO["/SRC=" S ZRO=$P(ZRO,"=",2) Q ;Source dir "RTN","ZTMGRSET",182,0) . S ZRO=$S(ZRO["/":$P(ZRO,"/"),1:ZRO) Q ;Source and Obj in same dir "RTN","ZTMGRSET",183,0) I ZTOS=8 Q $P($S(ZRO["(":$P($P(ZRO,"(",2),")"),1:ZRO)," ")_"/" ;Use first source dir. "RTN","ZTMGRSET",184,0) E Q "" "RTN","ZTMGRSET",185,0) ; "RTN","ZTMGRSET",186,0) DES S %D="%ZOSV^%ZTBKC1^%ZIS4^%ZISF^%ZISH^%XUCI" Q "RTN","ZTMGRSET",187,0) ; "RTN","ZTMGRSET",188,0) GLOBALS ;Set node zero of file #3.05 & #3.07 "RTN","ZTMGRSET",189,0) W !!,"Now, I will check your % globals." "RTN","ZTMGRSET",190,0) W ".........." "RTN","ZTMGRSET",191,0) F %="^%ZIS","^%ZISL","^%ZTER","^%ZUA" S:'$D(@%) @%="" "RTN","ZTMGRSET",192,0) S:$D(^%ZTSK(0))[0 ^%ZTSK(-1)=100,^%ZTSCH="" "RTN","ZTMGRSET",193,0) S Z1=$G(^%ZTSK(-1),-1),Z2=$G(^%ZTSK(0)) "RTN","ZTMGRSET",194,0) I Z1'=$P(Z2,"^",3) S:Z1'>0 ^%ZTSK(-1)=+Z2 S ^%ZTSK(0)="TASKS^14.4^"_^%ZTSK(-1) "RTN","ZTMGRSET",195,0) S:$D(^%ZUA(3.05,0))[0 ^%ZUA(3.05,0)="FAILED ACCESS ATTEMPTS LOG^3.05^^" "RTN","ZTMGRSET",196,0) S:$D(^%ZUA(3.07,0))[0 ^%ZUA(3.07,0)="PROGRAMMER MODE LOG^3.07^^" "RTN","ZTMGRSET",197,0) Q "RTN","ZTMGRSET",198,0) NAME ;Setup the static names for this system "RTN","ZTMGRSET",199,0) MGR W !,"NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G MGR:0[Y S ^%ZOSF("MGR")=X "RTN","ZTMGRSET",200,0) PROD W !,"PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G PROD:0[Y S ^%ZOSF("PROD")=X "RTN","ZTMGRSET",201,0) VOL W !,"NAME OF VOLUME SET: "_^%ZOSF("VOL")_"//" R X:$S($G(DTIME):DTIME,1:9999) I X]"" S:X?3U ^%ZOSF("VOL")=X I X'?3U W "MUST BE 3 Upper case." G VOL "RTN","ZTMGRSET",202,0) W ! Q "VER") 8.0^22.0 "BLD",1380,6) ^484 **END** **END**