1:49 PM 02-APR-2003 PATCH XU*8.0*1007 FOR MGR UCI XUCIDTM %XUCI ;SF/STAFF - SWAP UCIs DSM-11 ;2/3/93 16:37 ; [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;Jul 10, 1995 ; *** For DataTree *** 1 R !,"What Namespace: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^") G 2 ; 2 ; I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y X ^%ZOSF("PROGMODE") I Y W:'$D(XUSLNT) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q V D SWAP U I '$D(XUSLNT) W *7,!,"You're now in namespace: ",Y,! S $ZT="^%errlog",%ST=$D(^%ZOSF("OS")),^XUTL("XQ",$J,0)=DT,^("DUZ")=DUZ K K %ST,%UCI Q ; SWAP S X=$P(X,",") I $P($ZVER,"/",2)<4 X ^%ZOSF("PROGMODE") ZNSPACE:'Y X I 1 E X ^%ZOSF("PROGMODE") D:'Y ns^%m(X,1) Q ; GO ; D 2 Q:0[Y S X=PGM I PGM'?1"%".E X ^%ZOSF("TEST") I '$T W !?9,"'"_X_"' DOES NOT EXIST IN "_%UCI,! HALT K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM) ; DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1) I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2^%XUCI,RES Q D N Y,%XUCI D 2 Q:0[Y G @PGM Q SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^" Q RES F %=1:1:9 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%) Q ; ERR W !?9,"'"_X_"' IS AN INVALID NAMESPACE!",! XUCIMSM %XUCI ;SF/STAFF - SWAP UCIS FOR MSM-UNIX ;11/20/92 07:30 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;Jul 10, 1995 ;IHS/MFD 2+3 gets commented out,SWAP+2 has prog mode check removed 1 R !,"What UCI: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^") G 2 ; 2 ; I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y ;I $S($P($ZV,"Version ",2)'<2:$V(0,$J,2)#2,1:$V(2,$J)#2) W:'($D(XUSLNT)!$D(ZTQUEUED)) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q V D SWAP U I '($D(XUSLNT)!$D(ZTQUEUED)) W *7,!,"YOU'RE IN UCI: ",Y,! S $ZT="^%ZTER",%=$D(^%ZOSF("OS")) K K %,%UCI S Y=1 Q ; SWAP ;I $P($ZV,"Version ",2)'<2 S %ST=$S(X[",":$ZU($P(X,","),$P(X,",",2)),1:$ZU(X)) I $P($ZV,"Version ",2),%ST["," S %ST=$P(%ST,",",2)*32+$P(%ST,",") V 2:$J:%ST:2 Q ;IHS/MFD removed check for programmer mode V:'($V(0,$J,2)#2) F %ST=1:1:64 Q:$ZU(%ST)=X V:'($V(2,$J)#2) 2:$J:%ST-1:2 Q ; ENT G 2:$D(%UCI)#2,1 ; GO ; D 2 Q:0[Y S X=PGM I PGM'?1"%".E X ^%ZOSF("TEST") I '$T W !?9,"'"_X_"' DOES NOT EXIST IN "_%UCI,! HALT K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM) ; DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1) I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2^%XUCI,RES Q D N Y,%XUCI D 2 Q:0[Y G @PGM Q SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOF","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^" Q RES F %=1:1:10 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOF^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%) Q ; ERR W !?9,"'"_X_"' IS AN INVALID UCI!",! XUCIMSQ %XUCI ;SF/STAFF - SWAP UCIs M/SQL ;2/19/91 08:48 ; [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;Jul 10, 1995 ;FOR M/SQL 1 R !,"What UCI: ",%UCI:$S($D(DTIME):DTIME,1:60)," " Q:%UCI=""!(%UCI["^") G 2 ; 2 ; I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y I $ZJ#2 W:'($D(XUSLNT)!$D(ZTQUEUED)) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q V D SWAP U I '($D(XUSLNT)!$D(ZTQUEUED)) W *7,!,"YOU'RE IN UCI: ",Y,! S $ZT="^%ZTER",%=$D(^%ZOSF("OS")) K K %,%UCI S Y=1 Q ; SWAP D ^%ST I $ZJ#2=0 ZU 5:X Q ; GO ; D 2 Q:0[Y S X=PGM I PGM'?1"%".E X ^%ZOSF("TEST") I '$T W !?9,"'"_X_"' DOES NOT EXIST IN "_%UCI,! HALT K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM) ; DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1) I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2^%XUCI,RES Q D N Y,%XUCI D 2 G:0'[Y @PGM Q SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOF","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^" Q RES F %=1:1:10 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOF^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%) Q ; ERR W !?9,"'"_X_"' IS AN INVALID UCI!",! XUCIONT %XUCI ;SF/STAFF - SWAP UCIs DTM and Open M-NT ;04/24/97 11:47 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1007**;APR 1, 2003 ;;8.0;KERNEL;**34**;Jul 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY TASSC/MFD ; TASSC/MFD commented out 2+3, removed prog check at SWAP+2 ; *** For Intersystem Open M for NT*** 1 R !,"What Namespace: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^") G 2 ; 2 ; I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THE LINE BELOW IS COMMENTED OUT BY TASSC/MFD ;X ^%ZOSF("PROGMODE") I Y W:'$D(XUSLNT) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q ;----- END IHS MODIFICATION V D SWAP U I '$D(XUSLNT) W *7,!,"You're now in namespace: ",Y,! S $ZT="^%errlog",%ST=$D(^%ZOSF("OS")),^XUTL("XQ",$J,0)=DT,^("DUZ")=DUZ K K %ST,%UCI S Y=1 Q ; SWAP ;Do it I X["," S X=$P(X,",") ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THE LINE BELOW IS COMMENTED OUT AND REPLACED BY NEXT LINE BY TASSC/MFD ;N %ST X ^%ZOSF("PROGMODE") S:'Y %ST=$ZU(5,X) N %ST S %ST=$ZU(5,X) ;----- END IHS MODIFICATION Q ; GO ; D 2 Q:0[Y S X=PGM I PGM'?1"%".E X ^%ZOSF("TEST") I '$T W !?9,"'"_X_"' DOES NOT EXIST IN "_%UCI,! HALT K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM) ; DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1) I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2^%XUCI,RES Q D N Y,%XUCI D 2 Q:0[Y G @PGM Q SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^" Q RES F %=1:1:9 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%) Q ; ERR W !?9,"'"_X_"' IS AN INVALID NAMESPACE!",! XUCIVXD %XUCI ;SFISC/STAFF - SWAP UCIs VAX/DSM ;1/23/96 09:28 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**13**;Jul 10, 1995 ;FOR VAX-DSM 1 R !,"What UCI: ",%UCI:$S($D(DTIME):DTIME,1:10)," " Q:%UCI=""!(%UCI["^") G 2 ; 2 ; I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y X ^%ZOSF("PROGMODE") I Y W:'($D(XUSLNT)!$D(ZTQUEUED)) !,*7,"NO SWITCHING UCI'S IN PROGRAMMER MODE!",! S Y=0 Q V D SWAP U I '($D(XUSLNT)!$D(ZTQUEUED)) W *7,!,"YOU'RE IN UCI: ",$ZU(0),! S $ZT="^%ZTER",%=$D(^%ZOSF("OS")) K K %,%UCI S Y=1 Q ; SWAP ; X ^%ZOSF("PROGMODE") I 'Y S X=$S(X[",":$ZC(%SETUCI,$P(X,","),$P(X,",",2)),1:$ZC(%SETUCI,$P(X,","))),X=$ZC(%PGMSET),X=$ZC(%SECMAP) Q ; ENT G 2:$D(%UCI)#2,1 ; GO ; D 2 Q:0[Y S X=PGM I PGM'?1"%".E X ^%ZOSF("TEST") I '$T W !?9,"'"_X_"' DOES NOT EXIST IN "_%UCI,! HALT S X=$&ZLIB.%SETSYM("DHCP$UCI_CHANGE",1) K ^XUTL("XQ",$J),^UTILITY($J) G @(U_PGM) ; DO S %UCI=$P(XQZ,"[",2,9),PGM=$P(XQZ,"[",1),%UCI=$E(%UCI,1,$L(%UCI)-1) I %UCI="PROD"!(%UCI="MGR") S %UCI=^%ZOSF(%UCI) E S X=%UCI X ^%ZOSF("UCICHECK") G ERR:0[Y X ^%ZOSF("UCI") D SAV,D S %UCI=Y D 2,RES Q D N Y,%XUCI D 2 Q:0[Y G @PGM Q SAV S %XUCI="" F %="DUZ","DUZ(0)","DT","DTIME","IO","IO(0)","IOF","IOM","IOST","IOST(0)" S %XUCI=%XUCI_$S($D(@%)#2:@%,1:"")_"^" Q RES F %=1:1:10 S @($P("DUZ^DUZ(0)^DT^DTIME^IO^IO(0)^IOF^IOM^IOST^IOST(0)","^",%))=$P(%XUCI,"^",%) Q ; ERR W !?9,"'"_X_"' IS AN INVALID UCI!",! ZIS %ZIS ;SFISC/AC,RWF -- DEVICE HANDLER ;05/16/2001 17:36 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**18,23,69,112,199**;JUL 10, 1995 N %ZISOS,%ZISV S %ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^%ZOSF("VOL")) ;Check SPOOLER special case first 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 ; I '$D(%ZIS),$D(%IS) M %ZIS=%IS S:$D(%ZIS)[0 %ZIS="M" M %IS=%ZIS ;update %IS for now ; I $D(ZTQUEUED) D I '$D(IOP) S POP=1 G EXIT^%ZIS1 .I $D(ZTIO)#2,ZTIO="" S:%IS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" I '$D(ZTQUEUED),%IS["T",$P($G(IOP),";")="Q" S POP=1 G EXIT^%ZIS1 N %,%A,%E,%H,%I,%X,%Y,%Z,%Z1,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE,%ZISOLD,DTOUT,DUOUT ;Save symbols to restore if don't open a device D SYMBOL^%ZISUTL(0,$NA(%ZISOLD)) K IO("CLOSE"),IO("HFSIO"),IO("T") A K IO("P"),IO("Q"),IO("S"),IO("DOC"),IO("HFSIO") K2 D K2^%ZIS1 S %ZISB=%ZIS'["N",(%E,%H,POP)=0,%Y="" S:'$D(IO(0)) IO(0)=$I I %ZISOS["VAX DSM",$I["SYS$INPUT:.;" S:%ZIS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" ;I %IS["T"&(%IS["0") S (%H,%E)=0 G ^%ZIS1 I $D(IOP),IOP=$I!(IOP="HOME")!(0[IOP),$D(^XUTL("XQ",$J,"IO")) D HOME K %IS,%Y,%ZIS,%ZISB,%ZISV,IOP Q ;Don't worry about HOME if %ZIS[0 D:%ZIS'[0 GETHOME G EXIT^%ZIS1:POP,^%ZIS1 ;Jump to next part ; GETHOME I $D(IO("HOME")),$P(IO("HOME"),"^",2)=IO(0) S (%E,%H)=+IO("HOME") Q I $D(^XUTL("XQ",$J,"IOS")),$D(^("IO")),IO(0)=^("IO") S (%E,%H)=^("IOS") Q ;CALL LINEPORT CODE HERE--- S %=$$LINEPORT^%ZISUTL I % S (%E,%H)=% Q S %ZISVT=$I D VTLKUP I '%E S %ZISVT=$I D VIRTUAL I %ZISVT=""!(%E'>0) I %IS'[0 O IO(0)::0 I $T U IO(0) W !,"HOME DEVICE DOES NOT EXIST IN THE DEVICE FILE",!,"PLEASE CONTACT YOUR SYSTEM MANAGER!",*7 S %H=%E S:'%H&(%IS'[0) POP=1 S:(%H>0)&('$D(IO("HOME"))) IO("HOME")=%H_"^"_$I Q VIRTUAL ;See if a Virtual Terminal (LAT, TELNET) ;Change the MSM check for telnet to work with v4.4 I %ZISOS["MSM" X "I $P($ZV,""Version "",2)'<3 S %ZISVT=$ZDE(+%ZISVT) I %ZISVT?.E1""~""4.5N.E S %ZISVT=""TELNET""" F %ZISI=$L(%ZISVT):-1 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) Q:%ZISVT="" .D VTLKUP Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1: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 Q 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 Q ; CURRENT N POP,%ZIS,%IS,%E,%H S FF="#",SL=24,BS="*8",RM=80,(SUB,XY)="",%IS=0,%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")),POP=0 D GETHOME K %E,%IS,%ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX Q:POP I $D(^%ZIS(1,%H,"SUBTYPE")) S SUB=+^("SUBTYPE") K %H 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) E S SUB="" I $D(^%ZOSF("RM")) N X S X=RM X ^("RM") K %A Q HOME ;Entry point to establish IO* variables for home device. N X I '$D(^XUTL("XQ",$J,"IO")) S IOP="HOME" D ^%ZIS Q D RESETVAR I '$D(IO("C")),$D(IOM),IO=$I,$D(IO(1,IO)),$D(^%ZOSF("RM")) S X=+IOM X ^("RM") Q Q RESETVAR ;Reset home IO* variables. I '$D(^XUTL("XQ",$J,"IO")) Q N % F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%) S POP=0,IO(0)=IO,(IOPAR,IOUPAR)="" Q SAVEVAR ;Save home IO* variables, called from XUS1 N % F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY" I $D(@%) S ^XUTL("XQ",$J,%)=@% Q ZISLPC Q ;No longer called in Kernel v8. ; HLP1 G EN1^%ZIS7 HLP2 N %E,%H,%X,%ZISV,X S %ZISV=$S($D(^%ZOSF("VOL")):^("VOL"),1:"") G EN2^%ZIS7 ; REWIND(IO2,IOT,IOPAR) ;Rewind Device N %,X,Y,ZISGR S ZISGR=$$LGR^%ZOSV,X="REWERR^%ZIS",@^%ZOSF("TRAP") S %=$I I ZISGR]"",$D(@ZISGR) ;Restore last globa reference I '($D(IO2)#2)!'$D(IOT)!'$D(IOPAR) Q 0 I "MT^SDP^HFS"'[IOT Q 0 S @("Y=$$REW"_IOT_"^%ZIS4(IO,IOPAR)") I ZISGR]"",$D(@ZISGR) ;Restore last global reference U % Q Y REWERR ;Error encountered I ZISGR]"",$D(@ZISGR) ;Restore last globa reference Q 0 ; ZIS1 %ZIS1 ;SFISC/AC,RWF -- DEVICE HANDLER (DEVICE INPUT) ;05/14/2001 15:35 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**18,49,69,104,112,199**;JUL 10, 1995 MAIN ;Called from %ZIS with a GO I '$D(IOP),$D(^%ZIS(1,%E,0)),'$P(^(0),"^",3) S %A=%H,%Z=^(0) D L2^%ZIS2 G EXIT L1 ;Main Loop 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 S %E=%H,POP=0,%IS=%ZIS ;Reset %IS from %ZIS I %IS'["Q",$D(XQNOGO) S POP=1 W:'$D(IOP) !,*7,"OUTPUT IS NEVER ALLOWED FOR THIS OPTION" G EXIT D IOP:$D(IOP),R:'$D(IOP) G EXIT:$D(DTOUT)!$D(DUOUT)!(POP&$D(IOP)),L1:POP&'$D(IOP) D LKUP I %A'>0 S POP=1 D:'$D(DUOUT) MSG1 K DUOUT I POP G EXIT:$D(IOP),L1:'$D(IOP) I '$D(^%ZIS(1,%A,0)) D MSG1 K %ZISIOS S POP=1 I POP G EXIT:$D(IOP),L1:'$D(IOP) S %E=%A,%Z=^%ZIS(1,%A,0),%Z1=$G(^(1)) I $D(%ZIS("S")) N Y S Y=%E D XS^ZISX S:'$T POP=1 G G:POP W:'$D(IOP)&($P(%Z,"^",2)'=$I)&($P(%Z1,"^")]"") " ",$P(%Z1,"^") D L2^%ZIS2 G G L1:POP&'$D(IOP)&'($D(DTOUT)!$D(DUOUT)) ;Didn't get it ;For type[TRM reset $X & $Y I 'POP,%ZTYPE["TRM",IO]"",$D(IO(1,IO)) U IO S:'(IO=IO(0)&'$D(IO("S"))&'$D(ZTQUEUED)) $X=0,$Y=0 ; EXIT I $D(IO)#2,IO]"",$D(IO(1,IO))#2,$D(%Z1),$P(%Z1,"^",11) S IO(1,IO,"NOFF")=1 I 'POP,%ZIS["H" S IO(0)=IO,IO("HOME")=%ZISIOS_"^"_IO ;Make home device I %IS'[0,$G(IO(0))]"" U IO(0) ;Make sure return with home active G SETVAR:'POP!(%IS["T"),KILVAR ; IOP ;Request with IOP set S (%ZISVT,%X)=IOP S:%X'?1.UNP %X=$$UP(%X) I %X'="Q" D SETQ Q S %IS=%IS_%X K IOP W %X D SETQ Q ;Get ready to ask user for device R I %IS["Q",$D(XQNOGO) W !,*7,"AT THIS TIME, OUTPUT MUST BE QUEUED" S %A=$S($D(%IS("B")):%IS("B"),1:"HOME") ;Setup default I %IS["P",%A="HOME",$D(^%ZIS(1,%E,99)),$D(^%ZIS(1,+^(99),0)) S %A=$P(^(0),"^",1) RD W !,$S($D(%IS("A")):%IS("A"),1:"DEVICE: ") W:%A]"" %A,"// " D SBR S:%X="" %X=%A S %ZISVT=%X I %X?2"?".E D EN2^%ZIS7 G R I %X?1"?".E D EN1^%ZIS7 G R I $D(DTOUT)!$D(DUOUT)!(%X'?.ANP)!($L($P(%X,";"))>31) S:%IS["T" IO="" S POP=1 Q S:%X'?1.UNP %X=$$UP(%X) D SETQ G R:$T Q SETQ S %Y=$P(%X,";",2,9),%X=$P(%X,";",1) S:$L(";"_%Y,";/")=2 IO("P")=$P(";"_%Y,";/",2) 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) I $T,'$D(IOP) W "UEUE TO PRINT ON" Q ; Return $T value Q LKUP S %ZISMY=$P(%ZISVT,";",2,999),%ZISVT=$P(%ZISVT,";") I %X="H" W:'$D(IOP) "ome" S %X=0 I 0[%X!(%X="HOME")!(%X=$I) S %A=%H Q I $E(%ZISVT)="`",$D(IOP) S %A=+$E(%ZISVT,2,999) I $G(^%ZIS(1,%A,0))]"" Q S %A=0 I "P"[%X Q:$D(IOP)&('$D(^%ZIS(1,%E,99))) I $D(^%ZIS(1,%E,99)) S %A=+^(99) Q I %X=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS(1,")) S %A=^("^%ZIS(1,") Q S %A=+$O(^%ZIS(1,"B",%ZISVT,0)) Q:%A>0 ;mixed case lookup I %X'=%ZISVT S %A=+$O(^%ZIS(1,"B",%X,0)) Q:%A>0 ;uppercase lookup D VTLKUP^%ZIS S %A=%E Q:%A>0 ;mixed case lookup I %X'=%ZISVT S %ZISVT=%X D VTLKUP^%ZIS S %A=%E Q:%A>0 ;uppercase lookup N %XX,%YY S %XX=%X D 1^%ZIS5 S %A=+%YY Q SBR K DFOUT,DTOUT,DUOUT R %X:$S($D(DTIME)#2:DTIME,1:300) E W *7 S DTOUT=1 Q S:%X="."!(%X="^") DUOUT=1,%X="" Q LC S %X=$$UP(%X) Q LOW(%) Q $TR(%,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") UP(%) Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") YN W "? ",$P("YES// ^NO// ",U,%) RYN R %X:$S($D(DTIME):DTIME,$D(%ZISDTIM):%ZISDTIM,1:300) E S DTOUT=1,%X=U W *7 S:%X]""!'% %=$A(%X),%=$S(%=89:1,%=121:1,%=78:2,%=110:2,%=94:-1,1:0) I '%,%X'?."?" W *7,"??",!?4,"ANSWER 'YES' OR 'NO': " G RYN W:$X>73 ! W $P(" (YES)^ (NO)",U,%) Q MSG1 I '$D(IOP) W ?20,*7," [DEVICE DOES NOT EXIST]" Q SETVAR ;Come here to setup the variables for the selected device S:$D(IO)[0 IO="" G KILVAR:%IS["T"&(IO="") I $G(%Z)="" S ION="Unknown device",POP=1 G KILVAR S:IO'=IO(0)&($D(DUZ)#2) ^DISV(+DUZ,"^%ZIS(1,")=%E S ION=$P(%Z,"^",1),IOM=+%Z91,IOF=$P(%Z91,"^",2),IOSL=$P(%Z91,"^",3),IOBS=$P(%Z91,"^",4),IOXY=$P(%Z91,"^",5) S IOT=%ZTYPE,IOST(0)=%ZISIOST(0),IOST=%ZISIOST,IOPAR=%ZISOPAR,IOUPAR=%ZISUPAR,IOHG=%ZISHG S:IOF="" IOF="#" ;See that IOF has something K IOCPU S:$D(%ZISCPU) IOCPU=%ZISCPU G KIL ; KILVAR ;Come here to restore the calling variables D SYMBOL^%ZISUTL(1,"%ZISOLD") S:'$L($G(IOF)) IOF="#" S:'$D(IOST(0)) IOST(0)=0 ;See that all standard variables are defined F %I="IO","ION","IOM","IOBS","IOSL","IOST" S:$D(@%I)[0 @%I="" K IO("HFSIO"),IO("OPEN") I $D(%ZISCPU) S:'$D(IOCPU) IOCPU=%ZISCPU KIL ;Final exit cleanup S:'POP IOS=%ZISIOS I POP K:%IS'["T" %ZISIOS I %IS["T" K IOS S:$D(%ZISIOS) IOS=%ZISIOS S:%IS["T" IO("T")=1 K %ZIS,%IS,%A,%E,%H,%ZISOS,%ZISV,IOP K2 K %I,%X,%Y,%Z,%Z1,%Z91,%Z95,%ZTYPE,%ZTIME K %ZISCHK,%ZISCPU,%ZISI,%ZISR,%ZISVT,%ZISB,%ZISX,ZISI,%ZISHGL,%ZISHP,%ZISIO,%ZISIOS,%ZISIOM,%ZISIOF,%ZISIOSL,%ZISIOBS,%ZISIOST,%ZISIOST(0),%ZISTO,%ZISTP,%ZISHG,%ZISSIO,%ZISOPEN,%ZISOPAR,%ZISUPAR K %ZISMY,%ZISQUIT Q ZIS2 %ZIS2 ;SFISC/AC,RWF -- DEVICE HANDLER (CHECKS) ;03/17/2000 08:58 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**69,104,112,118,136**;JUL 10, 1995 HUNT S:'$D(%ZISHP) %ZISHP=%E,%E=0,%ZISHGL=0 F S %ZISHGL=$O(^%ZIS(1,%ZISHG(0),"HG",%ZISHGL)) Q:%ZISHGL'>0 I $D(^(+%ZISHGL,0))#2,$D(^%ZIS(1,+$P(^(0),"^"),0))#2,$P(^(0),"^",9)=%ZISV!($P(^(0),"^",9)="") S %E=+$P(^%ZIS(1,%ZISHG(0),"HG",+%ZISHGL,0),"^") Q G L2:%ZISHGL>0 S %ZISHPOP=1,%E=%ZISHP L2 ;Entry point from %ZIS1 I $D(DTOUT)!$D(DUOUT) K %ZISHP,%ZISHPOP Q CHECK K %ZISCPU S POP=0,%Z=^%ZIS(1,%E,0),IO=$P(%Z,"^",2) S:%IS["Q"&'$D(ZTQUEUED)&($P(%Z,"^",12)=1!$D(XQNOGO)) %ZISB=0,IO("Q")=1 ;Forced Queueing I $P(%Z,"^",12)=2 S %IS=$TR(%IS,"Q") I $D(IO("Q")) D Q . I '$D(IOP) W !,"Queuing NOT ALLOWED on this device" . S POP=1 K:$D(IOP) IO("Q") Q S %Z90=$G(^(90)),%Z95=$G(^(95)),%ZTIME=$G(^("TIME")),%ZTYPE=$G(^("TYPE")),%ZISHG=$O(^%ZIS(1,"AHG",%E,0)) I %ZISHG,$D(^%ZIS(1,+%ZISHG,0)) S:'$D(%ZISHG(0)) %ZISHG(0)=+%ZISHG S %ZISHG=$P(^(0),"^",1) E S %ZISHG="" I %ZTYPE="HG" D OTHCPU("HUNT GROUP") G T:$D(%ZISHG(0))!POP I %ZTYPE="RES" S %ZISRL=+$P(%Z1,"^",10) G T 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 S:%ZTYPE="VTRM"&'$D(IO("Q"))&(%A=%H) IO=$I 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 OCPU D OTHCPU("DEVICE") OOS G T:POP I %Z90,$D(DT)#2,%Z90'>DT S POP=1 ;Out Of Service Check 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 PTIME G T:POP!(IO=$I)!(IO=0) ;Prohibitted Time Check I %ZTIME]"",%ZISB S %A=$P(%ZTIME,"^",1),%X=$P($H,",",2),%=%X\60#60+(%X\3600*100),%X=$P(%A,"-",2) I %X'<%A&(%'>%X&(%'<%A))!(%X<%A&(%'<%A!(%'>%X))) S POP=1 I '$D(IOP),'$D(%ZISHP) W *7," [ACCESS PROHIBITED "_%A_"]" ;AT THIS TIME]" DUZ I 'POP D SEC ;Security Check ; T I POP,$D(%ZISHG(0)),%IS'["D",'$D(%ZISHPOP),%ZISB G HUNT I POP D HGBSY:$D(%ZISHPOP) ;G T2:%IS["T" TMPVAR K IO("S") S %ZISIOS=%E S:IO=0 IO=$I,IO("S")=%H S %ZISOPAR=$$IOPAR(%E,"IOPAR") S %ZISUPAR=$$IOPAR(%E,"IOUPAR"),%ZISTO=+$P(%ZTIME,"^",2) I $D(IO("S")) D I POP Q . S IO=$S(%IS["S":$P($G(^%ZIS(1,+$P(%Z,"^",8),0)),"^",2),1:IO) . I %IS["S",IO]"" S %H=+$P(%Z,"^",8),IO("S")=%H,IO(0)=IO . S IO("S")=$S($G(^XUTL("XQ",$J,"IOST(0)")):^("IOST(0)"),1:$G(^%ZIS(1,%H,"SUBTYPE"))) . S:IO="" POP=1 . Q S %A=+$G(^%ZIS(1,%E,"SUBTYPE")),%ZISTP=0 ;%A is pointer to subtype I %E=%H,%ZTYPE["TRM" D I 1 . I $D(^XUTL("XQ",$J,"IOST(0)")) D ;Use home . . S %A=+^XUTL("XQ",$J,"IOST(0)"),%Z91="",%ZISTP=1 . . F %ZISI="IOM","IOF","IOSL","IOBS","IOXY" S %Z91=%Z91_$G(^XUTL("XQ",$J,%ZISI))_"^" . E S %=$$LNPRTSUB^%ZISUTL I %>0 S %A=%,%Z91="" E S %Z91=$P($G(^%ZIS(2,%A,1)),"^",1,4),$P(%Z91,"^",5)=$G(^("XY")) ;I $D(%Z91),%Z91'?1.4"^" ;$P(%Z91,"^")]"",$P(%Z91,"^",2)]"",$P(%Z91,"^",3),$P(%Z91,"^",4)]"" D ST^%ZIS3(%ZISTP) S:%IS["U" USIO=$P(%Z91,"^",1,4) T2 I POP S:%IS'["T" IO="" Q G ^%ZIS3:"^MTRM^VTRM^TRM^SPL^MT^SDP^HFS^RES^OTH^BAR^HG^IMPC^CHAN^"[("^"_%ZTYPE_"^") ;Jump to next part S POP=1 Q ; HGBSY S POP=1 S:%IS'["T" IO="" K %ZISHP,%ZISHPOP Q:$D(IOP) W:$X>38 !,?5 W *7," All devices in hunt group "_%ZISHG_" are busy!" Q OTHCPU(%1) ;%1 should be either DEVICE or HUNT GROUP N %2,X,Y,%ZISMSG S %ZISMSG=0 F %2="CPU","VOLUME SET" D .I %2="VOLUME SET" S X=$P($P(%Z,"^",9),":"),Y=%ZISV .E D GETENV^%ZOSV S X=$P($P(%Z,"^",9),":",2),Y=$P($P(Y,"^",4),":",2) .I X=Y!(X="") Q:%1="DEVICE" D Q ;Other Vol Set/Cpu Check ..S %ZISHG(0)=%E,%ZISHG=$P(%Z,"^") ..I %ZISB S POP=1 ..E S IO=" " .I %2="VOLUME SET" S $P(%ZISCPU,":")=X .E S $P(%ZISCPU,":",2)=X .I %1="HUNT GROUP" K %ZISHG(0) .I %IS["Q" S IO("Q")=1,%ZISB=0 S:%1="HUNT GROUP" IO=" " .E I %ZISB&(%ZTYPE="TRM"&($D(%ZISHG(0))&(%IS'["D"))) S POP=1 .E W:'$D(IOP)&'%ZISMSG *7," ["_%1_" is on another "_%2_" ('"_X_"')]",! S POP=1,%ZISMSG=1 Q IOPAR(%DA,%N) ;Return I/O parameters Q $S($G(%ZIS(%N))]"":%ZIS(%N),1:$G(^%ZIS(1,%DA,%N))) ; 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 I POP,'$D(IOP),'$D(%ZISHP) W *7," [Access Prohibited]" Q ZIS3 %ZIS3 ;SFISC/AC,RWF -- DEVICE HANDLER(DEVICE TYPES & PARAMETERS) ;12/09/98 13:23 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**18,36,69,104**;JUL 10, 1995 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/ANMC/CLS 12/10/96 I %ZIS'["T",$G(^%ZIS(1,+%E,"POX"))]"" D XPOX^ZISX(%E) I $D(%ZISQUIT) S POP=1 K %ZISQUIT S %ZISCHK=1 I 'POP&(%ZISB)&(%ZTYPE'="RES")&(%ZTYPE'="OTH")&(%ZTYPE'="SDP")&(IO'["::") D DEVOK G Q:POP G @%ZTYPE:(%ZTYPE["TRM"),@(%ZTYPE_"^%ZIS6") ;Jump to next part ; Q I $D(%ZISUOUT) K %ZISUOUT,%ZISHP,%ZISHPOP Q I $D(%ZISHPOP)&$S(IO="":1,1:'$D(IO(1,IO))) D HGBSY^%ZIS2 Q I POP S:%IS'["T" IO="" I $D(%ZISHG(0)),%IS'["D",'$D(%ZISHPOP) G HUNT^%ZIS2 Q VTRM ;Virtual terminal type TRM D OPEN^%ZIS4:'POP&(%ZISB&(%IS'["T")),MARGN:'POP,SETPAR:'POP ;Terminal type I 'POP,%IS'["T",%ZISB=1,'$D(IOP),IO'=IO(0),'$D(IO("Q")),%IS["Q" D AQUE W:'$D(IOP) ! I '$D(IO("Q")) D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) G Q DEVOK N X,Y,X1 S X=IO,X1=%ZTYPE D DEVOK^%ZOSV I Y=-99!(Y=0)!(Y=$J) Q I Y>0 S POP=1 W:'$D(IOP)&('$D(%ZISHG(0))!(%IS["D")) !,*7,"[Device Unavailable]" Q I Y=-1 S IO="",POP=1 W:'$D(IOP)&('$D(ZISHG(0))!(%IS["D")) !,*7,"[Device does not Exist or Unavailable]" Q Q MARGN S %A=$P(%Y,";",1) 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 S:$P(%Y,";",2) $P(%Z91,"^",3)=+$P(%Y,";",2) I %A>3 S $P(%Z91,"^")=$S(%A>255:255,1:+%A) ALTP I '$D(IO("P")) Q:%A>3 G ASKMAR:%ZTYPE["TRM" Q S %X=$F(IO("P"),"M") I %X S %A=+$E(IO("P"),%X,99),$P(%Z91,"^")=$S(%A>255:255,1:%A) S %X=$F(IO("P"),"L") I %X S $P(%Z91,"^",3)=+$E(IO("P"),%X,99) Q:%A>3!(%ZTYPE'["TRM") ASKMAR I %IS["M",'$D(IOP),$S(%E=%H:+$P(%Z,"^",3),1:1),$P(%Z,"^",4) W " Right Margin: " W:$P(%Z91,"^")]"" +%Z91,"// " E Q ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THE LINE BELOW IS COMMENTED OUT AND REPLACED BY A NEW LINE TO ALLOW ;FOR SLAVED DEVICES WITH A $I OF 0. ORIG MOD BY IHS/ANMC/CLS 12/10/96 ;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 D SBR^%ZIS1 I '$D(DTOUT)&'$D(DUOUT) S:%X=""&($P(%Z91,"^")]"") %X=+%Z91 G ASKMAR:(%X'?1.N)!(%X<1) S $P(%Z91,"^")=$S(%X>255:255,1:%X) Q ;----- END IHS MODIFICATION S POP=1 I %ZISB&(%ZTYPE["TRM")&(IO'=IO(0)) C IO K IO(1,IO) Q Q SETPAR S:%ZISOPAR]""&($A(%ZISOPAR)-40) %ZISOPAR="("_%ZISOPAR_")" Q AQUE W ! S %=$S($D(IO("Q")):1,1:2),U="^",%ZISDTIM=60 I $D(IO("Q")) W !,"Previously, you have selected queueing." W !,"Do you "_$S($D(IO("Q")):"STILL ",1:"")_"want your output QUEUED" D YN^%ZIS1 K %ZISDTIM G AQUE:%=0 Q:$D(IO("Q")) I %=-1 S POP=1,%ZISHPOP=1,%ZISUOUT=1 C IO K IO(1,IO) Q I %=1 S IO("Q")=1 C IO K IO(1,IO) Q Q ST(%ZISTP) ; S %ZISIOST(0)=%A,%ZISIOST=$P($G(^%ZIS(2,%A,0)),"^") S:'$D(%Z91) %Z91=$P($G(^%ZIS(2,%A,1),"132^#^60^$C(8)"),"^",1,4),$P(%Z91,"^",5)=$G(^("XY")) Q:%ZISTP STP N %B ;%E is a pointer to the Device file S %B=$G(^%ZIS(1,%E,91)) 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")) Q SUBIEN(%1,%) ;Return Subtype ien. N %XX,%YY I $D(^%ZIS(2,"B",%1))>9 S %1=+$O(^%ZIS(2,"B",%1,0)) Q I '$G(%) S X="" Q S %XX=%1 D 2^%ZIS5 S %1=+%YY Q SUBTYPE(%A) ;Called from %ZISH N %ZISIOST,%Z91 S:$G(%A)="" %A="P-OTHER" D SUBIEN(.%A),ST(1) 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)" S:IOST="" IOST="P-OTHER",IOST(0)=0 Q ZIS4 %ZIS4 ;SF/GFT,RWF,MVB - DEVICE HANDLER SPOOL SPECIFIC CODE(MSM) ;02/11/97 11:02 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,36,49,59**;JUL 03, 1995 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/HQW/JLB 2/16/99 ; OPEN G OPN2:$D(IO(1,IO)) S POP=0 D OP1 S:'POP IO(1,IO)="" G NOPEN:'$D(IO(1,IO)) OPN2 I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") Q NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q I '$D(IOP) W *7," [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 S POP=1 Q Q OP1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O IO::%ZISTO S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q OPNERR S POP=1,IO("ERROR")=$ZE,IO("LASTERR")=$ZE Q ; O I $P($ZV,"Version ",2)'<3 D:%IS["L" ZIO ;D:$D(%ZISIOS) ZISLPC^%ZIS Q:'%ZISB ;No longer called in Kernel v8. OPRTPORT I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR") S %A=$S(%ZISOPAR]"":%ZISOPAR,%ZTYPE["TRM":+%Z91,1:"") S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A D O1 I POP W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q S IO(1,IO)="" I %ZTYPE="HFS" D Q:POP .N % S %=$I .U IO S:$ZA<0 POP=1 .U:'$D(ZTQUEUED) % I POP C:IO]"" IO K:IO]"" IO(1,IO) .I POP,'$D(IOP),'$D(ZTQUEUED) W !,?5,*7,"[FILE NOT FOUND]" Q N DX,DY S (DX,DY)=0 U IO X:$D(^%ZOSF("XY"))&'(IO=IO(0)&'$D(ZTQUEUED)&'$D(IO("S"))) ^("XY") I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1 U:%IS'[0 IO(0) G OXECUTE^%ZIS6 ; O1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O @%A S:'$T&(%A?.E1":".N) POP=1 L:$D(%ZISLOCK) -@%ZISLOCK S IO("ERROR")="" Q ; ZIO N % S (IO("ZIO"),%)=$ZDEV($I),%=$S(%?1.3N1P.E:$TR(%,"~",":"),1:%) S:(%?1.3N1P1.3N1P.E)&'$D(IO("IP")) IO("IP")=$TR(%,"~",":") S:(%?1A.ANP1"~"1.4N)&'$D(IO("CLNM")) IO("CLNM")=$TR($$LOW^%ZIS1(%),"~",":") Q ; SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name. I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G N S ZOSFV=($P($ZV,"Version ",2)'<2) R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) I '%ZISB!$D(IO("Q")) S:'ZOSFV IO=51 G OK I '$P(%ZY,"^",3),%ZFN D SPL3 G N:'%ZFN,DOC S %ZFN=-1 D SPL2 G:%ZFN<0 N S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#" I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS OK K %ZDA,%ZFN Q N K %ZDA,%ZFN,IO("DOC") S POP=1 Q ; SPL2 O 2:1 G SPL5:$ZA<0,SPL5:$ZC S %ZFN=$ZA#256 S IO(1,2)="",IO(1,2,"%ZFN")=%ZFN Q ; SPL3 Q:$D(IO(1,2))#2 O 2:%ZFN+256 G:$ZA<0 SPL5:$ZA<0,SPL5:$ZC S IO(1,2)="",IO(1,2,"%ZFN")=%ZFN Q SPL4 E G SPL5 ;U IO S %ZA=$ZA U:%IS'[0 IO(0) I %ZA<0 G SPL5 Q SPL5 W:'$D(IOP)&'$D(ZTQUEUED) !?5,*7,"Couldn't open the spool file." S %ZFN=-1 Q ; CLOSE N %Z1 S ZOSFV=($P($ZV,"Version ",2)'<2) C 2 K IO(1,2) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q S %Z1=+$G(^XTV(8989.3,1,"SPL")) S IO=2,%ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN'>0 U IO S %ZCR=$C(13),%Y="" G V2CL1^%ZOSV Q ;Send error up CL2 I %Z1<(%+1) S %=%+1,^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q I %2[$C(12) S %=%+1,^XMBS(3.519,XMZ,2,%,0)="|TOP|" S %=%+1,^XMBS(3.519,XMZ,2,%,0)=%2 Q ; HFS G HFS^%ZISF REWMT(IO,IOPAR) ;Rewind Magtape S X="REWERR^%ZIS4",@^%ZOSF("TRAP") U IO W *5 Q 1 REWSDP(IO,IOPAR) ;Rewind Sequential Block Processor S X="REWERR^%ZIS4",@^%ZOSF("TRAP") U IO:IOPAR Q 1 REWHFS(IO,IOPAR) ;Rewind Host File. REW1 S X="REWERR^%ZIS4",@^%ZOSF("TRAP") ; IHS/HQW/JLB 2/16/99 As of MSM 4.4 the original line from VA works ;N FILENAME ;IHS/ANMC/FBD-2/19/97-ADDED LINE-SUPPORT FOR ADDITION 2 LINES BELOW IHS/HQW/JLB 2/16/99 uncomment for MSM 4.3 and below U IO:(::0) ;IHS/ANMC/FBD-2/19/97-ORIGINAL LINE-COMMENTED OUT IHS/HQW/JLB 2/16/99 comment out for MSM 4.3 and below ;U IO I $$^%FINDFN(.FILENAME) C IO O IO:(FILENAME:"M") ;IHS/ANMC/FBD-2/ LINE-WORKAROUND TO MSM NO-REWIND PROBLEM IHS/HQW/JLB uncomment for MSM 4.3 and below Q 1 REWERR ;Error encountered. Q 0 ZIS4DTM %ZIS4 ;SFISC/GFT,RWF,MVB - DEVICE HANDLER SPOOL SPECIFIC CODE(DataTree Mumps) ;1/20/93 16:46 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23**;JUL 03, 1995 ; OPEN G OPN2:$D(IO(1,IO)) S POP=0 D OP1 S:'POP IO(1,IO)="" G NOPEN:'$D(IO(1,IO)) OPN2 I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") Q NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q I '$D(IOP) W *7," [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 S POP=1 Q Q OP1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOC) +@%ZISLOCK:60 O IO::%ZISTO S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q OPNERR S POP=1,IO("ERROR")=$ZE,IO("LASTERR")=$ZE Q ; O ;D:$D(%ZISIOS) ZISLPC^%ZIS Q:'%ZISB ;No longer called in Kernel v8. OPRTPORT I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR") S %A=$S(%ZISOPAR]"":%ZISOPAR,%ZTYPE["TRM":"(WIDTH="_+%Z91_")",1:"") I %A=""&(%ZTYPE="HFS"!(%ZTYPE="SDP")!(%ZTYPE="SPL")) S POP=1 W:'$D(IOP) !,?5,"INVALID PARAMETERS",! Q S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A D O1 I POP W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q S IO(1,IO)="" N DX,DY S (DX,DY)=0 U IO X:$D(^%ZOSF("XY"))&'(IO=IO(0)&'$D(ZTQUEUED)&'$D(IO("S"))) ^("XY") U:%IS'[0 IO(0) I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1 U:%IS'[0 IO(0) G OXECUTE^%ZIS6 ; O1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O @%A S:'$T&(%A?.E1":".N) POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q ; SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name. I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G N R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:'%ZISB!$D(IO("Q")) I '$P(%ZY,"^",3),%ZFN]"" S %ZISMODE="R" D SPL G:%ZFN']"" N G DOC S %ZFN="SPL"_%ZDA_".TMP" S %ZISMODE="W" D SPL G:%ZFN']"" N S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#" I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS OK K %ZDA,%ZFN,%ZISMODE,%ZY Q N K %ZDA,%ZFN,%ZISMODE,IO("DOC"),%ZY S POP=1 Q ; SPL I IO]"" O IO:(%ZISMODE:%ZFN):0 S:$T IO(1,IO)="" E D FREEDEV^%ZOSV1 G NOSPL:(IO=""),SPL Q NOSPL W:'$D(IOP) !?5,*7,"Couldn't open the spool file." S %ZFN="" Q ; CLOSE N %Z1 C:IO=IO(0)&(IO]"") IO K:IO=IO(0)&(IO]"") IO(1,IO) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q S %Z1=+$G(^XTV(8989.3,1,"SPL")) S %ZFN=$P(%ZS,"^",2) S %ZISMODE="R" D SPL Q:%ZFN']"" U IO S %ZCR=$C(13),%Y="" F %=0:0 R %X:5 Q:$ZIOS=3 S %2=%X D CL2 C:IO]"" IO K:IO]"" IO(1,IO) D del^%dos(%ZFN):$P($ZVER,"/",2)'<4,CLOSE^ZISPL1 K %Y,%X,%1,%ZISMODE,%ZFN Q CL2 I %Z1<(%+1) S %=%+1,^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q I %2[$C(12) S %=%+1,^XMBS(3.519,XS,2,%,0)="|TOP|" S %=%+1,^XMBS(3.519,XS,2,%,0)=%2 Q ; HFS G HFS^%ZISF ; REWMT(IO,IOPAR) ;Rewind Magtape ;Unknown whether magtapes are supported Q 0 REWSDP(IO,IOPAR) ;Rewind SDP G REW1 REWHFS(IO,IOPAR) ;Rewind Host File REW1 S X="HFSRWERR",@^%ZOSF("TRAP") U IO:(LFA=0) Q 1 REWERR ;Error encountered. Q 0 ZIS4MSM %ZIS4 ;SFISC/RWF,AC - DEVICE HANDLER SPOOL SPECIFIC CODE(MSM) ;30-OCT-1997 09:28 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,36,49,59,69**;JUL 03, 1995 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/JLB 12/01/98 ; OPEN G OPN2:$D(IO(1,IO)) S POP=0 D OP1 G NOPEN:'$D(IO(1,IO)) OPN2 I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") Q NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q I '$D(IOP) W *7," [BUSY] ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 S POP=1 Q Q OP1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q OPNERR S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ZE,$EC="" Q ; O I $P($ZV,"Version ",2)'<3 D:%IS["L" ZIO ;D:$D(%ZISIOS) ZISLPC^%ZIS Q:'%ZISB ;No longer called in Kernel v8. I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer port OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR") S %A=$S(%ZISOPAR]"":%ZISOPAR,%ZTYPE["TRM":+%Z91,1:"") S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A D O1 I POP W:'$D(IOP) !,?5,*7,"[Device is BUSY]" Q I %ZTYPE="HFS" D Q:POP . N % S %=$I . U IO S:$ZA<0 POP=1 . U:'$D(ZTQUEUED) % I POP C:IO]"" IO K:IO]"" IO(1,IO) . I POP,'$D(IOP),'$D(ZTQUEUED) W !,?5,*7,"[File not Found]" Q ;U IO S:'(IO=IO(0)&'$D(IO("S"))&'$D(ZTQUEUED)) $X=0,$Y=0 U IO S $X=0,$Y=0 I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1 ;U:%IS'[0 IO(0) G OXECUTE^%ZIS6 ; O1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)="" L:$D(%ZISLOCK) -@%ZISLOCK S IO("ERROR")="" Q ; ZIO N % S (IO("ZIO"),%)=$ZDEV($I),%=$S(%?1.3N1P.E:$TR(%,"~",":"),1:%) S:(%?1.3N1P1.3N1P.E)&'$D(IO("IP")) IO("IP")=$TR(%,"~",":") S:(%?1A.ANP1"~"1.4N)&'$D(IO("CLNM")) IO("CLNM")=$TR($$LOW^%ZIS1(%),"~",":") Q ; SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name. I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G N S ZOSFV=($P($ZV,"Version ",2)'<2) R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) I '%ZISB!$D(IO("Q")) S:'ZOSFV IO=51 G OK I '$P(%ZY,"^",3),%ZFN D SPL3 G N:'%ZFN,DOC S %ZFN=-1 D SPL2 G:%ZFN<0 N S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#" I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS OK K %ZDA,%ZFN Q N K %ZDA,%ZFN,IO("DOC") S POP=1 Q ; SPL2 O 2:1 G SPL5:$ZA<0,SPL5:$ZC S %ZFN=$ZA#256 S IO(1,2)="",IO(1,2,"%ZFN")=%ZFN Q ; SPL3 Q:$D(IO(1,2))#2 O 2:%ZFN+256 G:$ZA<0 SPL5:$ZA<0,SPL5:$ZC S IO(1,2)="",IO(1,2,"%ZFN")=%ZFN Q SPL4 E G SPL5 ;U IO S %ZA=$ZA U:%IS'[0 IO(0) I %ZA<0 G SPL5 Q SPL5 W:'$D(IOP)&'$D(ZTQUEUED) !?5,*7,"Couldn't open the spool file." S %ZFN=-1 Q ; CLOSE N %Z1 S ZOSFV=($P($ZV,"Version ",2)'<2) C 2 K IO(1,2) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q S %Z1=+$G(^XTV(8989.3,1,"SPL")) S IO=2,%ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN'>0 U IO S %ZCR=$C(13),%Y="" G V2CL1^%ZOSV Q ;Send error up CL2 I %Z1<(%+1) S %=%+1,^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q I %2[$C(12) S %=%+1,^XMBS(3.519,XMZ,2,%,0)="|TOP|" S %=%+1,^XMBS(3.519,XMZ,2,%,0)=%2 Q ; HFS G HFS^%ZISF REWMT(IO,IOPAR) ;Rewind Magtape S X="REWERR^%ZIS4",@^%ZOSF("TRAP") U IO W *5 Q 1 REWSDP(IO,IOPAR) ;Rewind Sequential Block Processor S X="REWERR^%ZIS4",@^%ZOSF("TRAP") U IO:IOPAR Q 1 REWHFS(IO,IOPAR) ;Rewind Host File. REW1 S X="REWERR^%ZIS4",@^%ZOSF("TRAP") ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THE LINE BELOW WAS COMMENTED OUT AND REPLACED BY 2 MORE LINES TO ;PROVIDE A WORKAROUND TO MSM NO-REWIND PROBLEM ON NT. ORIGINAL ;MODIFICATION BY IHS/JLB 12/01/98 ;U IO:(::0) I $$VERSION^%ZOSV(1)["NT" D .U IO:(::0) E N FILENAME U IO I $$^%FINDFN(.FILENAME) C IO O IO:(FILENAME:"M") ;----- END IHS MODIFICATION Q 1 REWERR ;Error encountered. Q 0 ZIS4MSQ %ZIS4 ;SFISC/GFT,RWF,AC - DEVICE HANDLER SPOOL SPECIFIC CODE (M/SQL) ;4/8/92 13:51 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23**;JUL 03, 1995 ; OPEN G OPN2:$D(IO(1,IO)) I %IS["T" L +^%ZTSCH("DEV",IO):0 G NOPEN:'$T,NOPEN:$D(^%ZTSCH("DEV",IO))#2,NOPEN:$D(^%ZTSCH("IO",IO)) S POP=0 D OP1 S:'POP IO(1,IO)="" G NOPEN:'$D(IO(1,IO)) I %IS["T" S ^%ZTSCH("DEV",IO)=$H L -^%ZTSCH("DEV",IO) OPN2 I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") Q NOPEN L:%IS["T" -^%ZTSCH("DEV",IO) I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q I '$D(IOP) W *7," [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 K:%E'=%H ^XUTL("ZISPARAM",IO) S POP=1 Q Q OP1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O IO::%ZISTO S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q OPNERR S POP=1,IO("ERROR")=$ZE,IO("LASTERR")=$ZE Q ; O ;D:$D(%ZISIOS) ZISLPC^%ZIS Q:'%ZISB ;No longer called in Kernel v8. OPRTPORT I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR") S %A=$S(%ZISOPAR]"":%ZISOPAR,%ZTYPE'["TRM":"",%ZISIOST?1"C".E:"("_+%Z91_":""C"")",%ZISIOST?1"PK".E:"("_+%Z91_":""P"")",1:+%Z91) S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A D O1 I POP W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q S IO(1,IO)="" N DX,DY S (DX,DY)=0 U IO X:$D(^%ZOSF("XY"))&'(IO=IO(0)&'$D(ZTQUEUED)) ^("XY") U:%IS'[0 IO(0) I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1 U:%IS'[0 IO(0) G OXECUTE^%ZIS6 ; O1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O @%A S:'$T&(%A?.E1":".N) POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q ; SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file num. I '$D(^XMB(3.51,0)) W:'$D(IOP) !?5,"The spooler files are not setup in this account." G N I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N R S %ZY=-1 D NEWDOC^ZISPL1:$D(DUZ)=11 G N:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q")) G:'%ZISB OK I '$P(Y,"^",3),%ZFN D SPL3 G N:%ZFN<0,DOC F %ZFN=1:1 I '$D(^XMB(3.51,"C",%ZFN))!$D(^(%ZFN,%ZDA)) Q:%ZFN<256 W:'$D(IOP) *7," DELETE SOME OTHER DOCUMENT!" G N D SPL2 S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS OK K %ZDA,%ZFN Q N K %ZDA,%ZFN,IO("DOC") S POP=1 Q SPL2 O IO:(%ZFN:0) S IO(1,IO)="",^SPOOL(0,IO("DOC"),%ZFN)="",^SPOOL(%ZFN,0)=IO("DOC")_"{"_$H Q SPL3 G SPL4:'$D(^SPOOL(%ZFN,2147483647)) O IO:(%ZFN:$P(^(2147483647),"{",3)) K ^(2147483647) S IO(1,IO)="" Q SPL4 W:'$D(IOP) !,"Spool file already open" S %ZFN=-1 Q CLOSE N %Z1 C:IO=IO(0) IO K:IO=IO(0) IO(1,IO) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q S %ZFN=$P(%ZS,"^",2),%ZCR=$C(13),%Y="",%=0,%3=$P(^SPOOL(%ZFN,2147483647),"{",3)-1 S %Z1=+$G(^XTV(8989.3,1,"SPL")) F %2=1:1:%3 S %X=^SPOOL(%ZFN,%2),%=%+1 D LIMIT:%Z1<% Q:%Z1<% S ^XMBS(3.519,XS,2,%,0)=$S($C(13,10)[%X:"",%X[$C(12):"|TOP|",1:$P(%X,$C(13),1)) K ^SPOOL(%ZFN),^SPOOL(0,$P(%ZS,U,1)),%Y,%X,%1,%2,%3 D CLOSE^ZISPL1 Q LIMIT S ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q HFS G HFS^%ZISF ZIS4ONT %ZIS4 ;SFISC/RWF,AC - DEVICE HANDLER SPOOL SPECIFIC CODE (OpenM/WNT) ;05/26/98 11:34 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**34,59,69**;Jul 10, 1995 ; OPEN G OPN2:$D(IO(1,IO)) S POP=0 D OP1 G NOPEN:'$D(IO(1,IO)) OPN2 I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") Q NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q I '$D(IOP) W *7," [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 K:%E'=%H ^XUTL("ZISPARAM",IO) S POP=1 Q Q OP1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q OPNERR S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ZE,$EC="" Q ; O D:%IS["L" ZIO I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer port OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR") S %A=$S(%ZISOPAR]"":%ZISOPAR,%ZTYPE'["TRM":"",%ZISIOST?1"C".E:"("_+%Z91_":""C"")",%ZISIOST?1"PK".E:"("_+%Z91_":""P"")",1:+%Z91) S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A D O1 I POP W:'$D(IOP) !,?5,*7,"[Device is BUSY]" Q ;U IO S:'(IO=IO(0)&'$D(IO("S"))&'$D(ZTQUEUED)) $X=0,$Y=0 U IO S $X=0,$Y=0 I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1 ;U:%IS'[0 IO(0) G OXECUTE^%ZIS6 ; O1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") L:$D(%ZISLOCK) +@%ZISLOCK:60 O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)="" L:$D(%ZISLOCK) -@%ZISLOCK S IO("ERROR")="" Q ZIO N % S %=$ZIO,IO("ZIO")=$I S:'$D(IO("IP"))&($E($I,2,4)="TNT")&($P(%,"/")?1.3N1"."1.3N1"."1.3N1"."1.3N) IO("IP")=$P(%,"/") Q ; SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file num. I '$D(^XMB(3.51,0)) W:'$D(IOP) !?5,"The spooler files are not setup in this account." G N I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N R S %ZY=-1 D NEWDOC^ZISPL1:$D(DUZ)=11 G N:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q")) G:'%ZISB OK I '$P(%ZY,"^",3),%ZFN D SPL3 G N:%ZFN<0,DOC F %ZFN=1:1 I '$D(^XMB(3.51,"C",%ZFN))!$D(^(%ZFN,%ZDA)) Q:%ZFN<256 W:'$D(IOP) *7," DELETE SOME OTHER DOCUMENT!" G N D SPL2 S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="" DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS OK K %ZDA,%ZFN Q N K %ZDA,%ZFN,IO("DOC") S POP=1 Q SPL2 O IO:(%ZFN:0) S IO(1,IO)="",^SPOOL(0,IO("DOC"),%ZFN)="",^SPOOL(%ZFN,0)=IO("DOC")_"{"_$H Q SPL3 G SPL4:'$D(^SPOOL(%ZFN,2147483647)) O IO:(%ZFN:$P(^(2147483647),"{",3)) K ^(2147483647) S IO(1,IO)="" Q SPL4 W:'$D(IOP) !,"Spool file already open" S %ZFN=-1 Q CLOSE I IO=2 K IO(1,IO) C IO N %Z1,%ZCR,%2,%3,%Y D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q S %ZFN=$P(%ZS,"^",2),%ZCR=$C(13),%Y="",%=0,%3=$P(^SPOOL(%ZFN,2147483647),"{",3) S %Z1=+$G(^XTV(8989.3,1,"SPL")) F %2=1:1:%3 Q:'$D(^SPOOL(%ZFN,%2)) S %X=^SPOOL(%ZFN,%2) D . I %Z1<% D LIMIT S %2=%3 Q . I %X[$C(13,12) D:$L($P(%X,$C(13))) ADD($P(%X,$C(13))) D ADD("|TOP|") Q . D ADD($P(%X,$C(13),1)) K ^SPOOL(%ZFN),^SPOOL(0,$P(%ZS,U,1)),%Y,%X,%1,%2,%3 D CLOSE^ZISPL1 Q ADD(L) S %=%+1,^XMBS(3.519,XS,2,%,0)=L Q LIMIT D ADD("*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***") S $P(^XMB(3.51,%ZDA,0),"^",11)=1 Q HFS G HFS^%ZISF REWMT(IO,IOPAR) ;Rewind Magtape S X="REWERR^%ZIS4",@^%ZOSF("TRAP") U IO W *5 Q 1 REWSDP(IO,IOPAR) ;Rewind SDP G REW1 REWHFS(IO,IOPAR) ;Rewind Host File. REW1 S X="REWERR^%ZIS4",@^%ZOSF("TRAP") C IO O IO:("RS"):1 Q 1 REWERR ;Error encountered Q 0 ZIS4VXD %ZIS4 ;SFISC/AC,RWF,MVB - DEVICE HANDLER SPOOL SPECIFIC CODE(VAX DSM) ;30-OCT-1997 09:28 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,36,49,59,69**;JUL 03, 1995 ; OPEN G OPN2:$D(IO(1,IO)) S POP=0 D OP1 G NOPEN:'$D(IO(1,IO)) OPN2 I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"") Q NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q I '$D(IOP) W *7," [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1 S POP=1 Q Q OP1 S $ZT="OPNERR^%ZIS4",$ZE="" L:$D(%ZISLOCK) +@%ZISLOCK:60 O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q OPNERR S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ZE,$EC="" Q ; O D:%IS["L" ZIO ;D:$D(%ZISIOS) ZISLPC^%ZIS Q:'%ZISB ;No longer called in Kernel v8. LCKGBL ;Lock Global I %ZTYPE="CHAN" N % S %=$G(^%ZIS(1,+%E,"GBL")) I %]"" L @("+^"_%_":0") S:'$T POP=1 I POP W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR") I %ZTYPE="CHAN",IO["::""TASK="!(IO["SYS$NET") D ODECNET Q:POP G OXECUTE^%ZIS6 S %A=%ZISOPAR_$S(%ZISOPAR["):":"",%ZTYPE["CHAN"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO) N % S %(IO)="",%=$P($P($NA(%(IO)),"(",2),")") S %A=%_$E(":",%A]"")_%A D O1 I POP D Q .I %ZTYPE="HFS",'$D(IOP),$G(IO("ERROR"))["file not found" W !,?5,*7,"[File Not Found]" Q .W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q ;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) U IO S $X=0,$Y=0 I %ZTYPE["TRM" U IO:(WIDTH=+%Z91) I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1 ;U:%IS'[0 IO(0) G OXECUTE^%ZIS6 ; O1 S $ZT="OPNERR^%ZIS4" L:$D(%ZISLOCK) +@%ZISLOCK:60 O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)="" L:$D(%ZISLOCK) -@%ZISLOCK S IO("ERROR")="" Q ; ODECNET ;OPEN DECNET CHANNEL S $ZT="OPNERR^%ZIS4" L:$D(%ZISLOCK) +@%ZISLOCK:60 O IO L:$D(%ZISLOCK) -@%ZISLOCK S IO("ERROR")="" I IO="SYS$NET",$I="SYS$INPUT:;" S IO(0)=IO U IO Q Q ZIO N % S %=$ZIO,%=$S(%["Host:":$P($P(%,"Host: ",2)," ")_":"_$P(%,"Port: ",2),1:%) S:%[" " %=$TR(%," ") S IO("ZIO")=% S:($ZIO["Host:")&'$D(IO("IP")) IO("IP")=$P(%,":") Q ; SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name. I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G N R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q")) G:'%ZISB OK I '$P(%ZY,"^",3),%ZFN]"" D SPL3 G N:%ZFN']"",DOC 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)="" DOC S IO=%ZFN,IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#" I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS OK K %ZDA,%ZFN Q N K %ZDA,%ZFN,IO("DOC") S POP=1 Q SPL2 O %ZFN:(NEWVERSION:PROT=W:RWD) G:$ZA<0 SPL4 S IO(1,%ZFN)="" Q SPL3 N X S X="SPL4^%ZIS4",@^%ZOSF("TRAP") O %ZFN:READONLY:1 S:'$T ZISPLQ=1 G:$ZA<0!('$T) SPL4 S IO(1,%ZFN)="" Q SPL4 W:'$D(IOP)&'$D(ZTQUEUED) !?5,*7,"Couldn't open the spool file." S %ZFN="" Q CLOSE N %Z1 C:IO]"" IO K:IO]"" IO(1,IO) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q S %ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN']"" U %ZFN S %ZCR=$C(13),%Y="",$ZT="SPLEOF^%ZIS4" S %Z1=+$G(^XTV(8989.3,1,"SPL")) F %=0:0 R %X#255:5 Q:$ZA<0 S %2=%X D CL2 G:%Z1<% SPLEX SPLEOF I $ZE'["ENDO" ZQ ;Send error up SPLEX C %ZFN:DELETE K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q ; 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 I %2[$C(12) S ^XMBS(3.519,XS,2,%,0)="|TOP|" Q S ^XMBS(3.519,XS,2,%,0)=%2 Q ; HFS G HFS^%ZISF REWMT(IO,IOPAR) ;Rewind Magtape S X="REWERR^%ZIS4",@^%ZOSF("TRAP") U IO W *5 Q 1 REWSDP(IO,IOPAR) ;Rewind SDP G REW1 REWHFS(IO,IOPAR) ;Rewind Host File. REW1 S X="REWERR^%ZIS4",@^%ZOSF("TRAP") U IO:DISCONNECT Q 1 REWERR ;Error encountered Q 0 ZIS5 %ZIS5 ;SFISC/STAFF --DEVICE LOOK-UP ;11/5/97 09:29 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**18,24,69**;JUL 10, 1995 N %DO,%DIY,%DD,%DIX S U="^",%DO="" K DUOUT I $D(^%ZIS(%ZISDFN,0)) S %DO=^(0) A G:%ZIS(0)'["A" X I $D(%ZIS("A")) S %DD=%ZIS("A") G B S %DD="Select "_$P(%DO,U,1)_": " B I $D(%ZIS("B")),%ZIS("B")]"" S %YY=%ZIS("B"),%XX=$O(^%ZIS(%ZISDFN,%D,%YY)),%DIY=$S($F(%XX,%YY)-1=$L(%YY):%XX,$D(^%ZIS(%ZISDFN,%YY,0)):$P(^(0),U,1),1:%YY) W %DD,%DIY,"// " R %XX:$S($D(DTIME):DTIME,1:9999) G G:%XX]"" S %XX=%DIY G G W !,%DD R %XX:$S($D(DTIME):DTIME,1:9999) G G NO:'$T,NO:%XX["^" G:%XX?.N&(+%XX=%XX) NUM I %XX'?.ANP!($L(%XX)>30) W:%ZIS(0)["Q" *7," ??" G A X I %XX=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS("_%ZISDFN_",")) S %YY=+^("^%ZIS("_%ZISDFN_",") D S G:'$T NO G GOT F G NO:%XX="" K %DS S %DS=0,%DS(0)=1,%DIX=%XX,%DIY=0 I $D(^%ZIS(%ZISDFN,%D,%XX)) G T1 TRY S %DIX=$O(^%ZIS(%ZISDFN,%D,%DIX)) G:$P(%DIX,%XX,1)'=""!(%DIX="") T2 S %DIY=0 T1 S %DIY=$O(^%ZIS(%ZISDFN,%D,%DIX,+%DIY)) G:%DIY'>0 TRY S %YY=+%DIY D S G:'$T T1 I %DS,'(%DS#10) D LST G NO:%XX=U,ADD:%YY<0,GOT:%YY>0 S %DS=%DS+1,%DS(%DS)=%DIY G T1 LSYN ; S I $D(^%ZIS(%ZISDFN,%YY,0)) G S1 Q S1 G S2:%ZISDFN'=1!(%D'="LSYN") I $P(^%ZIS(1,%YY,0),U,9)=%ZISV!($P(^(0),U,9)="") G S2 Q S2 N Y S Y=%YY D:$D(%ZIS("S")) XS^ZISX Q T2 G:'%DS NO S %DIY="" D LST G NO:%XX=U,ADD:%YY<1,GOT LST I %DS=1,'$D(%ZISLST) S %YY=%DS(1) Q S %YY=-1 Q:%ZIS(0)'["E" W ! F %DZ=%DS(0):1:%DS W !,$J(%DZ,2)," ",$P(^%ZIS(%ZISDFN,%DS(%DZ),0),U,1) D:%ZISDFN=1 I $D(%ZIS("W")),$D(^(0)) W " " D XW^ZISX . ;Show Location . S %=$G(^(1)) W:$X+$L($P(%,U))>74 !?75-$L(X) W " "_$P(%,U) L1 W:%DIY !,"Type '^' to Stop, or" W !,"Choose 1" W:%DS>1 "-",%DS R "> ",%YY:$S($D(DTIME):DTIME,1:9999) S %ZISLST=1 I %YY="",%DIY S %DS(0)=%DS+1,%YY=0 W ! Q I %YY=U!(%YY="") S %YY=-1,DUOUT=1 S:%YY=U %XX=U Q I +%YY'=%YY!(%YY<1)!(%YY>%DS) W:%ZIS(0)["Q" *7," ??" G L1 S %YY=%DS(%YY) Q GOT S %DZ=^%ZIS(%ZISDFN,+%YY,0) W:%ZIS(0)["E" " ",$P(%DZ,U,1) R I %ZIS(0)'["F" S:$S($D(DUZ)#2:$S(DUZ:1,1:0),1:0) ^DISV(DUZ,"^%ZIS("_%ZISDFN_",")=+%YY I %ZIS(0)["Z" S %YY(0)=^%ZIS(%ZISDFN,+%YY,0) Q K %ZISDFN,%DO,%DD,%DIX,%DIY,%DZ Q K K %D,%DS,%ZISLST Q ADD ;can't add to files NO S %YY=-1 G Q NUM I $D(^%ZIS(%ZISDFN,%XX)) S %YY=%XX D S I $T G GOT G F 1 F %D="B","LSYN" S %ZISDFN=1,%ZIS(0)=$S($D(IOP):"M",1:"EMQ") D %ZIS5 Q:%YY>0 D K Q 2 S %D="B",%ZISDFN=2,%ZIS(0)=$S($D(IOP):"M",1:"EMQ") D %ZIS5 D K Q ; LD1 S %E=0,%Y=0 D LCPU:"PD"[$E(%X) S %E=0 W ! L S %E=$S("PD"[$E(%X):$O(^UTILITY("ZIS",$J,"DEVLST","B",%E)),1:$O(^%ZIS(1,"B",%E))) G:%E="" RESTART S %A=+$O(^(%E,0)) G L:'$D(^%ZIS(1,%A,0)),L:$P(^(0),"^",2)=46,L:$P(^(0),"^",2)=63 I $D(%ZIS("S")) N Y S Y=%A D XS^ZISX G L:'$T I "AP"[$E(%X) G L:$P($G(^%ZIS(2,+$G(^%ZIS(1,%A,"SUBTYPE")),0)),U)'?1"P".E W $J($P(^%ZIS(1,%A,0),"^",1),9) W:$D(^(1)) " ",$P(^(1),"^",1) I $D(^(90)),^(90) W " ** OUT OF SERVICE" W ?39 I $X>40 W ! S %Y=%Y+1 I %Y>20 R "'^' TO STOP: ",%Y:$S($D(DTIME):DTIME,1:60),! G RESTART:%Y?1P S %Y=0 G L ; LCPU S %A=%ZISV LC1 S %A=$O(^%ZIS(1,"CPU",%A)) Q:$P(%A,".")'=%ZISV S %E=0 LC2 S %E=+$O(^%ZIS(1,"CPU",%A,%E)) G LC1:%E'>0,LC1:'$D(^%ZIS(1,%E,0)) S ^UTILITY("ZIS",$J,"DEVLST","B",$P(^(0),"^",1),%E)="" G LC2 RESTART S:$D(%H) %E=+%H K %X,^UTILITY("ZIS",$J,"DEVLST") Q ZIS6 %ZIS6 ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;02/04/2000 08:14 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,49,69,118,127,136**;JUL 10, 1995 ;Expect that IO is current device OXECUTE I $D(^%ZIS(2,%ZISIOST(0),2))=1 S %Y=^(2) D 2 ANSBAK 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 I $D(%ZISMTR) X ^%ZOSF("MAGTAPE") U IO W:$D(%MT("REW")) @%MT("REW") U IO(0) K %MT G QUIT:'$D(IO("P")) I $F(IO("P"),"B"),$D(^%ZIS(2,%ZISIOST(0),7)) S %Y=$P(^(7),"^",1) I %Y]"" W @%Y 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 S %Y=$S($D(^%ZIS(2,%ZISIOST(0),%X)):$P(^(%X),"^",$S(%Y=12:2,1:1)),1:"") I %Y]"" W @%Y 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) I %X S %Y=$S($D(^%ZIS(2,%ZISIOST(0),12.2)):$P(^(12.2),"^",%X),1:"") I %Y]"" W @%Y QUIT U:%IS'[0 IO(0) Q 2 Q:%Y="" I %IS'[0,$D(^%ZIS(1,+%H,"TYPE")),^("TYPE")["TRM" D OH Q:POP S %X=$T U IO D %Y^ZISX ;Q:'%X U IO(0) Q OH Q:$S($G(IO(0))]"":$D(IO(1,IO(0))),1:0) N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP") O IO(0)::0 S IO(1,IO(0))="" Q ;See that HOME DEVICE is open. ; SAY(%SAY) ; Q:%IS[0 U IO(0) W %SAY U IO Q RES1 ;Allocate a resource slot, Release in %ZISC. N A,L,X,%ZISD0 S %ZISD0=$O(^%ZISL(3.54,"B",IO,0)) I '%ZISD0 S %ZISD0=$$RADD(IO) ;New one L +^%ZISL(3.54,%ZISD0,0):2 I '$T S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX RES2 S X=$P(^%ZISL(3.54,%ZISD0,0),"^",2) I X<1 S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX S X=$S(X>0:X-1,1:0),$P(^%ZISL(3.54,%ZISD0,0),"^",2)=X ; R1 ;Grab a slot S IO(1,IO)="RES",A=$G(^%ZISL(3.54,%ZISD0,1,0),"^3.542^^") F L=1:1:%ZISRL I '$D(^%ZISL(3.54,%ZISD0,1,L,0)) Q I '$T K IO(1,IO) G RES2 ;No free slots 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)="" S $P(A,"^",3,4)=L_U_($P(A,U,4)+1),^%ZISL(3.54,%ZISD0,1,0)=A RESX L -^%ZISL(3.54,%ZISD0,0) Q ; RADD(X) ;Add Resource N %1,%2 S %1=$G(^%ZISL(3.54,0),"RESOURCE^3.54^^"),%2=$P(%1,U,3) F %2=%2:1 Q:'$D(^%ZISL(3.54,%2,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)="" Q %2 ; RESOK ;DEVOK check for RES devices, for all OS's. N %ZISD0,%ZISD1 S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,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 S X1=$G(^%ZISL(3.54,+%ZISD0,0)) I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q 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 Q ; Q G Q^%ZIS3 HG ; Q SPL N %E,%Z D MARGN^%ZIS3 W:'$D(IOP) ! D SPOOL^%ZIS4:%IS'["T" ;Spool type G Q MT D MARGN^%ZIS3,ASKPAR,AMTREW:'POP&'$D(IOP)&%ZISB W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Magtape type G Q SDP D MARGN^%ZIS3,ASKPAR W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Sequential disk processor type G Q HFS D MARGN^%ZIS3,HFS^%ZIS4 W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Host File Server type G Q RES G Q:%IS["T" N X,X1 I %IS'["R"!'$D(IOP) S POP=1 W:'$D(IOP) *7," [NOT AVAILABLE]" Q ;Resources G Q:$D(IO(1,IO)) I %IS["T" S X=IO,X1="RES" D DEVOK^%ZIS3 S:Y POP=1 G Q:POP D:%ZISB RES1 G Q CHAN ;Network Channel type devices -- DecNet or TCP/IP devices. I IO="SYS$NET",$I="SYS$INPUT:;" S IO(0)=IO U IO ;DECNET Server Device D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) G Q IMPC ;Imaging Work Station BAR ;Bar Code OTH D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Other Device type G Q ; ASKPAR 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 I POP,%ZISB&(%ZTYPE["TRM") C IO K IO(1,IO) Q Q:POP G SETPAR^%ZIS3 AMTREW 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 S:%=1 %ZISMTR=1 Q MSG1 W !?5,"Enter the desired parameters needed to open the selected device.",!?25 Q ; ZIS7 %ZIS7 ;SFISC/AC - DEVICE HANDLER HELP ;8/29/01 07:44 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1007**;APR 1, 2003 ;;8.0;KERNEL;**205**;JUL 10, 1995 EN1 W !,"Specify a device with optional parameters in the format" W !,?8,"Device Name;Right Margin;Page Length" W !,?21,"or" W !,?5,"Device Name;Subtype;Right Margin;Page Length" W !!,"Or in the new format" W !,?14,"Device Name;/settings" W !,?21,"or" W !,?10,"Device Name;Subtype;/settings" W !,"For example" W !,?17,"HOME;80;999" W !,?21,"or" W !,?13,"HOME;C-VT320;/M80L999" W !!,"Enter ?? for more information" Q EN2 S X=0 I $D(^%ZOSF("TEST")) S X="XQH" X ^("TEST") I $T S X=$O(^DIC(9.2,"B","XUDOC DEVICE PROMPT*",0)),X=$D(^DIC(9.2,+X,0)) I X S X=($P(^(0),"^",1)="XUDOC DEVICE PROMPT*") W !,"The following information is available:" ;W !?20,"Printer Listing",!?20,"Complete Device Listing",!?20,"Extended Help"_$S(X:"",1:" [UNAVAILABLE]") W !?20,"All Printers",!?20,"Printers only on '"_%ZISV_"'",!?20,"Complete Device Listing",!?20,"Devices only on '"_%ZISV_"'" W !,?20,"New Format for Device Specification",!?20,"Extended Help"_$S(X:"",1:" [UNAVAILABLE]") R W !!?15,"Select one (A,P,C,D,N, or E): " D SBR^%ZIS1 I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT Q Q:%X="" S %X=$E(%X_"?") I %X="?"!("APCDNE"'[%X) W !,"Enter 'A', 'P', 'C', 'D', 'N' or 'E'" G R I 'X,%X="E" W *7," [UNAVAILABLE]" G R I "APCD"[%X D LD1^%ZIS5 Q I "EN"'[%X W *7," [ERROR]" Q N %IS,%H,%E,%ZISB,%ZISV,IO S U="^",XQH=$S(%X="E":"XUDOC DEVICE PROMPT*",1:"XUDOC DEVICE ALT SYNTAX") D DT^DICRW:'$D(DUZ)#2!'$D(DTIME),EN^XQH Q ZISC %ZISC ;SFISC/GFT,AC,MUS - CLOSE LOGIC FOR DEVICES ;12/11/2001 08:43 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,36,49,69,199,216**;JUL 10, 1995 C0 ; N %,%ZISOS,%ZISV ;Clear IO var we will use for reporting K IO("ERROR"),IO("LASTERR"),IO("CLOSE") ;Protect ourself from calls with incomplete setup. S:$D(IO)[0 IO=$I S:'$D(IO(0)) IO(0)=$P S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")) S %=$S(+$G(IOS):IOS,$L($G(ION)):ION,1:IO) I (%="")!(IO="") G SETIO:IO(0)]"" G END I $G(IOT)="RES" D RES G SETIO ;Handle a resource device ; ;Define subtype info if not already defined. D SUBTYPE ; I $G(IOST(0))>0 D . I $G(^%ZIS(2,+IOST(0),3))]"",$D(IO(1,IO)) D . . U IO S:$X $X=1 D X3^ZISX:'$D(IO("T")) ;perform close execute ; I $D(IO(1,IO)) D ;Perform the following if the device is open. . I $G(IO("P"))["B" D ;Return to normal intensity . . S %=$P($G(^%ZIS(2,+IOST(0),7)),"^",3) I %]"" W @% . I $G(IO("P"))["P" D ;Return to default pitch . . S %=$G(^%ZIS(2,+IOST(0),12.11)) I %]"" W @% . ; . W:$$FF @IOF ;form feed issued at close . I $$CLOSPP D X11^ZISX:'$D(IO("T")) K IO("S") ;Close printer port . Q ; ;I '$D(IOCPU)&(IO'=IO(0)!$D(IO("C"))),$D(IO(1,IO)) D ;Don't use IOCPU as we now use IO(1,IO) I (IO'=IO(0)!$D(IO("C"))),$D(IO(1,IO)) D . U:$S($D(ZTQUEUED):0,'$L($G(IO(0))):0,$D(IO(1,IO(0)))#2:1,1:0) IO(0) . C IO K IO(1,IO) S IO("CLOSE")=IO ;close device ; ;I $G(^%ZIS(2,+IOST(0),3.1))]"" D X31^ZISX:'$D(IO("T")) ; D:IO'=IO(0) RESETP I $D(IOT),IOT="CHAN",$D(IOS) D .S %=$G(^%ZIS(1,+IOS,"GBL")) .I %]"" L @("-^"_%) ;unlock global used to control access to network channels. I $D(IO("SPOOL")) D CLOSE^%ZIS4 ;Special close for spool device SETIO ; ;See if old device has PCX code I $G(IOS),$G(^%ZIS(1,+IOS,"PCX"))]"" S %ZISPCX=^("PCX") ;Setup the IO(0) device, should be the home device S IO=IO(0),(IOPAR,IOUPAR)="" K IO("T") D CIOS(IO(0)) G END:'IOS 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"))) I IOT["TRM",$D(^XUTL("XQ",$J,"IOST(0)")) D HOME^%ZIS G END S %="Y" I IOST(0),$D(^%ZIS(2,IOST(0),1)) S %=^(1),IOM=+%,IOF=$P(%,"^",2),IOSL=$P(%,"^",3),IOBS=$P(%,"^",4) I $D(^%ZIS(1,IOS,91)) S %=^%ZIS(1,IOS,91) S:+% IOM=+% S:$P(%,"^",3) IOSL=$P(%,"^",3) ;Don't know the subtype so set some defaults I %="Y" S IOM=80,IOSL=24,IOF="#",IOST="C-OTHER",IOBS="$C(8)" S1 S:IOST(0) IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^"),IOXY=$G(^("XY")) I '$D(ZTQUEUED),'$D(IO("C")),IOT["TRM" D RM:$D(IO(1,IO)) ;With home device set, Do Post-close execute code of Device closed. END I '$D(IO("T")),$G(%ZISPCX)]"" S %Y=%ZISPCX D %Y^ZISX ;See that any extra IO variables are cleaned up K %,%E,%H,%ZISI,%ZISOS,%ZISPCX,%ZISV,%ZISVT,%ZISX K IO("P"),IO("DOC"),IO("HFSIO"),IO("SPOOL"),IOC,IONOFF ;IOCPU should not be changed. Q ; SUBTYPE ;Find a subtype N %S S IOST=$G(IOST),IOST(0)=+$G(IOST(0)) I $L(IOST)&$L(IOST(0)) Q ;Have a subtype S %S=$G(^%ZIS(2,+IOST(0),0)) I $L(%S) S IOST=$P(%S,U) Q I $L(IOST) S %S=$O(^%ZIS(2,"B",$G(IOST,"X"),0)) I %S>0 S IOST(0)=+%S Q S IOST="",IOST(0)=0 D CIOS($I) Q:IOS'>0 S IOST(0)=$G(^%ZIS(1,+IOS,"SUBTYPE")),IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^") Q ; CIOS(%I) ;Find a value for IOS (IEN into device file) I $D(^XUTL("XQ",$J,"IOS")) S IOS=+^("IOS") Q I $D(%ZISV) S %ZISVT=%I D VTLKUP^%ZIS S IOS=+%E E S IOS=+$O(^%ZIS(1,"C",%I,0)) Q:$G(IOS)>0 S %ZISVT=%I D VIRTUAL^%ZIS I $D(%ZISVT) S %H=%E I %ZISVT]"",%H>0,$D(^%ZIS(1,%H,0)),$D(^("TYPE")),^("TYPE")="VTRM" K %ZISVT S IOS=%H Q ; RESETP I IO]"" K ^XUTL("ZISPARAM",IO) Q Q RM N X S X=+IOM X ^%ZOSF("RM") Q RES ;Close resource device. Q:'$D(IO(1,IO))&'$D(^%ZISL(3.54,"AJ",$J)) S %ZISJOB=$J ; RES1 G RQ:'$D(IOS),RQ:'$D(^%ZIS(1,+IOS,1)) S %ZISRL=+$P(^(1),"^",10),%ZISRL=$S(%ZISRL:%ZISRL,1:1) S %X=$O(^%ZISL(3.54,"B",IO,0)) G RQ:'%X G RQ:'$D(^%ZISL(3.54,+%X,0)) S %ZISD0=+%X,%ZISY0=^(0) S %X=$O(^%ZISL(3.54,"AJ",%ZISJOB,%ZISD0,0)) S %ZISD1=%X G RQ:'%X S %Y=$G(^%ZISL(3.54,%ZISD0,1,+%ZISD1,0)) G RQ:$P(%Y,"^",3)'=%ZISJOB D KILLRES(+%ZISD0,+%ZISD1) RQ K IO(1,IO),%X,%Y,%ZISD0,%ZISD1,%ZISJOB,%ZISRES,%ZISRL,%ZISY0,%ZTRTN,ZTSAVE,ZTIO Q KILLRES(D0,D1) ;Kill one resource use Q:(D0'>0)!(D1'>0) N %X,%Y,%J,%ZISRL L +^%ZISL(3.54,D0,0) S %Y=$G(^%ZISL(3.54,D0,0)) G KRX:%Y="" S %X=$G(^%ZISL(3.54,D0,1,D1,0)),%J=$P(%X,"^",3) S:%J="" %J=" " K ^%ZISL(3.54,D0,1,D1,0),^%ZISL(3.54,D0,1,"B",D1,D1),^%ZISL(3.54,"AJ",%J,D0,D1) S %X=$P(%Y,"^",2)+1,$P(^%ZISL(3.54,D0,0),"^",2)=%X ;I '$D(^%ZISL(3.54,%ZISD0,1,0)) S ^(0)="^3.542A^^" G RQ 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) KRX L -^%ZISL(3.54,D0,0) Q DQCRES ;Tasked entry point to close resource device. S IO=%ZISRES G RES1 CHKDVOPN ;CHECK DEVICES THAT ARE OPENED. ;NEEDS TO BE REVIEWED BEFORE DISTRIBUTION ;THE CODE BELOW IS SPECIFIC TO VAX DSM. N X,Y S X=$J D DEVOPN S Y=","_Y,X=","_IO_"," I Y'[X K IO(1,IO) Q DEVOPN ; N %FST,X1,X2,X3,X4,X5,X6,X7,X8,X9 S %FST=1,Y="" F D Q:%DONE=0 .S %DONE=$ZC(%OPNLIST,%FST,.X1,.X2,.X3,.X4,.X5,.X6,.X7,.X8,.X9) .Q:%DONE=0 .S %FST=0,Y=Y_X1_"," Q FF() ;Issue form feed 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 Q 0 ; CLOSPP() ;Close printer port I $D(IO("S")),$D(^%ZIS(2,+IO("S"),11))&$D(IO(1,IO)) Q 1 Q 0 ZISEDIT ZISEDIT ;SFISC/AC - DEVICE EDIT ;11/9/92 17:00 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;Jul 10, 1995 ; MT S ZISTYPE="MT",DIC("A")="Select Magtape Device: " D EDIT K ZISTYPE Q ; SDP S ZISTYPE="SDP",DIC("A")="Select SDP Device: " D EDIT K ZISTYPE Q ; SPL S ZISTYPE="SPL",DIC("A")="Select Spool Device: " D EDIT K ZISTYPE Q ; HFS S ZISTYPE="HFS",DIC("A")="Select Host File Device: " D EDIT K ZISTYPE Q ; CHAN S ZISTYPE="CHAN",DIC("A")="Select Network Channel: " D EDIT K ZISTYPE Q ;;7.1P0;Kernel;; EDIT S DIC=3.5,DIC(0)="AEMQZL",DIC("S")="I $G(^(""TYPE""))="_""""_ZISTYPE_"""" D ^DIC I Y'>0 K DIC Q S DA=+Y I $P(Y,"^",3) S DIE=DIC,DR="2///"_ZISTYPE D ^DIE K DIE,DR S DR="[XUDEVICE "_ZISTYPE_"]",DDSFILE=3.5 D ^DDS K DA,DR,DDSFILE Q ZISF %ZISF ;SFISC/AC - HOST FILE CODE FOR MSM ;05/07/98 10:56 ;;8.0;KERNEL;**104**;JUL 10, 1995 HFS Q:$D(IOP)&$D(%IS("HFSIO"))&$D(%IS("IOPAR")) I $D(%ZIS("HFSNAME")) D Q:$D(%ZIS("HFSMODE")) .I $D(%ZIS("HFSMODE")) D ..S %ZISOPAR=$$MODE^%ZISF(%ZIS("HFSNAME"),%ZIS("HFSMODE")) ..W:'$D(IOP) " HOST FILE TO USE: "_%ZIS("HFSNAME") Q .S %X=%ZIS("HFSNAME") D SETOPAR .W:'$D(IOP) " HOST FILE TO USE: "_%ZIS("HFSNAME"),! Q E D ASKHFS ;Note the HFS name is part of the IO parameter string H S:$D(%ZIS("HFSMODE")) %ZISOPAR=$$MODE^%ZISF(%X,%ZIS("HFSMODE")) H1 S:$D(IO("Q"))!(%IS["Z") IO("HFSIO")="" S:$E(%ZISOPAR)'="(" %ZISOPAR="("""_%ZISOPAR_""":""W"")" S:$D(IO("HFSIO")) IO("HFSIO")=IO D ASKPAR^%ZIS6,SETPAR^%ZIS3 K %ZY HFSIOO Q:$D(%ZIS("HFSMODE")) I '$D(IOP),$$ASKHFSIO(%E) W ?45,"INPUT/OUTPUT OPERATION: " Q:'$T D SBR^%ZIS1 I $D(DTOUT)!$D(DFOUT)!$D(DUOUT) S POP=1 Q D HOPT(1):%X="?"!($F("?^R^W^M^A",%X)'>1),HOPT1:%X="??" G HFSIOO:%X="?"!($F("?^R^W^M^A",%X)'>1) S $P(%ZISOPAR,"""",4)=%X Q ; HOPT(X) ;Display Input/Output operation -- X=1 for scroll, X=2 for MWAPI. I X=1 D .W !,"Enter one of the following host file input/ouput operation:" .W !,?16,"R = READ",!,?16,"W = WRITE",!,?16,"M = READ/WRITE",!,?16,"A = APPEND" Q E D .K TMP("ZISGHFS","G","HFSOPER","CHOICE") .S TMP("ZISGHFS","G","HFSOPER","CHOICE","1^R")="READ" .S TMP("ZISGHFS","G","HFSOPER","CHOICE","2^W")="WRITE" .S TMP("ZISGHFS","G","HFSOPER","CHOICE","3^M")="READ/WRITE" .S TMP("ZISGHFS","G","HFSOPER","CHOICE","4^A")="APPEND" Q HOPT1 S %ZISI=$O(^DIC(9.2,"B","XUHFSPARAM-MSM",0)) Q:'%ZISI Q:'$D(^DIC(9.2,+%ZISI,0)) Q:$P(^(0),"^",1)'="XUHFSPARAM-MSM" Q:$D(^DIC(9.2,+%ZISI,1))'>9 F %X=0:0 S %X=$O(^DIC(9.2,+%ZISI,1,%X)) Q:%X'>0 I $D(^(%X,0)) W !,^(0) W ! S %X="??" Q ; CHKNM(H) ;Check HFS name for dir I $$OSTYPE^%ZOSV<3 S H=$TR(H,"/","\") ;for DOS/NT only I H[":"!(H["\")!(H["/") Q H Q $$DEFDIR^%ZISH("")_H ; ASKHFS ;---Ask host file name here--- S %X='$P($G(^%ZIS(1,%E,1)),"^",5) S:'%X %X="" Q:$D(IOP)!%X!$D(%ZIS("HFSNAME")) ASKAGN W !,"HOST FILE NAME: " S %ZY=$$GETHFSNM(%ZISOPAR) W:%ZY]"" %ZY_"//" D SBR^%ZIS1 I %X?1."?".E W !,"ENTER HOST FILE NAME" G ASKAGN I $D(DTOUT)!$D(DUOUT) K %ZY S POP=1 Q S %X=$S(%X]"":%X,1:%ZY) I %X="" W *7,!,"You must enter the name of a host file" G ASKAGN D SETOPAR Q ; SETOPAR ;Set the file name into %ZISOPAR S %X=$$CHKNM(%X) I %ZISOPAR?1"("1"""".ANP1""""1":"1"""".AN1""""1")" S $P(%ZISOPAR,"""",2)=%X Q S %ZISOPAR=%X Q MODE(X1,X2) ;Return value in Y N Y S Y="("_""""_X1_""":"_""""_$S(X2="RW":"M",X2="R":"R",X2="W":"W",X2="A":"A",1:"W")_""")" Q Y ASKHFSIO(DA) ; I $G(^%ZIS(1,DA,"TYPE"))="HFS",'$D(%ZIS("HFSMODE")),'$P(^(0),"^",4),$P($G(^(1)),"^",6) Q 1 Q 0 GETHFSNM(X) ;Extract host file name from variable X. N Y S Y=X S:Y?1"("1"""".ANP1""""1":"1"""".AN1""""1")" Y=$P(Y,"""",2) I $D(%IS("B","HFS"))#2,%IS("B","HFS")]"" S Y=%IS("B","HFS") Q Y ZISFMSM %ZISF ;SFISC/AC - HOST FILE CODE FOR MSM ;05/07/98 10:56 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**104**;JUL 10, 1995 HFS Q:$D(IOP)&$D(%IS("HFSIO"))&$D(%IS("IOPAR")) I $D(%ZIS("HFSNAME")) D Q:$D(%ZIS("HFSMODE")) .I $D(%ZIS("HFSMODE")) D ..S %ZISOPAR=$$MODE^%ZISF(%ZIS("HFSNAME"),%ZIS("HFSMODE")) ..W:'$D(IOP) " HOST FILE TO USE: "_%ZIS("HFSNAME") Q .S %X=%ZIS("HFSNAME") D SETOPAR .W:'$D(IOP) " HOST FILE TO USE: "_%ZIS("HFSNAME"),! Q E D ASKHFS ;Note the HFS name is part of the IO parameter string H S:$D(%ZIS("HFSMODE")) %ZISOPAR=$$MODE^%ZISF(%X,%ZIS("HFSMODE")) H1 S:$D(IO("Q"))!(%IS["Z") IO("HFSIO")="" S:$E(%ZISOPAR)'="(" %ZISOPAR="("""_%ZISOPAR_""":""W"")" S:$D(IO("HFSIO")) IO("HFSIO")=IO D ASKPAR^%ZIS6,SETPAR^%ZIS3 K %ZY HFSIOO Q:$D(%ZIS("HFSMODE")) I '$D(IOP),$$ASKHFSIO(%E) W ?45,"INPUT/OUTPUT OPERATION: " Q:'$T D SBR^%ZIS1 I $D(DTOUT)!$D(DFOUT)!$D(DUOUT) S POP=1 Q D HOPT(1):%X="?"!($F("?^R^W^M^A",%X)'>1),HOPT1:%X="??" G HFSIOO:%X="?"!($F("?^R^W^M^A",%X)'>1) S $P(%ZISOPAR,"""",4)=%X Q ; HOPT(X) ;Display Input/Output operation -- X=1 for scroll, X=2 for MWAPI. I X=1 D .W !,"Enter one of the following host file input/ouput operation:" .W !,?16,"R = READ",!,?16,"W = WRITE",!,?16,"M = READ/WRITE",!,?16,"A = APPEND" Q E D .K TMP("ZISGHFS","G","HFSOPER","CHOICE") .S TMP("ZISGHFS","G","HFSOPER","CHOICE","1^R")="READ" .S TMP("ZISGHFS","G","HFSOPER","CHOICE","2^W")="WRITE" .S TMP("ZISGHFS","G","HFSOPER","CHOICE","3^M")="READ/WRITE" .S TMP("ZISGHFS","G","HFSOPER","CHOICE","4^A")="APPEND" Q HOPT1 S %ZISI=$O(^DIC(9.2,"B","XUHFSPARAM-MSM",0)) Q:'%ZISI Q:'$D(^DIC(9.2,+%ZISI,0)) Q:$P(^(0),"^",1)'="XUHFSPARAM-MSM" Q:$D(^DIC(9.2,+%ZISI,1))'>9 F %X=0:0 S %X=$O(^DIC(9.2,+%ZISI,1,%X)) Q:%X'>0 I $D(^(%X,0)) W !,^(0) W ! S %X="??" Q ; CHKNM(H) ;Check HFS name for dir I $$OSTYPE^%ZOSV<3 S H=$TR(H,"/","\") ;for DOS/NT only I H[":"!(H["\")!(H["/") Q H Q $$DEFDIR^%ZISH("")_H ; ASKHFS ;---Ask host file name here--- S %X='$P($G(^%ZIS(1,%E,1)),"^",5) S:'%X %X="" Q:$D(IOP)!%X!$D(%ZIS("HFSNAME")) ASKAGN W !,"HOST FILE NAME: " S %ZY=$$GETHFSNM(%ZISOPAR) W:%ZY]"" %ZY_"//" D SBR^%ZIS1 I %X?1."?".E W !,"ENTER HOST FILE NAME" G ASKAGN I $D(DTOUT)!$D(DUOUT) K %ZY S POP=1 Q S %X=$S(%X]"":%X,1:%ZY) I %X="" W *7,!,"You must enter the name of a host file" G ASKAGN D SETOPAR Q ; SETOPAR ;Set the file name into %ZISOPAR S %X=$$CHKNM(%X) I %ZISOPAR?1"("1"""".ANP1""""1":"1"""".AN1""""1")" S $P(%ZISOPAR,"""",2)=%X Q S %ZISOPAR=%X Q MODE(X1,X2) ;Return value in Y N Y S Y="("_""""_X1_""":"_""""_$S(X2="RW":"M",X2="R":"R",X2="W":"W",X2="A":"A",1:"W")_""")" Q Y ASKHFSIO(DA) ; I $G(^%ZIS(1,DA,"TYPE"))="HFS",'$D(%ZIS("HFSMODE")),'$P(^(0),"^",4),$P($G(^(1)),"^",6) Q 1 Q 0 GETHFSNM(X) ;Extract host file name from variable X. N Y S Y=X S:Y?1"("1"""".ANP1""""1":"1"""".AN1""""1")" Y=$P(Y,"""",2) I $D(%IS("B","HFS"))#2,%IS("B","HFS")]"" S Y=%IS("B","HFS") Q Y ZISFONT %ZISF ;SFISC/AC - HOST FILES FOR OpenM/WNT ;3/10/98 15:26 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**34**;Jul 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY TASSC/MFD 6/11/01 (CACHE) HFS ;Host File Server Q:$D(IOP)&$D(%IS("HFSIO"))&$D(%IS("IOPAR")) I $D(%ZIS("HFSNAME")) S IO=%ZIS("HFSNAME"),%X=IO ; E D ASKHFS H S:$D(%ZIS("HFSMODE")) %ZISOPAR=$$MODE^%ZISF(%ZIS("HFSMODE")) H1 I $D(IO("Q"))!(%IS["Z") S IO("HFSIO")="" S IO=$S(%X]"":%X,1:IO),IO=$$CHKNM(IO) ;See that we have a directory S:$D(IO("HFSIO")) IO("HFSIO")=IO W:'$D(IOP)&$D(%ZIS("HFSNAME")) " HOST FILE TO USE: "_%ZIS("HFSNAME"),! D ASKPAR^%ZIS6,SETPAR^%ZIS3 HFSIOO I '$D(IOP),%ZTYPE="HFS",'$D(%ZIS("HFSMODE")),'$P(^%ZIS(1,%E,0),"^",4),%ZISOPAR="",$D(^%ZIS(1,%E,1)),$P(^(1),"^",6) W ?45,"INPUT/OUTPUT OPERATION: R//" Q:'$T D SBR^%ZIS1 I $D(DTOUT)!$D(DFOUT)!$D(DUOUT) S POP=1 Q D HOPT:%X="?"!'$$CHECK(%X),HOPT1:%X="??" G HFSIOO:%X="?"!'$$CHECK(%X) S:%X]"" %ZISOPAR="("""_%X_""")" Q ; CHECK(X) ;Check that we have valid option N Y,% Q:(X["R")&(X["W") 0 ;Can't have both S Y=1 F %=1:1:$L(X) I "AFNRSVW"'[$E(X) S Y=0 Q Y ; ASKHFS ;---Ask host file name here--- I $D(%IS("B","HFS"))#2,%IS("B","HFS")]"" D .S IO=%IS("B","HFS") ;Set default host file name S %X='$P($G(^%ZIS(1,%E,1)),"^",5) S:'%X %X="" I $D(IOP)!%X!$D(%ZIS("HFSNAME")) S %X="" Q ASKAGN W !,"HOST FILE NAME: "_IO_"//" D SBR^%ZIS1 I %X?1."?".E W !,"ENTER HOST FILE NAME" G ASKAGN S:$D(DTOUT)!$D(DUOUT) POP=1 Q CHKNM(H) ;Check the HFS name N N S N=H ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THE LINE BELOW WAS COMMENTED OUT AND REPLACED BY THE NEXT 2 LINES ;ORIGINAL MODIFICATION BY TASSC/MFD 6/11/01 ;I (H'["\")&(H'[":") S N=$$DEFDIR^%ZISH("")_H I $ZV["Windows",(H'["\")&(H'[":") S N=$$DEFDIR^%ZISH("")_H I $ZV["UNIX",H'["/" S N=$$DEFDIR^%ZISH("")_H ;------ END IHS MODIFICATION Q N ; MODE(X) ;Return %ZISOPAR in Y. N Y,Q S Q=$C(34) S Y=$S(X["R"&(X["W"):"RWS",X="N":"NWS",X="W":"NWS",X="A":"AWS",1:"RS") Q $S(Y]"":Q_Y_Q,1:Y) HOPT W !,"You may enter a string of codes that represents",!,"the following host file input/ouput operation:" W !?16,"R = READ ACCESS",!?16,"W = WRITE ACCESS",!?16,"N = NEWVERSION",!?16,"S = STREAM FORMAT",!?16,"V = VARIABLE FORMAT",!?16,"A = APPEND" W !,"Example valid groupings 'RS', 'NWS', 'AWS'" Q HOPT1 S %ZISI=$O(^DIC(9.2,"B","XUHFSPARAM-MVX",0)) Q:'%ZISI Q:'$D(^DIC(9.2,+%ZISI,0)) Q:$P(^(0),"^",1)'="XUHFSPARAM-MVX" Q:$D(^DIC(9.2,+%ZISI,1))'>9 F %X=0:0 S %X=$O(^DIC(9.2,+%ZISI,1,%X)) Q:%X'>0 I $D(^(%X,0)) W !,^(0) W ! S %X="??" Q ZISFVXD %ZISF ;SFISC/AC - HOST FILES (VAX DSM) ;05/06/98 16:32 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1007**;APR 1, 2003 ;;8.0;KERNEL;**104**;JUL 10, 1995 HFS Q:$D(IOP)&$D(%IS("HFSIO"))&$D(%IS("IOPAR")) I $D(%ZIS("HFSNAME")) S IO=%ZIS("HFSNAME"),%X=IO E D ASKHFS H S:$D(%ZIS("HFSMODE")) %ZISOPAR=$$MODE(%ZIS("HFSMODE")) H1 I $D(IO("Q"))!(%IS["Z") S IO("HFSIO")="" S %ZHFN=$S(%X]"":%X,1:IO),%ZHFN=$$CHKNM(%ZHFN),%XX=$&ZLIB.%PARSE(%ZHFN) G H2:%XX["::" I %XX]"",$&ZLIB.%GETDVI(%XX,"DEVCLASS")="DISK" E S DUOUT=1,POP=1 W:'$D(IOP) !,"HOST FILE NAME NOT VALID" Q H2 S IO=$&ZLIB.%PARSE(%ZHFN,".DAT") I $D(IO("HFSIO")) S IO("HFSIO")=IO W:'$D(IOP)&$D(%ZIS("HFSNAME")) " HOST FILE TO USE: "_IO,! D ASKPAR^%ZIS6,SETPAR^%ZIS3 HFSIOO Q:$D(%ZIS("HFSMODE")) I '$D(IOP),%ZTYPE="HFS",'$P(^%ZIS(1,%E,0),"^",4),%ZISOPAR="",$P($G(^%ZIS(1,%E,1)),"^",6) W ?45,"INPUT/OUTPUT OPERATION: " Q:'$T D SBR^%ZIS1 I $D(DTOUT)!$D(DFOUT)!$D(DUOUT) S POP=1 Q D HOPT:%X="?"!($F("?^R^N^RW",%X)'>1),HOPT1:%X="??" G HFSIOO:%X="?"!($F("?^R^N^RW",%X)'>1) S %ZISOPAR=$S(%X="R":"(READONLY)",%X="N":"(NEWVERSION)",1:"") Q ; ASKHFS ;---Ask host file name here--- I $D(%IS("B","HFS"))#2,%IS("B","HFS")]"" D .S IO=%IS("B","HFS") ;Set default host file name S %X='$P($G(^%ZIS(1,%E,1)),"^",5) S:'%X %X="" I $D(IOP)!%X!$D(%ZIS("HFSNAME")) S %X="",%ZHFN=IO Q ASKAGN W !,"HOST FILE NAME: "_IO_"//" D SBR^%ZIS1 I %X?1."?".E W !,"ENTER HOST FILE NAME" G ASKAGN S:$D(DTOUT)!$D(DUOUT) POP=1 Q ASKHFSIO(DA) ;Ask HFS Input/Output operation. I %ZTYPE="HFS",'$P(^%ZIS(1,DA,0),"^",4),%ZISOPAR="",$P($G(^%ZIS(1,DA,1)),"^",6) Q 1 Q 0 ; CHKNM(H) ;Check HFS for dir I H[":"!(H["[") Q H Q $$DEFDIR^%ZISH("")_H ; MODE(X) ;Returns OPEN parameters in Y N Y S Y=$S(X["R"&(X["W"):"",X["A":"",X="R":"(READONLY)",X="W":"(NEWVERSION)",1:"(NEWVERSION)") Q Y HOPT W !,"Enter one of the following host file input/ouput operation:" W !,?16,"R = READONLY",!,?16,"N = NEWVERSION",!,?15,"RW = READ/WRITE",! Q HOPT1 S %ZISI=$O(^DIC(9.2,"B","XUHFSPARAM-VXD",0)) Q:'%ZISI Q:'$D(^DIC(9.2,+%ZISI,0)) Q:$P(^(0),"^",1)'="XUHFSPARAM-VXD" Q:$D(^DIC(9.2,+%ZISI,1))'>9 F %X=0:0 S %X=$O(^DIC(9.2,+%ZISI,1,%X)) Q:%X'>0 I $D(^(%X,0)) W !,^(0) W ! S %X="??" Q ; ;--- OPEN/CLOSE EXECUTES, PRE-OPEN and POST-CLOSE EXECUTES FOR P-MESSAGE --- OEXPMSG Q ;Open Execute for p-message device CEXPMSG S XMREC="R X#255:1" U IO:DISCONNECT D ^XMAPHOST,READ^XMAPHOST K XMIO Q ;Close Execute for p-message device Q POXPMSG Q ;Pre-open Execute for p-message device PCXPMSG Q ;Post-close Execute for p-message device ; ;--- OPEN/CLOSE EXECUTES, PRE-OPEN and POST-CLOSE EXECUTES FOR BROWSER DEVICE --- OEXDDBR D OPEN^DDBRZIS Q ;Open Execute for Browser device CEXDDBR D CLOSE^DDBRZIS Q ;Close Execute for Browser device POXDDBR I '$$TEST^DDBRT S %ZISQUIT=1 W $C(7),!,"Browser not selectable from current terminal.",! Q ;Pre-close Execute for Browser device PCXDDBR D POST^DDBRZIS Q ;Post-close Execute for Browser device ZISH %ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;05/21/98 11:17 ;;8.0;KERNEL;**24,36,49,65,84,104**;JUL 10, 1995 ; OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open Host File ;X1=handle name ;X2=directory name \dir\ ;X3=file name ;X4=file access mode e.g.: W for write, R for read, A for append, B for block. ;X5=Max record size for a new file, X6=Subtype N %,%1,%2,%I,%P1,%P2,%P6,%T,%ZA,%ZISHIO S %I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%Q=$C(34) M %ZISHIO=IO S %P2=$S(X4["RW":"RW",X4["W":"W",X4["N":"W",X4["A":"A",1:"R") S %P1=X2_X3,%P6=$S(X4["B":%Q_%Q,1:$C(13,10)) F %2=51:1:54 I '$D(IO(1,%2)) O %2:(%P1:%P2::::%P6):0 I $T S %T=%2 Q I '%T S POP=1 Q ;S %1=$$MODE^%ZISF(X2_X3,X4) U %2 S %ZA=$ZA I %ZA=-1 U:%I]"" %I C %2 S POP=1 Q S IO=%2,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6)) I $G(X1)]"" D SAVDEV^%ZISUTL(X1) Q ; CLOSE(X) ;SR. Close HFS device not opened by %ZIS. ;X=HANDLE NAME, IO=Device N % I $G(IO)]"" C IO K IO(1,IO) I $G(X)]"" D RMDEV^%ZISUTL(X) D HOME^%ZIS Q ; OPENERR ; Q 0 ; DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s) ;S Y=$$DEL^ZOSHMSM("\dir\","fl") ; ,.array) ;Changed %ZX2 to a $NAME string N %,%ZH,ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC S %ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)="" ;Get fls to act on ;No '*' allowed S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:'%ZH I %ZH["*" S ZOSHQ=1 Q Q:$D(ZOSHQ) 0 S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:%ZH="" D .;S ZOSHC="rm "_X1_% .S ZOSHC=$ZOS(2,%ZX1_%ZH) ;Use system function to delete file Q 1 ; LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array") ; "fl*", ; .array, ; ;Change X2 = $NAME OF CLOSE ROOT ;Change X3 = $NAME OF CLOSE ROOT ; N %ZISH,%ZISHN,%ZX,%ZISHY S %ZISHN=0,%ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)="" ;Get fls to act on S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D .S %ZX=%ZX1_%ZISH .F %ZISHN=1:1 D Q:$P(%ZISHY,"^")=""!(%ZISHY<0) S @%ZX3@($P(%ZISHY,"^"))="" ;S @%ZX3@(%ZISHN)=$P(%ZISHY,"^") ..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY) ..E S %ZISHY=$ZOS(12,%ZX,0) Q $O(@%ZX3@(""))]"" ; MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") ; N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) I X1=Y1 Q $ZOS(3,X2,Y2)'<0 S X=X1_X2,Y=Y1_Y2 ; S %ZISHDV1=51,%ZISHDV2=52,%ZISHFN1=X,%ZISHFN2=Y O %ZISHDV1:(%ZISHFN1) O %ZISHDV2:(%ZISHFN2:"W") U %ZISHDV1:(::0:2) S %ZISHSIZ=$ZB U %ZISHDV1:(::0:0) S (%ZISHPCT,%ZB,%ZC)=0 D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) Q 1 ; SLOWCOPY ; Copy without view buffer N X,Y O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"") FOR DO Q:%ZC!(%ZB=%ZISHSIZ) . U %ZISHDV1 R X#1024 Q:$L(X)=0 . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1) . S X=%ZB/%ZISHSIZ*100\1 ; %done . Q:X=%ZISHPCT S %ZISHPCT=X . Q ;U 0 W $J(%ZISHPCT,3),*13 Q ; PWD() ;ef,SR. Print working directory N Y S Y=$$DEFDIR("") I $L(Y) Q Y S Y=$ZOS(11,$ZOS(14)) Q:Y<0 "" S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"") Q $ZOS(14)_":"_Y ; JW ;Call dos $ZOS S ZOSHX=$ZOS(ZOSHNUM,ZOSHC) Q DEFDIR(DF) ;ef. Default Dir and frmt Q:DF="." "" ;Special way to get current dir. S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) S DF=$TR(DF,"/","\") I $E(DF,$L(DF))'="\" S DF=DF_"\" Q DF FL(X) ;Fl len N ZOSHP1,ZOSHP2 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) I $L(ZOSHP1)>8 S X=4 Q I $L(ZOSHP2)>3 S X=4 Q Q READNXT(REC) ;Read any sized record into array. N T,I,X,LB U IO S LB=$ZB R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC,%ZL=%ZA Q:$$EOF(%ZC) Q:%ZA<255 F I=1:1 S LB=LB+%ZA Q:LB<%ZB R X#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC Q:$$EOF(%ZC)!('$L(X)) S REC(I)=X Q STATUS() ;ef,SR. Return EOF status U $I Q $$EOF($ZC) ; EOF(X) ;Eof flag, pass in $ZC Q (X=-1) ; READREC(X) ;Read record from host file. N Y U IO R X S Y=$ZC U $P Q Y MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB N I,F,MX S OVF=$G(OVF,"%ZISHOF") S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; S F=$NA(@HF,IX-1) ;Get first part I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) S %ZISHF=%ZISHF_")" Q FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global ;p1=host file directory ;p2=host file name ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT ;p4=INCREMENT SUBSCRIPT ;p5=Overflow subscript, defaults to "OVF" N %ZA,%ZB,%ZC,%ZL,%OVFCNT,%CONT,%XX N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") D MAKEREF(%ZX3,%ZX4,"%ZISHOF") D OPEN^%ZISH(,%ZX1,%ZX2,"R") I POP Q 0 S X="ERREOF^%ZISH",@^%ZOSF("TRAP") U IO F K %XX D READNXT(.%XX) D Q:$$EOF(%ZC) . S I=('$$EOF(%ZC))!($$EOF(%ZC)&$L(%XX)) Q:'I . S @%ZISHF=%XX . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) . S %ZISHI=%ZISHI+1 . Q D CLOSE() ;Normal exit Q 1 ; ERREOF D CLOSE() ;Error close and exit Q 0 ; GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. ;Previously name LOAD ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory, p4=host file name N %ZISHY,%ZISHOX S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W") Q %ZISHY ; GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A") Q %ZISHY MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y D MAKEREF(%ZX1,%ZX2) D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open I POP Q 0 N X S X="ERREOF^%ZISH",@^%ZOSF("TRAP") F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! D CLOSE() Q 1 ; ZISHMNT %ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;05/21/98 11:17 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1006,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,36,49,65,84**;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ANMC/LJF 6/1/98; IHS/HQW/JLB 2/16/99; IHS/OKCAO/POC 1/22/99; IHS/AAO/RPL 4/14/99; IHS/ANMC/LJF 2/19/97; IHS/MFD; IHS/OKCAO/POC 1/25/99; IHS/OIRM/DSD/AEF/02/19/03 ;THIS IS ROUTINE ZISHMNT ; OPEN(X1,X2,X3,X4,X5) ;SR. Open Host File I '$D(X4) Q $$OPEN^ZISHMSMD(X1,X2,X3); IHS/ANMC/LJF 6/1/98 ;X1=handle name ;X2=directory name \dir\ ;X3=file name ;X4=file access mode e.g.: W for write, R for read, A for append, B for block. ;X5=Max record size for a new file N %,%1,%2,%I,%P1,%P2,%P6,%T,%ZA,%ZISHIO S %I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%Q=$C(34) M %ZISHIO=IO S %P2=$S(X4["RW":"RW",X4["W":"W",X4["N":"W",X4["A":"A",1:"R") S %P1=X2_X3,%P6=$S(X4["B":%Q_%Q,1:$C(13,10)) F %2=51:1:54 I '$D(IO(1,%2)) O %2:(%P1:%P2::::%P6):0 I $T S %T=%2 Q I '%T S POP=1 Q ;S %1=$$MODE^%ZISF(X2_X3,X4) U %2 S %ZA=$ZA I %ZA=-1 U:%I]"" %I C %2 S POP=1 Q S IO=%2,IO(1,IO)="",IOT="HFS",POP=0 I $G(X1)]"" D SAVDEV^%ZISUTL(X1) Q ; CLOSE(X) ;SR. Close HFS device not opened by %ZIS. ;X=HANDLE NAME, IO=Device N % I $G(IO)]"" C IO K IO(1,IO) I $G(X)]"" D RMDEV^%ZISUTL(X) D HOME^%ZIS Q ; OPENERR ; Q 0 ; DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s) ;S Y=$$DEL^ZOSHMSM("\dir\","fl") ; ,.array) ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;LINE ADDED TO REDIRECT TO DEL^ZISHMSMD AS CODE BELOW DOES NOT WORK ;ORIGINAL MODIFICATION BY IHS/OIRM/DSD/AEF/02/19/03 Q $$DEL^ZISHMSMD(%ZX1,%ZX2) ;----- END IHS MODIFICATION ;Changed %ZX2 to a $NAME string N %,%ZH,ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC S %ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)="" ;Get fls to act on ;No '*' allowed S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:'%ZH I %ZH["*" S ZOSHQ=1 Q Q:$D(ZOSHQ) 0 S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:%ZH="" D .;S ZOSHC="rm "_X1_% .S ZOSHC=$ZOS(2,%ZX1_%ZH) ;Use system function to delete file Q 1 ; LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array") ; "fl*", ; .array, ;IHS/HQW/JLB 2/16/99 Enables NT to read directory of files ;IHS/OKCAO/POC 1/22/99 D LIST1 Q VAR LIST1 ; S VAR=1 ;VAR=1 MEANS NO FILES OR A PROBLEM I $G(%ZX1)']""!($G(%ZX2)']"") Q ;PROBLEM D DF(.%ZX1); IHS/AAO/RPL 4/21/99 S X=$ZOS(12,%ZX1_%ZX2,0) Q:$P(X,"^")="" S %ZX3(1)=$P(X,"^",1); IHS/AAO/RPL 4/14/99 changed %ZX3(0) to %ZX3(1) to start counting with 1 not 0 F I=2:1 S X=$ZOS(13,X) Q:$P(X,"^",1)="" S %ZX3(I)=$P(X,"^",1); IHS/AAO/RPL changed F I=1:1 to F I=2:1 I $P(X,"^")'="" S X=$ZOS(16,X) S VAR='$D(%ZX3) Q ; ;Change X2 = $NAME OF CLOSE ROOT ;Change X3 = $NAME OF CLOSE ROOT ; N %ZISH,%ZISHN,%ZX,%ZISHY S %ZISHN=0,%ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)="" ;Get fls to act on S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D .S %ZX=%ZX1_%ZISH .F %ZISHN=1:1 D Q:$P(%ZISHY,"^")=""!(%ZISHY<0) S @%ZX3@($P(%ZISHY,"^"))="" ;S @%ZX3@(%ZISHN)=$P(%ZISHY,"^") ..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY) ..E S %ZISHY=$ZOS(12,%ZX,0) Q $O(@%ZX3@(""))]"" ; MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") ; N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) I X1=Y1 Q $ZOS(3,X2,Y2)'<0 S X=X1_X2,Y=Y1_Y2 ; S %ZISHDV1=51,%ZISHDV2=52,%ZISHFN1=X,%ZISHFN2=Y O %ZISHDV1:(%ZISHFN1) O %ZISHDV2:(%ZISHFN2:"W") U %ZISHDV1:(::0:2) S %ZISHSIZ=$ZB U %ZISHDV1:(::0:0) S (%ZISHPCT,%ZB,%ZC)=0 D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) Q 1 ; SLOWCOPY ; Copy without view buffer N X,Y O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"") FOR DO Q:%ZC!(%ZB=%ZISHSIZ) . U %ZISHDV1 R X#1024 Q:$L(X)=0 . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1) . S X=%ZB/%ZISHSIZ*100\1 ; %done . Q:X=%ZISHPCT S %ZISHPCT=X . Q ;U 0 W $J(%ZISHPCT,3),*13 Q ; PWD(X) ;ef,SR. Print working directory Q $$PWD^ZISHMSMD(.X) ; IHS/ANMC/LJF 2/19/97 N Y S Y=$$DEFDIR("") I $L(Y) Q Y S Y=$ZOS(11,$ZOS(14)) Q:Y<0 "" S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"") Q $ZOS(14)_":"_Y ; JW ;Call dos $ZOS S ZOSHX=$ZOS(ZOSHNUM,ZOSHC) Q DF(X) ;Dir frmt ; IHS/MFD added subroutine and edited for NT/DOS Q:X="" S X=$TR(X,"/","\") I $E(X,$L(X))'="\" S X=X_"\" Q DEFDIR(DF) ;ef. Default Dir and frmt Q:DF="." "" ;Special way to get current dir. S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) S DF=$TR(DF,"/","\") I $E(DF,$L(DF))'="\" S DF=DF_"\" Q DF FL(X) ;Fl len N ZOSHP1,ZOSHP2 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) ;DONT CARE IF LESS THAN 3 OR GREATER THAN 8 ON NT BOX IHS/OKCAO/POC 1/25/99 ;I $L(ZOSHP1)>8 S X=4 Q ;I $L(ZOSHP2)>3 S X=4 Q Q READNXT(REC) ;Read any sized record into array. N T,I,X,LB U IO S LB=$ZB R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC,%ZL=%ZA Q:$$EOF(%ZC) Q:%ZA<255 F I=1:1 S LB=LB+%ZA Q:LB<%ZB R X#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC Q:$$EOF(%ZC)!('$L(X)) S REC(I)=X Q STATUS() ;ef,SR. Return EOF status U $I Q $$EOF($ZC) ; EOF(X) ;Eof flag, pass in $ZC Q (X=-1) ; READREC(X) ;Read record from host file. N Y U IO R X S Y=$ZC U $P Q Y MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB N I,F,MX S OVF=$G(OVF,"%ZISHOF") S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; S F=$NA(@HF,IX-1) ;Get first part I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) S %ZISHF=%ZISHF_")" Q FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global ;p1=host file directory ;p2=host file name ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT ;p4=INCREMENT SUBSCRIPT ;p5=Overflow subscript, defaults to "OVF" N %ZA,%ZB,%ZC,%ZL,%OVFCNT,%CONT,%XX N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") D MAKEREF(%ZX3,%ZX4,"%ZISHOF") D OPEN^%ZISH(,%ZX1,%ZX2,"R") I POP Q 0 S X="ERREOF^%ZISH",@^%ZOSF("TRAP") U IO F K %XX D READNXT(.%XX) D Q:$$EOF(%ZC) . S I=('$$EOF(%ZC))!($$EOF(%ZC)&$L(%XX)) Q:'I . S @%ZISHF=%XX . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) . S %ZISHI=%ZISHI+1 . Q D CLOSE() ;Normal exit Q 1 ; ERREOF D CLOSE() ;Error close and exit Q 0 ; GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. ;Previously name LOAD ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory, p4=host file name N %ZISHY,%ZISHOX S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W") Q %ZISHY ; GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A") Q %ZISHY MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y D MAKEREF(%ZX1,%ZX2) D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open I POP Q 0 N X S X="ERREOF^%ZISH",@^%ZOSF("TRAP") F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! D CLOSE() Q 1 ; ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 SEND(ZISH1,ZISH2,ZISH3) ;SEND FILE ; ;THIS IS A PLACE HOLDER WAITING FOR NT SCRIPT - THIS IS HERE TO ;PREVENT A ERROR ON NT SYSTEMS - AEF/02/12/03 ; Q SENDTO1(ZISH1,ZISH2) ; ; Q ;----- END IHS MODIFICATION ZISHMSM %ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;05/21/98 11:17 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,36,49,65,84,104**;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ANMC/LJF 6/1/98; IHS/ANMC/LJF 2/19/97; IHS/MFD; TASSC/MFD ;THIS IS ROUTINE ZISHMSM ; OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open Host File ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;NEW LINE IS INSERTED TO DIVERT CALL TO $$OPEN^ZISHMSMD IF ONLY ;3 PARAMETERS ARE PASSED. ORIGINAL MOD BY IHS/ANMC/LJF 6/1/98 I '$D(X4) Q $$OPEN^ZISHMSMD(X1,X2,X3) ;----- END IHS MODIFICATION ;X1=handle name ;X2=directory name \dir\ ;X3=file name ;X4=file access mode e.g.: W for write, R for read, A for append, B for block. ;X5=Max record size for a new file, X6=Subtype N %,%1,%2,%I,%P1,%P2,%P6,%T,%ZA,%ZISHIO S %I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%Q=$C(34) M %ZISHIO=IO S %P2=$S(X4["RW":"RW",X4["W":"W",X4["N":"W",X4["A":"A",1:"R") S %P1=X2_X3,%P6=$S(X4["B":%Q_%Q,1:$C(13,10)) F %2=51:1:54 I '$D(IO(1,%2)) O %2:(%P1:%P2::::%P6):0 I $T S %T=%2 Q I '%T S POP=1 Q ;S %1=$$MODE^%ZISF(X2_X3,X4) U %2 S %ZA=$ZA I %ZA=-1 U:%I]"" %I C %2 S POP=1 Q S IO=%2,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6)) I $G(X1)]"" D SAVDEV^%ZISUTL(X1) Q ; CLOSE(X) ;SR. Close HFS device not opened by %ZIS. ;X=HANDLE NAME, IO=Device N % I $G(IO)]"" C IO K IO(1,IO) I $G(X)]"" D RMDEV^%ZISUTL(X) D HOME^%ZIS Q ; OPENERR ; Q 0 ; DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s) ;S Y=$$DEL^ZOSHMSM("\dir\","fl") ; ,.array) ;Changed %ZX2 to a $NAME string N %,%ZH,ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC S %ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)="" ;Get fls to act on ;No '*' allowed S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:'%ZH I %ZH["*" S ZOSHQ=1 Q Q:$D(ZOSHQ) 0 S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:%ZH="" D .;S ZOSHC="rm "_X1_% .S ZOSHC=$ZOS(2,%ZX1_%ZH) ;Use system function to delete file Q 1 ; LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array") ; "fl*", ; .array, ; ;Change X2 = $NAME OF CLOSE ROOT ;Change X3 = $NAME OF CLOSE ROOT ; N %ZISH,%ZISHN,%ZX,%ZISHY S %ZISHN=0,%ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)="" ;Get fls to act on S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D .S %ZX=%ZX1_%ZISH .F %ZISHN=1:1 D Q:$P(%ZISHY,"^")=""!(%ZISHY<0) S @%ZX3@($P(%ZISHY,"^"))="" ;S @%ZX3@(%ZISHN)=$P(%ZISHY,"^") ..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY) ..E S %ZISHY=$ZOS(12,%ZX,0) Q $O(@%ZX3@(""))]"" ; MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") ; N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) I X1=Y1 Q $ZOS(3,X2,Y2)'<0 S X=X1_X2,Y=Y1_Y2 ; S %ZISHDV1=51,%ZISHDV2=52,%ZISHFN1=X,%ZISHFN2=Y O %ZISHDV1:(%ZISHFN1) O %ZISHDV2:(%ZISHFN2:"W") U %ZISHDV1:(::0:2) S %ZISHSIZ=$ZB U %ZISHDV1:(::0:0) S (%ZISHPCT,%ZB,%ZC)=0 D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) Q 1 ; SLOWCOPY ; Copy without view buffer N X,Y O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"") FOR DO Q:%ZC!(%ZB=%ZISHSIZ) . U %ZISHDV1 R X#1024 Q:$L(X)=0 . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1) . S X=%ZB/%ZISHSIZ*100\1 ; %done . Q:X=%ZISHPCT S %ZISHPCT=X . Q ;U 0 W $J(%ZISHPCT,3),*13 Q ; PWD(X) ;ef,SR. Print working directory ;IHS/OIRM/DSD/AEF/1/22/03 PUT 'X' PARAMETER BACK IN FOR IHS ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;NEW LINE IS ADDED TO DIVERT TO $$PWD^ZISHMSMD. ORIGINAL MODIFICATION ;BY IHS/ANMC/LJF 2/19/97 Q $$PWD^ZISHMSMD(.X) ;----- END IHS MODIFICATION N Y S Y=$$DEFDIR("") I $L(Y) Q Y S Y=$ZOS(11,$ZOS(14)) Q:Y<0 "" S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"") Q $ZOS(14)_":"_Y ; JW ;Call dos $ZOS S ZOSHX=$ZOS(ZOSHNUM,ZOSHC) Q ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;NEW SUBROUTINE IS ADDED TO CHANGE SLASHES IN DIRECTORY REFERENCES ;FROM "/" TO "\" FOR NT/DOS COMPATIBILITY. ORIGINAL MODIFICATION ;BY IHS/MFD DF(X) ;Dir frmt Q:X="" S X=$TR(X,"/","\") I $E(X,$L(X))'="\" S X=X_"\" Q ;----- END IHS MODIFICATION DEFDIR(DF) ;ef. Default Dir and frmt Q:DF="." "" ;Special way to get current dir. S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) S DF=$TR(DF,"/","\") I $E(DF,$L(DF))'="\" S DF=DF_"\" Q DF FL(X) ;Fl len N ZOSHP1,ZOSHP2 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THESE TWO LINES ARE COMMENTED OUT, FILE LENGTH IS NO LONGER AN ISSUE. ;ORIGINAL MODIFIATION BY TASSC/MFD ;I $L(ZOSHP1)>8 S X=4 Q ;I $L(ZOSHP2)>3 S X=4 Q ;----- END IHS MODIFICATION Q READNXT(REC) ;Read any sized record into array. N T,I,X,LB U IO S LB=$ZB R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC,%ZL=%ZA Q:$$EOF(%ZC) Q:%ZA<255 F I=1:1 S LB=LB+%ZA Q:LB<%ZB R X#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC Q:$$EOF(%ZC)!('$L(X)) S REC(I)=X Q STATUS() ;ef,SR. Return EOF status U $I Q $$EOF($ZC) ; EOF(X) ;Eof flag, pass in $ZC Q (X=-1) ; READREC(X) ;Read record from host file. N Y U IO R X S Y=$ZC U $P Q Y MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB N I,F,MX S OVF=$G(OVF,"%ZISHOF") S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; S F=$NA(@HF,IX-1) ;Get first part I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) S %ZISHF=%ZISHF_")" Q FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global ;p1=host file directory ;p2=host file name ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT ;p4=INCREMENT SUBSCRIPT ;p5=Overflow subscript, defaults to "OVF" N %ZA,%ZB,%ZC,%ZL,%OVFCNT,%CONT,%XX N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") D MAKEREF(%ZX3,%ZX4,"%ZISHOF") D OPEN^%ZISH(,%ZX1,%ZX2,"R") I POP Q 0 S X="ERREOF^%ZISH",@^%ZOSF("TRAP") U IO F K %XX D READNXT(.%XX) D Q:$$EOF(%ZC) . S I=('$$EOF(%ZC))!($$EOF(%ZC)&$L(%XX)) Q:'I . S @%ZISHF=%XX . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) . S %ZISHI=%ZISHI+1 . Q D CLOSE() ;Normal exit Q 1 ; ERREOF D CLOSE() ;Error close and exit Q 0 ; GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. ;Previously name LOAD ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory, p4=host file name N %ZISHY,%ZISHOX S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W") Q %ZISHY ; GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A") Q %ZISHY MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y D MAKEREF(%ZX1,%ZX2) D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open I POP Q 0 N X S X="ERREOF^%ZISH",@^%ZOSF("TRAP") F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! D CLOSE() Q 1 ; ZISHMSMD ZISHMSMD ; IHS/DSM/MFD - HOST COMMANDS FOR DOS (MSMD); [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ADC/GTH 06/03/96; IHS/AAO/RPL; IHS/HQW/JLB 3/1/99 ; ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. ; OPEN(ZISH1,ZISH2,ZISH3) ; ----- Open DOS file. ; S Y=$$OPEN^%ZISH("\directory\","filename","R") ;error 1=no dev ; 2=open new fl with 'R' ; 3=passes fls by ref ; 4=invalid fl len ; ; --------------------------------------------------------------- ; PROGRAMMERS NOTE: IHS/ADC/GTH - 06-03-96 ; The VA's K8 version of %ZISH added another parameter to $$OPEN, ; the "handle name" of the file, but put the parameter at the ; beginning of the formal parameter list, instead of at the end, ; causing backwards incompatibility problems. ; This version is the IHS's version, with three parameters. ; ZISHMSMD resides in the production UCI and is called by %ZISH ; on DOS-based machines. ; --------------------------------------------------------------- ; NEW ZISHDF,ZISHIOP,%ZIS,POP,ZISHQ ; ; -- Directory format. D DF(.ZISH1) ; ; -- Pass by value or quit. I $O(ZISH2(0)) S ZISHX=3 Q ZISHX ; ; -- Check filename length. D FL(.ZISH2) I ZISH2=4 Q ZISH2 ; S ZISHDF=$S(ZISH1'="":ZISH1_ZISH2,1:ZISH2) ; ; -- Open MSM host. F ZISHIOP=51:1:54 I '$D(IO(1,ZISHIOP)) S IOP=ZISHIOP,%ZIS("IOPAR")="("""_ZISHDF_""":"""_ZISH3_""")" D ^%ZIS Q:'POP I POP Q 1 ; ; -- Check new file with "R" privileges. I ZISH3="R" D .U IO I $ZA=-1 S ZISHQ=2 D ^%ZISC ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. ; I '$D(ZISHQ),'$D(ZTQUEUED) U IO(0) Q $S($D(ZISHQ):ZISHQ,1:0) ; DEL(ZISH1,ZISH2) ; ----- Delete file(s). ; S Y=$$DEL^%ZISH("\directory\","filename") ; ,.array) ;error 1=attempted wild card * del ; NEW ZISHDA,ZISHF,ZISHX,ZISHQ,ZISHDF,ZISHC,ZISHNUM ; ; -- Directory format. D DF(.ZISH1) ; ; -- Set array if filename(s) are passed by value. I '$O(ZISH2(0)) S ZISH2(1)=ZISH2 ; ; -- Get file(s) to act on. ; -- No '*' allowed. F ZISHDA=0:0 S ZISHDA=$O(ZISH2(ZISHDA)) Q:'ZISHDA S ZISHF=ZISH2(ZISHDA) I ZISHF["*" S ZISHX=1,ZISHQ=1 Q I $D(ZISHQ) Q ZISHX F ZISHDA=0:0 S ZISHDA=$O(ZISH2(ZISHDA)) Q:'ZISHDA S ZISHF=ZISH2(ZISHDA) D . I ZISH1'="" S ZISHDF=ZISH1_ZISHF . S ZISHC=$S(ZISH1'="":ZISHDF,1:ZISHF) . S ZISHNUM=2 . D JW .Q Q ZISHX ; FROM(ZISH1,ZISH2,ZISH3,ZISH4,ZISH5) ; ----- Get DOS file(s) from. ; S Y=$$FROM^%ZISH("\dir\","fl","mach","qlfr","\dir\") ; "fl*" ; .array Q 20 ; SEND(ZISH1,ZISH2,ZISH3) ; ----- Send DOS file(s). (MV to export directory.) ; S Y=$$SEND^%ZISH("\dir\","fl","mach") ; "fl*" ; .array NEW Y,ZISH,ZISHPARM I '$L($G(ZISH2)) Q "1^" ; Put array of files in ZISH2() S Y=$$LIST(.ZISH1,ZISH2,.ZISH2) F ZISH=1:1 Q:'$D(ZISH2(ZISH)) S Y=$$MV(ZISH1,ZISH2(ZISH),"\EXPORT\",ZISH2(ZISH)) Q Y ; ; LIST(ZISH1,ZISH2,ZISH3) ; ----- Create local array holding filename(s). ; S Y=$$LIST^%ZISH("\dir\","fl",".return array") ; "fl*", ; .array, ; NEW ZISHC,ZISHDA,ZISHDF,ZISHX,ZISHF,X,Y,ZISHCNT ; ; -- Set array counter for pass back array. S ZISHCNT=0 ; ; -- Directory format. D DF(.ZISH1) ; ; ; -- Set array if filename(s) are passed by value. I '$O(ZISH2(0)) S ZISH2(1)=ZISH2 ; ; -- Get filename(s) to act on. F ZISHDA=0:0 S ZISHDA=$O(ZISH2(ZISHDA)) Q:'ZISHDA S ZISHF=ZISH2(ZISHDA) D . I $P(ZISHF,".",2)="" S ZISHF=ZISHF_".*" . S ZISHDF=$S(ZISH1'="":ZISH1_ZISHF,1:ZISHF) .; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. . S ZISHCNT=ZISHCNT+1 S ZISHX=$ZOS(12,ZISHDF,32+16+4+1) I $P(ZISHX,U)'="",$P(ZISHX,U)'<0 S ZISH3(ZISHCNT)=$P(ZISHX,U) .;Above line fixed 12/17 'I $P...'<0' . F S ZISHCNT=ZISHCNT+1 S ZISHX=$ZOS(13,ZISHX) Q:$P(ZISHX,U)=""!(ZISHX<0) S ZISH3(ZISHCNT)=$P(ZISHX,U) .; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. .Q Q ZISHX ; ; MV(ZISH1,ZISH2,ZISH3,ZISH4) ; ----- Rename a file(s). ; S Y=$$MV^%ZISH("\dir\","fl","\dir\","fl") ; NEW ZISHC,ZISHX ; ; -- Directory format. D DF(.ZISH1) D DF(.ZISH3) ; ; -- Check for pass by value, or quit. I $O(ZISH2(0))!($O(ZISH4(0))) S ZISHX=3 Q ZISHX ; ; -- Check for 'from' and 'to' directory. S ZISH2=$S(ZISH1="":ZISH2,1:ZISH1_ZISH2) S ZISH4=$S(ZISH3="":ZISH4,1:ZISH3_ZISH4) ; S ZISHX=$ZOS(3,ZISH2,ZISH4) ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. Q ZISHX ; PWD(ZISH1) ; ----- Print working directory. ; S Y=$$PWD^%ZISH(.return array) ; ; --------------------------------------------------------------- ; PROGRAMMERS NOTE: IHS/ADC/GTH - 06-03-96 ; The VA's K 8 version makes $$PWD a parameter-less extrinsic, which ; makes it backwards incompatible with IHS. This is the IHS's ; version of $$PWD. ; --------------------------------------------------------------- ; NEW X,Y S ZISH1(1)=$ZOS(11,"C") ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. Q ZISH1(1) ; WAS Q ZISH(1) AND GAVE UNDEF ON ZISH(1) ;IHS/AAO/RPL ; JW ; ----- Call DOS $ZOS. S ZISHX=$ZOS(ZISHNUM,ZISHC) ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. Q ; DF(X) ; ----- Directory format. Q:X="" S X=$TR(X,"/","\") I $E(X,$L(X))'="\" S X=X_"\" Q ; STATUS() ; -----EndOfFile flag. Q $ZC ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. ; FL(X) ; ----- Check for filename length. N ZISHP1,ZISHP2 S ZISHP1=$P(X,"."),ZISHP2=$P(X,".",2) ; Don't really care about filename length for NT systems IHS/HQW/JLB 3/1/99 ;I $L(ZISHP1)>8 S X=4 Q IHS/HQW/JLB 3/1/99 ;I $L(ZISHP2)>3 S X=4 Q IHS/HQW/JLB 3/1/99 Q ; ZISHMSMU ZISHMSMU ; IHS/DSM/MFD - HOST COMMANDS FOR UNIX (MSMU); [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1006,1007**;APR 1, 2003 ;;8.0;KERNEL;;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/HQW/JLS 12/24/97; IHS/ANMC/LJF 12/11/96; IHS/ADC/GTH 06/03/96; IHS/AAO/RPL 4/9/99; TASSC/MFD ; ; Excepted from IHS SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. ; ;IHS/HQW/JLS 12/24/97 This routine called by %ZISH on UNIX Systems ; ;IHS/ANMC/LJF 12/11/96 ; -- changed exit value for PWD call to make it work for VA calls ; OPEN(ZISH1,ZISH2,ZISH3) ; ----- Open unix file. ; S Y=$$OPEN^%ZISH("/directory/","filename","R") ;error 1=no device ; 2=open new file with 'R' ; 3=passed files by reference ; 4=invalid filename length ; ; --------------------------------------------------------------- ; PROGRAMMERS NOTE: IHS/ADC/GTH - 06-03-96 ; The VA's K8 version of %ZISH added another parameter to $$OPEN, ; the "handle name" of the file, but put the parameter at the ; beginning of the formal parameter list, instead of at the end, ; causing backwards incompatibility problems. ; This version is the IHS's version, with three parameters. ; --------------------------------------------------------------- ; NEW ZISHDF,ZISHIOP,%ZIS,POP,ZISHQ,IOUPAR ; ; -- Directory format. D DF(.ZISH1) ; ; -- Pass by value, or quit. I $O(ZISH2(0)) Q 3 ; ; -- Check filename length. D FL(.ZISH2) I ZISH2=4 Q 4 ; S ZISHDF=$S(ZISH1'="":ZISH1_ZISH2,1:ZISH2) ; ; -- Open MSM host. F ZISHIOP=51:1:54 I '$D(IO(1,ZISHIOP)) S IOP=ZISHIOP,%ZIS("IOPAR")="("""_ZISHDF_""":"""_ZISH3_""")" D ^%ZIS Q:'POP I POP Q 1 ; ; -- Check new filename with "R" privileges. I ZISH3="R" U IO I $ZA=-1 S ZISHQ=2 D ^%ZISC ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. ; I '$D(ZISHQ),'$D(ZTQUEUED) U IO(0) Q $S($D(ZISHQ):ZISHQ,1:0) ; DEL(ZISH1,ZISH2) ; ----- Delete file(s). ; S Y=$$DEL^%ZISH("/directory/","filename") ; ,.array) NEW ZISHDA,ZISHF,ZISHX,ZISHQ,ZISHDF,ZISHC ; ; -- Directory format. D DF(.ZISH1) ; ; -- Set array if filename(s) passed by value. I '$O(ZISH2(0)) S ZISH2(1)=ZISH2 ; ; -- Get filename(s) to act on. ; -- No '*' allowed. F ZISHDA=0:0 S ZISHDA=$O(ZISH2(ZISHDA)) Q:'ZISHDA S ZISHF=ZISH2(ZISHDA) I ZISHF["*" S ZISHX=1,ZISHQ=1 Q I $D(ZISHQ) Q ZISHX F ZISHDA=0:0 S ZISHDA=$O(ZISH2(ZISHDA)) Q:'ZISHDA S ZISHF=ZISH2(ZISHDA) D . I ZISH1'="" S ZISHDF=ZISH1_ZISHF . S ZISHC="rm "_$S(ZISH1'="":ZISHDF,1:ZISHF) . D JW .Q Q ZISHX ; FROM(ZISH1,ZISH2,ZISH3,ZISH4,ZISH5) ; ----- Get unix file(s) from. ; S Y=$$FROM^%ZISH("/dir/","fl","mach","qlfr","/dir/") ; "fl*" ; .array Q 20 ; SEND(ZISH1,ZISH2,ZISH3) ;Send unix fl ; S Y=$$SEND^%ZISH("/dir/","fl","mach") ; "fl*" ; .array NEW ZISH,ZISHPARM S ZISH1=$G(ZISH1) ; If directory not passed, use system. I '$L($G(ZISH2)) Q "-1^" I '$L($G(ZISH3)) Q "-1^" S Y=$$LIST(.ZISH1,ZISH2,.ZISH2) ; Put array of files in ZISH2() I OS=AIX S ZISHPARM="-nc" S ZISHPARM="-a";IHS/AAO/RPL -a for ascii mode with ftpsend -n = suppress sending results in UNIX mail message to the user -c = pack file(s) with 'compress' before sending I OS=SCO S ZISHPARM="-p" -p = pack the file before the send request F ZISH=1:1 Q:'$D(ZISH2(ZISH)) S ZISHC="cd /usr/spool/uucppublic; ftpsend "_ZISHPARM_" "_ZISH3_" "_ZISH2(ZISH) D JW;IHS/AAO/RPL 4/9/99 ftpsend after cd to public or nothing gets sent. Q ZISHX ;IHS/AAO/RPL moved down from above line ; ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;Subroutine SENDTO1 is added to use sendto1 script to send file SENDTO1(X,Y) ;use sendto1 script to send unix file ;X=Entry in ZISH SEND PARAMETERS FILE (name or ien) ;Y=file (path and filename) ; ; S Y=$$SENDTO1^%ZISH("param","/path/file") ; N ZISH I '$L($G(Y)) Q "-1^" S ZISHFL=Y D GETDA I '$G(ZISHDA1) Q Y S ZISHDA=ZISHDA1 D ONE I Y=0 D .S Y="0^processed" .I $G(ZISHRNUM) S Y=Y_"^"_ZISHRNUM Q Y ;----- END IHS MODIFICATION LIST(ZISH1,ZISH2,ZISH3) ; ----- Set local array holding filename(s). ; S Y=$$LIST^%ZISH("/dir/","fl",".return array") ; "fl*", ; .array, ; NEW ZISHC,ZISHDA,ZISHDF,ZISHX,ZISHLN,ZISHF,X,Y,POP,ZISHIOP1 ; ; -- Directory format. D DF(.ZISH1) ; ; -- Init ZISHAUTO.$J. S ZISHC="rm /tmp/ZISHAUTO."_$J D JW ; ; -- Set array if filename(s) are passed by value. I '$O(ZISH2(0)) S ZISH2(1)=ZISH2 ; ; -- Get filename(s) to act on. ; -- Append listing to ZISHAUTO.$J. F ZISHDA=0:0 S ZISHDA=$O(ZISH2(ZISHDA)) Q:'ZISHDA S ZISHF=ZISH2(ZISHDA) D . S ZISHDF=$S(ZISH1'="":ZISH1_ZISHF,1:ZISHF) . S ZISHC="ls "_ZISHDF_" >> /tmp/ZISHAUTO."_$J . D JW .Q ; ; -- Open ZISHAUTO.$J to read. ; -- Create the 'Return Array' to pass back to user. S ZISHIOP1=ION_";"_IOST_";"_IOM_";"_IOSL S ZISHX=$$OPEN("/tmp/","ZISHAUTO."_$J,"R") I ZISHX Q ZISHX F ZISHLN=1:1 U IO R X Q:$$STATUS=-1 S ZISH3(ZISHLN)=$P(X,"/",$L(X,"/")) D ^%ZISC S IOP=ZISHIOP1 D ^%ZIS ; ; -- Remove ZISHAUTO.$J. S ZISHC="rm /tmp/ZISHAUTO."_$J D JW ; Q ZISHX ; MV(ZISH1,ZISH2,ZISH3,ZISH4) ; ----- Rename a file. ; S Y=$$MV^%ZISH("/from_dir/","from_fl","/to_dir/","to_fl") ; NEW ZISHC,ZISHX ; ; -- Directory format. D DF(.ZISH1) D DF(.ZISH3) ; ; -- Check for pass by value, or quit. I $O(ZISH2(0))!($O(ZISH4(0))) Q 3 ; ; -- Check for 'from' and 'to' directory. S ZISH2=$S(ZISH1="":ZISH2,1:ZISH1_ZISH2) S ZISH4=$S(ZISH3="":ZISH4,1:ZISH3_ZISH4) ; S ZISHC="mv "_ZISH2_" "_ZISH4 D JW Q ZISHX ; PWD(ZISH1) ; ----- Print working directory. ; S Y=$$PWD^%ZISH(.return array) ; ; --------------------------------------------------------------- ; PROGRAMMERS NOTE: IHS/ADC/GTH - 06-03-96 ; The VA's K 8 version makes $$PWD a parameter-less extrinsic, which ; makes it backwards incompatible with IHS. This is the IHS's ; version of $$PWD. ; --------------------------------------------------------------- ; ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;IHS/OIRM/DSD/AEF/1/22/03 -THE LINE BELOW IS COMMENTED OUT AND REPLACED ;BY NEW LINES TO GET DEF DIR FROM KERNEL SYSTEM PARAMETERS FILE ;S ZISH1(1)="/tmp" S ZISH1(1)=$G(^XTV(8989.3,1,"DEV")) I ZISH1(1)="" S ZISH1(1)="/tmp/" S ZISH1(1)=$TR(ZISH1(1),"\","/") I $E(ZISH1(1),$L(ZISH1(1)))'="/" S ZISH1(1)=ZISH1(1)_"/" Q ZISH1(1) ;IHS/ANMC/LJF 12/11/96 ;Q 1 ;IHS/ANMC/LJF 12/11/96 ;----- END IHS MODIFICATION ; JW ; -- MSM extrinsic. S ZISHX=$$JOBWAIT^%HOSTCMD(ZISHC) ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. Q ; DF(X) ; ----- Directory format. Q:X="" S X=$TR(X,"\","/") I $E(X,$L(X))'="/" S X=X_"/" Q ; STATUS() ; ----- EndOfFile flag. Q $ZC ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. ; ; FL(X) ; ----- Filename length. NEW ZISHP1,ZISHP2 S ZISHP1=$P(X,"."),ZISHP2=$P(X,".",2) ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THESE TWO LINES ARE COMMENTED OUT, FILE LENGTH IS NO LONGER AN ISSUE. ;ORIGINAL MODIFIATION BY TASSC/MFD ;I $L(ZISHP1)>14 S X=4 Q ;I $L(ZISHP2)>8 S X=4 Q ;----- END IHS MODIFICATION Q ; IHS() ;EP - Determine if the call was from an IHS application. I '$L($G(XQY0)) Q 1 I "AB"[$E($G(XQY0)_" ") Q 1 ; If required, add more checks, below. ; I "xxx"[$E($G(XQY0)_" ") Q Q 0 ; ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;New subroutines added to support new $$SENDTO1 function ;Original modification by MJD DIST(ZISH1,ZISH2) ;send distribution list N ZISH I '$L($G(Y)) Q "-1^" S ZISHFL=Y D GETDA I '$D(ZISHDA1) Q Y I '$O(^%ZIB(9888888.93,ZISHDA1,1,0)) Q "-1^no entries in distribution list" S ZISHDA=0 F S ZISHDA=$O(^%ZIB(9888888.93,ZISHDA1,1,ZISHDA)) Q:'ZISHDA D .D ONE S Y="0^list processed" Q Y ONE ;run one F I=1:1:10 S ZISH(I)=$P(^%ZIB(9888888.93,ZISHDA,0),"^",I) S:ZISH(8)="" ZISH(8)="sendto1" S ZISHC=ZISH(8) I ZISH(3)'="",ZISH(4)'="" D .S:ZISH(6)'="" ZISH(6)=ZISH(6)_" " .S ZISH(6)=ZISH(6)_"-l "_ZISH(3)_":"_ZISH(4) I ZISH(5)'="" D .S:ZISH(6)'="" ZISH(6)=ZISH(6)_" " .S ZISH(6)=ZISH(6)_"-r "_ZISH(5) I ZISH(10)'="" D .S:ZISH(6)'="" ZISH(6)=ZISH(6)_" " .S ZISH(6)=ZISH(6)_"-w "_ZISH(6) S:ZISH(6)'="" ZISHC=ZISHC_" "_ZISH(6) S ZISHC=ZISHC_" "_ZISH(2)_" "_ZISHFL I ZISH(8)="sendto1",ZISH(7)="B" D .S ZISHRNUM=$$NXNM() .S ZISHC=ZISHC_" "_ZISHRNUM .S DIE="^%ZIB(9888888.93,",DA=ZISHDA,DR=".09///"_ZISHRNUM .D ^DIE D @(ZISH(7)) K ZISH,ZISHDA,ZISHFL Q ; F ;call hostcmd foreground S Y=$$TERMINAL^%HOSTCMD(ZISHC) Q B ;call hostcmd background S Y=$$JOBWAIT^%HOSTCMD(ZISHC) Q SCRIPT(X) ;run a script ;x=entry in ZISH SEND PARAMETERS file (name or ien) D GETDA I '$G(ZISHDA) Q Y S ZISH(7)=$P(^%ZIB(9888888.93,ZISHDA,0),"^",7) I ZISH(7)="" Q Y S I=0 F S I=$O(^%ZIB(9888888.93,ZISHDA,2,I)) Q:'I D .S ZISHC=^%ZIB(9888888.93,ZISHDA,2,I,0) .D @(ZISH(7)) Q Y GETDA ;internal entry number K ZISHDA1 S Y="-1^" I $G(X)="" Q I X,$D(^%ZIB(9888888.93,X,0)) D Q .S ZISHDA1=X .K Y S ZISHDA1=$O(^%ZIB(9888888.93,"B",X,0)) I '$D(^%ZIB(9888888.93,+ZISHDA1,0)) D .K ZISHDA1 Q NXNM() ;get next reference number I '$D(^%ZIB(9888888.93,"ARNUM")) D .S ^%ZIB(9888888.93,"ARNUM")=0 L +^%ZIB(9888888.93,"ARNUM"):1 I '$T Q 0 S Y=^%ZIB(9888888.93,"ARNUM")+1 S ^%ZIB(9888888.93,"ARNUM")=Y L -^%ZIB(9888888.93,"ARNUM") Q Y ;----- END IHS MODIFICATION ZISHMSU %ZISH ;IHS/PR,SFISC/AC ; HOST COMMANDS - UNIX (MSU); [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ADC/GTH 11/25/96; IHS/ANMC/LJF 12/11/96; TASSC/DFM; IHS/OIRM/DSD/AEF/12/19/02 ;IHS/OIRM/DSD/AEF/1/21/03 ;THIS IS ROUTINE ZISHMSU ; ; For unix operating systems. ; ; Save in MGR uci as %ZISH. ; ; IHS/ADC/GTH 11-25/96 - Intercepts added for IHS calls that are ; not compatible with VA calls. See $$IHS^ZISHMSMU if any options ; need to be added for your site. ; ;IHS/ANMC/LJF 12/11/96 ; -- checked for passing of 4th parameter, if not sent use IHS code ; -- redirected PWD call to IHS code ; ; OPEN(X1,X2,X3,X4) ; I '$D(X4) Q $$OPEN^ZISHMSMU(X1,X2,X3) ;IHS/ANMC/LJF 12/11/96 ;I $$IHS^ZISHMSMU Q $$OPEN^ZISHMSMU(X1,X2,X3) ; IHS/ADC/GTH 10-28-96 ;X1=handle name ;X2=directory name /dir/ ;X3=file name ;X4=file access mode e.g.: W for write, R for read, A for append. N %,%1,%I S %I=$I F %=51:1:54 O %::0 S %T=$T Q:%T I %T S IO=%,IO(1,IO)="",POP=0 ; E U:$D(IO(1,%I) %I S POP=1 Q ; IHS/ADC/GTH 11-25-96 E U:$D(IO(1,%I)) %I S POP=1 Q ; IHS/ADC/GTH 11-25-96 S %1=$$MODE^%ZISF(X2_X3,X4) S %=%_":"_%1 U @% S %ZA=$ZA I %ZA=-1 U %I C IO K IO(1,IO) S POP=1 Q ;Q 0 ;S IO=%,IO(1,IO)="" I $G(X1)]"" D SAVDEV^%ZISUTL(X1) Q ;Q 1 ; CLOSE(X) ;Close HFS device not opened by %ZIS. ;X=HANDLE NAME N % I $G(X)]"" C IO K IO(1,IO) D RMDEV^%ZISUTL(X),HOME^%ZIS Q C IO K IO(1,IO) D HOME^%ZIS Q ; OPENERR ; Q 0 ; DEL(%ZISHX1,%ZISHX2) ;Del fl(s) I $$IHS^ZISHMSMU Q $$DEL^ZISHMSMU(%ZISHX1,%ZISHX2) ; IHS/ADC/GTH - 10-28-96 ;S Y=$$DEL^ZOSHMSM("/dir/","fl") ; ,.array) ;Changed param 2 to a $NAME string. N %ZISH,%ZISHLGR N ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC ; ;Dir frmt ;D DF(.ZOSH1) CHANGE TO USE $TR S %ZISHX1=$TR(%ZISHX1,"\","/") ; ;Get fls to act on ;No '*' allowed S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:'%ZISH I %ZISH["*" S ZOSHQ=1 Q I $D(ZOSHQ) X "I $G(%ZISHLGR)]"""",$D(@%ZISHLGR)" Q 0 S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D .S ZOSHC="rm "_%ZISHX1_%ZISH .;S ZOSHC=$ZOS(2,%ZOSHX1_%ZISH) .D JW I $G(%ZISHLGR)]"",$D(@%ZISHLGR) Q 1 ; ; LIST(%ZISHX1,%ZISHX2,%ZISHX3) ;Create a local array holding fl names I $$IHS^ZISHMSMU Q $$LIST^ZISHMSMU(%ZISHX1,%ZISHX2,.%ZISHX3) ; IHS/ADC/GTH - 10-28-96 ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array") ; "fl*", ; .array, ; ;Change X2 = $NAME OF CLOSE ROOT ;Change X3 = $NAME OF CLOSE ROOT ; N %ZISH,%ZISHLGR,%ZISHN,%ZISHX,%ZISXX,%ZISHY S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference S ZOSHC="rm ZOSHAUTO."_$J D JW S %ZISHN=0 ;Get fls to act on S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D .S %ZISHX=%ZISHX1_%ZISH .S ZOSHC="ls -d "_%ZISHX_" >> ZOSHAUTO."_$J .D JW D OPEN("","","ZOSHAUTO."_$J,"R") F ZOSHLN=1:1 U IO R %ZISHXX Q:$$STATUS=-1 D .S %ZISHY=$P(%ZISHXX,"/",$L(%ZISHXX,"/")) .I %ZISHY]"" S @%ZISHX3@(%ZISHY)="" C IO K IO(1,IO) ;Remove ZOSHAUTO.$J S ZOSHC="rm ZOSHAUTO."_$J D JW I $G(%ZISHLGR)]"",$D(@%ZISHLGR) Q $O(@%ZISHX3@(""))]"" ; MV(X1,X2,X3,X4) ;Rename a fl I $$IHS^ZISHMSMU Q $$MV^ZISHMSMU(X1,X2,X3,X4) ; IHS/ADC/GTH - 10-28-96 ;S Y=$$MV^ZOSHMSM("/dir/","fl","/dir/","fl") ; N %,%1 N ZOSHC,ZOSHX ; ;Dir frmt D DF(.X1) D DF(.X3) ; ;Pbv or qit I $O(X2(0))!($O(X4(0))) S ZOSHX=3 X "I $G(%ZISHLGR)]"""",$D(@%ZISHLGR)" Q ZOSHX ; ;Check for 'from' and 'to' directory ; ;S ZOSHC="mv "_X1_X2_" "_X3_X4 S ZOSHC="cp "_X1_X2_" "_X3_X4_" ; rm "_X1_X2 D JW I $G(%ZISHLGR)]"",$D(@%ZISHLGR) Q 1 ;ZOSHX ; PWD(X) ;Print working directory Q $$PWD^ZISHMSMU(.X) ;IHS/ANMC/LJF 12/11/96 I $$IHS^ZISHMSMU Q $$PWD^ZISHMSMU(.X) ; IHS/ADC/GTH - 10-28-96 ; N %,%IS,POP,X,Y,ZOSHC,ZOSHDA,ZOSHDF,ZOSHF,ZOSHIOP,ZOSHLN,ZOSHQ,ZOSHX,ZOSHSYFI,ZOSHIOP1 ; ;Init ZOSHAUTO.$J S ZOSHC="rm ZOSHAUTO."_$J D JW ; S ZOSHC="pwd > ZOSHAUTO."_$J D JW ; ;Open ZOSHAUTO.$J to read. ;Create the 'Return Array' to pass back to user D OPEN^%ZISH("","ZOSHAUTO."_$J,"R") I POP Q "" F %1=1:1 U IO R % Q:$$STATUS=-1 S Y=% D CLOSE^%ZISH("") ; ;Remove ZOSHAUTO.$J S ZOSHC="rm ZOSHAUTO."_$J D JW ; S Y=Y_$S($E(Y,$L(Y))'="/":"/",1:"") Q Y ; JW ;msm extrinsic S ZOSHX=$$JOBWAIT^%HOSTCMD(ZOSHC) Q DF(X) ;Dir frmt Q:X="" S X=$TR(X,"\","/") I $E(X,$L(X))'="/" S X=X_"/" Q ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;ORIGINAL MODIFICATION BY IHS/OIRM/DSD/AEF 12/19/02 ;ADDED SUBROUTINE DEFDIR TO PREVENT CHKNM+3^%ZISF ERROR ;AT THE 'Enter a Host File:' PROMPT WHEN A PATH IS NOT SPECIFIED DEFDIR(DF) ;ef. Default Dir and frmt Q:DF="." "" ;Special way to get current dir. S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) I $E(DF,$L(DF))'="/" S DF=DF_"/" Q DF ;----- END IHS MODIFICATION STATUS() ;Eof flag Q $ZC QL(X) ;Qlfrs Q:X="" S:$E(X)'="-" X="-"_X Q FL(X) ;Fl len N ZOSHP1,ZOSHP2 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) ;----- BEGIN IHS MODIFICATION - XU*8*1007 ;THESE TWO LINES ARE COMMENTED OUT, FILE LENGTH IS NO LONGER AN ISSUE. ;ORIGINAL MODIFICATION BY TASSC/MFD ;I $L(ZOSHP1)>14 S X=4 Q ;I $L(ZOSHP2)>8 S X=4 Q ;----- END IHS MODIFICATION Q ; FTG(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;Unload contents of host file into global ;p1=hostf file directory ;p2=host file name ;p3= NOW $NAME REFERENCE INCLUDING STARTING SUBSCRIPT ;p4=INCREMENT SUBSCRIPT ;p5=Overflow subscript, defaults to "OVF" N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHS,ZISHIO,%ZISHOVL,%ZISHX,ZISHY S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference S %ZISHOVL=$G(%ZISHOVL,"OVF") S %ZISHI=$$QS^XLFUTL(%ZISHX3,%ZISHX4) S %ZISHL=$$QL^XLFUTL(%ZISHX3) I %ZISHX4=(%ZISHL+1),%ZISHI="" S %ZISHI=1 S %ZISH1=$NA(@%ZISHX3,%ZISHX4-1) F %ZISH=%ZISHX4+1:1:%ZISHL S %ZISHS(%ZISH)=$$QS^XLFUTL(%ZISHX3,%ZISH) D OPEN^%ZISH("",%ZISHX1,%ZISHX2,"R") S %ZISHX="",%ZPZB="",%ZPL="",%OVLCNT=0,%CONT=0,%ZISHNREC=1 U IO F D READNXT(.%XX) Q:$$STATUS&'$L(%XX) D ;U 0 W !,"%ZB="_%ZB,!,"%ZPZB+%ZL="_(%ZPZB+%ZL),!,"%ZPZB="_%ZPZB_" %ZL="_%ZL U IO S %ZISHNREC=$S(%ZB'=(%ZPZB+%ZL):1,1:0) S:%ZISHNREC %ZISHI=%ZISHI+1 S %ZPZB=$ZB,%ZPL=%ZL .I %ZISHNREC D ..;U 0 W !,"NEWRECORD" U IO ;XU*8.0*1007;IHS/OIRM/DSD/AEF - 1/21/03 COMMENTED OUT TO PREVENT ERROR IN RPC BROKER ..S %ZISHX=%XX ..S %ZISH2=$NA(@%ZISH1@(%ZISHI)) ..S %ZISH=%ZISH+1 ..F %ZISH=%ZISHX4+1:1:%ZISHL S %ZISH2=$NA(@%ZISH2@(%ZISHS(%ZISH))) ..S @%ZISH2=$E(%ZISHX,1,255) ..S %OVLCNT=0,%CONT=0 ..Q:%ZL'>255 ..D LOOP .E D ..;U 0 W !,"CONTINUATION RECORD" U IO ;XU*8.0*1007;IHS/OIRM/DSD/AEF - 1/21/03 COMMENTED OUT TO PREVENT ERROR IN RPC BROKER ..S %ZL2=$L(%ZISHX),%ZISHX=%ZISHX_$E(%XX,1,255-%ZL2) ..D SETOVL ..S %XX=$E(%XX,256-%ZL2,$L(%XX)) ..S %ZISHX=%XX ..D:%ZISHX]"" SETOVL ..I $L(%ZISHX)>255 D LOOP .;U 0 W !,"%ZB="_%ZB,!,"%ZPZB+%ZL="_(%ZPZB+%ZL),!,"%ZPZB="_%ZPZB_" %ZL="_%ZL U IO ;XU*8.0*1007;IHS/OIRM/DSD/AEF - 1/21/03 COMMENTED OUT TO PREVENT ERROR IN RPC BROKER .S %ZISHNREC=$S(%ZB'=(%ZPZB+%ZL):1,1:0) .I %ZISHNREC D ..S %ZISHI=%ZISHI+1 ;B:%ZISHI=2 .S %ZPZB=$ZB,%ZPL=%ZL ;I %ZISHX]"",%ZISHNREC D SETOVL EOF2 C IO K IO(1,IO) I $G(%ZISHLGR)]"",$D(@%ZISHLGR) ;restore last global reference. Q 1 LOOP S %CONT=1 F Q:$L(%ZISHX)'>255 D .S %ZISHX=$E(%ZISHX,256,$L(%ZISHX)) .D SETOVL:$L(%ZISHX)>255 Q NEXTLUP F Q:%ZA=%ZL D .D READNXT(.%XX) Q:$$STATUS .S %ZL2=$L(%ZISHX),%ZISHX=%ZISHX_$E(%XX,1,255-%L2) .D SETOVL .S %XX=$E(%XX,256-%L2,$L(%XX)) .I $L(%XX)>255 S %ZISHX=%XX D LOOP .E S %ZISHX=%XX D SETOVL Q READNXT(%XX) ; U IO R %XX Q:$$STATUS S %ZA=$ZA,%ZB=$ZB,%ZL=$L(%XX) Q SETOVL ; S %OVLCNT=%OVLCNT+1 S @$NA(@%ZISH1@(%ZISHI))@(%ZISHOVL,%OVLCNT)=$E(%ZISHX,1,255) Q Q 1 GTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;Load contents of global to host file. ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name ; N %ZISHLGR,%ZISHY S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference S %ZISHY=$$MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"W") Q %ZISHY GATF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;Load contents of global to host file. ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHLGR,%ZISHY S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference S %ZISY=$$MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"A") I $G(%ZISHLGR)]"",$D(@%ZISHLGR) Q %ZISHY ; MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;Load contents of global to host file. ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name ;p5=access mode N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHIO,%ZISHX,%ZISHY S %I=$$QS^XLFUTL(%ZISHX1,%ZISHX2) S %L=$$QL^XLFUTL(%ZISHX1) S %1=$NA(@%ZISHX1,%ZISHX2-1) F %ZISH=%ZISHX2+1:1:%ZISHL S %ZISHS(%ZISH)=$$QS^XLFUTL(%ZISHX1,%ZISH) D OPEN^%ZISH("",%ZISHX3,%ZISHX4,%ZISHX5) S %ZISHX="EOF3^%ZISH" F D Q:'($D(@%ZISH2)#2) S %ZISHX=@%ZISH2,%ZISHI=%ZISHI+1 U IO W %ZISHX,! .S %ZISH2=$NA(@%ZISH1@(%ZISHI)) .F %ZISH=%ZISHX2+1:1:%ZISHL S %ZISH2=$NA(@%ZISH2@(%ZISHS(%ZISH))) ;C %ZISHIO D CLOSE^%ZISH("") Q 1 Q ; FROM(ZISH1,ZISH2,ZISH3,ZISH4,ZISH5) ; ----- Get unix file(s) from. ; Q $$FROM^ZISHMSMU(ZISH1,ZISH2,ZISH3,ZISH4,ZISH5) ; ; SEND(ZISH1,ZISH2,ZISH3) ;Send unix fl ; Q $$SEND^ZISHMSMU(ZISH1,ZISH2) ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;Subroutine SENDTO1 is added to use sendto1 script to send file SENDTO1(ZISH1,ZISH2) ;Use sendto1 script to send unix file ; Q $$SENDTO1^ZISHMSMU(ZISH1,ZISH2) ;----- END IHS MODIFICATION ZISHONT %ZISH ;IHS\PR,SFISC/AC - Host File Control for Cache on Windows or Unix ;12/08/98 12:56 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**34,65,84,104**;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY TASSC/MFD ;THIS IS ROUTINE ZISHONT ; ;TASSC/MFD Many mods to enable functioning on Cache, Windows or Unix. ; This routine no longer calls any other routines. ; OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open Host File I '$D(X4) Q $$OPENI(X1,X2,X3) ;TASSC/MFD added call ;X1=handle name ;X2=directory name \dir\ ;X3=file name ;X4=file access mode e.g.: W for write, R for read, A for append. ;X5=Max record size for a new file, X6=Subtype N %,%1,%2,%I,%T,%ZA,%ZISHIO S %I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)) M %ZISHIO=IO S %1=$S(X4["A":"AW",X4["W":"WN",1:"R")_$S(X4["B":"U",1:"S") ;$$MODE^%ZISF(X2_X3,X4) S %=X2_X3 O %:(%1):2 I '$T S POP=1 Q U % S %ZA=$ZA I %ZA=-1 U:%I]"" %I C % S POP=1 Q S IO=%,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6)) I $G(X1)]"" D SAVDEV^%ZISUTL(X1) Q ; CLOSE(X) ;SR. Close HFS device not opened by %ZIS. ;X=HANDLE NAME ;IO=Device N % I $G(IO)]"" C IO K IO(1,IO) I $G(X)]"" D RMDEV^%ZISUTL(X) D HOME^%ZIS Q ; OPENERR ; Q 0 ; DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s) ;S Y=$$DEL^ZOSHMSM("\dir\",$NA(array)) ;TASSC/MFD modified to accommodate IHS calls without $NA array in %ZX2 ;in addition the VA quits 0 if failure whereas IHS quits 0 success N %,%ZISH,ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC,%ZISHDC,%ZISHT,X S %ZX1=$$DEFDIR($G(%ZX1)) ;Get fls to act on ;No '*' allowed I %ZX2["*" Q 1 ;TASSC/MFD S %ZISHDC=$S($ZV["UNIX":"rm ",1:"del ") ;TASSC/MFD S %ZISHT=$ZT,X="*DELI",@^%ZOSF("TRAP") ;TASSC/MFD, 9/9/02 added * to not unwind stack I $D(@%ZX2)<10 G DELI ;TASSC/MFD S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:'%ZISH I %ZISH["*" S ZOSHQ=1 Q I $D(ZOSHQ) S X=%ZISHT,@^%ZOSF("TRAP") Q 0 S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D . S %=$S(%ZISH[%ZX1:%ZISH,1:%ZX1_%ZISH) . S %=$ZF(-1,%ZISHDC_%) ;TASSC/MFD changed del to a variable to allow Unix or Windows S X=%ZISHT,@^%ZOSF("TRAP") Q 1 ; LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names ;S Y=$$LIST^ZOSHDOS("\dir\",$NA(array),$NA(return array)) ; N %ZISH,%ZISHN,%ZX,%ZISHY,%ZY,%ZISHT,X S %ZX1=$$DEFDIR($G(%ZX1)) ;TASSC/MFD added LISTI sub to accommodate IHS call without $NA array in %ZX2 S %ZISHT=$ZT,X="*LISTI",@^%ZOSF("TRAP") ;TASSC/MFD, 9/9/02 added * to not unwind stack I %ZX2'["*",$D(@%ZX2)<10 G LISTI ;TASSC/MFD I %ZX2["*",$D(@%ZX2)<10 G LISTI ;TASSC/MFD ;Get fls to act on S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D .S %ZX=%ZX1_%ZISH,%ZISHY=$$UP^XLFSTR($P(%ZX,"*")) .F %ZISHN=0:1 D Q:(%ZX="") .. S %ZX=$ZSEARCH($S(%ZISHN:"",1:%ZX)) .. Q:(%ZX="")!($$UP^XLFSTR(%ZX)'[%ZISHY)!(%ZX?.E1.2".") .. S %ZY=$P(%ZX,"\",$L(%ZX,"\")),@%ZX3@(%ZY)="" S X=%ZISHT,@^%ZOSF("TRAP") ;TASSC/MFD reset trap Q $O(@%ZX3@(""))]"" ; MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") ; N %,%ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y,%ZISHMVC S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) S X=X1_X2,Y=Y1_Y2 S %ZISHMVC=$S($ZV["UNIX":"cp ",1:"copy ") ;TASSC/MFD added line to allow cp on UNIX S %=$ZF(-1,%ZISHMVC_X_" "_Y) ;TASSC/MFD changed X1/Y1 to X/Y S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) Q 1 ; S (%ZISHPCT,%ZB,%ZC)=0 D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) Q 1 ; SLOWCOPY ; Copy without view buffer N X,Y O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"") FOR DO Q:%ZC!(%ZB=%ZISHSIZ) . U %ZISHDV1 R X#1024 Q:$L(X)=0 . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1) . S X=%ZB/%ZISHSIZ*100\1 ; %done . Q:X=%ZISHPCT S %ZISHPCT=X . Q ;U 0 W $J(%ZISHPCT,3),*13 Q ; PWD(X) ;ef,SR. Print working directory ;TASSC/MFD parameter put back in for IHS N Y S Y=$$DEFDIR("") I Y="" S Y=$ZSEARCH("*") S X(1)=$P(Y,".",1) Q X(1) ;TASSC/MFD changed to subscripted return var ; DEFDIR(DF) ;ef. Default Dir and frmt ;TASSC/MFD modified to handle UNIX also Q:DF="." "" ;Special way to get current dir. S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) ;TASSC/MFD split line, moved to DEFDIR+6 I $ZV["UNIX" S DF=$TR(DF,"\","/") ;TASSC/MFD added line I $ZV["UNIX",$L(DF),$E(DF,$L(DF))'="/" S DF=DF_"/" ;TASSC/MFD added line Q:$ZV["UNIX" DF ;TASSC/MFD added line S DF=$TR(DF,"/","\") I $L(DF),$E(DF,$L(DF))'="\" S DF=DF_"\" Q DF DF(X) ;Dir frmt ;TASSC/MFD added DF+2 Q:X="" I $ZV["UNIX" S X=$TR(X,"\","/") S:$E(X,$L(X))'="/" X=X_"/" Q ;TASSC/MFD added line for UNIX sys S X=$TR(X,"/","\") I $E(X,$L(X))'="\" S X=X_"\" Q Q FL(X) ;Fl len N ZOSHP1,ZOSHP2 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) ;I $L(ZOSHP1)>8 S X=4 Q ;TASSC/MFD we don't care how long the file name is ;I $L(ZOSHP2)>3 S X=4 Q ;TASSC/MFD we don't care how long the file name is Q READNXT(REC) ;Read any sized record into array. N %,I,X S %ZA=0,$ZT="READNX" U IO R X S %ZB=$A($ZB),REC=$E(X,1,255) Q:$L(X)<256 S %=256 F I=1:1 Q:$L(X)<% S REC(I)=$E(X,%,%+254),%=%+255 Q READNX ;Check for EOF ;I $ZE["ENDOFFILE" S %ZA=-1 ;TASSC/MFD commented out I $ZEOF S %ZA=-1 ;TASSC/MFD added line since we are checking for $ZEOF Q STATUS() ;ef,SR. Return EOF status U $I Q $$EOF($ZA) ; EOF(X) ;Eof flag, pass in $ZC Q $ZEOF ;TASSC/MFD check for $ZEOF rather than ENDOFFILE error ;Q (X=-1) ;TASSC/MFD original line commented out ; READREC(X) ;Read record from host file. N Y U IO R X S Y=$ZC U $P Q Y MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB N I,F,MX S OVF=$G(OVF,"%ZISHOF") S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; S F=$NA(@HF,IX-1) ;Get first part I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 %ZX I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) S %ZISHF=%ZISHF_")" Q FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global ;p1=hostf file directory ;p2=host file name ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT ;p4=INCREMENT SUBSCRIPT ;p5=Overflow subscript, defaults to "OVF" N %ZA,%ZB,X,%OVFCNT,%ZISHF,%ZISHO,POP,%ZISUB N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") D MAKEREF(%ZX3,%ZX4,"%ZISHOF") D OPEN^%ZISH(,%ZX1,%ZX2,"R") I POP Q 0 S X="ERREOF^%ZISH",@^%ZOSF("TRAP") U IO F K %XX D READNXT(.%XX) Q:$$EOF(%ZA) D . S @%ZISHF=%XX . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) . S %ZISHI=%ZISHI+1 . Q D CLOSE() ;Normal exit Q 1 ; ERREOF D CLOSE() ;Error close and exit Q 0 ; GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY,%ZISHOX S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"W") Q %ZISHY ; GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"A") Q %ZISHY ; MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y D MAKEREF(%ZX1,%ZX2) D OPEN^%ZISH(,$G(%ZX3),%ZX4,%ZX5) ;Default dir set in open I POP Q 0 N X S X="ERREOF^%ZISH",@^%ZOSF("TRAP") F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! D CLOSE() Q 1 ; ; ; TASSC/MFD all subs below are IHS-added ; OPENI(X1,X2,X3) ; called from OPEN sub above, or can be called directly N %,%1,%2,%I,%T,%ZA,%ZISHIO S %I=$I,%T=0,POP=0,X1=$$DEFDIR($G(X1)) M %ZISHIO=IO ;TASSC/MFD 11/15/02 uncommented and changed X2= to X1= to get \ appended to directory variable X1 S %1=$S(X3["A":"AW",X3["W":"WN",1:"R")_$S(X3["B":"U",1:"S") ;$$MODE^%ZISF(X2_X3,X4) S %=X1_X2 O %:(%1):2 I '$T S POP=1 Q 1 U % S %ZA=$ZA I %ZA=-1 U:%I]"" %I C % S POP=1 Q 1 S IO=%,IO(1,IO)="",IOT="HFS",POP=0 ;I $G(X1)]"" D SAVDEV^%ZISUTL(X1) I '$D(ZTQUEUED) U IO(0) Q 0 ; DELI ; called from DEL sub above S X=%ZISHT,@^%ZOSF("TRAP") ; reset the trap S %ZISH=%ZX2,%=$S(%ZISH[%ZX1:%ZISH,1:%ZX1_%ZISH) D . S %=$ZF(-1,%ZISHDC_%) Q % LISTI ;List files, put in %ZX3 array ; called from LIST sub above ; reset trap first S X=%ZISHT,@^%ZOSF("TRAP") ;TASSC/MFD reset trap S VAR=1 ;VAR=1 means no files or a problem I $G(%ZX1)']""!($G(%ZX2)']"") Q S %ZX=%ZX1_%ZX2,%ZISHY=$$UP^XLFSTR($P(%ZX,"*")) F %ZISHN=0:1 D Q:(%ZX="") . S %ZX=$ZSEARCH($S(%ZISHN:"",1:%ZX)) . Q:(%ZX="")!($$UP^XLFSTR(%ZX)'[%ZISHY)!(%ZX?.E1.2".") . I $ZV["UNIX" S %ZY=$P(%ZX,"/",$L(%ZX,"/")),%ZX3(%ZISHN+1)=%ZY . I $ZV["Windows" S %ZY=$P(%ZX,"\",$L(%ZX,"\")),%ZX3(%ZISHN+1)=%ZY ;S VAR='$D(%ZX3) Q '$D(%ZX3) ; SEND(ZISH1,ZISH2,ZISH3,ZISHPARM) ;Send UNIX or Windows fl ; S Y=$$SEND^%ZISH("/dir/","fl","mach","ftpsend param") ; "fl*" ; .array ; TASSC/MFD added ZISHPARM as a 4th parameter, parameters for send scripts ; NEW ZISH S ZISH1=$G(ZISH1) ; If directory not passed, use system. I '$L($G(ZISH2)) Q "-1^" I '$L($G(ZISH3)) Q "-1^" S Y=$$LIST(.ZISH1,ZISH2,.ZISH2) ; Put array of files in ZISH2() I '$L($G(ZISHPARM)) S ZISHPARM="-a" ; -a for ascii mode with ftpsend S ZISHC="cd /usr/spool/uucppublic; ftpsend " ;TASSC/MFD moved script into a var ; -n = suppress sending results in UNIX mail message to the user ; -c = pack file(s) with 'compress' before sending I $ZV["Windows" S ZISHC="sendto " ;TASSC/MFD accommodate Windows, use full path names on files F ZISH=1:1 Q:'$D(ZISH2(ZISH)) D . S ZISHC=ZISHC_ZISHPARM_" "_ZISH3_" "_ZISH2(ZISH) . D JW ;IHS/AAO/RPL 4/9/99 ftpsend after cd to public or nothing gets sent. Q ZISHX ;IHS/AAO/RPL moved down from above line ; JW ; -- Cache extrinsic. S ZISHX=$$JOBWAIT^%HOSTCMD(ZISHC) ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93. Q ; IP() ; return underlying connections ip address Q $P($ZU(54,13,$P($ZIO,"/")),",") HOST() ; return underlying host name Q $P($ZU(54,13,$P($ZIO,"/")),",",2) ZISHPW %ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM (PW);09/23/96 11:22 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,36**;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ADC/GTH 2/19/97; IHS/ANMC/LJF 2/19/97 ;THIS IS ROUTINE ZISHPW ; OPEN(X1,X2,X3,X4,X5) ;SR. Open Host File I $$IHS^ZISHMSMU Q $$OPEN^ZISHMSMU(X1,X2,X3) ; IHS/ADC/GTH 2/19/97 ;X1=handle name ;X2=directory name \dir\ ;X3=file name ;X4=file access mode e.g.: W for write, R for read, A for append. ;X5=Max record size for a new file N %,%1,%2,%I,%T,%ZA,%ZISHIO S %I=$I,%T=0,POP=0 M %ZISHIO=IO F %=51:1:54 O %::0 I $T S %T=% Q I '%T U:%I]"" %I S POP=1 Q S %1=$$MODE^%ZISF(X2_X3,X4) S %2=%_":"_%1 U @%2 S %ZA=$ZA I %ZA=-1 U:%I]"" %I C % S POP=1 Q S IO=%,IO(1,IO)="" I $G(X1)]"" D SAVDEV^%ZISUTL(X1) Q ; CLOSE(X) ;SR. Close HFS device not opened by %ZIS. ;X=HANDLE NAME ;IO=Device N % I $G(IO)]"" C IO K IO(1,IO) I $G(X)]"" D RMDEV^%ZISUTL(X) D HOME^%ZIS Q ; OPENERR ; Q 0 ; DEL(%ZISHX1,%ZISHX2) ;SR. Del fl(s) I $$IHS^ZISHMSMU Q $$DEL^ZISHMSMU(%ZISHX1,%ZISHX2) ; IHS/ADC/GTH 2/19/97 ;S Y=$$DEL^ZOSHMSM("\dir\","fl") ; ,.array) ;Changed X2 to a $NAME string N %,%ZISH N ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC S %ZISHX1=$TR(%ZISHX1,"/","\") ;Get fls to act on ;No '*' allowed S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:'%ZISH I %ZISH["*" S ZOSHQ=1 Q I $D(ZOSHQ) Q 0 S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D .;S ZOSHC="rm "_X1_% .S ZOSHC=$ZOS(2,%ZISHX1_%ZISH) .;D JW Q 1 ; LIST(%ZISHX1,%ZISHX2,%ZISHX3) ;SR. Create a local array holding fl names I $$IHS^ZISHMSMU Q $$LIST^ZISHMSMU(%ZISHX1,%ZISHX2,.%ZISHX3) ; IHS/ADC/GTH 2/19/97 ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array") ; "fl*", ; .array, ; ;Change X2 = $NAME OF CLOSE ROOT ;Change X3 = $NAME OF CLOSE ROOT ; N %ZISH,%ZISHN,%ZISHX,%ZISHY S %ZISHN=0 ;Get fls to act on S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D .S %ZISHX=%ZISHX1_%ZISH .F %ZISHN=1:1 D Q:$P(%ZISHY,"^")=""!(%ZISHY<0) S @%ZISHX3@($P(%ZISHY,"^"))="" ;S @%ZISHX3@(%ZISHN)=$P(%ZISHY,"^") ..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY) ..E S %ZISHY=$ZOS(12,%ZISHX,0) Q $O(@%ZISHX3@(""))]"" ; MV(X1,X2,Y1,Y2) ;SR. Rename a fl I $$IHS^ZISHMSMU Q $$MV^ZISHMSMU(X1,X2,Y1,Y2) ; IHS/ADC/GTH 2/19/97 ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") ; N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y S X=X1_X2 S Y=Y1_Y2 I X1=Y1 Q $ZOS(3,X,Y)'<0 ; S %ZISHDV1=51,%ZISHDV2=52,%ZISHFN1=X,%ZISHFN2=Y O %ZISHDV1:(%ZISHFN1) O %ZISHDV2:(%ZISHFN2:"W") U %ZISHDV1:(::0:2) S %ZISHSIZ=$ZB U %ZISHDV1:(::0:0) S (%ZISHPCT,%ZB,%ZC)=0 D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) Q 1 ; SLOWCOPY ; Copy without view buffer N X,Y O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"") FOR DO Q:%ZC!(%ZB=%ZISHSIZ) . U %ZISHDV1 R X#1024 Q:$L(X)=0 . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1) . S X=%ZB/%ZISHSIZ*100\1 ; %done . Q:X=%ZISHPCT S %ZISHPCT=X . Q ;U 0 W $J(%ZISHPCT,3),*13 Q ; PWD(X) ;SR. Print working directory Q $$PWD^ZISHMSMU(.X) ; IHS/ANMC/LFJ 2/19/97 I $ZV["UNIX" Q $$PWD^ZISHMSMU() ; IHS/ADC/GTH 2/19/97 N Y S Y=$ZOS(11,$ZOS(14)) Q:Y<0 "" S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"") Q $ZOS(14)_":"_Y ; JW ;Call dos $ZOS S ZOSHX=$ZOS(ZOSHNUM,ZOSHC) Q DF(X) ;Dir frmt Q:X="" S X=$TR(X,"/","\") I $E(X,$L(X))'="\" S X=X_"\" Q FL(X) ;Fl len N ZOSHP1,ZOSHP2 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) I $L(ZOSHP1)>8 S X=4 Q I $L(ZOSHP2)>3 S X=4 Q Q READNXT(REC) ;Read any sized record into array. N T,I,X,LB U IO S LB=$ZB R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC,%ZL=%ZA Q:$$EOF(%ZC) Q:%ZA<255 F I=1:1 S LB=LB+%ZA Q:LB<%ZB R X#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC Q:$$EOF(%ZC)!('$L(X)) S REC(I)=X Q STATUS() ;SR. Return EOF status ;U $I Q $ZC ; Q $$EOF($ZC) ; EOF(X) ;Eof flag, pass in $ZC Q (X=-1) ; READREC(X) ;Read record from host file. N Y U IO R X S Y=$ZC U $P Q Y MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB N I,F,MX S OVF=$G(OVF,"%ZISHOF") S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; S F=$NA(@HF,IX-1) ;Get first part I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) S %ZISHF=%ZISHF_")" Q FTG(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;SR. Unload contents of host file into global ;p1=hostf file directory ;p2=host file name ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT ;p4=INCREMENT SUBSCRIPT ;p5=Overflow subscript, defaults to "OVF" N %ZA,%ZB,%ZC,%ZL,X,%OVFCNT,%CONT N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZISHX,%ZISHY,POP,%ZISUB S %ZISHOF=$G(%ZISHX5,"OVF") D MAKEREF(%ZISHX3,%ZISHX4,"%ZISHOF") D OPEN^%ZISH(,%ZISHX1,%ZISHX2,"R") I POP Q 0 S X="ERREOF^%ZISH",@^%ZOSF("TRAP") U IO F K %XX D READNXT(.%XX) Q:$$EOF(%ZC) D . S @%ZISHF=%XX . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) . S %ZISHI=%ZISHI+1 . Q D CLOSE() ;Normal exit Q 1 ; ERREOF D CLOSE() ;Error close and exit Q 0 ; GTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;SR. Load contents of global to host file. ;Previously name LOAD ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY,%ZISHOX S %ZISHY=$$MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"W") Q %ZISHY ; GATF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;SR. Append to host file. ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY S %ZISHY=$$MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"A") Q %ZISHY MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZISHX,Y D MAKEREF(%ZISHX1,%ZISHX2) D OPEN^%ZISH(,%ZISHX3,%ZISHX4,%ZISHX5) I POP Q 0 N X S X="ERREOF^%ZISH",@^%ZOSF("TRAP") F Q:'($D(@%ZISHF)#2) S %ZISHX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZISHX,! D CLOSE() Q 1 ; ZISHUNT ZISHUNT ;SFISC/AC - HUNT GROUP MANAGER (UNT);11/29/89 15:52 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;Jul 10, 1995 ; EDIT ;Edit Hunt Groups. S DIC("A")="Select Hunt Group: ",ZISHG(0)="E" D DIC Q DEL ;Delete Hunt Groups K ^TMP($J) S DIC("A")="Delete which Hunt Group: ",ZISHG(0)="D",ZISHGK=0 D DIC Q:'ZISHGK W !,"You have selected for deletion the following Hunt Groups:",! F ZISI=1:1:ZISHGK I $D(^TMP($J,"DEL",ZISI)) W !?20,$P(^(ZISI),"^",2) W !!,"OK TO DELETE" S %=0,U="^" D YN^DICN I %'=1 W *7," ??" K ^TMP($J),ZISI,ZISHGK Q F ZISI=1:1:ZISHGK I $D(^TMP($J,"DEL",ZISI)) S ZISY=^(ZISI),DA=+ZISY,DIE="^%ZIS(1,",DR=".01///@" D ^DIE W !?20,$P(ZISY,"^",2)_" -- DELETED" K ^TMP($J),ZISI,ZISHGK,ZISY Q DIC W !,DIC("A") R X:DTIME G END:X["^",END:X="" I X?1"?" W !," Enter name of Hunt Group",!!," DO YOU WANT THE ENTIRE HUNT GROUP LIST" S %=0,U="^" D YN^DICN G DIC:%'=1 S X="??" D LST G DIC I X?2"?" D LST G DIC S DIC="^%ZIS(1,",DIC(0)="EMZ",DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG""" I X=$C(32) S X=$S($D(^DISV(DUZ,"^%ZIS(1,")):^("^%ZIS(1,"),1:"") G DIC:'X S X="`"_X D ^DIC I Y<0 S X1=$O(^%ZIS(1,"B",X)) I X1]"",$P(X1,X)="" G DIC I Y<0 X:$D(^DD(3.5,.01,0)) $P(^(0),"^",5) I '$D(X) W *7," ??" G DIC G @ZISHG(0) ; LST S DIC="^%ZIS(1,",DIC(0)="EMZ",DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG""" D ^DIC Q ; E I Y<0 W !?2,*7," ARE YOU ADDING '"_X_"' AS A NEW HUNT GROUP" S %=0,U="^" D YN^DICN W:%'=1 *7," ??" G DIC:%'=1 D ADD Q:Y'>0 S DIE=DIC,DA=+Y,DR=30 D ^DIE S DIC("A")="Select Hunt Group: ",ZISHG(0)="E" G DIC ;S DIC="^%ZIS(1,",DIC(0)="AEMZ",DIC("A")="Select Hunt Group: ",DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG""" D ^DIC Q ADD ;Add Hunt Groups S DIC(0)="LMZ",DLAYGO=3,DIC("DR")="2////HG" D ^DIC I Y<0 W *7,"<"_X_" DELETED>" Q Q D I Y>0,$P(Y,"^",2)]"" S ZISHGK=ZISHGK+1,^TMP($J,"DEL",ZISHGK)=Y,DIC("A")="Another Hunt Group: " W:Y'>0 *7," ??" S DIC("A")="Delete which Hunt Group: ",ZISHG(0)="D" G DIC END K DA,DIC,DIE,DR,X1,X,Y,ZISHG(0) Q ZISHVXD %ZISH ;ISF/AC,RWF - VAX DSM Host file Control ;05/21/98 10:34 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,36,65,84,104**;JUL 10, 1995 ;THIS IS ROUTINE ZISHVXD ; OPENERR ; Q 0 ; OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open file ;D OPEN^%ZISH([handlename],[directory],filename,[accessmode],[recsize]) ;X1=handle name ;X2=directory, X3=filename, X4=access mode ;X5=new file max record size, X6=Subtype ; N %,%1,%2,%IO,%I2,%P,%T,X,Y,$ETRAP S $ETRAP="D OPNERR^%ZISH" S X2=$$DEFDIR($G(X2)),X4=$$UP^XLFSTR(X4) S Y=$S(X4["A":"",X4["R":"READONLY",X4["W":"NEWVERSION",1:"READONLY") S Y=Y_$S(X4["B":":BLOCKSIZE=512",$G(X5)&(X4["W"):":RECORDSIZE="_+X5,1:"") S:$E(Y)=":" Y=$E(Y,2,999) S %IO=X2_X3,%I2="%IO:"_$S($L(Y):"("_Y_")",1:"")_":3" O @%I2 S %T=$T I '%T S POP=1 Q S IO=%IO,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6)) I $G(X1)]"" D SAVDEV^%ZISUTL(X1) U IO:NOTRAP U $P ;Enable use of $ZA to test EOF condition. Q OPNERR ;error on open S POP=1,$ECODE="" U:$G(%P)]"" %P Q ; CLOSE(X) ;SR. Close HFS device not opened by %ZIS. ;X1=Handle name, IO=device I IO]"" C IO K IO(1,IO) I $G(X)]"" D RMDEV^%ZISUTL(X) D HOME^%ZIS Q DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s) ;S Y=$$DEL^ZISH("/dir/",namevalue) N %ZISH,%ZISHLGR,%ZXIT,%ZX,X N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH" S %ZX1=$$DEFDIR($G(%ZX1)) ;Get fls to act on ;No '*' allowed S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:'%ZISH I %ZISH["*" S %ZXIT=1 Q Q:$D(%ZXIT) 0 S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" S %ZX=%ZX1_%ZISH D . S %ZX=$ZSEARCH(%ZX) I %ZX]"" O %ZX:READONLY:0 I $T C %ZX:DELETE Q 1 DELERR ;Trap any $ETRAP error, unwind and return. Q:$ESTACK>1 S $ECODE="" Q:'$QUIT Q 0 ; LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Set local array holding fl names ;S Y=$$LIST^ZISH("/dir/","list_root","return_root") ;list_root can have XX("A*"), XX("test.com")... ;Both arrays passed as $NA values (closed roots). N %IO,%X,%ZISH,%ZISH1,%ZISHIO,%ZX,POP,X,%ZISHDL1,%ZISHDL2,%ZISHDN1,%ZISHDN2 N $ETRAP,$ESTACK S $ETRAP="",%ZX1=$$DEFDIR($G(%ZX1)) S %IO=$I,%ZISHDN1="ZISH"_$J_".TMPA",%ZISHDN2="ZISH"_$J_".TMPB" S %ZISHDL1=%ZX1_%ZISHDN1,%ZISHDL2=%ZX1_%ZISHDN2 S $ZT="SPAWNERR^%ZISH" ;Init %ZISHDL1, %ZISHDL2 by deleteing them I $ZSEARCH(%ZISHDL1)["ZISH" S X=$&ZLIB.%SPAWN("DEL "_%ZISHDL1_";*") I $ZSEARCH(%ZISHDL2)["ZISH" S X=$&ZLIB.%SPAWN("DEL "_%ZISHDL2_";*") ;Get fls to act on, Build listing in ZISH_$J_.TMPA (%ZISHDL1) S %ZISH1=0,%ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" S X=$$LIST1(%ZX1_%ZISH) ;Open %ZISHDL1 to read list backin. S $ZT="LSTEOF^%ZISH" O %ZISHDL1::5 I '$T G LSTEOF U %ZISHDL1:NOTRAP R %ZX I $ZA=-1 G LSTEOF F I=0:1 U %ZISHDL1 R %ZX G LSTEOF:$ZA=-1 I %ZX]"" S %X=$P(%ZX,$C(32)) D . I %ZX'["Total of",%ZX'?.E1".DIR;".N,%ZX'?1"Directory".E D . . I (%X[%ZISHDN1)!(%X[%ZISHDN2) Q . . S @%ZX3@(%X)="" LSTEOF S $ZT="" I $L(%IO) U:$D(IO(1,%IO)) IO C %ZISHDL1:DELETE I $ZSEARCH(%ZISHDL2)]"" S X=$&ZLIB.%SPAWN("DEL "_%ZISHDL2_";*") I $ZSEARCH(%ZISHDL1)]"" S X=$&ZLIB.%SPAWN("DEL "_%ZISHDL1_";*") S $ECODE="" Q ($Q(@%ZX3)]"") ; LIST1(%ZX) ;Get one part of the list S $ZT="LSTERR^%ZISH" I %ZISH1 D . S X=$&ZLIB.%SPAWN("DIR/COL=1 "_%ZX,,%ZISHDL2) . I X S X=$&ZLIB.%SPAWN("APPEND "_%ZISHDL2_" "_%ZISHDL1) I '%ZISH1 S X=$&ZLIB.%SPAWN("DIR/COL=1 "_%ZX,,%ZISHDL1),%ZISH1=1 Q 1 LSTERR ;Error in list I $ZSEARCH(%ZISHDL2)["ZISH" S X=$&ZLIB.%SPAWN("DEL "_%ZISHDL2_";*") Q 0 ; SPAWNERR ;TRAP ERROR OF SPAWN O %ZISHDL1:READONLY:1 I $T C %ZISHDL1:DELETE S $ECODE="" Q 0 ; MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl ;S Y=$$MV^ZISH("/dir/","fl","/dir/","fl") N X,Y,%ZISHDL1 S %ZISHDL1="ZISH"_$J_".TMPA",X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) S $ZT="SPAWNERR^%ZISH" ;Pbv or qit I (X2="")!(Y2="") Q 0 I X1=Y1 D .O @(""""_X1_X2_"""") .C @(""""_X1_X2_""":RENAME="_""""_Y1_Y2_"""") E D .S Y=$&ZLIB.%SPAWN("COPY "_X1_X2_" "_Y1_Y2,,%ZISHDL1) .O %ZISHDL1:READONLY:1 .I $T C %ZISHDL1:DELETE .S X=$&ZLIB.%PARSE(X1_X2) .S Y=$&ZLIB.%SPAWN("DEL "_X,,%ZISHDL1) .O %ZISHDL1:READONLY:1 .I $T C %ZISHDL1:DELETE Q 1 PWD() ;ef,SR. Print working directory N Y S Y=$$DEFDIR("") S:Y="" Y=$&ZLIB.%PARSE("TMP.TMP",,,"DEVICE")_$&ZLIB.%DIRECTORY Q Y ; DEFDIR(DF) ;ef. Default Dir and frmt S DF=$G(DF) Q:DF="." "" ;Special way to get current dir. S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) ;Check syntax, NT system $TR(DF,"/","\") Q DF STATUS() ;ef,SR. Return EOF status U $I:NOTRAP Q $$EOF($ZA) ; EOF(X) ;Eof flag, Pass in $ZA Q (X=-1) QL(X) ;Qlfrs Q:X="" S:$E(X)'="-" X="-"_X Q FL(X) ;Fl len N ZOSHP1,ZOSHP2 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) I $L(ZOSHP1)>14 S X=4 Q I $L(ZOSHP2)>8 S X=4 Q Q ; MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB N I,F,MX S OVF=$G(OVF,"%ZISHOF") S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; S F=$NA(@HF,IX-1) ;Get first part I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) S %ZISHF=%ZISHF_")" Q FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global ;p1=host file directory ;p2=host file name ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT ;p4=INCREMENT SUBSCRIPT ;p5=Overflow subscript, defaults to "OVF" N %ZA,%ZB,%ZC,%ZL,X,%OVFCNT,%CONT N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") D MAKEREF(%ZX3,%ZX4,"%ZISHOF") D OPEN^%ZISH(,%ZX1,%ZX2,"R") I POP Q 0 N $ETRAP S $ETRAP="",X="ERREOF^%ZISH",@^%ZOSF("TRAP") U IO F K %XX D READNXT(.%XX) Q:$$EOF(%ZA) D . S @%ZISHF=%XX . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) . S %ZISHI=%ZISHI+1 . Q D CLOSE() ;Normal exit Q 1 ; ERREOF D CLOSE() ;Got error Reading file Q 0 ; READNXT(REC) ; N T,I,X,%ZL U IO:NOTRAP R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZL=%ZA Q:$$EOF(%ZA) F I=1:1:%ZL\255 R X#255 S %ZA=$ZA Q:$$EOF(%ZA) S REC(I)=X Q GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. ;Previously name LOAD ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY,%ZISHLGR,%ZISHOX S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W") Q %ZISHY ; GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISHY S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A") Q %ZISHY ; MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; ;p1=$NAME of global reference ;p2=incrementing subscript ;p3=host file directory ;p4=host file name N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHS,%ZISHOX,IO,%ZX,Y D MAKEREF(%ZX1,%ZX2) D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open I POP Q 0 N X N $ETRAP S $ETRAP="",X="ERREOF^%ZISH",@^%ZOSF("TRAP") F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! D CLOSE() ;Normal Exit Q 1 ; ZISP %ZISP ;AC/SFISC - Collect screen parameters(Graphic set) ;11/04/97 14:41 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**69**;JUL 10, 1995 Q PSET D PKILL F %ZISI=1:1 S %ZISZ=$T(Z+%ZISI) Q:%ZISZ="" D . I $P(%ZISZ,";",6)="E" S %ZISX=$G(^%ZIS(2,IOST(0),$P(%ZISZ,";",5))) . E S %ZISX=$P($G(^%ZIS(2,IOST(0),$P(%ZISZ,";",5))),"^",$P(%ZISZ,";",6)) . S @$P(%ZISZ,";",3)=%ZISX Q PKILL K IOBAROFF,IOBARON,IOCLROFF,IOCLRON,IODPLXL,IODPLXS,IOITLOFF,IOITLON,IOSMPLX,IOSPROFF,IOSPRON,IOSUBOFF,IOSUBON Q ;The following OLDPSET entry point is no longer used. OLDPSET D PKILL F %ZISI=1:1 S %ZISZ=$T(Z+%ZISI) Q:%ZISZ="" D SETDR^%ZISS D SET2^%ZISS1 G KV^%ZISS Q Z ;;Variable name;Element number;Global subscript;Piece position;1=input key IOBARON ;;IOBARON;60;BAR1;E IOBAROFF ;;IOBAROFF;61;BAR0;E IOCLRON ;;IOCLRON;67.21;CLR1;E IOCLROFF ;;IOCLROFF;67.22;CLR0;E IOSMPLX ;;IOSMPLX;1001;1001;1 IODPLXL ;;IODPLXL;1002;1001;2 IODPLXS ;;IODPLXS;1003;1001;3 IOSUBON ;;IOSUBON;65;SUB1;E IOSUBOFF ;;IOSUBOFF;65.1;SUB0;E IOSPRON ;;IOSPRON;65.2;SPR1;E IOSPROFF ;;IOSPROFF;65.3;SPR0;E IOITLON ;;IOITLON;66;I1;E IOITLOFF ;;IOITLOFF;67;I0;E ZISPL ZISPL ;SF/RWF - UTILITIES FOR SPOOLING ;04/07/98 16:16 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,69**;Jul 10, 1995 ;This is the general code for managment of the spooler file. DELETE ;delete a document from the file. A S DIC("A")="Delete which SPOOL DOCUMENT: " D GETDOC G:Y<0 EXIT I '$P(ZISPL0,U,7) W !,*7,"This Document hasn't been printed. Are you sure??" S DIR(0)="S^n:NO;y:YES;c:CLEAR",DIR("A")="...OK TO DELETE",DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!("yc"'[Y) EXIT S ZISY=Y D DSD($P(ZISPL0,U,10)) ;delete data I ZISY["c" S X=^XMB(3.51,ZISDA,0),^(0)=$P(X,"^",1)_"^^^^"_DUZ_"^^^"_$P(X,"^",8) K ^XMB(3.51,ZISDA,2) W " ... DOCUMENT CLEARED!!" G EXIT ; D DSDOC(ZISDA) ;Delete entry W " ...DOCUMENT DELETED!!",*7,! G EXIT DEL ;Called from mailman to delete the document. Q ;Obsolete GETDOC ;Get a spool document to work on. S Y=-1 Q:$D(DUZ)[0 S ZISPLU=$S($D(^VA(200,DUZ,"SPL")):^("SPL"),1:"") I $P(ZISPLU,"^",1)'["y" W !,?5,*7,"You must be authorized by IRM to use spooling" Q S DIC=3.51,DIC(0)="AEMQZ" D ^DIC Q:Y<0 I $P(Y(0),U,2)]"" W !,?5,*7,"This spool is still active and can't be worked on." G GETDOC S ZISDA=+Y,ZISPL0=Y(0) K DIC Q ; PRINT ; N %,DIC,DIE,DR,DA,X,Y,ZISPL0,ZISPG,ZISDA,ZISDA2,ZISPLC,ZISFDA,ZISIEN,ZISIOP,ZISMSG P S DIC("A")="Print which SPOOL DOCUMENT: " D GETDOC K IOP,%ZIS,%IS Q:Y<0 S ZISPG=$P(ZISPL0,U,8) I $P(ZISPL0,U,3)="m" W !,"Sorry, this spool document has been converted into a mail message",!,"and you are unable to print it" G EXIT I $P(ZISPL0,U,10)'>0 W !,"Sorry there isn't anything to print." G EXIT I $P(ZISPL0,U,11) D MSG2 S %=2 D YN^DICN G EXIT:%'=1 IO ; S DIR(0)="N^1:99",DIR("A")="Copies to Print" D ^DIR S ZISPLC=+$G(Y) I $D(DIRUT) G EXIT U IO(0) S %IS="MQ" D ^%ZIS G:POP EXIT S ZISIOP=ION_";"_IOST_";"_IOM_";"_IOSL U IO(0) S ZISDA2=$$FIND1^DIC(3.5121,","_ZISDA_",","O",ION) I ZISDA2>0,$P(^XMB(3.51,ZISDA,2,ZISDA2,0),"^",3) S ZISMSG="This device is currently printing a copy of this document" G CIO I +ZISPG>IOM!($P(ZISPG,";",2)>IOSL) S ZISMSG="Current page is "_IOM_" by "_IOSL_$C(13,10)_" Page must be at least "_(+ZISPG)_" by "_$P(ZISPG,";",2) G CIO S %=$S(ZISDA2>0:ZISDA2_",",1:"?+1,")_ZISDA_"," S ZISFDA(3.5121,%,.01)=ION,ZISFDA(3.5121,%,1)=ZISPLC D UPDATE^DIE("","ZISFDA","ZISIEN") S:ZISDA2'>0 ZISDA2=ZISIEN(1) W ! I '$D(IO("Q")) S %ZIS="",IOP=ZISIOP D ^%ZIS G:'POP DQP^ZISPL2 S ZTRTN="DQP^ZISPL2",ZTDESC="Print spool document",ZTIO=ZISIOP,ZTSAVE("ZISDA")="",ZTSAVE("ZISDA2")="",ZTSAVE("ZISPLC")="" K IO("Q") D ^%ZTLOAD,^%ZISC K ZTSK G EXIT:$P(ZISPLU,"^",2)'["y" W !!,"Also send to" G IO ; CIO ;Close device and go to IO D ^%ZISC U IO D:$D(ZISMSG) G IO . W !,ZISMSG K ZISMSG CEXIT ;Close device and Exit D ^%ZISC EXIT D KILL^XUSCLEAN S ZTREQ="@" Q ; KERMIT ;Use Kermit to send a spooler file D GETDOC Q:Y'>0 S ZISDA=$P(ZISPL0,U,10) G EXIT:ZISDA'>0 S XTKDIC="^XMBS(3.519,"_ZISDA_",2,",XTKFILE=$P(ZISPL0,U) D MODE^XTKERMIT G EXIT:$D(DIRUT) D SEND^XTKERMIT G EXIT ; BROWSE ;Use FM Browser to look at document D GETDOC Q:Y'>0 S ZISDA=$P(ZISPL0,U,10) G EXIT:ZISDA'>0 D BROWSE^DDBR($NA(^XMBS(3.519,ZISDA,2)),"NR",$P(ZISPL0,U)) G EXIT ; MAIL ;Make into a mail message S ZISPLU=$S($D(^VA(200,DUZ,"SPL")):^("SPL"),1:"") I $P(ZISPLU,U,3)["n" W !,"You are not authorized to convert Spool Documents into Mail Messages." G EXIT S Y=-1 D GETDOC G:Y'>0 EXIT S XS=$P(ZISPL0,"^",10) I 'XS D MSG1 G EXIT S DIR(0)="Y",DIR("A")="Convert spool doc: "_$P(ZISPL0,U)_" into a mail message",DIR("B")="YES" D ^DIR G EXIT:$D(DIRUT),EXIT:Y'=1 ;The following code will move the text from file #3.519 into file #3.9, S %=$P(ZISPL0,U,9) I '+% D MSG1 G EXIT G DQMAIL:%<500 W !,"You have "_%_" lines of text to convert into a mail message.",!,"Do you wish to queue this conversion process" S %=1 D YN^DICN G EXIT:$D(DIRUT),DQMAIL:%=2 ; S ZTIO="",ZTRTN="DQMAIL^ZISPL",ZTDESC="Convert spool document into mail message",ZTSAVE("ZISDA")="" D ^%ZTLOAD G EXIT ; DQMAIL W:'$D(ZTQUEUED) !,"Moving it..." S ZISPL0=$G(^XMB(3.51,ZISDA,0)),XS=$P(ZISPL0,"^",10),XMY(DUZ)="",XMTEXT="^XMBS(3.519,"_XS_",2,",XMSUB="Spool document: "_$P(ZISPL0,"^") D:XS>0 ^XMD ;to make new I $D(XMZ) S XMDUZ=DUZ D NNEW^XMA D DSDOC(ZISDA),DSD(XS) W:'$D(ZTQUEUED) !," Now a normal mail message.." G EXIT ; DSD(DA) ;Delete an entry in the spool data file. Q:DA'>0 N DIK K ^XMB(3.51,"AM",DA) S DIK="^XMBS(3.519," D ^DIK Q DSDOC(DA) ;Delete an entry in the spool doc file. Q:DA'>0 N DIK S DIK="^XMB(3.51," D ^DIK Q ; MSG1 W !,"This spool document doesn't have any text." Q MSG2 W !,"You have exceeded the total spool document line limit allowed." W !,"Therefore, this spool document is incomplete." W !!,"Do you still wish to print this document" Q ; ZISPL1 ZISPL1 ;SF/RWF - %ZIS UTILITIES FOR SPOOLING ;11/20/97 08:53 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,36,69**;Jul 10, 1995 ;This is general code for managment of the spooler file from %ZIS. Q ; FILE ;Called by %ZIS4 to setup spool data file. S %ZDA=$S($D(IO("SPOOL")):IO("SPOOL"),$D(^XUTL("XQ",$J,"SPOOL")):^("SPOOL"),1:0) Q:%ZDA'>0 I '$D(ZISPLAD),$D(^XUTL("XQ",$J,"ADSPL")) S ZISPLAD=^("ADSPL") K ^XUTL("XQ",$J,"SPOOL"),^("ADSPL"),IO("SPOOL") S %ZS=$S($D(^XMB(3.51,%ZDA,0)):^(0),1:"") I %ZS']"" S %ZDA=-1 Q I '$D(ZTSK) S ZTRTN="DQC^ZISPL1",ZTDESC="Background Spool Filer",ZTDTH=$H,ZTIO="",ZTSAVE("%ZDA")="" S:$D(ZISPLAD) ZTSAVE("ZISPLAD")="",ZTSAVE("%ZS")="" D ^%ZTLOAD K ZISPLAD,ZTSK S %ZDA=-1 Q N X,Y K DD,DO S X=%ZDA,DIC="^XMBS(3.519,",DIC(0)="LZ",DLAYGO=3.519 D FILE^DICN S XS=+Y K DD,DO,DLAYGO S $P(^XMB(3.51,%ZDA,0),"^",3)="a",$P(^(0),"^",6)=DT,$P(^(0),"^",10)=XS,^XMB(3.51,"AM",XS,%ZDA)="" Q ; CLOSE S ^XMBS(3.519,XS,2,0)="^^"_%_"^"_%,$P(^XMB(3.51,%ZDA,0),"^",2,3)="^r",$P(^(0),"^",9)=% I $D(ZISPLAD) F %=0:0 S %=$O(^%ZIS(1,+ZISPLAD,"SPL",%)) Q:%'>0 D .I $D(^%ZIS(1,+ZISPLAD,"SPL",%,0)) S %X=^(0) D ..S ZISPLC=$S($P(%X,"^",2)]"":+$P(%X,"^",2),1:1),%X=$P(%X,"^") ..I $D(^%ZIS(1,+%X,0)) K ZISDA2 S ZISPLDV=$P(^(0),"^"),DIE="^XMB(3.51,",DR="[XU-ZISPL1]",(ZISDA,DA)=%ZDA D ADSPL K ^XMB(3.51,"C",%ZFN),XMZ,XMDUZ,%ZDA,%ZFN,% Q ; DQC ;DQ the move from spool to mail message. S IO("SPOOL")=%ZDA D CLOSE^%ZIS4 Q ; ADSPL N %,ZTSK D ^DIE Q:'$D(ZISDA2) S %X="^"_ZISPLC_"^^^^^"_ZISPLDV_";"_$P(%ZS,"^",8)_"^"_$H ; QDSPL S ZISPLC=$P(%X,"^",2),ZTIO=$P(%X,"^",7),ZTDTH=$P(%X,"^",8),ZTRTN="DQP^ZISPL2",ZTDESC="Auto despool document" I ZTIO]"",ZTDTH]"",ZISPLC S ZISDA=%ZDA,ZTSAVE("ZISDA")="",ZTSAVE("ZISDA2")="",ZTSAVE("ZISPLC")="" D ^%ZTLOAD K ZTSK Q ; NEWDOC ;Called by %ZIS4 to get or setup a spool document. N DIC,X,Y I $S($D(^VA(200,DUZ,"SPL")):$E(^("SPL"),1),1:"N")'["y" W:'$D(IOP) !?5,"You aren't an authorized SPOOLER user." Q D LIMITS I '$D(IOP),%Z1'>%Z2!($P(%Z1,"^",2)'>%Z3) D MSG1 Q R S %Y=$S($D(IO("DOC")):IO("DOC"),$G(%ZISMY)]"":$P(%ZISMY,";",1),1:$P(%Y,";",1)) K %Z1,%Z2,%Z3 S DIC=3.51,U="^",DIC("DR")="",DIC("S")="I '$P(^(0),U,10)",DIC("W")="W "" Status: "",$P(^(0),U,3),"" Lines: "",$P(^(0),U,9)" I %IS'[0,$D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",9) D GENDOC G R1 I $D(IOP) S X=%Y,DIC(0)="XMLZ" E S DIC(0)="AEQMZL" S:%Y?1A.ANP DIC("B")=%Y S DLAYGO=3,%ZY=-1 D ^DIC K DLAYGO Q:Y<0 R1 S %ZY=Y,%ZY(0)=Y(0),ZISIOST="P-OTHER",$P(%Z91,"^",2)="#" G:'$P(Y,"^",3) ND3 S %=$$NOW^XLFDT S ^XMB(3.51,+Y,0)=$P(^XMB(3.51,+Y,0),"^",1)_"^^o^"_%_U_DUZ_"^^^"_+%Z91_";"_$P(%Z91,"^",3),^XMB(3.51,"AOK",+Y,DUZ)="",^XMB(3.51,"ADUZ",DUZ,+Y)="" ND3 S %=$P(^XMB(3.51,+Y,0),"^",8),$P(%Z91,"^")=+%,$P(%Z91,"^",3)=$P(%,";",2) Q LIMITS S %Z1=$G(^XTV(8989.3,1,"SPL")),(%Z2,%Z3)=0 ;The next line only counts doc names w/ data ;F %=0:0 S %=$O(^XMB(3.51,"ADUZ",DUZ,%)) Q:%'>0 S %Z4=$S($D(^XMB(3.51,%,0)):^(0),1:""),%Z2=%Z2+$P(%Z4,"^",9),%Z3=$P(%Z4,"^",10)>1+%Z3 ;This line counts all doc names. F %=0:0 S %=$O(^XMB(3.51,"ADUZ",DUZ,%)) Q:%'>0 S %Z4=$G(^XMB(3.51,%,0)),%Z2=%Z2+$P(%Z4,"^",9),%Z3=%Z3+1 Q GENDOC ;Auto generate document name. D FLST S %ZY=$E($P(^%ZIS(1,%ZISIOS,0),"^"),1,25) I %ZY["|DT|" S %ZY=$P(%ZY,"|DT|")_$$HTE^XLFDT($H,"2D")_$P(%ZY,"|DT|",2) G1 S ZISPLST=ZISPLST+1,X=%ZY_"_"_+ZISPLST G G1:$D(^XMB(3.51,+ZISPLST,0)),G1:$O(^XMB(3.51,"B",X,0))>0 S DIC=3.51,DIC(0)="XMLZ",DINUM=+ZISPLST,DLAYGO=3 D ^DIC K DLAYGO I Y'>0 G G1 Q ; MSG1 W !,*7,"You have too many documents or lines, Please delete some documents" Q ; FLST S ZISPLST=$P($G(^XMB(3.51,0)),"^",3) Q ZISPL2 ZISPL2 ;SF/RWF - SPOOLER CLEAN-UP ;12/03/97 14:57 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,36,69**;Jul 10, 1995 1 N DA,DIC,DIK,ZIS,ZISPL K ^XMB(3.51,"AM") ;Clear X-ref first S DIK="^XMB(3.51," D IXALL^DIK ;Re-Index S ZISPL=$G(^XTV(8989.3,1,"SPL"),"1^1^999"),ZISDT=$$FMADD^XLFDT(DT,"-"_$P(ZISPL,"^",3)) F DA=0:0 S DA=$O(^XMB(3.51,DA)) Q:DA'>0 S ZIS=^XMB(3.51,DA,0) I "rpm"[$P(ZIS,"^",3),ZISDT>$S($P(ZIS,"^",6)]"":$P(ZIS,"^",6),$P(ZIS,"^",4)]"":$P(ZIS,"^",4),1:ZISDT) D DELETE F DA=0:0 S DA=$O(^XMB(3.51,DA)) Q:DA'>0 S ZIS=^XMB(3.51,DA,0) I "ao"[$P(ZIS,"^",3),ZISDT>$S($P(ZIS,"^",6)]"":$P(ZIS,"^",6),$P(ZIS,"^",4)]"":$P(ZIS,"^",4),1:ZISDT) D CLOSE F DA=0:0 S DA=$O(^XMBS(3.519,DA)) Q:DA'>0 I '$D(^XMB(3.51,"AM",DA)) D DSD^ZISPL(DA) ;Remove Spool data w/o Spool entry Q DELETE ;REMOVE SPOOL DOC. D DSD^ZISPL($P(ZIS,U,10)) ;Delete Spool Data entry S DIK="^XMB(3.51," D ^DIK ;Delete entry Q CLOSE ;Close a SPOOL DOC that has been open too long. I $$NEWERR^%ZTER N $ESTACK,$ETRAP S $ETRAP="" S X="ET^ZISPL2",@^%ZOSF("TRAP") S %ZFN=$P(ZIS,"^",2),IO=%ZFN,IO("SPOOL")=DA D SPL3^%ZIS4 I %ZFN="" D DELETE Q X "N DA,ZIS D CLOSE^%ZIS4" Q ET ;TRAP ERROR. D DELETE Q DQP Q:'$D(^XMB(3.51,ZISDA,2,ZISDA2,0))!('$D(ZISPLC)) ;Dequeue print S ZISPL0=^XMB(3.51,ZISDA,0),FF="|TOP|",XS=$P(ZISPL0,U,10) Q:XS'>0 U IO F ZISCNT=ZISPLC:-1:1 S PG=1 D OUT S $P(^(0),U,6)=$P(^XMB(3.51,ZISDA,2,ZISDA2,0),U,6)+1 W:$Y>3 @IOF D NOW^%DTC S $P(^XMB(3.51,ZISDA,0),"^",3)="p",$P(^(0),"^",7)=%,$P(^XMB(3.51,ZISDA,2,ZISDA2,0),U,3,5)="^^"_% D ^%ZISC G EXIT^ZISPL ; OUT ; F I=0:0 S I=$O(^XMBS(3.519,XS,2,I)) Q:I'>0 S X=^(I,0),Y=(X=FF) W:Y @IOF W:'Y X,! I Y S PG=PG+1,$P(^XMB(3.51,ZISDA,2,ZISDA2,0),"^",3,4)=PG_"^"_I Q ZISS %ZISS ;AC/SF,SLC/RWF - Collect screen parameters ;11/5/97 16:01 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**69**;JUL 10, 1995 KV K %ZIS,%ZISXX,%ZISYY,%ZISE,%ZISFN,%ZISN,%ZISNP,%ZISX,%ZISY,%ZISZ,%ZISI,ZISCH,ZISEND,ZISNUM,ZISQ,ZISXL,ZISXLN,ZISNP Q KILL ;REMOVES EXTENDED OUTPUT VARIABLES. K IOARM0,IOARM1,IOAWM0,IOAWM1,IOBOFF,IOBON,IOCUB,IOCUD,IOCUF,IOCUU,IODCH,IODHLB,IODHLT,IODL,IODWL,IOECH,IOEDBOP,IOEDEOP,IOEDALL,IOEFLD,IOELBOL,IOELEOL,IOELALL,IOHDWN,IOHOME,IOHTS,IOHUP K IOICH,IOIL,IOIND,IOINHI,IOINLOW,IOINORM,IOIRM0,IOIRM1,IOIS,IOKPAM,IOKPNM,IOMC,IONEL,IOPROP,IOPTCH10,IOPTCH12,IOPTCH16,IORC,IORESET,IORI,IORLF,IORVOFF,IORVON,IOSC,IOSGR0,IOSWL,IOSTBM,IOTBC,IOTBCALL,IOUOFF,IOUON K IOKP0,IOKP1,IOKP2,IOKP3,IOKP4,IOKP5,IOKP6,IOKP7,IOKP8,IOKP9,IOPF1,IOPF2,IOPF3,IOPF4,IOFIND,IOSELECT,IOPREVSC,IONEXTSC,IOCOMMA,IOMINUS,IOPERIOD,IOENTER,IOINSERT,IOREMOVE K IOSMPLX,IODPLXL,IODPLXS Q ; GSET G SETZ^%ZISS2 ; GKILL G KILL^%ZISS2 ; ENDR ;Entry point for DR Value entered into variable X. Q:'$D(IOST(0))!'$D(X)#2 S %ZISZ="" D DR,SET2^%ZISS1,KV Q ; ENS ;Entry point to retrieve all screen parameters. Q:'$D(IOST(0)) D KILL,SET1,SET2^%ZISS1,KV Q ; SET1 ;D SETZ SETZ F %ZISI=1:1 S %ZISZ=$T(Z+%ZISI) Q:%ZISZ="" D SETDR Q DR ;Process variable X. F %ZISN=1:1:$L(X,";") S (%,%ZISZ)=$P(X,";",%ZISN),%ZISZ=$T(@%ZISZ) S:%ZISZ="" %ZISZ=$T(@$E(%,3,$L(%))) I %ZISZ]"",$P(X,";",%ZISN)=$P(%ZISZ,";",3)!($E($P(X,";",%ZISN),3,999)=$P(%ZISZ,";",3)) D SETDR Q SETDR ;SET VARIABLES I $P(%ZISZ,";",6)="E" S %ZISX=$G(^%ZIS(2,IOST(0),$P(%ZISZ,";",5))) E S %ZISX=$P($G(^%ZIS(2,IOST(0),$P(%ZISZ,";",5))),"^",$P(%ZISZ,";",6)) S %ZISZ($P(%ZISZ,";",3))=%ZISX S:$P(%ZISZ,";",7)!$D(%ZISSALL) %ZISZ($P(%ZISZ,";",3),1)="" Q ; LODUTL ;Load global subscripts and piece positions into ^UTILITY($J,"%ZISS",glob loc,piece pos) K ^UTILITY($J) F %ZISI=1:1 S %ZISZ=$T(Z+%ZISI) Q:%ZISZ="" S ^UTILITY($J,"%ZISS",$P(%ZISZ,";",5),$P(%ZISZ,";",6))="" Q LODUTL1 ;Load data element numbers into ^UTILITY($J,"%ZISSDD",data element number K ^UTILITY($J) F %ZISI=1:1 S %ZISZ=$T(Z+%ZISI) Q:%ZISZ="" S ^UTILITY($J,"%ZISSDD",$P(%ZISZ,";",4))="" Q Z ;;Variable name;Element number;Global subscript;Piece position;1=input key IOPTCH10 ;;IOPTCH10;10;5;1 IOPTCH12 ;;IOPTCH12;12;5;2 IOPTCH16 ;;IOPTCH16;12.1;12.1;E IOHOME ;;IOHOME;13;5;3 IORVON ;;IORVON;14;5;4 IORVOFF ;;IORVOFF;15;5;5 IOELEOL ;;IOELEOL;16;5;6 IOEDEOP ;;IOEDEOP;17;5;7 IOBON ;;IOBON;18;5;8 IOBOFF ;;IOBOFF;19;5;9 IORESET ;;IORESET;20;6;1 IOSGR0 ;;IOSGR0;20.5;6;8 IOHUP ;;IOHUP;21;6;2 IOHDWN ;;IOHDWN;22;6;3 IOUON ;;IOUON;23;6;4 IOUOFF ;;IOUOFF;24;6;5 IORLF ;;IORLF;25;6;6 IOPROP ;;IOPROP;26;6;7 IOINHI ;;IOINHI;27;7;1 IOINLOW ;;IOINLOW;28;7;2 IOINORM ;;IOINORM;29;7;3 IOIRM1 ;;IOIRM1;30;7;4 IOIRM0 ;;IOIRM0;30;7;5 IOEDBOP ;;IOEDBOP;32;13;1 IOEDALL ;;IOEDALL;33;13;2 IOELBOL ;;IOELBOL;34;13;3 IOELALL ;;IOELALL;35;13;4 IOECH ;;IOECH;36;13;5 IOEFLD ;;IOEFLD;37;13;6 IOCUU ;;IOCUU;40;8;1;1 IOCUD ;;IOCUD;41;8;2;1 IOCUF ;;IOCUF;42;8;3;1 IOCUB ;;IOCUB;43;8;4;1 IODL ;;IODL;45;8;6 IOIL ;;IOIL;46;8;7 IODCH ;;IODCH;47;8;8 IOICH ;;IOICH;48;8;9 IOCUON ;;IOCUON;49;8.1;1 IOCUOFF ;;IOCUOFF;49.1;8.1;2 IOIND ;;IOIND;70;14;1 IORI ;;IORI;71;14;2 IOSC ;;IOSC;72;14;3 IORC ;;IORC;73;14;4 IONEL ;;IONEL;74;14;5 IOAWM1 ;;IOAWM1;75;15;1 IOAWM0 ;;IOAWM0;76;15;2 IOARM1 ;;IOARM1;77;15;3 IOARM0 ;;IOARM0;78;15;4 IOKPAM ;;IOKPAM;79;15;5 IOKPNM ;;IOKPNM;79.1;15;6 IOHTS ;;IOHTS;80;16;1 IOTBC ;;IOTBC;81;16;2 IOTBCALL ;;IOTBCALL;82;16;3 IOSTBM ;;IOSTBM;83;16;4 IODHLT ;;IODHLT;85;17;1 IODHLB ;;IODHLB;86;17;2 IODWL ;;IODWL;87;17;3 IOSWL ;;IOSWL;88;17;4 IOMC ;;IOMC;112;PRT;1 IOSMPLX ;;IOSMPLX;1001;1001;1 IODPLXL ;;IODPLXL;1002;1001;2 IODPLXS ;;IODPLXS;1003;1001;3 KP0 ;;KP0;120;18;1;1 KP1 ;;KP1;121;18;2;1 KP2 ;;KP2;122;18;3;1 KP3 ;;KP3;123;18;4;1 KP4 ;;KP4;124;18;5;1 KP5 ;;KP5;125;18;6;1 KP6 ;;KP6;126;18;7;1 KP7 ;;KP7;127;18;8;1 KP8 ;;KP8;128;18;9;1 KP9 ;;KP9;129;18;10;1 PF1 ;;PF1;130;19;1;1 PF2 ;;PF2;131;19;2;1 PF3 ;;PF3;132;19;3;1 PF4 ;;PF4;133;19;4;1 MINUS ;;MINUS;134;19;5;1 COMMA ;;COMMA;135;19;6;1 ENTER ;;ENTER;136;19;7;1 PERIOD ;;PERIOD;137;19;8;1 FIND ;;FIND;140;20;1;1 SELECT ;;SELECT;141;20;2;1 INSERT ;;INSERT;142;20;3;1 REMOVE ;;REMOVE;143;20;4;1 PREVSCRN ;;PREVSCRN;144;20;5;1 NEXTSCRN ;;NEXTSCRN;145;20;6;1 HELP ;;HELP;146;21;1;1 DO ;;DO;147;21;2;1 ZISS1 %ZISS1 ;AC/SFISC - Collect screen parameters 5/29/88 2:02 PM ;11/05/97 08:40 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**69**;JUL 10, 1995 VALID D L K %ZISI,%ZISNP,ZISCH,ZISEND,ZISNUM,ZISQ,ZISXL,ZISXLN Q ; SET2 S %ZISFN="" F %ZISZ=0:0 S %ZISFN=$O(%ZISZ(%ZISFN)) Q:%ZISFN="" I $D(%ZISZ(%ZISFN))#2 S %ZISXX=%ZISZ(%ZISFN) D INDCK Q INDCK S %ZISY="" I "IOEFLD^IOSTBM"[%ZISFN S @%ZISFN=%ZISXX Q I %ZISXX]"" S @("%ZISY="_%ZISXX) ;E S @("%ZISY="_"""""") I $E(%ZISFN,1,2)="IO" S @%ZISFN=%ZISY E S @("IO"_$E(%ZISFN,1,6))=%ZISY Q:'$D(%ZIS)#2 Q:%ZIS'["I" Q:'$D(%ZISZ(%ZISFN,1)) SRAY S %=%ZISY,%ZISY=$A($E(%ZISY,1)) F %1=2:1:$L(%) S %ZISY=%ZISY_$S($A(%,%1)<32:$A(%,%1),$A(%,%1)=127:127,1:$E(%,%1)) S IOIS(%ZISY)=%ZISFN Q CHECK ;Entry point called from input transforms of fields in DEV/TT files. S %ZISXX=X D L S X=%ZISYY K %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN Q CHECK1 ;Entry point called from input transforms of fields in DEV/TT files. S %ZISXX=$S(X?1"W ".E:$E(X,3,$L(X)),1:X) D L S X=$S(X?1"W ".E:"W "_%ZISYY,1:%ZISYY) K %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN Q FORM ;Entry point called from input transforms of fields in DEV/TT files. Q:$L(X,"_")'>1 ;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 S %ZISSY="" 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:"_") S X=%ZISSY K %ZISSI,%ZISSY Q ; L S ZISQ="""",%ZISNP=0,ZISXLN=$L(%ZISXX) I 'ZISXLN S %ZISYY="" Q 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 S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX Q L1 I ZISCH="_"!(ZISCH=",") S %ZISYY=%ZISYY_"_" Q I ZISCH=ZISQ D QUOTE Q I ZISCH="$" D DOLR Q I ZISCH="*" D STAR Q I ZISCH="(" D PAREN Q S %ZISYY=%ZISYY_ZISCH Q L2 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 Q L3 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)_")" Q 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 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 Q 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' N %A,ZISOS,X,NIO S ZISOS=^%ZOSF("OS"),TO=$G(TO,30) I $$NEWERR^%ZTER N $ETRAP S $ETRAP="" S X="OPNERR^%ZISTCP",@^%ZOSF("TRAP"),POP=1 ;I IP'?1.3N1P1.3N1P1.3N1P1.3N S IP=$$NSLOOKUP(IP) ;Lookup the name I IP'?1.3N1P1.3N1P1.3N1P1.3N Q ;Not in the IP format I (SOCK<1)!(SOCK>65535) Q G CVXD:ZISOS["VAX",CMSM:ZISOS["MSM",CONT:ZISOS["OpenM" S POP=1 Q CVXD ;Open VAX DSM Socket S NIO=SOCK O NIO:(TCPCHAN,ADDRESS=IP):TO G:'$T NOOPN U NIO:NOECHO D VAR Q CMSM ;Open MSM Socket S NIO=56 O NIO::TO G:'$T NOOPN U NIO::"TCP" W /SOCKET(IP,SOCK) I $KEY="" C NIO G NOOPN D VAR Q CONT ;Open OpenM socket S NIO="|TCP|"_SOCK O NIO:(IP:SOCK:"S"::512:512):TO G:'$T NOOPN U NIO D VAR Q VAR ;Setup IO variables S:'$D(IO(0)) IO(0)=$I S IO=NIO,IO(1,IO)=IP,POP=0 S IOT="TCP",IOF="#",IOST="P-TCP",IOST(0)=0 Q NOOPN ;Didn't make the conection S POP=1 Q OPNERR ; S POP=1 D ERRCLR Q CLOSE ;Close and reset N NIO I $$NEWERR^%ZTER N $ETRAP S $ETRAP="G CLOSEX^%ZISTCP" E N X S X="CLOSEX^%ZISTCP",@^%ZOSF("TRAP") S NIO=IO,IO("CLOSE")=IO,IO=$S($G(IO(0))]"":IO(0),1:$P) I NIO]"" K IO(1,NIO) C NIO CLOSEX D HOME^%ZIS D ERRCLR Q ERRCLR ; S:$ECODE]"" IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ECODE,$ECODE="" Q ; LISTEN(SOCK,RTN,NOTUSED) ;Listen on socket, run routine, single thread. N %A,ZISOS,X,NIO,EXIT S ZISOS=^%ZOSF("OS") D GETENV^%ZOSV S U="^",XUENV=Y,XQVOL=$P(Y,U,2) I $$NEWERR^%ZTER N $ETRAP S $ETRAP="" S X="OPNERR^%ZISTCP",@^%ZOSF("TRAP"),POP=1 I $G(^%ZIS(14.5,"LOGON",XQVOL)) Q LOOP S POP=1 D LVXD:ZISOS["DSM",LMSM:ZISOS["MSM",LONT:ZISOS["OpenM" I POP Q S EXIT=0,EXIT=$$LAUNCH(NIO,RTN) I $G(^%ZIS(14.5,"LOGON",XQVOL)) S EXIT=1 I ZISOS["DSM" U NIO:DISCONNECT E C NIO ; Q:EXIT ;Quit server, App set IO("C"), Logon inhibit. G LOOP ; LMSM ;MSM ;For multi thread use MSM's MSERVER process. ;This is the listener for TCP connects. ;It takes the place of the INETD Unix process S NIO=56,%="" O NIO::30 Q:'$T S POP=0 U NIO::"TCP" W /SOCKET("",SOCK) Q ; LONT ;Open port in Accept mode with standard terminators, big buffers. S NIO="|TCP|"_SOCK,%="" O NIO:(:SOCK:"AT"::32767:32767):30 Q:'$T S POP=0 U NIO ;Wait on read for a connect F U NIO R *NEWCHAR:60 S %ZA=$ZA,%ZB=$ZB Q:$T U NIO:(::"-M") ;Work like DSM Q ; LVXD ;Open port and listen ;Use UCX for multiple listeners S NIO=SOCK O NIO:(TCPCHAN):30 Q:'$T S POP=0 U NIO Q ;Let application wait at the read for a connect. Q ; LAUNCH(IO,RTN) ;Run job for this conncetion. N NIO,SOCK,ZISOS,EXIT,XQVOL S IO(0)=IO,POP=0,IOT="TCP",IOF="#",IOST="P-TCP",IOST(0)=0 D @RTN Q $D(IO("C")) ;Use IO("C") to quit server ZISTCPS %ZISTCPS ;ISC-SF/RWF - DEVICE HANDLER TCP/IP SERVER CALLS ;10/12/99 13:10 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**78,118,127**;Jun 02, 1994 Q ; CLOSE ;Close and reset G CLOSE^%ZISTCP Q ; LISTEN(SOCK,RTN,X) ;Listen on socket, start routine N %A,ZISOS,X,NIO,EXIT S ZISOS=^%ZOSF("OS") I $$NEWERR^%ZTER N $ETRAP S $ETRAP="" S X="OPNERR^%ZISTCPS",@^%ZOSF("TRAP"),POP=1 D GETENV^%ZOSV S U="^",XUENV=Y,XQVOL=$P(Y,U,2) LOOP S POP=1 D LONT:ZISOS["OpenM" Q ; ; LONT ;Open port in Accept mode with standard terminators. S NIO="|TCP|"_SOCK,%="",EXIT=0 O NIO:(:SOCK:"AT"):30 Q:'$T S POP=0 U NIO ;Wait on read for a connect LONT2 F U NIO R *NEWCHAR:60 S EXIT=$$EXIT Q:$T!EXIT I EXIT HALT ;JOB params (:Concurrent Server bit:principal input:principal output) J CHILDONT^%ZISTCPS(NIO,RTN):(:4:NIO:NIO):10 S %ZA=$ZA I %ZA\8196#2=1 W *-2 ;Job failed to clear bit G LONT2 ; CHILDONT(IO,RTN) ;Child process for OpenM S $ETRAP="D ^%ZTER L HALT",IO=$P U IO:(::"-M") ;Work like DSM S NEWJOB=$$NEWOK I 'NEWJOB W "421 Service temporarily down.",$C(13,10),! I NEWJOB K NEWJOB D VAR,@RTN HALT ; VAR ;Setup IO variables S IO(0)=IO,IO(1,IO)="",POP=0 S IOT="TCP",IOF="#",IOST="P-TCP",IOST(0)=0 Q NEWOK() ;Is it OK to start a new process I $G(^%ZIS(14.5,"LOGON",^%ZOSF("VOL"))) Q 0 I $$AVJ^%ZOSV()<3 Q 0 Q 1 OPNERR ; S POP=1,IO("ERROR")=$ECODE I $$NEWERR^%ZTER S $ECODE="" Q EXIT() ;See if time to exit I $$S^%ZTLOAD Q 1 Q 0 ZISUTL %ZISUTL ;Device Handler Utility routine ;06/11/2001 17:01 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**18,24,34,69,118,127,199**;JUL 10, 1995 Q ;No entry from top GETDEV(X) ;Return IO variables I '$D(^TMP("XUDEVICE",$J,X)) S POP=1 Q ;Cleanup first N % K IO("S") D SYMBOL(2) ;Kill first D SYMBOL(1,$NA(^TMP("XUDEVICE",$J,X))) ;F %="IO","IO(""S"")","IOS","IOT","IOBS","IOF","IOM","ION","IOSL","IOST","IOST(0)","IOXY" I $D(^TMP("XUDEVICE",$J,X,%))#2 S @%=^(%) Q ; SAVDEV(NM) ;Save IO variables ;NM=Handle name N %,Y I $G(IO)="" Q S Y=$$FINDEV(NM) I 'Y S Y=$$NEXTDEV S ^TMP("XUDEVICE",$J,Y,0)=NM,^TMP("XUDEVICE",$J,"B",NM,Y)="" D SYMBOL(0,$NA(^TMP("XUDEVICE",$J,Y))) ;F %="IO","IO(""S"")","IOS","IOT","IOBS","IOF","IOM","ION","IOSL","IOST","IOST(0)","IOXY" I $D(@%)#2 S ^TMP("XUDEVICE",$J,Y,%)=@% Q ; SYMBOL(MODE,ROOT) ;0=Save, 1=Restore, 5=Kill IO variables N % F %="IO","IO(""DOC"")","IO(""HFSIO"")","IO(""Q"")","IO(""S"")","IO(""SPOOL"")","IO(""ZIO"")","IOBS","IOCPU","IOF","IOHG","IOM","ION","IOPAR","IOUPAR","IOS","IOSL","IOST","IOST(0)","IOT","IOXY" D . I MODE=0 S:$D(@%)#2 @ROOT@(%)=@% Q . I MODE=1 S:$D(@ROOT@(%)) @%=@ROOT@(%) Q . I MODE=5 K @% . Q Q FINDEV(NM) ;Find Device name and return IEN. Q $O(^TMP("XUDEVICE",$J,"B",NM,0)) ; RMDEV(X) ;Remove saved IO variables. N Y S Y=$$FINDEV(X) Q:'Y K ^TMP("XUDEVICE",$J,"B",X),^TMP("XUDEVICE",$J,+Y) Q ; RMALLDEV() ;Remove saved IO variables for all devices saved in table. K ^TMP("XUDEVICE",$J) Q 1 ; NEXTDEV() ;Return next available device. N Y F Y=1:1 Q:'$D(^TMP("XUDEVICE",$J,Y)) Q Y ; OPEN(HNDL,IOP,%ZIS) ;Open extrinsic function ;Parameters ;HNDL=Handle name ;IOP string--optional ;%ZIS string--optional N % I $G(IOP)="" K IOP ;Remove IOP if null. D ^%ZIS,SAVDEV(HNDL):POP=0 Q ; CLOSE(X1) ;Close extrinsic functionsl ;X1=Handle N %,Y S Y=$$FINDEV(X1) Q:'Y D GETDEV(Y) D ^%ZISC,RMDEV(X1) Q ; USE(X1) ;Restore IO* variables pertaining to the device. ;X1=Handle name N %,Y S Y=$$FINDEV^%ZISUTL(X1) Q:'Y D GETDEV^%ZISUTL(Y) U $S($D(IO(1,IO)):IO,1:IO(0)) Q ; LINEPORT() ;Return device name for line port. ; N %,%1,Y S Y=0 S %=$$LNPRTIEN^%ZISUTL($$LNPRTNAM^%ZISUTL) S Y=+$P($G(^%ZIS(3.23,+%,0)),"^",3) Q Y LNPRTSUB() ;Return line port subtype pointer. N % S %=$$LNPRTIEN^%ZISUTL($$LNPRTNAM^%ZISUTL) Q +$P($G(^%ZIS(3.23,+%,0)),"^",4) ; LNPRTNAM() ;Return Line port name N Y,% S Y="",%=$G(^%ZOSF("OS")) I %["VAX DSM"!(%["OpenM-NT") D .S Y=$ZIO E I %["MSM" D .S Y=$ZDEV($I) Q Y LNPRTIEN(X) ;Return internal entry number of Line/port Q:X'?1AN.29ANP 0 Q $O(^%ZIS(3.23,"B",X,0)) LNPRTADR(X) ;Returns Line/Port name of a fixed device. N %,Y S Y="" S %=$O(^%ZIS(1,"B",X,0)) S %=$O(^%ZIS(3.23,"C",+%,0)) I %,$G(^%ZIS(3.23,+%,0))]"" S Y=$P(^(0),"^") Q Y ; FIND(IOP) ;e.f. Get the IEN of a device N %XX,%YY,%ZIS,%ZISV S %ZISV=^%ZOSF("VOL"),%XX=$$UP^%ZIS1(IOP) D 1^%ZIS5 Q %YY NOQ(IOP) ;e.f. Return queueing status ;Call with Device name, Return 1 if NO QUEUE, Else 0. N %X,%Y S %X=$$FIND(IOP) Q:%X'>0 0 S %Y=$P($G(^%ZIS(1,%X,0)),U,12) Q %Y=2 ; UNIQUE(ZISNA) ;Build a unque number to add to a device name ;If passed a name put the number before the last dot. N %,%1 S %=$H,%=$H_"-"_$J,%=$$CRC32^XLFCRC(%) I '$L($G(ZISNA)) Q % S %1=$L(ZISNA,"."),%="_"_% S:%1=1 %=ZISNA_% S:%1>1 %=$P(ZISNA,".",1,%1-1)_%_"."_$P(ZISNA,".",%1) Q % ZISX ZISX ;SF/GFT,AC - PROGRAM THAT XECUTES NODES IN ^%ZIS GLOBAL. ;1/3/90 15:08 ; [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;Jul 10, 1995 X3 X ^%ZIS(2,+IOST(0),3) Q X31 ;X ^%ZIS(2,+IOST(0),3.1) Q ;Old code X10 X ^%ZIS(2,IO("S"),10) Q X11 X ^%ZIS(2,+IO("S"),11) K IO("S") Q XPCX X ^%ZIS(1,+IOS,"PCX") Q XPOX(X) ;Execute pre-open execute code. X ^%ZIS(1,+X,"POX") Q %Y X %Y Q XS X %ZIS("S") Q XW X %ZIS("W") Q ZOSF ZOSFONT ;SFISC/AC - SETS UP ^%ZOSF FOR Open M for NT ;09/29/98 08:26 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**34,104**;JUL 03, 1995 S %Y=1 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF") K ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I) F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z="" S X=$P($T(Z+1+I),";;",2,99) S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X) MGR W !,"NAME OF MANAGER'S NAMESPACE: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G MGR:Y="" S ^%ZOSF("MGR")=X PROD W !,"PRODUCTION (SIGN-ON) NAMESPACE: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G PROD:Y="" S ^%ZOSF("PROD")=Y VOL W !,"NAME OF THIS CONFIGURATION: "_^%ZOSF("VOL")_"//" R X:$S($G(DTIME):DTIME,1:9999) I X]"" S:X?1.5U ^%ZOSF("VOL")=X I X'?1.5U W "MUST BE 1-5 uppercase characters." G VOL OS S $P(^%ZOSF("OS"),"^",1)="OpenM-NT" S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=18 W !!,"ALL SET UP",!! Q Z ;; ;;ACTJ ;;S Y=$$ACTJ^%ZOSV() ;;AVJ ;;S Y=$$AVJ^%ZOSV() ;;BRK ;;U $I:("":"+B") ;;DEL ;;X "ZR ZS @X" K ^UTILITY("ROU",X) ;;EOFF ;;U $I:("":"+S") ;;EON ;;U $I:("":"-S") ;;EOT ;;S Y=$ZA\1024#2 ;;ERRTN ;;^%ZTER ;;ETRP ;;Q ;;GD ;;D ^%GD ;;JOBPARAM ;;D JOBPAR^%ZOSV ;;LABOFF ;;U IO:("":"+S+I-T":$C(13,27)) ;;LOAD ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%" ;;LPC ;;S Y=$ZC(X) ;;MAXSIZ ;;S $ZS=X+X ;;MGR ;;%SYS ;;MAGTAPE ;;S %MT("BS")="*-1",%MT("FS")="*-2",%MT("WTM")="*-3",%MT("WB")="*-4",%MT("REW")="*-5",%MT("RB")="*-6",%MT("REL")="*-7",%MT("WHL")="*-8",%MT("WEL")="*-9" ;;MTBOT ;;S Y=$ZA\32#2 ;;MTONLINE ;;S Y=$ZA\64#2 ;;MTWPROT ;;S Y=$ZA\4#2 ;;MTERR;;MAGTAPE ERROR ;;S Y=$ZA\32768#2 ;;NBRK ;;U $I:("":"-B") ;;NO-PASSALL ;;U $I:("":"-I+T") ;;NO-TYPE-AHEAD ;;U $I:("":"+F":$C(13,27)) ;;PASSALL ;;U $I:("":"+I-T") ;;PRIINQ;; Priority in current queue ;;N %PRIO D ^%PRIO S Y=$S('%PRIO:5,%PRIO>0:8,1:3) ;;PRIORITY;;set priority to X (1=low, 10=high) ;;D @($S(X>7:"NORMAL",X>3:"NORMAL",1:"LOW")_"^%PRIO") ;Don't do HIGH ;;PROGMODE ;;S Y=$ZJ#2 ;;PROD ;;VAH ;;RD ;;D ^%RD ;;RESJOB ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^RESJOB[MGR]" D DO^%XUCI ;;RM ;;U $I:X ;;RSEL;;ROUTINE SELECT ;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA ;;RSUM ;;ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y ;;SS ;;D ^%SS ;;SAVE ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=^(XCN,0) Q:$E(%,1)=""$"" I $E(%,1)'="";"" ZI %" X "ZR X XCS ZS @X" S ^UTILITY("ROU",X)="" K XCS ;;SIZE ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 ;;TEST ;;I X?1(1"%",1A).7AN,$D(^$ROUTINE(X)) ;;TMK;;MAGTAPE MARK ;;S Y=$ZA\4#2 ;;TRAP;;S X="^%ET",@^%ZOSF("TRAP") TO SET ERROR TRAP ;;$ZT=X ;;TRMOFF ;;U $I:("":"-I-T":$C(13,27)) ;;TRMON ;;U $I:("":"+I+T") ;;TRMRD ;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0) ;;TYPE-AHEAD ;;U $I:("":"-F":$C(13,27)) ;;UCI ;;D UCI^%ZOSV ;;UCICHECK ;;S Y=$$UCICHECK^%ZOSV(X) ;;UPPERCASE ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") ;;XY ;;S $X=DX,$Y=DY ;;VOL;;VOLUME SET NAME ;;ROU ;;ZD ;;S Y=$ZD(X) ZOSFMSM ZOSFMSM ;SFISC/AC - SETS UP ^%ZOSF FOR MSM-UNIX SYSTEMS ;8/1/94 11:16 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;JUL 10, 1995 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/MFD ;IHS/MFD fixed TEST node for MSM S %Y=1 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF") I '$D(^%ZOSF("VOL")) S ^%ZOSF("VOL")=$P($ZU(0),",",2) K ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I) F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z="" S X=$P($T(Z+1+I),";;",2,99) S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X) MGR W !,"NAME OF MANAGER'S UCI,VOLUME GROUP: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) S:X="" X=^%ZOSF("MGR") X ^("UCICHECK") I 0[Y W *7," ??" G MGR S ^%ZOSF("MGR")=Y PROD W !,"PRODUCTION (SIGN-ON) UCI,VOLUME GROUP: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) S:X="" X=^%ZOSF("PROD") X ^("UCICHECK") I 0[Y W *7," ??" G PROD S ^%ZOSF("PROD")=Y VOL W !,"NAME OF THIS VOLUME GROUP: "_^%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 OS S $P(^%ZOSF("OS"),"^")=$S($ZV["MSM":$P($ZV,","),1:"MSM") S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=8 W !!,"ALL SET UP",!! Q ; Z ;; ;;ACTJ ;;S Y=$$ACTJ^%ZOSV() ;;AVJ ;;S Y=$$AVJ^%ZOSV() ;;BRK ;;B 1 ;;CPU ;;Q ;;DEL ;;X "ZR ZS @X" K ^UTILITY("%RD",X) ;;EOFF ;;U $I:(::::1) ;;EON ;;U $I:(:::::1) ;;EOT ;;S Y=$ZA\1024#2 ;;ERRTN ;;^%ZTER ;;ETRP ;;Q ;;GD ;;D ^%GD ;;LABOFF ;;U IO:(::::1) ;;JOBPARAM ;;G JOBPAR^%ZOSV ;;LOAD ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%" ;;LPC;;Parity Check - ASCII sum ;;S Y=$ZCRC(X) ;;MAXSIZ ;;S %K=X D INT^%PARTSIZ ;;MGR ;;MGR,AAA ;;MAGTAPE ;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ;;MTBOT ;;S Y=$ZA#2 ;;MTERR ;;S Y=($ZA\256#8)+($ZA\4096#8) ;;MTONLINE ;;S Y=$ZA\16#4=3 ;;MTWPROT ;;S Y=$ZA\2048#2 ;;NBRK ;;B 0 ;;NO-PASSALL ;;U $I:(:::::8388608) ;;NO-TYPE-AHEAD ;;U $I:(::::100663296) ;;PASSALL ;;U $I:(::::8388608) ;;PRIINQ ;;S Y=$$PRIINQ^%ZOSV() ;;PRIORITY ;;G PRIORITY^%ZOSV ;;PROD ;;VAH,AAA ;;PROGMODE ;;S Y=$$PROGMODE^%ZOSV() ;;RD ;;D ^%RD ;;RESJOB ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^KILLJOB[MGR]" D DO^%XUCI ;;RM ;;U:IOT["TRM" $I:X ;;RSEL ;;K ^UTILITY($J) G ^%RSEL ;;RSUM ;;ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y ;;SAVE ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=^(XCN,0) Q:$E(%,1)=""$"" I $E(%,1)'="";"" ZI %" X "ZR X XCS ZS @X" S ^UTILITY("%RD",X)="" K XCS ;;SIZE ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 ;;SS ;;D ^%SS ;;TEST ;;I $S($E(X)'="%":$D(^ (X)),1:$D(^[$G(^%ZOSF("MGR"))] (X))) ;;TMK ;;S Y=$ZA\128#2 ;;TRAP ;;$ZT=X ;;TRMOFF ;;U $I:(::::::::$C(13,27)) ;;TRMON ;;U $I:(::::::::$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127)) ;;TRMRD ;;S Y=$ZB ;;TYPE-AHEAD ;;U $I:(::::67108864:33554432) ;;UCI ;;S Y=$ZU(0) ;;UCICHECK ;;S Y=$$UCICHECK^%ZOSV(X) ;;UPPERCASE ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") ;;VOL ;;AAA ;;XY ;;U $I:(::::::DY*256+DX) ;;ZD ;;S Y=$ZD(X) ZOSFONT ZOSFONT ;SFISC/AC - SETS UP ^%ZOSF FOR Open M for NT ;09/29/98 08:26 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**34,104**;JUL 03, 1995 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY TASSC/MFD ;THE CODE IN THE RESJOB NODE WAS CHANGED FROM XQZ="^RESJOB[MGR]" TO ;XQZ="^RESJOB[%SYS]" SINCE THE RESJOB ROUTINE RESIDES ON %SYS IN CACHE S %Y=1 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF") K ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I) F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z="" S X=$P($T(Z+1+I),";;",2,99) S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X) MGR W !,"NAME OF MANAGER'S NAMESPACE: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G MGR:Y="" S ^%ZOSF("MGR")=X PROD W !,"PRODUCTION (SIGN-ON) NAMESPACE: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G PROD:Y="" S ^%ZOSF("PROD")=Y VOL W !,"NAME OF THIS CONFIGURATION: "_^%ZOSF("VOL")_"//" R X:$S($G(DTIME):DTIME,1:9999) I X]"" S:X?1.5U ^%ZOSF("VOL")=X I X'?1.5U W "MUST BE 1-5 uppercase characters." G VOL OS S $P(^%ZOSF("OS"),"^",1)="OpenM-NT" S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=18 W !!,"ALL SET UP",!! Q Z ;; ;;ACTJ ;;S Y=$$ACTJ^%ZOSV() ;;AVJ ;;S Y=$$AVJ^%ZOSV() ;;BRK ;;U $I:("":"+B") ;;DEL ;;X "ZR ZS @X" K ^UTILITY("ROU",X) ;;EOFF ;;U $I:("":"+S") ;;EON ;;U $I:("":"-S") ;;EOT ;;S Y=$ZA\1024#2 ;;ERRTN ;;^%ZTER ;;ETRP ;;Q ;;GD ;;D ^%GD ;;JOBPARAM ;;D JOBPAR^%ZOSV ;;LABOFF ;;U IO:("":"+S+I-T":$C(13,27)) ;;LOAD ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%" ;;LPC ;;S Y=$ZC(X) ;;MAXSIZ ;;S $ZS=X+X ;;MGR ;;%SYS ;;MAGTAPE ;;S %MT("BS")="*-1",%MT("FS")="*-2",%MT("WTM")="*-3",%MT("WB")="*-4",%MT("REW")="*-5",%MT("RB")="*-6",%MT("REL")="*-7",%MT("WHL")="*-8",%MT("WEL")="*-9" ;;MTBOT ;;S Y=$ZA\32#2 ;;MTONLINE ;;S Y=$ZA\64#2 ;;MTWPROT ;;S Y=$ZA\4#2 ;;MTERR;;MAGTAPE ERROR ;;S Y=$ZA\32768#2 ;;NBRK ;;U $I:("":"-B") ;;NO-PASSALL ;;U $I:("":"-I+T") ;;NO-TYPE-AHEAD ;;U $I:("":"+F":$C(13,27)) ;;PASSALL ;;U $I:("":"+I-T") ;;PRIINQ;; Priority in current queue ;;N %PRIO D ^%PRIO S Y=$S('%PRIO:5,%PRIO>0:8,1:3) ;;PRIORITY;;set priority to X (1=low, 10=high) ;;D @($S(X>7:"NORMAL",X>3:"NORMAL",1:"LOW")_"^%PRIO") ;Don't do HIGH ;;PROGMODE ;;S Y=$ZJ#2 ;;PROD ;;VAH ;;RD ;;D ^%RD ;;RESJOB ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^RESJOB[%SYS]" D DO^%XUCI ;;RM ;;U $I:X ;;RSEL;;ROUTINE SELECT ;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA ;;RSUM ;;ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y ;;SS ;;D ^%SS ;;SAVE ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=^(XCN,0) Q:$E(%,1)=""$"" I $E(%,1)'="";"" ZI %" X "ZR X XCS ZS @X" S ^UTILITY("ROU",X)="" K XCS ;;SIZE ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 ;;TEST ;;I X?1(1"%",1A).7AN,$D(^$ROUTINE(X)) ;;TMK;;MAGTAPE MARK ;;S Y=$ZA\4#2 ;;TRAP;;S X="^%ET",@^%ZOSF("TRAP") TO SET ERROR TRAP ;;$ZT=X ;;TRMOFF ;;U $I:("":"-I-T":$C(13,27)) ;;TRMON ;;U $I:("":"+I+T") ;;TRMRD ;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0) ;;TYPE-AHEAD ;;U $I:("":"-F":$C(13,27)) ;;UCI ;;D UCI^%ZOSV ;;UCICHECK ;;S Y=$$UCICHECK^%ZOSV(X) ;;UPPERCASE ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") ;;XY ;;S $X=DX,$Y=DY ;;VOL;;VOLUME SET NAME ;;ROU ;;ZD ;;S Y=$ZD(X) ZOSFU414 ZOSFMSM ;SFISC/AC - SETS UP ^%ZOSF FOR MSM-UNIX SYSTEMS ;8/1/94 11:16 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATION BY IHS/MFD ;IHS/MFD fixed TEST node for MSM I '$D(^%ZOSF("VOL")) S ^%ZOSF("VOL")=$P($ZU(0),",",2) K ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I) F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z="" S X=$P($T(Z+1+I),";;",2,99) S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X) MGR W !,"NAME OF MANAGER'S UCI,VOLUME GROUP: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) S:X="" X=^%ZOSF("MGR") X ^("UCICHECK") I 0[Y W *7," ??" G MGR S ^%ZOSF("MGR")=Y PROD W !,"PRODUCTION (SIGN-ON) UCI,VOLUME GROUP: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) S:X="" X=^%ZOSF("PROD") X ^("UCICHECK") I 0[Y W *7," ??" G PROD S ^%ZOSF("PROD")=Y VOL W !,"NAME OF THIS VOLUME GROUP: "_^%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 OS S $P(^%ZOSF("OS"),"^")=$S($ZV["MSM":$P($ZV,","),1:"MSM") S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=8 W !!,"ALL SET UP",!! Q ; Z ;; ;;ACTJ ;;S Y=$$ACTJ^%ZOSV() ;;AVJ ;;S Y=$$AVJ^%ZOSV() ;;BRK ;;B 1 ;;CPU ;;Q ;;DEL ;;X "ZR ZS @X" K ^UTILITY("%RD",X) ;;EOFF ;;U $I:(::::1) ;;EON ;;U $I:(:::::1) ;;EOT ;;S Y=$ZA\1024#2 ;;ERRTN ;;^%ZTER ;;ETRP ;;Q ;;GD ;;D ^%GD ;;LABOFF ;;U IO:(::::1) ;;JOBPARAM ;;G JOBPAR^%ZOSV ;;LOAD ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%" ;;LPC;;Parity Check - ASCII sum ;;S Y=$ZCRC(X) ;;MAXSIZ ;;S %K=X D INT^%PARTSIZ ;;MGR ;;MGR,AAA ;;MAGTAPE ;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ;;MTBOT ;;S Y=$ZA#2 ;;MTERR ;;S Y=($ZA\256#8)+($ZA\4096#8) ;;MTONLINE ;;S Y=$ZA\16#4=3 ;;MTWPROT ;;S Y=$ZA\2048#2 ;;NBRK ;;B 0 ;;NO-PASSALL ;;U $I:(:::::8388608) ;;NO-TYPE-AHEAD ;;U $I:(::::100663296) ;;PASSALL ;;U $I:(::::8388608) ;;PRIINQ ;;S Y=$$PRIINQ^%ZOSV() ;;PRIORITY ;;G PRIORITY^%ZOSV ;;PROD ;;VAH,AAA ;;PROGMODE ;;S Y=$$PROGMODE^%ZOSV() ;;RD ;;D ^%RD ;;RESJOB ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^KILLJOB[MGR]" D DO^%XUCI ;;RM ;;U:IOT["TRM" $I:X ;;RSEL ;;K ^UTILITY($J) G ^%RSEL ;;RSUM ;;ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y ;;SAVE ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=^(XCN,0) Q:$E(%,1)=""$"" I $E(%,1)'="";"" ZI %" X "ZR X XCS ZS @X" S ^UTILITY("%RD",X)="" K XCS ;;SIZE ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 ;;SS ;;D ^%SS ;;TEST ;;I $S($E(X)'="%":$D(^ (X)),1:$D(^[$G(^%ZOSF("MGR"))] (X))) ;;TMK ;;S Y=$ZA\128#2 ;;TRAP ;;$ZT=X ;;TRMOFF ;;U $I:(::::::::$C(13,27)) ;;TRMON ;;U $I:(::::::::$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127)) ;;TRMRD ;;S Y=$ZB ;;TYPE-AHEAD ;;U $I:(::::67108864:33554432) ;;UCI ;;S Y=$ZU(0) ;;UCICHECK ;;S Y=$$UCICHECK^%ZOSV(X) ;;UPPERCASE ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") ;;VOL ;;AAA ;;XY ;;U $I:(::::::DY*256+DX) ;;ZD ;;S Y=$ZD(X) ZOSFVXD ZOSFVXD ;SFISC/MVB - ZOSF TABLE FOR VAX DSM V3.3, V4 & V6 ;06/30/97 15:23 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**65**;JUL 03, 1995 ;Remember to update XGKB for escape processing. S %Y=1 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF") I '$D(^%ZOSF("VOL")) S ^%ZOSF("VOL")=$P($ZC(%UCI),",",4) K ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I) F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z="" S X=$P($T(Z+1+I),";;",2,99) S:Z="OS" $P(^%ZOSF(Z),"^")=X I Z'="OS" S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X) ; OS S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=16 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 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")=Y 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 W ! Q V4 S $P(^%ZOSF("OS"),"^",1)="VAX DSM(V4)" S ^("JOBPARAM")="S Y="""" Q" ; S Y=JOB X'S UCI,VOLUMESET S ^("TEST")="N %,Y S %=$P($ZC(%PGMSHOW),"","") O %:(INDEXED:READONLY) U %:KEY=$E($C(0)_X_$C(0,0,0,0,0,0,0,0),1,9) R Y C % I $L(Y)" Q Z ; ;;ACTJ ;;S Y=$$ACTJ^%ZOSV() ;;AVJ ;;S Y=$$AVJ^%ZOSV() ;;BRK ;;U $I:CENABLE ;;DEL ;;X "ZR ZS @X" ;;EOFF ;;U $I:NOECHO ;;EON ;;U $I:ECHO ;;EOT ;;S Y=$ZA\1024#2 ;;ERRTN ;;^%ZTER ;;ETRP ;;Q ;;GD ;;G ^%GD ;;JOBPARAM ;;S Y=$$INFO^%SY(X),Y=$P(Y,",",1,2) ;;LABOFF ;;U IO:NOECHO ;;LOAD ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%" ;;LPC ;;S Y=$ZC(%LPC,X) ;;MAGTAPE ;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ;;MAXSIZ ;;Q ;;MGR ;;MGR,AAA ;;MTBOT ;;S Y=$ZA\32#2 ;;MTERR ;;S Y=$ZA\32768#2 ;;MTONLINE ;;S Y=$ZA\64#2 ;;MTWPROT ;;S Y=$ZA\4#2 ;;NBRK ;;U $I:NOCENABLE ;;NO-PASSALL ;;G NOPASS^%ZOSV ;;NO-TYPE-AHEAD ;;U $I:NOTYPE ;;OS ;;VAX DSM(V6) ;;PASSALL ;;G PASSALL^%ZOSV ;;PRIINQ ;;S Y=$$PRIINQ^%ZOSV() ;;PRIORITY ;;Q ;G PRIORITY^%ZOSV ;;PROD ;;VAH,AAA ;;PROGMODE ;;S Y=$$PROGMODE^%ZOSV() ;;RD ;;G ^%RD ;;RESJOB ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^FORCEX[MGR]" D DO^%XUCI ;;RM ;;U $I:WIDTH=$S(X<256:X,1:0) ;;RSEL ;;K ^UTILITY($J) D ^%RSEL M ^UTILITY($J)=%UTILITY K %UTILITY ;;RSUM ;;ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y ;;SS ;;G ^%SY ;;SAVE ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=^(XCN,0) Q:$E(%,1)=""$"" I $E(%,1)'="";"" ZI %" X "ZR X XCS ZS @X" S ^UTILITY("ROU",X)="" K XCS ;;SIZE ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 ;;TEST ;;I $D(^ (X))!$D(^!(X)) ;;TMK ;;S Y=$ZA\16384#2 ;;TRAP ;;$ZT=X ;;TRMOFF ;;U $I:TERM="" ;;TRMON ;;U $I:TERM=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127) ;;TRMRD ;;S Y=$ZB ;;TYPE-AHEAD ;;U $I:TYPE ;;UCI ;;S Y=$ZC(%UCI),Y=$P(Y,",",1)_","_$P(Y,",",4) ;;UCICHECK ;;S Y=$$UCICHECK^%ZOSV(X) ;;UPPERCASE ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") ;;XY ;;S $X=DX,$Y=DY ;;VOL ;;AAA ;;ZD ;;N % S Y=$ZC(%CDATASC,+X,1) F %=1:1:3 I $L($P(Y,"/",%))<2 S $P(Y,"/",%)=0_$P(Y,"/",%) ZOSV1VXD ZOSV1VXD ;SFISC/AC - View commands & special functions(continued). ;6/24/96 14:41 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24**;JUL 03, 1995 DEVOPN ;List devices opened. N %,%B,%I,%L,%X,%X1,%X2,%Y S %X1=$V($V(0)+8),%X2=$V(%X1),Y="" F %I=1:1 D D1 S %X2=$V(%X2) Q:%X2=%X1 Q D1 S %X=$V(%X2+8) S %L=$V(%X+4,-1,1),%B=$V(%X+8) S %Y="" F %=1:1:%L S %Y=%Y_$C($V(%B,-1,1)) S %B=%B+1 S Y=Y_%Y_"," Q ; DEVOK ;Check Device Availability. (not complete) ;INPUT: X=Device $I, X1=IOT -- X1 needed for resources ;OUTPUT: Y=0 if available, Y=job # if owned, Y=-1 if device does not exists. S Y=0 Q:X["::" I $G(X1)="RES" G RES S Y=$ZC(%GETDVI,X,"EXISTS") G DV1:Y D DV2 Q:Y=-1 I Y="TERM" S Y=-1 Q S Y=-2 Q DV1 S Y=$ZC(%GETDVI,X,"PID") I Y=$J!($ZC(%GETDVI,X,"SPL")) S Y=0 Q I Y,$ZC(%GETJPI,X,"MASTER_PID")=Y G DVOPN Q:Y>0 D DV2 G DVOPN:Y="TERM" S Y=$S(Y="DISK":0,Y="MAILBOX":0,Y="TAPE":0,1:-1) Q DV2 S Y=$ZC(%PARSE,X) I Y="" S Y=-1 Q I X]"" S Y=$ZC(%GETDVI,$S(Y]"":Y,1:X),"DEVCLASS") Q Q DVOPN S $ZT="DVERR",Y=0 Q:$D(%ZTIO) L:$D(%ZISLOCK) +@%ZISLOCK:60 O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK:60 Q L:$D(%ZISLOCK) -@%ZISLOCK S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q S:X]"" IO(1,X)="" Q DVERR I $ZE["OPENERR" S Y=-1 Q ZQ RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0)) I '%ZISD0 S Y=-1,%ZISD0=$O(^%ZIS(1,"C",X)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"") I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q 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 K %ZISD0,%ZISD1 Q ZOSV2VXD %ZOSV2 ; SFISC/JC - Capacity Mgmt - Performance Data ;06/27/96 10:17 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**35**;JUL 03, 1995 DB ;Collect volume set information for this environment START D VSET^%VOLDEF I '%SMSTART G DONE S0 S ALL=1,ANS="Y" S A=$ZC(%VIEWBUFFER,1) S VSNUM="",VOLNUM="",GRTOT=0 S1 S VSNUM=$O(%VOL(VSNUM)),BLK0=0 G:VSNUM="" S3 S2 S VOLNUM=$O(%VOL(VSNUM,VOLNUM)) G:VOLNUM="" S1 I VOLNUM="BIJ" G S2 S DDU=$P(%VOL(VSNUM,VOLNUM),"^"),MPS=$P(%VOL(VSNUM,VOLNUM),"^",2),STRNO="S"_VSNUM D DISK S BLK0=BLK0+(MPS*400) G S2 ; S3 ; DONE K QUES,DTAB,D,TYY,UU,DDU,YES,ALL,Y,BLK0,GRTOT K PREV,MPS,M0,MP0,CT,MBLK,AVAIL,TYP,USE,OLDAVAIL,OLDUSE K %ISAV,%NULL,TAV,TYPES EXIT Q ; DISK ; Set up XUCM ARRAY S TAV=0,CNT=1+$G(CNT) S XUCM(CNT)=VOLNUM_"^"_DDU_"^" D GETSTAT^%VOLTAB I '%RDACC Q S PREV=100 F M0=0:1:MPS S MBLK=M0*400+399+BLK0 D MAPGET S XUCM(CNT)=XUCM(CNT)_TAV_"^"_(MPS*400) ; MAPGET ; I M0=MPS Q S AVAIL=0,$ZE="ERR" V MBLK:STRNO S $ZE="" G NOERR ERR S $ZE="",TYP=100 G TYPCHK NOERR I $V(1006,0,2)=65535&($V(1012,0,2)=32769) G OK NOTOK S TYP=100 G TYPCHK OK I $V(1008,0,2)=56173 S USE="* SPOOL *",TYP=4 G TYPCHK I $V(1008,0,2)+$V(1010,0,2)'=65535 G NOTOK S AVAIL=$V(1022,0,2) G SPECL:$V(1008,0,2)'=21845 I AVAIL=399 S TYP=1 G TYPCHK I AVAIL=398,M0=0 S TYP=100 G TYPCHK S TYP=100 S:AVAIL=0 TYP=5 G TYPCHK SPECL I AVAIL S AVAIL=0,TYP=100 G TYPCHK I $V(1008,0,2)=13107 S TYP=3 G TYPCHK I $V(1008,0,2)=43690 S TYP=2 G TYPCHK G NOTOK ; TYPCHK S TAV=TAV+AVAIL I TYP=100 G NEWTYP I TYP=PREV S CT=CT+1 Q S MP0=M0,CT=0,OLDAVAIL=AVAIL NEWTYP S PREV=TYP Q RTHSTOP ;(TASKMAN-RUN IN MGR@0001) STOP RTHIST/MOVE OUT DATA/PURGE RTH Q:$$OS<6.1 N I,J,K,L,M,N,O,P,Q,R,X,C,S D INIT^%VOLDEF,GETGRP^%SYSROU ;I '$D(^["MGR"]RTH(SCSNODE)),$V(%SMSTART)\32#2'=1 G RTH S RTNODE="" F S RTNODE=$O(^["MGR"]RTH(RTNODE)) Q:RTNODE="" D .S ^["MGR"]RTH(RTNODE)=0 .S ^%ZRTL("RTH",RTNODE)=0,C=0 .S SUB=0,U="^" F S SUB=$O(^["MGR"]RTH(RTNODE,SUB)) Q:SUB<1 D ..Q:$G(^["MGR"]RTH(RTNODE,SUB,"LABEL"))'["VPM" ..Q:'$D(^["MGR"]RTH(RTNODE,SUB,"STIME")) S %H=^("STIME") D YX^%DTC S S=$P(^["MGR"]RTH(RTNODE,SUB,"ETIME"),",",1)-$P(^("STIME"),",",1)*86400+$P(^("ETIME"),",",2)-$P(^("STIME"),",",2) ..S I=$G(^["MGR"]RTH(RTNODE,SUB,"ROUREF")) I I S I=I*10/S+.5\1/10 ..S J=$G(^["MGR"]RTH(RTNODE,SUB,"MAPROU")) I J S J=J*10/S+.5\1/10 ..S K=$G(^["MGR"]RTH(RTNODE,SUB,"Global Gets")) I K S K=K*10/S+.5\1/10 ..S L=$G(^["MGR"]RTH(RTNODE,SUB,"Global Sets")) I L S L=L*10/S+.5\1/10 ..S M=$G(^["MGR"]RTH(RTNODE,SUB,"Global Kills")) I M S M=M*10/S+.5\1/10 ..S N=$G(^["MGR"]RTH(RTNODE,SUB,"Logical Reads")) I N S N=N*10/S+.5\1/10 ..S O=$G(^["MGR"]RTH(RTNODE,SUB,"Logical Writes")) I O S O=O*10/S+.5\1/10 ..S P=$G(^["MGR"]RTH(RTNODE,SUB,"Physical Reads")) I P S P=P*10/S+.5\1/10 ..S Q=$G(^["MGR"]RTH(RTNODE,SUB,"Physical Writes")) I Q S Q=Q*10/S+.5\1/10 ..S Z="",R=0 F S Z=$O(^["MGR"]RTH(RTNODE,SUB,"DDP",Z)) Q:Z="" S R=R+$G(^(Z,"XMTS")) ..I R S R=R*10/S+.5\1/10 ..S C=1+C,^%ZRTL("RTH",RTNODE,C)=RTNODE_U_SUB_U_$TR(Y,":")_U_S_U_I_U_J_U_K_U_L_U_M_U_N_U_O_U_P_U_Q_U_R ..I $D(^["MGR"]RTH(RTNODE,SUB,"PMF-R","TTYGLOREF")) D ...S ^%ZRTL("RTH",RTNODE,"RT",SUB,0)=^["MGR"]RTH(RTNODE,SUB,"STIME") ...S X=0 F S X=$O(^["MGR"]RTH(RTNODE,SUB,"PMF-R","TTYGLOREF",X)) Q:X<1 S Y=^(X),^%ZRTL("RTH",RTNODE,"RT",SUB,X)=Y .S ^%ZRTL("RTH",RTNODE)=1 Q RTH ;(TASKMAN) INITIATE NEW RTHIST DATA COLLECTIONS FOR THE DAY Q:$$OS<6.1 D INIT^%VOLDEF,GETGRP^%SYSROU S LOOP=0 LOOP ;WAIT UNTIL LAST SESSION COMPLETES I LOOP>90 S $ZE="Timed Out Starting RTHIST" D ^%ZTER Q I $V(%SMSTART)\32#2=1 S LOOP=LOOP+1 H 60 G LOOP K ^["MGR"]RTH(SCSNODE) S ^["MGR"]RTH(SCSNODE)=0 S TIMS=24,TIM=10,TIMI=50 S X="NOW",%DT="T" D ^%DT D DD^%DT S NOW=Y S SUB=0 F I=1:1 Q:$O(^["MGR"]RTH(SCSNODE,SUB))="" S SUB=$O(^(SUB)) S WHEN=$P($ZH,",",3),LAB="VPM SESSION-"_NOW I $$OS>6.1 S CONF=$ZC(%VERSION,"INTERNAL") E S CONF=$ZV S CONF=CONF_","_^[LIB]SYS(-1,SCSNODE,"RUNNING") S SZ=^[LIB]SYS(^("RUNNING"),"RTHIST","BUFFERS")*512 S RTHOPT="/MANAGER/UCI=MGR/NORMS_ROU/NORMS_LIB/SYM=50000/SOU=20000" S X=$$CVDAT^RTHIST(WHEN),$ZT="TRAP^%ZOSV2" J START^RTHIST1(SZ,TIM,TIMS,TIMI,X,SUB,CONF,LAB,SCSNODE):(ERROR="VPM$RTHIST.LOG":OPTIONS=RTHOPT:NAME="VPM_RTHIST_"_GRP) I $D(ZTQUEUED) S ZTREQ="@" Q TRAP ;Give process time to die off I $ZE["SYSTEM-F-DUPLNAM" S RETRY=$G(RETRY)+1 I RETRY'>90 H 60 G RTH K RETRY Q RT ; N NODE,RUN,ET,CNT,ZCT,STIM,X Q:^%ZOSF("OS")'["DSM" W " Node",?7,"Run",?24,"Label",?48,"Start",?57,"ET",?61,"Count",?70,"RT",! S (NODE,RUN)=0 F S NODE=$O(^["MGR"]RTH(NODE)) Q:NODE="" D . F S RUN=$O(^["MGR"]RTH(NODE,RUN)) Q:RUN="" D . . S (ET,CNT,ZCT)=0 . . F I=1:1:34 S X=^["MGR"]RTH(NODE,RUN,"PMF-R","TTYGLOREF",I) D . . . S ET=ET+$P(X,";",2),Y=$P(X,";",3),ZCT=ZCT+Y . . . F J=1:1:12 S CNT=CNT+$P(Y,",",J) . . I $$OS<6.5 S ET=ET+(.3*ZCT)+(.5*(CNT-ZCT)) . . I $$OS'<6.5 S ET=ET/100+(.005*CNT) . . S X=$P(^["MGR"]RTH(NODE,RUN,"STIME"),",",2) . . S H=X\3600,M=X#3600\60,S=X#3600#60 . . S STIM=$J(H,2)_":"_$S($L(M)<2:0_M,1:M)_":"_$S($L(S)<2:0_S,1:S) . . W NODE,?7,$J(RUN,3),?13,$E(^["MGR"]RTH(NODE,RUN,"LABEL"),1,30),?45,STIM,?55,$J($P(^("ETIME"),",",2)-$P(^("STIME"),",",2),4),?60,$J(CNT,6),?69 W:CNT $J(ET/CNT,4,2) . . W ! Q TRNLNM(%) ;TRANSLATE A VAX LOGICAL I ^%ZOSF("OS")'["VAX" Q "" I $$OS>6.1 Q $ZC(%TRNLNM,%) E Q $ZC(%TRNLOG,%) OS() ; Q $P($ZV," V",2) PRV() ;current privs Q $&ZLIB.%GETJPI("","CURPRIV") ZOSVDTM %ZOSV ;SFISC/AC,LL/DFH,sfisc/fyb ;10/31/95 10:04 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**13**;Jul 10, 1995 ; ** For DataTree ** ; ACTJ() ; Active Jobs Q $$njobs^%mjob("running") ; AVJ() ; Available Jobs Q $$njobs^%mjob("free") ; T0 ; start RT clock S XRT0=$H Q T1 ; store RT datum S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0 Q MAXJ ; Maximum # of Jobs S Y=$$njobs^%mjob("total") Q ; BAUD ; Baud rate of device - used by BAUD field of the Device File ; Internal entry of device is D0 ZETRAP BAUDERR S X=$zdevspeed($P(^%ZIS(1,D0,0),"^",2)) Q BAUDERR S X="" Q ; LGR() Q $ZR ;Last global reference ; EC() Q $ZE ;Error code ; DEVOPN ;X=$J,Y=List of devices separated by a comma G DEVOPN^%ZOSV1 ; DEVOK ;X=Device $I, Y=0 if available, Y=999 if device is busy ;Y=-1 if device is undefined. G RES:$G(X1)="RES" I $E(X)="/"!($E(X)="\") S Y=0 Q I $D(X)[0 S X=$I I X=$I S Y=$J Q I X<20,(X>9) S Y=0 D NULLDEV O X:("W":NULLDEV):0 C:$T X S:'$T Y=999 Q ZETRAP NODEV O X::0 I '$T S Y=999 Q C X S Y=0 Q RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0)) I '%ZISD0 S Y=-1,%ZISD0=%O(^%ZIS(1,"C",X)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"") I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q 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 K %ZISD0,%ZISD1 Q NULLDEV ; based on %device K HWTYPE S NULLDEV="NUL",H=$V($S($P($ZVER,"/",2)<4:4,1:1),3,-1) S HWTYPE=$S(H<10:"WS",H<20:"MF",H<64:"?",H<129:"PC",1:"?") I HWTYPE'="PC" S NULLDEV="[NUL]" K H,HWTYPE Q ; NODEV S Y=-1 Q ; DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X ;I $P($ZVER,"/",2)<4 D ^%VARLOG S Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR Q ; ORDER ; Save part of the symbol table in location specified by X S (Y,Y1)=$P(Y,"*",1) I $D(@Y)=0 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y[Y1) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR F %=0:0 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 K %,X,Y,Y1 Q ; JOBPAR ; Returns job X's namespace D JSTAT^%ZOSV1 I ($P($ZVER,"/",2)'<4)&($P($ZVER,"/",2)<4.3) S Y=$ZCONVERT($V(0,JA+908,-5),"U") E S Y=$$jstat^%mjob(X),Y=$P(Y,"|",4) Q ; ; NOLOG ; No logins allowed S Y=0 Q ; PARSIZ ; S X=3 Q ; PRIINQ() ; Priority Inquire N X,Y S X=$J ;D JSTAT^%ZOSV1 ;I ZVER S Y=$V(0,$V(1,(X-1*2)+100,-2)*16+5,-1)-128\2 S:Y Y=10-Y S Y=$$jstat^%mjob(X),Y=$P(Y,"|",7) S:Y Y=10-Y Q Y ; PRIORITY ; Set priority of job I X<1!(X>10) Q S Y=X,X=10-X ; convert Kernel to DTM priority I $P($ZVER,"/",2)<4 V 64+$J:50:$C(128+X) Q S X=X*2+128 zc #changepriority(X) V 2:5:$C(X) Q PRGMODE ; W ! S ZTPAC=$S($D(^VA(200,+DUZ,.1))#10:$P(^(.1),"^",5),1:""),XUVOL=^%ZOSF("VOL") I ZTPAC]"" X ^%ZOSF("EOFF") R !,"PAC: ",X:60 S X=$ZCONVERT(X,"U") X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB X ^%ZOSF("UCI") S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI U:$I>99 $I:IXXLATE=2 D ^%mshell ; UCICHECK(X) ; The call to ns^%m for Version 4 is necessary ; only if namespaces are password protected. ZETRAP BADUCI N CURUCI S X=$P(X,",") S X=$ZCONVERT(X,"U"),CURUCI=$ZNSPACE I $P($ZVER,"/",2)<4 ZNSPACE X ZNSPACE CURUCI Q X D ns^%m(X,1) S ^UTILITY($J)="" ; *** force error if dataset not mounted I CURUCI'=X D ns^%m(CURUCI,1) Q X BADUCI ; set flag and return to old namespace S Y=0 I $P($ZVER,"/",2)<4 ZNSPACE CURUCI E D ns^%m(CURUCI,1) Q Y ; VERSION(X) ;return OS version, X=1 - return OS Q $S($G(X):$P($ZV,"/"),1:$P($ZV,"/",2)) ; SETNM(X) ;Set name, Fall into SETENV SETENV ; Set environment S XUENV=X_"^" I $P($ZVER,"/",2)>4.2 V 2:374:$C($L(X))_X:$J#256 Q S X1=X,X=$J D JSTAT^%ZOSV1 V 0:JA+374:$C($L(X1))_X1 Q GETENV ; Get environment S Y=$ZNSPACE_"^"_^%ZOSF("VOL")_"^^"_^%ZOSF("VOL") Q TRMON ;Turn terminators on U $I:IXINTERP=2 N % S %=$$getall^%mixinterp() I $A(%)'=35 F %=0:1:31,127 D set^%mixinterp(%,35) Q TRMOFF ;Turn terminators off U $I:IXINTERP=$S($I>99:1,1:0) Q PASSALL ;Pass all characters U $I:IXINTERP=3 N % S %=$$getall^%mixinterp() I $A(%)'=18 F %=0:1:31,127 D set^%mixinterp(%,18) Q NOPASS ;Do not pass all characters D TRMOFF Q ; HFSREW(IO,IOPAR) ;Rewind Host File S $ZT="HFSRWERR" U IO:(LFA=0) Q 1 HFSRWERR ;Error encountered. Q 0 LOGRSRC(OPT) ;record resource usage in ^XUCP Q SETTRM(X) ;Turn on specified terminators. U $I:TERM=X Q 1 ZOSVKRM %ZOSVKR ;SF/KAK - Collect RUM Statistics for MSM ;3/10/00 07:43 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94,107,122,143**;Jul 21, 1998 ; RO(OPT) ; Record option resource usage in ^XTMP("KMPR","JOB" ; N KMPRTYP S KMPRTYP=0 ; option G EN ; RP(PRTCL) ; Record protocol resource usage in ^XTMP("KMPR","JOB" ; ; Variable PRTCL = option_name^protocol_name S OPT=$P(PRTCL,"^"),PRTCL=$P(PRTCL,"^",2) Q:PRTCL="" N KMPRTYP S KMPRTYP=1 ; protocol Q ; RU(KMPROPT,KMPRTYP,KMPRSTAT) ;-- record resource usage in ^XTMP("KMPR","JOB" Q ; EN ; Q ZOSVKRO %ZOSVKR ;SF/KAK - Collect RUM Statistics for OpenM/Cache;8/20/99 08:43 ;3/27/00 11:24 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94,107,122,143**;Jul 21, 1998 ; RO(OPT) ; Record option resource usage in ^XTMP("KMPR","JOB" ; N KMPRTYP S KMPRTYP=0 ; option G EN ; RP(PRTCL) ; Record protocol resource usage in ^XTMP("KMPR","JOB" ; ; Variable PRTCL = option_name^protocol_name N OPT,KMPRTYP S OPT=$P(PRTCL,"^"),PRTCL=$P(PRTCL,"^",2) Q:PRTCL="" ; protocol S KMPRTYP=1 G EN ; RU(KMPROPT,KMPRTYP,KMPRSTAT) ;-- record resource usage in ^XTMP("KMPR","JOB" ;--------------------------------------------------------------------- ; KMPROPT... Option name (may be option, protocol, rpc, etc.). ; KMPRTYP... Type of option: ; 0 - Option. ; 1 - Protocol. ; 2 - RPC (Remote Procedure Call). ; 3 - HL7. ; KMPRSTAT.. Status (for future use). 1 - start ; 2 - stop ;--------------------------------------------------------------------- ; Q:$G(KMPROPT)="" S KMPRTYP=+$G(KMPRTYP) S KMPRSTAT=$G(KMPRSTAT) ; N OPT,PRTCL ; ; OPT = option name. ; PRTCL = protocol name (optional). S OPT=$P(KMPROPT,"^"),PRTCL=$P(KMPROPT,"^",2) ; EN ; ; C........ comma (,) ; CURRENT.. current stats ; DATE..... date in fileman format ; DIFF..... difference (CURRENT minus PREV) ; DOW...... day of week ; HDATE.... date/time in $h format ; NODE..... current node ; PRIMETM.. prime time or non-prime time ; PREV..... previous stats ; N C,CURRENT,CURRHR,DATE,DIFF,DOW,HDATE,I,NODE,PREV,PREVHR N PRIMETM,TIME,Y ; quit if not in "PROD" uci. S Y="" X $G(^%ZOSF("UCI")) Q:Y'[$G(^%ZOSF("PROD")) D GETENV^%ZOSV S NODE=$P(Y,"^",3) S C=",",U="^" I KMPRTYP I OPT="" S:$P($G(^XTMP("KMPR","JOB",NODE,$J)),U,10)["$LOGIN$" OPT="$LOGIN$" I OPT="" Q:'+$G(^XUTL("XQ",$J,"T")) S OPT=$P($G(^XUTL("XQ",$J,^XUTL("XQ",$J,"T"))),U,2) Q:OPT="" ; ; CURRENT = current stats for this $job. ; cpu^dio^bio^pg_fault^cmd^glo^$H_date^$H_sec^ascii_time S CURRENT=$$STATS Q:CURRENT="" ; concatenate ^OPTion^option_type S CURRENT=CURRENT_U_$S(KMPRTYP=2:"`"_OPT,KMPRTYP=3:"&"_OPT,1:OPT)_"***"_$G(PRTCL)_U_$G(XQT) ; if option and login or taskman I 'KMPRTYP I OPT="$LOGIN$"!(OPT="$STRT ZTMS$") S ^XTMP("KMPR","JOB",NODE,$J)=CURRENT Q ; if logout or stopping task or programmer mode I OPT="$LOGOUT$"!(OPT="$STOP ZTMS$")!(OPT="XUPROGMODE") K ^XTMP("KMPR","JOB",NODE,$J) ; ; PREV = previous stats for this $job. S PREV=$G(^XTMP("KMPR","JOB",NODE,$J)) S ^($J)=CURRENT Q:PREV="" ; ; check for negative numbers for m commands and glo references F I=5,6 D .S:$P(CURRENT,U,I)<0 $P(CURRENT,U,I)=$P(CURRENT,U,I)+(2**32) .S:$P(PREV,U,I)<0 $P(PREV,U,I)=$P(PREV,U,I)+(2**32) ; S $P(CURRENT,U,7)=$P(CURRENT,U,7)-$P(PREV,U,7)*86400+$P(CURRENT,U,8) S HDATE=$P(PREV,U,7),$P(PREV,U,7)=$P(PREV,U,8) ; quit if not $h Q:'HDATE ; ; DIFF = CURRENT - PREV (current stats minus previous stats) ; cpu^dio^bio^pg_fault^cmd^glo^elapsed_sec^option_type F I=1:1:7 S $P(DIFF,U,I)=$P(CURRENT,U,I)-$P(PREV,U,I) ; option name time S OPT=$P(PREV,U,10),TIME=$P($P(PREV,U,8),".") ; date in fm format. S DATE=$$HTFM^XLFDT(HDATE),DATE=$P(DATE,".") ; day of week. S DOW=$$DOW^XLFDT(DATE,1) ; PRIMETM = 0: non-prime time ; 1: prime time S PRIMETM=0 ; prime time if not saturday or sunday or holiday ; if after 8am and before 5pm. I DOW>0&(DOW<6)&('$G(^HOLIDAY(DATE,0))) I TIME>28799&(TIME<61201) S PRIMETM=1 ; daily stats by $j. F I=1:1:7 S $P(^XTMP("KMPR","DLY",NODE,HDATE,OPT,$J,PRIMETM),U,I)=$P($G(^XTMP("KMPR","DLY",NODE,HDATE,OPT,$J,PRIMETM)),U,I)+$P(DIFF,U,I) ; 8th piece is count. S $P(^XTMP("KMPR","DLY",NODE,HDATE,OPT,$J,PRIMETM),U,8)=$P(^XTMP("KMPR","DLY",NODE,HDATE,OPT,$J,PRIMETM),U,8)+1 ; ; keep track of hours with activity - this will be used to determine ; actual hours of activity when moving data to file 8971.1 S DATE=$$HTFM^XLFDT(HDATE_","_TIME) ;S TIME=+$E($P(DATE,".",2),1,2),DATE=$P(DATE,".") ; hour for 'previous' dat. S PREVHR=+$E($P(DATE,".",2),1,2),DATE=$P(DATE,".") ; current hour. S CURRHR=+$E($P($$HTFM^XLFDT($H),".",2),1,2) ; record all hours this option ran. F TIME=PREVHR:1:CURRHR D .; because of zero hour add 1 to time - will offset each hour by 1 .S:DATE $P(^XTMP("KMPR","HOURS",DATE,NODE),U,(TIME+1))=1 ; Q ; STATS() ;-- extrinsic - return current stats for this $job ; N V S V=$V(-1,$J) ; current stats for this $job. ; cpu^dio^bio^pg_fault^cmd^glo^$H_date^$H_sec^time in thousands Q "^^^^"_$P($P(V,"^",7),",")_"^"_$P($P(V,"^",7),",",2)_"^"_+$H_"^"_$P($H,",",2)_"^"_$ZTIMESTAMP ZOSVKRV %ZOSVKR ;SF/KAK/RAK - Collect RUM Statistics for VAX-DSM;8/20/99 08:44 ;3/10/00 07:42 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94,107,122,143**;Jul 21, 1998 ; RO(OPT) ; Record option resource usage in ^XTMP("KMPR","JOB" ; N KMPRTYP S KMPRTYP=0 ; option G EN ; RP(PRTCL) ; Record protocol resource usage in ^XTMP("KMPR","JOB" ; ; Variable PRTCL = option_name^protocol_name N OPT S OPT=$P(PRTCL,"^"),PRTCL=$P(PRTCL,"^",2) Q:PRTCL="" N KMPRTYP S KMPRTYP=1 ; protocol G EN ; RU(KMPROPT,KMPRTYP,KMPRSTAT) ;-- set resource usage into ^XTMP("KMPR","JOB" ;----------------------------------------------------------------------- ; KMPROPT... Option name (may be option, protocol, rpc, etc.). ; KMPRTYP... Type of option: ; 0 - Option. ; 1 - Protocol. ; 2 - RPC (Remote Procedure Call). ; 3 - HL7. ; KMPRSTAT.. Status (for future use). 1 - start ; 2 - stop ;----------------------------------------------------------------------- ; Q:$G(KMPROPT)="" S KMPRTYP=+$G(KMPRTYP) S KMPRSTAT=$G(KMPRSTAT) ; N OPT,PRTCL ; ; OPT = option name. ; PRTCL = protocol name (optional). S OPT=$P(KMPROPT,"^"),PRTCL=$P(KMPROPT,"^",2) ; EN ; ; C........ comma (,) ; CURRENT.. current stats ; DATE..... date in fileman format ; DIFF..... difference (CURRENT minus PREV) ; DOW...... day of week ; HDATE.... date/time in $h format ; NODE..... current node ; PRIMETM.. prime time or non-prime time ; PREV..... previous stats ; N ARRAY,C,CURRENT,CURRHR,DATE,DIFF,DOW,HDATE,I,NODE,PREV,PREVHR N PRIMETM,TIME,Y ; quit if not in "PROD" uci. S Y="" X $G(^%ZOSF("UCI")) Q:Y'[$G(^%ZOSF("PROD")) S C=",",NODE=$P($ZC(%GETSYI),C,4),U="^" I KMPRTYP I OPT="" S:$P($G(^XTMP("KMPR","JOB",NODE,$J)),U,10)["$LOGIN$" OPT="$LOGIN$" I OPT="" Q:'+$G(^XUTL("XQ",$J,"T")) S OPT=$P($G(^XUTL("XQ",$J,^XUTL("XQ",$J,"T"))),U,2) Q:OPT="" ; ; CURRENT = current stats for this $job. ; cpu^dio^bio^pg_fault^cmd^glo^$H_date^$H_sec^ascii_time S CURRENT=$$STATS Q:CURRENT="" ; concatenate ^OPTion^option_type S CURRENT=CURRENT_U_$S(KMPRTYP=2:"`"_OPT,KMPRTYP=3:"&"_OPT,1:OPT)_"***"_$G(PRTCL)_U_$G(XQT) ; if option and login or taskman. I 'KMPRTYP I OPT="$LOGIN$"!(OPT="$STRT ZTMS$") S ^XTMP("KMPR","JOB",NODE,$J)=CURRENT Q ; ; PREV = previous stats for this $job. S PREV=$G(^XTMP("KMPR","JOB",NODE,$J)) S ^($J)=CURRENT I OPT="$LOGOUT$"!(OPT="$STOP ZTMS$")!(OPT="XUPROGMODE") K ^XTMP("KMPR","JOB",NODE,$J) Q:PREV="" ; check for negative numbers for m commands and glo references F I=5,6 D .S:$P(CURRENT,U,I)<0 $P(CURRENT,U,I)=$P(CURRENT,U,I)+(2**32) .S:$P(PREV,U,I)<0 $P(PREV,U,I)=$P(PREV,U,I)+(2**32) ; S $P(CURRENT,U,7)=$P(CURRENT,U,7)-$P(PREV,U,7)*86400+$P(CURRENT,U,8) S HDATE=$P(PREV,U,7),$P(PREV,U,7)=$P(PREV,U,8) ; quit if not $h Q:'HDATE ; ; DIFF = CURRENT - PREV (current stats minus previous stats) ; cpu^dio^bio^pg_fault^cmd^glo^elapsed_sec^option_type F I=1:1:7 S $P(DIFF,U,I)=$P(CURRENT,U,I)-$P(PREV,U,I) ; option name time S OPT=$P(PREV,U,10),TIME=$P($P(PREV,U,8),".") ; date in fm format. S DATE=$$HTFM^XLFDT(HDATE),DATE=$P(DATE,".") ; day of week. S DOW=$$DOW^XLFDT(DATE,1) ; PRIMETM = 0: non-prime time ; 1: prime time S PRIMETM=0 ; prime time if not saturday or sunday or holiday ; if after 8am and before 5pm. I DOW>0&(DOW<6)&('$G(^HOLIDAY(DATE,0))) I TIME>28799&(TIME<61201) S PRIMETM=1 ; global location for data storage. S ARRAY=$NA(^XTMP("KMPR","DLY",NODE,HDATE,OPT,$J,PRIMETM)) ; daily stats by $j. F I=1:1:7 S $P(@ARRAY,U,I)=$P($G(@ARRAY),U,I)+$P(DIFF,U,I) ; 8th piece is count. S $P(@ARRAY,U,8)=$P(@ARRAY,U,8)+1 ; keep track of hours with activity - this will be used to determine ; actual hours of activity when moving data to file 8971.1 S DATE=$$HTFM^XLFDT(HDATE_","_TIME) ;S TIME=+$E($P(DATE,".",2),1,2),DATE=$P(DATE,".") ; hour for 'previous' dat. S PREVHR=+$E($P(DATE,".",2),1,2),DATE=$P(DATE,".") ; current hour. S CURRHR=+$E($P($$HTFM^XLFDT($H),".",2),1,2) ; record all hours this option ran. F TIME=PREVHR:1:CURRHR D .; because of zero hour add 1 to time. this will offset each hour by 1. .S:DATE $P(^XTMP("KMPR","HOURS",DATE,NODE),U,(TIME+1))=1 ; Q ; STATS() ;-- extrinsic - return current stats for this $job N C,H,KMPRCMD,KMPRGLO,ZH S C="," ;,ZH=$ZH,H=$P(ZH,C,3) D JT Q:KMPRCMD="" "" S ZH=$ZH,H=$P(ZH,C,3),H=$E(H,13,23),H=$P($H,C)_C_($P(H,":")*3600+($P(H,":",2)*60)+$P(H,":",3)) ; ; current stats for this $job. ; cpu^dio^bio^pg_fault^cmd^glo^$H_date^$H_sec^ascii_time Q $P(ZH,C)_U_$P(ZH,C,7)_U_$P(ZH,C,8)_U_$P(ZH,C,4)_U_KMPRCMD_U_KMPRGLO_U_$P(H,C)_U_$P(H,C,2)_U_$P(ZH,C,3) ; JT ; Calculate the Job Table (%KMPRJT) for this job ; %KMPRJT should be made a system wide variable ; N %GLSBASE,%JOB,%JOBSIZ,%JOBTAB,%MAXPROC,%PID,%SMSTART,%TYPE,KMPROUT,X ; ; Return the current number of commands and global references ; KMPRCMD and KMPRGLO equal to null if NOT successful S (KMPRCMD,KMPRGLO)="",KMPROUT=0,U="^" ; ; Check for correct Job Table (%KMPRJT) for this job I $D(%KMPRJT) I $V(%KMPRJT+20)=$J S %TYPE="DSM" D USER G EXIT S %SMSTART=$V($ZK(GLS$SMSTART)) G:'%SMSTART EXIT S %GLSBASE=$V($V(0)+44) S %JOBTAB=%SMSTART+$V(%SMSTART+$V(%GLSBASE+124)),%JOBSIZ=$V(%GLSBASE+128) S %MAXPROC=$V($V(%GLSBASE+84)+%SMSTART) ; ; Go through Job Table looking for this process F %JOB=1:1:%MAXPROC Q:KMPROUT S %KMPRJT=%JOB*%JOBSIZ+%JOBTAB D .I $V(%KMPRJT+20) S %PID=$V(%KMPRJT+20),%TYPE="DSM" I %PID=$J D USER S KMPROUT=1 ; EXIT ; S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP") Q ; USER ; ; Watch for NONEXPR process S X="UERR^%ZOSVKR",@^%ZOSF("TRAP") ; ; Process improperly exited DSM I %TYPE="DSM",$V(%KMPRJT+$ZK(JOB_B_FLAGS),-1,1)\$ZK(JOB_M_EXITED)#2 G IMPROP ; ; Get commands and global references from job table S KMPRCMD=$V(%KMPRJT),KMPRGLO=$V(%KMPRJT+12) Q UERR ; ; Ignore NONEXPR (improperly exited DSM process) and SUSPENDED process I $ZE["NONEXPR"!($ZE["SUSPENDED") Q ZQ IMPROP ; ; Ignore improperly exited DSM process Q ZOSVKSD %ZOSVKSD ;SF/KAK - Calculate Disk Capacity ; 25 Jan 1999 4:23 pm [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1007**;APR 1, 2003 ;;8.0;KERNEL;**121,197**;May 4, 2001 ; ; This routine will help to calculate disk capacity for ; either DSM or OpenM-NT system platforms by looking up ; volume set table information ; EN(SITENUM,SESSNUM,VOLS) ;-- called by routine SYS+2^KMPSLK ;-------------------------------------------------------------------- ; SITENUM = Station number of site ; SESSNUM = SAGG session number ; VOLS = Array containing names of monitored volumes ; ; Returns ^XTMP("KMPS",SITENUM,SESSNUM,"@VOL",vol_name) = vol_size ;-------------------------------------------------------------------- ; N OS,OSTAG S OS=$P($G(^%ZOSF("OS")),U),OSTAG=$S(OS["VAX DSM":"DSM",OS["OpenM-NT":"OMNT",1:"UNK") Q:OSTAG="UNK" D @OSTAG Q ; DSM ;-------------------------------------------------------------------- ; VAX-DSM code ;-------------------------------------------------------------------- ; ;-- code from routine %VOLDEF ; VOLSET ; D VSSEL(,,"FULL") Q ; VSSEL(PAR,VAL,FLAG) ; ; PAR = "VSNUM","VSNAM", or "DBNAM" (optional) ; VAL = value of PAR (optional) ; FLAG = shows what to be included for all VOL nodes (optional) ; "FULL" - includes all volumes ; S PAR=$G(PAR),VAL=$G(VAL),FLAG=$G(FLAG) N N,QUIT,V,VT,VOL,VOLNAM,VOLTOT ; I '$$SM Q S VOL=$$NVOLSETS-1 F V=0:1:VOL S VOL(V)="" I $V($$SMX("VOLSNAM",V)) D .; .; define variable QUIT .I FLAG["FULL" S QUIT=0 .; .; point to volume table .S VT=$$VOLTAB(V) .; .; get volume set mount name .S VOL(V)=$V(VT+$ZK(VOLTAB_NAM),-3,3) .; .S VOLNAM=VOL(V),VOLTOT=0 .; .; build volume set table .F N=1:1:$V(VT+$ZK(VOLTAB_VOLS)) S VOLTOT=VOLTOT+$$GETVID(VT,N) .D SETNODE(SITENUM,SESSNUM,VOLNAM,VOLTOT) Q ; SM(X,S) ; ; start of shared memory I $G(X)="" Q $V($ZK(GLS$SMSTART)) I $G(S)="" S S="L" X "S X=$V($ZK(GLS$SMSTART))+$ZK(GLS$"_S_"_"_X_")" Q X ; SMX(X,INDEX) ; Q $$SM(X,"AL")+(4*INDEX) ; NVOLSETS() ; Q $V($$SM("NVOLSETS")) ; VOLTAB(VSNUM) ; pointer to volume table entry Q $$SM+$V($$SMX("VOLTAB",VSNUM)) ; GETVID(VT,N) ; Get info from volume descriptor for each volume ; ; get number of blocks Q ($V(N-1*8+$ZK(VOLTAB_VDES)+VT)) ; ;-- end of code from routine %VOLDEF ; OMNT ;-------------------------------------------------------------------- ; OpenM-NT Version for Cache 3.2 ;-------------------------------------------------------------------- ; ;-- code from routine %FREECNT ; N DIR,DIRUP,VOLTOT,X,Y,ZU ; S DIR="" F S DIR=$O(^|"%SYS"|SYS("UCI",DIR)) Q:DIR="" D .Q:$G(^|"%SYS"|SYS("UCI",DIR))]"" .S X=DIR .X ^%ZOSF("UPPERCASE") .; .; strip off trailing '\' if needed .I $E(Y,$L(Y))="\" S Y=$E(Y,1,$L(Y)-1) .S DIRUP=Y .; .; use $ZU(49) to see if directory is mounted .S ZU=$ZU(49,DIR) .; .; quit if directory does not exist or is dismounted .Q:ZU<0 .; .; quit is directory is not mounted .Q:+ZU=256 .; .; volume size = blocks per map * number of maps .S VOLTOT=+$P(ZU,",",2)*$P(ZU,",",4) .; .;-- end of code from routine %FREECNT .; .D SETNODE(SITENUM,SESSNUM,DIRUP,VOLTOT) Q ; SETNODE(SITENUM,SESSNUM,VOLNAM,VOLTOT) ; ; Set the @VOL node in the ^XTMP("KMPS" global array ; ; quit if SAGG is not monitoring this volume set (directory) Q:'$D(VOLS(VOLNAM)) ; S ^XTMP("KMPS",SITENUM,SESSNUM,"@VOL",VOLNAM)=VOLTOT Q ZOSVKSME %ZOSVKSE ;SF/KAK - Automatic %GE Routine (MSM) ;14 OCT 92 4:30 pm [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94**;Jul 21, 1998 ; ; MSM Version ; Q ; called by routine ^KMPSGE in VAH START(KMPSTEMP) ; I $D(^%ZOSF("TRAP")) S X="ERROR^%ZOSVKSE",@^%ZOSF("TRAP") E S $ZT="ERROR^%ZOSVKSE" ;W !,"Global Efficiency - Automated Version",! ; S KMPSSITE=$P(KMPSTEMP,"^"),NUM=$P(KMPSTEMP,"^",2),KMPSLOC=$P(KMPSTEMP,"^",3),KMPSDT=$P(KMPSTEMP,"^",4),KMPSPROD=$P(KMPSTEMP,"^",5) K KMPSTEMP,X S KMPSZU=$ZU(0),KMPSVOL=$P(KMPSZU,",",2) S ^[KMPSPROD,KMPSLOC]XTMP("KMPS","START",KMPSVOL,NUM)="" GET ; O 63 D INT^%ZOSVKSS I '$D(%UTILITY($J)) G EXIT ;W !,"No globals selected" S KMPSCC="" F KMPSI=1:0 S KMPSCC=$O(%UTILITY($J,KMPSCC)) Q:(KMPSCC="")!($D(^[KMPSPROD,KMPSLOC]XTMP("KMPS","STOP"))) S %BN=$ZBN(@("^["""_$ZU(0)_"""]"_KMPSCC)) D SP G EXIT SP ; Q:%BN=0 SP2 ; ;W !!,"^",KMPSCC D INT1^%ZOSVKSS S ^[KMPSPROD,KMPSLOC]XTMP("KMPS",KMPSSITE,NUM,KMPSDT,KMPSCC,KMPSZU)=%LHB(1) F I=1:1:%L D DSP1 ;W ?T(3),$J(%SPN,T(4)-T(3)-4) ;blocks allocated ;W ?T(4),$J(%SPN*1012,T(5)-T(4)-2) ;bytes allocated ;W ?T(5),$J(%SPU,T(6)-T(5)-2) ;bytes used ;I %SPN W ?T(6),$J(%SPU*100/%SPN/1012,9,2) ;percent efficiency Q DSP1 ; I I=%L S ^[KMPSPROD,KMPSLOC]XTMP("KMPS",KMPSSITE,NUM,KMPSCC,KMPSZU,KMPSDT,"D")=%SPN(I)_"^"_$P(%SPU(I)*100/%SPN(I)/1012+.5,".")_"%^Data" E S ^[KMPSPROD,KMPSLOC]XTMP("KMPS",KMPSSITE,NUM,KMPSCC,KMPSZU,KMPSDT,I)=%SPN(I)_"^"_$P(%SPU(I)*100/%SPN(I)/1012+.5,".")_"%^"_$S(I=(%L-1):"Bottom p",1:"P")_"ointer" ;W ?T(1),$J(I,T(2)-T(1)-3) ;ptr number ;W ?T(2),$J(%LHB(I),T(3)-T(2)-5) ;ptr block start ;W ?T(3),$J(%SPN(I),T(4)-T(3)-4) ;blocks allocated ;W ?T(4),$J(%SPN(I)*1012,T(5)-T(4)-2) ;bytes allocated ;W ?T(5),$J(%SPU(I),T(6)-T(5)-2) ;bytes used ;I %SPN(I) W ?T(6),$J(%SPU(I)*100/%SPN(I)/1012,9,2) ;percent efficiency ;W ! Q EXIT ; C 63 K ^[KMPSPROD,KMPSLOC]XTMP("KMPS","START",KMPSVOL),KMPSFS,KMPSLOC,KMPSMGR,KMPSPROD,KMPSSITE,KMPSUCI,KMPSVOL,KMPSZU,NUM K I,T,X K %BN,KMPSCC,KMPSI,%L,%LHB,%SP,%SPN,%SPU Q ERROR ; S ZUZR=$ZR I $D(^%ZOSF("TRAP")) S X="",@^%ZOSF("TRAP") D @^%ZOSF("ERRTN") E S $ZT="" D ^%ET H ZOSVKSMS %ZOSVKSS ;SF/KAK - Automatic %GSEL Routine (MSM) ;14 OCT 92 4:30 pm [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94**;Jul 21, 1998 ; ; MSM Version ; INT ; Internal entry point GS4 ; K %UTILITY($J) S KMPSGN="*" STR S KMPSGN=$P(KMPSGN,"*"),KMPSR1=KMPSGN,KMPSR2=KMPSR1_$S($ZB($V($V(44),-3,2),128,1):$C(#7E7E),1:$C(#FF)) NOREF S KMPSGN=KMPSR1 F KMPSI=0:0 S KMPSGN=$O(@("^"_KMPSGN)) Q:KMPSGN=""!(KMPSGN]KMPSR2) S %UTILITY($J,KMPSGN)="" I '$D(%UTILITY($J)) S ^[KMPSPROD,KMPSLOC]XTMP("KMPS",KMPSSITE,NUM," NO GLOBALS ",KMPSZU)="" EXIT K KMPSGN,KMPSI,KMPSR1,KMPSR2 Q ; INT1 ; Automatic %GE1 routine O 63 N (%BN,%SPN,%SPU,%L,%LHB) V %BN S T=$V(1020,0,1),%L=0 G GDIR:T=1,GPTR:T=2,GDATA:T=3,GXDATA:T=4,RDIR:T=5,RTNHDR:T=6,RTNDATA:T=7,MAPBLK:T=8,JRNL:T=9,SBP:T=10 Q ;W !!,*7,"** Unknown block type, block#=,%BN,", type=",T,*7,! Q ; GDIR ; global directory block GPTR ; pointer block RDIR ; routine directory S %L=%L+1,%SPN=1,%LHB(%L)=%BN,%SPU=$V(1022,0,2) S BP=$V(1021,0,1),%BN=$V(2+$V(1,0,1),0,3) ;down link F I=1:1 S %BNX=$V(1012,0,4) Q:'%BNX V %BNX S %SPN=%SPN+1,%SPU=%SPU+$V(1022,0,2) S %SPN(%L)=%SPN,%SPU(%L)=%SPU I BP<128 V %BN G GDIR G:T'=2 SUMUP V %BN GDATA ; Global data S %L=%L+1,%SPN=1,%LHB(%L)=%BN,%SPU=$V(1022,0,2) F I=1:1 S %BN=$V(1012,0,4) Q:'%BN V %BN S %SPN=%SPN+1,%SPU=%SPU+$V(1022,0,2) S %SPN(%L)=%SPN,%SPU(%L)=%SPU G SUMUP GXDATA ;global extended data RTNHDR ;routine header block RTNDATA ;routine continuation block JRNL ;journal block SBP ;sequential block processor block S %L=%L+1,%SPN=1,%LHB(%L)=%BN,%SPU=1022 F I=1:1 S %BN=$V(1012,0,4) Q:'%BN V %BN S %SPN=%SPN+1,%SPU=%SPU+$V(1022,0,2) S %SPN(%L)=%SPN,%SPU(%L)=%SPU G SUMUP MAPBLK ;map block S %L=%L+1,%SPN=1,%LHB(%L)=%BN,%SPU=1022 Q SUMUP ; S (%SPN,%SPU)=0 F I=1:1:%L S %SPN=%SPN+%SPN(I),%SPU=%SPU+%SPU(I) K (%SPN,%SPU,%L,%LHB) C 63 Q ZOSVKSOE %ZOSVKSE ;SF/KAK - Automatic INTEGRIT Rouine (OpenM-NT) ;21 AUG 97 9:13 pm [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94,197**;MaY 4, 2001 ; ; OpenM-NT Version for Cache 3.2 ; Q START(KMPSTEMP) ;-- called by routine OMNT+1^KMPSGE in VAH ; N DIRNAM,KMPSDT,KMPSERR,KMPSERR1,KMPSERR2,KMPSERR3,KMPSERR4,KMPSLOC,KMPSPROD,KMPSSITE,KMPSVOL,KMPSZU,NUM,X ; I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERROR^%ZOSVKSE" E S X="ERROR^%ZOSVKSE",@^%ZOSF("TRAP") ; S U="^",KMPSSITE=$P(KMPSTEMP,U),NUM=$P(KMPSTEMP,U,2),KMPSLOC=$P(KMPSTEMP,U,3) S KMPSDT=$P(KMPSTEMP,U,4),KMPSPROD=$P(KMPSTEMP,U,5),KMPSVOL=$P(KMPSTEMP,U,6) K KMPSTEMP S KMPSZU=$ZU(5)_","_KMPSVOL S ^XTMP("KMPS","START",KMPSVOL,NUM)="" ; UCI ;-- code from routine INTEGRIT ; ; DIRNAM = directory name S DIRNAM=KMPSVOL D UC1 DONE ; normal exit C 63 K ^XTMP("KMPS","START",KMPSVOL) Q ; UC1 ; N A,BLK,CUR,DIRSTAT,ERR,G,GLOBAL,J,LEV,LINK,LNB,LNBLK,LNBYTE,LSNP,LTOTBLK,LTOTBYTE N N,NB,NBLK,NBYTE,NP,RET,TL,TOTBLK,TOTBYTE ; ; prevent dismounted database S DIRSTAT=$P($ZU(49,DIRNAM),",",1) ; either dismounted or does not exist I DIRSTAT<0 D ERR G ERROR O 63:"^^"_DIRNAM D INTEG1 I $G(GLOBAL(1))="" S ^XTMP("KMPS",KMPSSITE,NUM," NO GLOBALS ",KMPSVOL)="" Q D EV1 Q ; GLOCHK ; N GLOINFO,JRNL,PROT,PROTINFO ; ; these extra logic ideas are from routine %GD ; GLO = name ^ type ^ protection ^ growth_area ^ root_block (first pointer block) ^ journal ^ collate S PROT=$P(GLO,U,3),PROT(0)="N",PROT(1)="R",PROT(2)="RW",PROT(3)="RWD" ; protection - world ^ group ^ owner ^ network S PROTINFO=PROT(PROT\16#4)_U_PROT(PROT\4#4)_U_PROT(PROT#4)_U_PROT(PROT\64#4) S JRNL=$S($P(GLO,U,6):"Y",1:"N") ; global info = jrnl^collating^blank^growth area block^blank^protection:world^group^owner^network^first pointer block S GLOINFO=JRNL_U_$P(GLO,U,7)_"^^"_$P(GLO,U,4)_"^^"_PROTINFO_U_$P(GLO,U,5) ; end of extra logic ideas ; S TOTBLK=TOTBLK+1 S G=$P(GLO,U,2,99),G=$P(G,U,4),LEV=1 ; ; quit if global is implicit - do not process I G\256=65535 Q ; S X="ERRHND^%ZOSVKSE",@^%ZOSF("TRAP") S $ZE="" ; B ; LEV(LEV) = root block S LEV(LEV)=G V G S A=$V(2043,0) ; find bottom level I A=2!(A=6) S G=$V(2,-5),LEV=LEV+1 G B ; S X="",@^%ZOSF("TRAP") ; ; W LEV_" Levels in this global" S (NBLK,LNBLK,NBYTE,LNBYTE)=0,CUR=1 ; LEV(1) = first block number S ^XTMP("KMPS",KMPSSITE,NUM,KMPSDT,$P(GLO,U),KMPSZU)=LEV(1)_U_GLOINFO C S BLK=LEV(CUR),RET="RETURN^"_$ZN ; W "Level: "_CUR_", " ; S X="ERRHND^%ZOSVKSE",@^%ZOSF("TRAP") ; D RESTART^%ZOSVKSS ; S X="",@^%ZOSF("TRAP") ; Q:+$G(^XTMP("KMPS","STOP")) RETURN S TOTBLK=NP+TOTBLK,LTOTBLK=LTOTBLK+LSNP S TOTBYTE=TOTBYTE+NB,LTOTBYTE=LTOTBYTE+LNB I $ZE="" S CUR=CUR+1 I CURP ; C1 ; build name S A=$V(P,0),P=P+1 I A S NAM=NAM_$C(A) G C1 ; ; info = type ^ protection ^ growth_area ^ root_block (first pointer block) ^ journal ^ collate S INFO=$V(P,0,"2O")_U_$V(P+2,0)_U_$V(P+3,0,"3O")_U_$V(P+6,0,"3O")_U_$V(P,0)_U_$V(P+1,0) ; ; one entry S GLOBAL=NAM_U_INFO I $L(GLOBAL(C))>460 S GLOBAL(C)=GLOBAL(C)_"*",C=C+1,GLOBAL(C)="" ; S GLOBAL(C)=GLOBAL(C)_GLOBAL_"," ; S G=G+1,P=P+9,NAM="" G NEXT D1 S GD=$V(2040,0,"3O") I GD G B1 Q ;-- end code from routine INTEG1 ; ERROR ; ERROR - Tell all SAGG jobs to STOP collection ; C 63 S KMPSERR="Error encountered while running SAGG collection routine for volume set "_$G(KMPSVOL) S KMPSERR2="Last global reference = "_$ZR S KMPSERR3=$$EC^%ZOSV I $D(KMPSERR4) S KMPSERR4="For more information, read text at line tag "_KMPSERR4_" in routine ^%ZOSVKSS" ; S ^XTMP("KMPS","ERROR",KMPSVOL)="",^XTMP("KMPS","STOP")=1 K ^XTMP("KMPS","START",KMPSVOL) ; D ^%ZTER,UNWIND^%ZTER ; Q ZOSVKSOS %ZOSVKSS ;SF/KAK - Automatic INTEGRIT Routine (cont.) (OpenM-NT) ;21 AUG 97 2:42 pm [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94,197**;May 24, 2001 ; ; OpenM-NT Version for Cache 3.2 ; RESTART ;-- called by routine C+6^%ZOSVKSE ; ;-- code from routine CHECKPNT ; K SUB,C N B,FLAG ; S (FLAG,NP,NB,LSNP,LNB,ERR)=0 ; S X="",@^%ZOSF("TRAP") ; V BLK S A=$V(2,-5) V A S A=",,"_($V(2043,0,1)*16777216+A)_"," ; S X="ERR^%ZOSVKSS",@^%ZOSF("TRAP") ; CHK Q:+$G(^XTMP("KMPS","STOP")) ; V BLK S LINK=$V(2040,0,"3O") S A=$V($P(A,",",3),-7,$P(A,",",4),400) S TL=$P(A,",",3)\16777216 S NP=NP+A,NB=NB+$P(A,",",2) ; ; big global data blocks (type 12) I FLAG=0,(TL=8)!(TL=12) S FLAG=1 V BLK S B=$V(2,-5) D .F Q:'B V B S B=$V(2040,0,"3O") F N=1:1 Q:$V(N-1*2+1,-6)="" S X=$V(N-1*2+2,-6) S:$A(X)=3 LNB=LNB+($A(X,2)*2048)+$ZWA(X,3),LSNP=LSNP+$A(X,2)+1 ; CHKB I LINK S BLK=LINK G CHK ; ; ragged edge I $P(A,",",3)#16777216,$P(A,",",3)\16777216-16 G ER6 ; END S X="",@^%ZOSF("TRAP") ; ; W "# ptrs = "_NP S LNBLK=+$G(LNBLK) ; na% => cannot calculate the percent efficiency of first pointer block I CUR=1 S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,CUR)="1^na%^Pointer" I (NBLK+LNBLK) D .; W ", # blks = "_(NBLK+LNBLK)_", # ptrs/blk = "_(NP\(NBLK+LNBLK)) .; W ", eff = "_(((NBYTE+LNBYTE)*100)\((2036*NBLK)+(2048*LNBLK)))_"%" .S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,CUR)=(NBLK+LNBLK)_"^"_(((NBYTE+LNBYTE)*100)\((2036*NBLK)+(2048*LNBLK)))_"%^"_$S(CUR=(LEV-1):"Bottom p",1:"P")_"ointer" S TL=$P(A,",",3)\16777216 ; ; m-code blocks (type 16) - do not store into ^XTMP("KMPS") ; I TL=16 W "Routine level: # rtns = "_NP ; ; global data blocks (type 8) and big global data blocks (type 12) I TL=8!(TL=12) D .; I NP W "Data level: # blks = "_NP_", eff = " W:NP (NB*100\(2036*NP))_"%" .I NP S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,"D")=NP_"^"_$S(NP:NB*100\(2036*NP),1:"")_"%^Data" .; I LSNP W "Long String level: # blks = "_LSNP_",eff = " W:LSNP (LNB*100\(2048*LSNP))_"%" .I LSNP S ^XTMP("KMPS",KMPSSITE,NUM,$P(GLO,"^"),KMPSZU,KMPSDT,"L")=LSNP_"^"_$S(LSNP:LNB*100\(2048*LSNP),1:"")_"%^LongString" S NBLK=NP,LNBLK=LSNP,NBYTE=NB,LNBYTE=LNB Q ;-- end code from routine CHECKPNT ; ERR ;-- code from routine CHECK0 ; S (LE,LL,ERR)=0 ; ; global is too large for INTEGRIT - use ^DIAG to check this global I $ZE?1"".E S ERR=1 Q ; S D=BLK,LN=$P(A,",",4),TL=$P(A,",",3)\16777216 ; S X="ERROR^%ZOSVKSS",@^%ZOSF("TRAP") ; V BLK D CHECK1 Q:ERR ; K B F I=1:2:C-2 S B=C(I)-1#400,B(C(I)-B,B)="" D CM(1) Q:ERR ; K B F I=1:2:C-2 I C(I,1) D MB D CM(249) Q:ERR ; K B S NP=C\2+NP,NB=NB+LE,A=",,"_(TL*16777216+LL)_","_LN K C ; S X="ERR^%ZOSVKSS",@^%ZOSF("TRAP") ; G CHKB ; ERROR I $ZE?1"2048) D ER19 .F K=0:1:N S BL=(((($A(X,A+3)*256)+$A(X,A+2))*256)+$A(X,A+1)),A=A+3 S B=BL-1#400 I $D(B(BL-B,B)) D ER20 S B(BL-B,B)=C(I)_","_J_","_K ;-- end code from routine CHECK0 ; CHECK1 ;-- code from routine CHECK1 ; F C=1:2 Q:$V(C,-5)="" S SUB(C)=$V(C,-5) F I=1:2:C-2 D .S C(I)=$V(I+1,-6),C(I,1)=C(I)\8388608#2,C(I)=C(I)#8388608 .I C(I)=BLK G ER10 I $P(A,",",3)#16777216-C(1),$P(A,",",3)\16777216-16 G ER3 F E=1:2:C-2 S D=C(E) V D D CH Q:ERR I TL=16,LINK S D=LINK V D S LL=$V(2,-5) Q ; CH I $V(0,0)#256 G ER7 S TL1=$V(2043,0,1) I (TL=8)!(TL=12) D .I 'C(E,1),TL1'=8 G ER16 .I C(E,1),TL1'=12 G ER17 I (TL-8),(TL-12),$V(2043,0,1)-TL G ER12 S LE=LE+$V(2046,0,2) I $V(1,-5)'=SUB(E) G ER8 Q:TL=16 S LL=$V(2040,0,"3O") I E+2128 S TY=TY-128 Q ; GETPTR ; Extract the 1st down pointer from block in the ; viewbuffer. ; ; Output: ; BN - downpointer ; N P S P=$V(1,0,1)+2 S BN=$V(P,0,3) Q ; NOUCI ; global efficiency is available only for volume set globals ; no volume sets are currently accessible ; END ; K %UTILITY,BLKS,BN,BYTES,CNT,DLVL,DPTR,GDIR,GN,I,LVL,OFF,P,RLP,STRNO,STY,TY,UCINAM,UCIOFF,UCITAB,VSNAM,VSNUM,X K ^[KMPSPROD,KMPSLOC]XTMP("KMPS","START",KMPSVOL) Q ZOSVKSVS %ZOSVKSS ;SF/KAK - Automatic %GE Routine (VAX-DSM) ;14 OCT 92 4:30 pm [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**90,94,197**;May 4, 2001 ; ; VAX-DSM Version ; ;-- code from routine %GSEL ; S %=$ZC(%UCI),%LOC="",%SUBTR=0 I %]"" N %UCI,%SYS S %UCI=$P(%,","),%SYS=$P(%,",",4),%LOC="["""_%UCI_""","""_%SYS_"""]" INIT K %UTILITY,%GD START S X="ERR1^%ZOSVKSE",@^%ZOSF("TRAP"),$ZE="" ASK ; prompt for name specifications and select names in %UTILITY S %X="*" D SELECT I $O(%UTILITY(""))="" S ^[KMPSPROD,KMPSLOC]XTMP("KMPS",KMPSSITE,NUM," NO GLOBALS ",KMPSZU)="" G END ; SELECT ; Input: %X = one item S %ST="",(%CNT,%MI)=0 S %FI="zzzzzzzz" ; GET ; search directory and put names in %UTILITY ; Input: %ST = start string ; %FI = end string G GETRMS:$ZU("")="",GETGLS ; GETRMS ; get RMS global names ; Input: %ST = starting name ; %FI = ending name S %W=%ST I %FI'["z" S %W="" I $E(%W,1)'="%" S %F="DSM$GLOBAL_DIR:"_%W_"*.GBL" E S %F="DSM$GLOBAL_LIB:"_$E(%W,2,$L(%W))_"*.GBL" I $E(%ST,1)="^" S %ST=$E(%ST,2,$L(%ST)) I $E(%FI,1)="^" S %FI=$E(%FI,2,$L(%FI)) S %F=$ZSE(%F) F Q:%F="" S %N=$P($P(%F,"]",2),".") S:$E(%W)="%" %N="%"_%N Q:%N]%FI D SELONE:%N=%ST!(%N]%ST) S %F=$ZSE("") Q ; SELONE ; select one entire global ; delete all selected subtree(s) K %UTILITY(%N,"S") S %UTILITY(%N)="",%CNT=%CNT+1 Q ; GETGLS ; get DSM volume set global names ; create %GD array of all of them and choose right ones ; %GD utility create %GD array S %W=%ST I %FI'["z" S %W="" I $D(%GD)'=11 D %GDI(%UCI,%SYS,1,0) S %F=$O(%GD("")) F Q:%F="" S %N=%F Q:%F]%FI D SELONE:%N=%ST!(%N]%ST) S %F=$O(%GD(%F)) Q ; END K %GD,%X,%ST,%FI,%MI,%W,%F,%,%N,%SUBTR,%LOC,%CNT K %ERR,%GNM,%L,%PSN,%QS,%QT,%RV,%SB,%ST,%V,%C ;-- end code from routine ^%GSEL ; G EGD ; %GDI(%UCI,%SYS,%NP,%LIB) ; ;-- code from routine %GD ; ; enter with %UCI, %SYS, %NP and %LIB defined ; %NP = no printout is set to 1 ; N %OPT S %OPT=0 ; return the %GD array containing volume set globals I $ZU("")=""!(%UCI="")!(%SYS="") ZT "Error in SAGG utility" D %DSM G %EXIT ; %DSM ; display the global directory of a volume set ; this may be different from selected UCI S %=$ZC(%UCI) ; ; construct volume set name S %VSET="S"_$P($ZU(%UCI,%SYS),",",2) ; ;-- code from line tag %DIR S %DIR=$S($ZU("")]"":%UCI_","_%SYS,1:$P($P($ZC(%GBLSHOW),",",1+%LIB),"]",1)_"]") ; ; compute value for priming $ZSORT S %C=0,%NAM="%" ; ; if priming value exists set it -- code from line tag %WRTGLO I $D(@("^[%UCI,%SYS]"_%NAM)) S %GD(%NAM)="" ; ; $ZS through global names -- code from line tag %WRTGLO F D Q:%NAM="" I $E(%NAM)="%"!'%LIB S %GD(%NAM)="" .S %NAM=$ZS(@("^[%UCI,%SYS]"_%NAM)) ; ; finish up Q ; %EXIT K %DIR,%,%N,%C,%D,%UCI,%SYS,%LIB,%VSET K %NAM,%OPT,%NP Q ;-- end code from routine %GD ; EGD ;-- code from %EGD ; extended global directory information ; S U="^",P=$ZU(0) Q:P="" S %UCI=$P(P,","),%SYS=$P(P,",",2) ; ; construct volume set name S VS="S"_$P($ZU(%UCI,%SYS),",",2) ; ; get global directory block S GD=$ZC(%UCIDIR,%UCI,%SYS) ; ; open a 1 block view buffer S P=$ZC(%VIEWBUFFER,1,1,1) READ V GD:VS S P=0 NAME I $V(1022,0,2)'>P S GD=$V(1014,0,3) G READ:GD,EXIT S NAM="" F P=P:1 S A=$V(P,0,1),NAM=NAM_$C(A\2) I A#2=0 Q ; PROT = protection S P=P+1,PROT=$V(P+1,0,1) F I=1:1:4 S @("A"_I_"=$P(""N,R,RW,RWP"","","",PROT#4+1)"),PROT=PROT\4 S B=P+2 D S BL1=B,B=P+5 D S BL2=B .S B=$V(B+2,0,1)*256+$V(B+1,0,1)*256+$V(B,0,1) ; COL = collate S COL=$V(P,0,2)#2+1 S BITS=$V(P,0,2)\2#2+7 ; ; %UTILITY(global name) = jrnl^collating^bits^growth area block ; ^protection:system^world^group^user ; ^blank^1st pointer block ; where collating: N = Numeric ; S = String ; I $D(%UTILITY(NAM)) S %UTILITY(NAM)=$S($V(P,0,2)\4#2:"Y",1:"N")_U_$P("N,S",",",COL)_U_BITS_U_BL1_U_A4_U_A3_U_A2_U_A1_U_U_BL2 ; S P=P+8 G NAME EXIT ; K A,A1,A2,A3,A4,B,BL1,BL2,BITS,COL,GD,NAM,P,PROT,VS Q ;-- end code from routine %EGD ZOSVMNT %ZOSV ;SFISC/AC - $View commands for MSM-NT ;2/26/98 10:47 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**13,25**;Jul 10, 1995 ; ; ZOSVMNT should be saved in MGR as %ZOSV on NT Machines ; Wally Fort sent this routine by itself to IHS ; IHS/JLB 5/1/98 ACTJ() ; Q $S($$V3:$V($V(44)+168,-3,2),1:$V(168,-4,2)) AVJ() ; Q $S($$V3:$V($V(44)+94,-3,2)+1-$V($V(44)+168,-3,2),1:$V($V(3,-5),-3,0)-$V(168,-4,2)) T0 ; start RT clock I $$OSTYPE()'=1 S XRT0=$H Q S XRT0=$P($H,",")_","_($V(#46C,-3,4)*5.4925\1/100) Q T1 ; store RT datum I $$OSTYPE()'=1 S ^%ZRTL(3,XRTL,+$H,$P($H,",",2))=XTR0 K XTR0 Q S ^%ZRTL(3,XRTL,+$H,XRTN,$V(#46C,-3,4)*5.4925\1/100)=XRT0 K XRT0 Q JOBPAR ; S Y=$V(2,X,2) Q:'Y S Y=$ZU(Y#32,Y\32) Q PROGMODE() ; Q $V(0,$J,2)#2 PRGMODE ; W ! S ZTPAC=$S('$D(^VA(200,+DUZ,.1)):"",1:$P(^(.1),U,5)),XUVOL=^%ZOSF("VOL") ;I ZTPAC="" W *7,"YOU HAVE NO PROGRAMMER ACCESS CODE!",! Q I ZTPAC]"" X ^%ZOSF("EOFF") R !,"PAC: ",X:60 X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB I '$$PROGMODE() D UCI S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI B 2 V 0:$J:$ZB($V(0,$J,2),1,7):2 S $ECODE=",U<>," ABORT E S $ECODE=",U<>," Q W !,"YOU ARE NOW IN PROGRAMMING MODE!",! S $ZE="" B:ZOSVER -2 K ZOSVER Q ; SIGNOFF ; I 0 ;I $V($V(44)+4,-3,2)\32768#2 Q Q UCI ; S Y=$ZU(0) Q ;X ^%ZOSF("UCI") Q ; UCICHECK(X) ; N Y,I S Y="",$ZT="BADUCI^%ZOSV" I X["," S Y=$ZU($P(X,","),$P(X,",",2)),(X,Y)=$ZU($P(Y,","),$P(Y,",",2)) Q:Y]"" Y F I=1:1:64 G:$ZU(I)="" BADUCI Q:$ZU(I)=X!($P($ZU(I),",")=X)!(I=X) Q $ZU(I) ; BADUCI Q "" ; BAUD S Y=^%ZOSF("MGR"),X=$S($D(^%ZIS(1,D0,0)):$P(^(0),"^",2),1:"") Q:X="" I '$D(^[Y]SYS(0,"DDB",+X)) S X="" Q S X=$P(^(+X),",",3)#100 Q:'X S X=$P("50,75,110,134.5,150,300,600,1200,1800,2400,3600,4800,9600",",",X) Q ; LGR() Q $ZR ;Last global ref. ; EC() Q $ZE ;Error code ; DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X S Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR Q ; ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X S (Y,Y1)=$P(Y,"*",1) I $D(@Y)=0 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y[Y1) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR F %=0:0 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 K %,X,Y,Y1 Q ; PRIORITY ; N %D,%P S %P=(X>5) D INT^%HL Q ; PRIINQ() ; Q $S($V(20,$J,2):10,1:1) PARSIZ ; S X=3 Q ; NOLOG ; S Y=$S($$V3:"$V($V(44)+4,-3,2)",1:"$V(4,-4,2)")_"\64#2" Q ; DEVOPN ; ;X=$J,Y=List of devices separated by a comma N %,%1,%I,%X S Y="" I $$V3 S %=$V($V(44)+10,-3,2),%1=$V($V(44)+8,-3,2)+$V(44),%=$V(%*5+%1) E S %=$V(5,-5,0) F %I=1:1:255 S %X=$V(%+%I+%I,-3,2) I %X,%X#4=0,%X/4=X S Y=Y_%I_"," Q DEVOK ; ;X=Device $I, Y=0 if available, Y=Job # if owned, ;Y=-1 if device is undefined. G RES:$G(X1)="RES" I $E(X)="/"!($E(X)="\") S Y=0 Q I X=2 S Y=0 Q I X'?1.N!(X'>0!(X'<1024)) S Y=-1 Q N % I $$VERSION(1)["NT" D DVOPN Q ; I $$V3 S %=$V($V(44)+8,-3,2)+$V(44),%=$V($V($V(44)+10,-3,2)*5+%),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4,1:-1) E S %=$V(5,-5,0),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4+$V(272,-4),1:-1) I 'Y D DVOPN Q S:Y=$J Y=0 Q DVOPN S $ZT="DVERR",Y=0 Q:$D(%ZTIO) L:$D(%ZISLOCK) +@%ZISLOCK:60 O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK Q L:$D(%ZISLOCK) -@%ZISLOCK S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q S:X]"" IO(1,X)="" Q DVERR I $ZE["OPENERR" S Y=-1 L:$D(%ZISLOCK) -@%ZISLOCK Q I $ZE["" S Y=-1 L:$D(%ZISLOCK) -@%ZISLOCK Q ZQ RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0)) I '%ZISD0 S Y=-1,%ZISD0=%O(^%ZIS(1,"C",X)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"") I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q 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 K %ZISD0,%ZISD1 Q V2CL1 F %=0:0 Q:$ZA<0 R %X:5 Q:%X']"" F %1=0:0 S %1=$L(%Y),%Y=%Y_$E(%X,1,255-%1),%X=$E(%X,256-%1,$L(%X)),%1=$F(%Y,%ZCR) Q:%1'>0 S %2=$E(%Y,$A(%Y)=10+1,%1-2),%Y=$E(%Y,%1,$L(%Y)) D V2CL2 I %Y]"" S %2=$E(%Y,$A(%Y)=10+1,$L(%Y)) D V2CL2 C 2:256 K IO(1,2) D CLOSE^ZISPL1 K %Y,%X,%1,ZOSFV Q V2CL2 S %1=$F(%2,$C(12)) I %1>0 S %=%+1 D LIMIT:%Z1<% Q:%Z1<% S ^XMBS(3.519,XS,2,%,0)="|TOP|",%2=$E(%2,1,%1-2)_$E(%2,%1,$L(%2)) S %=%+1,^XMBS(3.519,XS,2,%,0)=%2 Q ; LIMIT S ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q ; SET ;SET SPECIAL VARIABLES S X=$H X ^%ZOSF("ZD") S DT=$E(Y,7,8)+200_$E(Y,1,2)_$E(Y,4,5) Q GETENV ;Get enviroment (UCI^VOL^NODE) S Y=$P($ZU(0),",",1)_"^"_$P($ZU(0),",",2)_"^^"_$P($ZU(0),",",2) Q VERSION(X) ;return OS version, X=1 - return OS Q $S($G(X):$P($ZV,"Version "),1:$P($ZV,"Version ",2)) V3() ;returns 1=version 3, 0=version 4 Q $P($ZV,"Version ",2)<4 OSTYPE() ;Return 1 = PC/PLUS, 2 = NT, 3 = UNIX N % S %=$$VERSION(1) Q $S(%["MSM-PC/PLUS":1,%["Windows NT":2,1:3) ; SETNM(X) ;Set name, Fall into SETENV SETENV ;Set enviroment Q ZHDIF ;Display dif of two $$ZH^%MSMOPS's S U="^" W !?2,"CPU=",$J($P(%ZH1,U)-$P(%ZH0,U),6,2),?14,"ET=",$J($P(%ZH1,U,7)-$P(%ZH0,U,7),6,2),?25,"PRD=",$J($P(%ZH1,U,3)-$P(%ZH0,U,3),4),?35,"LRD=",$J($P(%ZH1,U,2)-$P(%ZH0,U,2),6),?47,"LWT=",$J($P(%ZH1,U,4)-$P(%ZH0,U,4),5) W ?58,"TI=",$J($P(%ZH1,U,5)-$P(%ZH0,U,5),4),?67,"TO=",$J($P(%ZH1,U,6)-$P(%ZH0,U,6),5) Q LOGRSRC(OPT) ;record resource usage in ^XUCP Q:$$OSTYPE'=1 N C,H,I,J,U S C=",",U="^",%=$$ZH^%MSMOPS,H=$P($H,C)_C_($V(#46C,-3,4)*5.4925\1/100) I $P(H,",",2)\1#100=0 S J=$$HTFM^XLFDT($H,1),I=$$FMADD^XLFDT(J,365)_U_J,^XTMP("XUCP",0)=I S ^XTMP("XUCP","NODNAM",$P(H,C),$J,$P(H,C,2))=$P(%,U)_U_$P(%,U,3)_U_$P(%,U,2)_U_$P(%,U,4,6)_U_OPT_U_($P(%,U,7)*100\1/100) Q SETTRM(X) ;Set specified terminators. U $I:(::::::::X) Q 1 ZOSVMSM %ZOSV ;SFISC/AC - $View commands for MSM-PC/PLUS ;06/25/99 14:02 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**13,25,49,94,107,118**;Jul 10, 1995 ; ACTJ() ;Active Jobs Q $S($$V3:$V($V(44)+168,-3,2),1:$V(168,-4,2)) AVJ() ;Available jobs Q $S($$V3:$V($V(44)+94,-3,2)+1-$V($V(44)+168,-3,2),1:$V($V(3,-5),-3,0)-$V(168,-4,2)) ; JOBPAR ; S Y=$V(2,X,2) Q:'Y S Y=$ZU(Y#32,Y\32) Q ; PROGMODE() ; Q $V(0,$J,2)#2 PRGMODE ; W ! S ZTPAC=$S('$D(^VA(200,+DUZ,.1)):"",1:$P(^(.1),U,5)),XUVOL=^%ZOSF("VOL") I ZTPAC]"" X ^%ZOSF("EOFF") R !,"PAC: ",X:60 X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q K XMB,XMTEXT,XMY S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB X ^%ZOSF("UCI") S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI V 0:$J:$ZB($V(0,$J,2),1,7):2 PRGMODEX W !,"YOU ARE NOW IN PROGRAMMING MODE!",! S $ECODE=",U," Q ; SIGNOFF ; I 0 ;I $V($V(44)+4,-3,2)\32768#2 Q Q UCI ; S Y=$ZU(0) Q ;X ^%ZOSF("UCI") Q ; UCICHECK(X) ; N Y,I S Y="",$ZT="BADUCI^%ZOSV" I X["," S Y=$ZU($P(X,","),$P(X,",",2)),(X,Y)=$ZU($P(Y,","),$P(Y,",",2)) Q:Y]"" Y F I=1:1:64 G:$ZU(I)="" BADUCI Q:$ZU(I)=X!($P($ZU(I),",")=X)!(I=X) Q $ZU(I) ; SHARELIC(TYPE) ;Intersystem Cache and DSM only Q ; BADUCI Q "" ; BAUD S X=9600 Q ; LGR() Q $ZR ;Last global ref. ; EC() Q $ZE ;Error code ; DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X S Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR Q ; ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X S (Y,Y1)=$P(Y,"*",1) I $D(@Y)=0 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y[Y1) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR F %=0:0 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 K %,X,Y,Y1 Q ; PRIORITY ; Q:X>5 N %D,%P S %P=(X>5) D INT^%HL Q ; PRIINQ() ; Q $S($V(20,$J,2):10,1:1) PARSIZ ; S X=3 Q ; NOLOG ; S Y=$S($$V3:"$V($V(44)+4,-3,2)",1:"$V(4,-4,2)")_"\64#2" Q ; DEVOPN ; ;X=$J,Y=List of devices separated by a comma N %,%1,%I,%X S Y="" I $$V3 S %=$V($V(44)+10,-3,2),%1=$V($V(44)+8,-3,2)+$V(44),%=$V(%*5+%1) E S %=$V(5,-5,0) F %I=1:1:255 S %X=$V(%+%I+%I,-3,2) I %X,%X#4=0,%X/4=X S Y=Y_%I_"," Q DEVOK ; ;X=Device $I, Y=0 if available, Y=Job # if owned, ;Y=-1 if device is undefined. G RES:$G(X1)="RES" I $E(X)="/"!($E(X)="\") S Y=0 Q I X=2 S Y=0 Q I X'?1.N!(X'>0!(X'<1024)) S Y=-1 Q N % I $$VERSION(1)["NT" D DVOPN Q ; I $$V3 S %=$V($V(44)+8,-3,2)+$V(44),%=$V($V($V(44)+10,-3,2)*5+%),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4,1:-1) E S %=$V(5,-5,0),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4+$V(272,-4),1:-1) I 'Y D DVOPN Q S:Y=$J Y=0 Q DVOPN S $ZT="DVERR",Y=0 Q:$D(%ZTIO) L:$D(%ZISLOCK) +@%ZISLOCK:60 O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK Q L:$D(%ZISLOCK) -@%ZISLOCK S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q S:X]"" IO(1,X)="" Q DVERR I $ZE["OPENERR" S Y=-1 L:$D(%ZISLOCK) -@%ZISLOCK Q I $ZE["" S Y=-1 L:$D(%ZISLOCK) -@%ZISLOCK Q ZQ RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,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 S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"") I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q 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 K %ZISD0,%ZISD1 Q V2CL1 F %=0:0 Q:$ZA<0 R %X:5 Q:%X']"" F %1=0:0 S %1=$L(%Y),%Y=%Y_$E(%X,1,255-%1),%X=$E(%X,256-%1,$L(%X)),%1=$F(%Y,%ZCR) Q:%1'>0 S %2=$E(%Y,$A(%Y)=10+1,%1-2),%Y=$E(%Y,%1,$L(%Y)) D V2CL2 I %Y]"" S %2=$E(%Y,$A(%Y)=10+1,$L(%Y)) D V2CL2 C 2:256 K IO(1,2) D CLOSE^ZISPL1 K %Y,%X,%1,ZOSFV Q V2CL2 S %1=$F(%2,$C(12)) I %1>0 S %=%+1 D LIMIT:%Z1<% Q:%Z1<% S ^XMBS(3.519,XS,2,%,0)="|TOP|",%2=$E(%2,1,%1-2)_$E(%2,%1,$L(%2)) S %=%+1,^XMBS(3.519,XS,2,%,0)=%2 Q ; LIMIT S ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q ; SET ;SET SPECIAL VARIABLES S X=$H X ^%ZOSF("ZD") S DT=$E(Y,7,8)+200_$E(Y,1,2)_$E(Y,4,5) Q GETENV ;Get enviroment (UCI^VOL^NODE) S Y=$P($ZU(0),",",1)_"^"_$P($ZU(0),",",2)_"^^"_$P($ZU(0),",",2) Q VERSION(X) ;return OS version, X=1 - return OS Q $S($G(X):$P($ZV,"Version "),1:$P($ZV,"Version ",2)) V3() ;returns 1=version 3, 0=version 4 Q $P($ZV,"Version ",2)<4 OSTYPE() ;Return 1 = PC/PLUS, 2 = NT, 3 = UNIX N % S %=$$VERSION(1) Q $S(%["MSM-PC/PLUS":1,%["Windows NT":2,1:3) ; SETNM(X) ;Set name, Fall into SETENV SETENV ;Set enviroment Q ; T0 ; start RT clock I $$OSTYPE()'=1 S XRT0=$H Q S XRT0=$P($H,",")_","_($V(#46C,-3,4)*5.4925\1/100) Q T1 ; store RT datum I $$OSTYPE()'=1 S ^%ZRTL(3,XRTL,+$H,$P($H,",",2))=XRT0 K XRT0 Q S ^%ZRTL(3,XRTL,+$H,XRTN,$V(#46C,-3,4)*5.4925\1/100)=XRT0 K XRT0 Q ; ZHDIF ;Display dif of two $$ZH^%MSMOPS's S U="^" W !?2,"CPU=",$J($P(%ZH1,U)-$P(%ZH0,U),6,2),?14,"ET=",$J($P(%ZH1,U,7)-$P(%ZH0,U,7),6,2),?25,"PRD=",$J($P(%ZH1,U,3)-$P(%ZH0,U,3),4),?35,"LRD=",$J($P(%ZH1,U,2)-$P(%ZH0,U,2),6),?47,"LWT=",$J($P(%ZH1,U,4)-$P(%ZH0,U,4),5) W ?58,"TI=",$J($P(%ZH1,U,5)-$P(%ZH0,U,5),4),?67,"TO=",$J($P(%ZH1,U,6)-$P(%ZH0,U,6),5) Q LOGRSRC(OPT,TYPE,STATUS) ;record resource usage in ^XTMP("KMPR" Q:($$OSTYPE'=1)!('$G(^%ZTSCH("LOGRSRC"))) ; quit if RUM not turned on. ; call to RUM routine. D RU^%ZOSVKR($G(OPT),$G(TYPE),$G(STATUS)) Q SETTRM(X) ;Set specified terminators. U $I:(::::::::X) Q 1 ZOSVMSQ %ZOSV ;SFISC/AC - $View commands for M/SQL (ISM VAX) systems. ;12/15/95 08:53 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**13**;Jul 03, 1995 ACTJ() ; N Y,% S Y=$V(204,-2,4),%="" F Y=0:1:Y-1 S %=$ZJ(%) Q:%="" Q Y AVJ() ; Q 128-$$ACTJ() PRIINQ() ; Q 8 UCI ; ;S Y=$V(4,-2,4)+348,Y=$V(Y+1,$J,-$V(Y,$J,1)) Q ;*** D ^%ST S Y=$V(%ST("DIR")+1,$J,-$V(%ST("DIR"),$J,1)) Q ; UCICHECK(X) ; N Y,% S X=$P(X,",",1),Y=0,%=^%ZOSF("MGR"),%=$D(^[%]SYS("UCI",0)) F %=0:0 S Y=$O(^(Y)) Q:Y=""!(Y=X) Q Y JOBPAR ; K ZJ S ZJ="" F Y=0:0 S ZJ=$ZJ(ZJ) Q:'$L(ZJ) S ZJ(ZJ)="" ;S Y="" Q:'$D(ZJ(X)) S Y=$V($V(4,-2,4)+349,X,-$V($V(4,-2,4)+348,X,1)) K ZJ Q S Y="" Q:'$D(ZJ(X)) S Y=$P($V(-1,X),"^",5) K ZJ Q ; T0 ; start RT clock S XRT0=$H Q T1 ; store RT datum S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0 Q NOLOG ; S Y="$V(0,-2,4)\4096#2" Q ; PRGMODE ; W ! S ZTPAC=$S('$D(^VA(200,+DUZ,.1)):"",1:$P(^(.1),U,5)),XUVOL=^%ZOSF("VOL") S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB D UCI S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI D ^%BJ X "ZR B" Q LGR() Q $ZR ;Last Global ref. ; EC() Q $ZE ;Error code ; DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X S Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR Q ; ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X S (Y,Y1)=$P(Y,"*",1) I $D(@Y)=0 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y[Y1) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR F %=0:0 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 K %,X,Y,Y1 Q ; PARSIZ ; S X=3 Q ; DEVOPN ;List of Devices opened ;Returns variable Y. Y=Devices owned separated by a comma S X=$J N % S Y=$P($V(-1,$J),"^",3) F %=1:1:$L(Y,",") S $P(Y,",",%)=$P($P(Y,",",%),"*",1) Q DEVOK ; I $G(X1)="RES" G RES I X=2 S Y=0 Q S $ZT="OPNERR" O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 Q ;G NOPN S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q S:X]"" IO(1,X)="" Q Q NOPN ; N ZJ S $ZT="NJ" S ZJ="" F %=0:0 S ZJ=$ZJ(ZJ) Q:'ZJ D NOPN1 Q:'ZJ Q NOPN1 S Y=$V(-1,ZJ) I $P(Y,"^",3)[X_","!($P(Y,"^",3)[X_"*,") S Y=ZJ,ZJ="" Q Q NJ Q ;NOJOB ERROR OPNERR S Y=-1 Q ; RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0)) I '%ZISD0 S Y=-1,%ZISD0=%O(^%ZIS(1,"C",X)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"") I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q 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 K %ZISD0,%ZISD1 Q GETENV ;Get environment (UCI^VOL^NODE) X ^%ZOSF("UCI") S Y=Y_"^"_^%ZOSF("VOL")_"^^"_^%ZOSF("VOL") Q VERSION(X) ;return OS version, X=1 - return OS Q $S($G(X):$P($ZV," V"),1:$P($P($ZV," V",2)," ")) ; SETNM(X) ;Set name, Fall into SETENV SETENV ;Set environment Q ; HFSREW(IO,IOPAR) ;Rewind Host File. S $ZT="HFSRWERR" C IO O @(""""_IO_""""_$S(IOPAR]"":":"_IOPAR_":1",1:":1")) I '$T Q 0 Q 1 HFSRWERR ;Error encountered Q 0 LOGRSRC(OPT) ;record resource usage in ^XUCP Q ZOSVONT %ZOSV ;SFISC/AC - $View commands for Open M for NT. ;12/04/2001 15:30 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**34,94,107,118,136,215**;Jul 10, 1995 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY TASSC/MFD 11/15/02 ACTJ() ;# Active jobs N Y,% S %=0 F Y=0:1 S %=$ZJ(%) Q:%="" Q Y AVJ() ;# available jobs ;Return fixed value if version < 2.1.6 (e.i. not Cache) N ZOSV,port,t,x,v,maxpid,lmflim,$ET S v=+$$VERSION() I 2.1>v Q 15 ;Not Cache ;maxpid: from %SS, need ISM to provide maxpid in ^%MACHINE S $ET="",maxpid=$v($zu(40,2,118),-2,4) X "S ZOSV=$ZU(5),%=$ZU(5,""%SYS"") S lmflim=$$inquire^LMFCLI,%=$ZU(5,ZOSV)" ;Get the license info ;Add together the enterprise and division licenses avaliable S x=$P(lmflim,";",2)+$P($P(lmflim,"|",2),";",2) S t=+lmflim+$P(lmflim,"|",2) ;Check the license total Q $S(t5 N %D,%P S %P=(X>5) D INT^%HL Q ; PRIINQ() ; Q $S($V(20,$J,2):10,1:1) PARSIZ ; S X=3 Q ; NOLOG ; S Y=$S($$V3:"$V($V(44)+4,-3,2)",1:"$V(4,-4,2)")_"\64#2" Q ; DEVOPN ; ;X=$J,Y=List of devices separated by a comma N %,%1,%I,%X S Y="" I $$V3 S %=$V($V(44)+10,-3,2),%1=$V($V(44)+8,-3,2)+$V(44),%=$V(%*5+%1) E S %=$V(5,-5,0) F %I=1:1:255 S %X=$V(%+%I+%I,-3,2) I %X,%X#4=0,%X/4=X S Y=Y_%I_"," Q DEVOK ; ;X=Device $I, Y=0 if available, Y=Job # if owned, ;Y=-1 if device is undefined. G RES:$G(X1)="RES" I $E(X)="/"!($E(X)="\") S Y=0 Q I X=2 S Y=0 Q I X'?1.N!(X'>0!(X'<1024)) S Y=-1 Q N % I $$VERSION(1)["NT" D DVOPN Q ; I $$V3 S %=$V($V(44)+8,-3,2)+$V(44),%=$V($V($V(44)+10,-3,2)*5+%),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4,1:-1) E S %=$V(5,-5,0),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4+$V(272,-4),1:-1) I 'Y D DVOPN Q S:Y=$J Y=0 Q DVOPN S $ZT="DVERR",Y=0 Q:$D(%ZTIO) L:$D(%ZISLOCK) +@%ZISLOCK:60 O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK Q L:$D(%ZISLOCK) -@%ZISLOCK S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q S:X]"" IO(1,X)="" Q DVERR I $ZE["OPENERR" S Y=-1 L:$D(%ZISLOCK) -@%ZISLOCK Q I $ZE["" S Y=-1 L:$D(%ZISLOCK) -@%ZISLOCK Q ZQ RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0)) I '%ZISD0 S Y=-1,%ZISD0=%O(^%ZIS(1,"C",X)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"") I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q 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 K %ZISD0,%ZISD1 Q V2CL1 F %=0:0 Q:$ZA<0 R %X:5 Q:%X']"" F %1=0:0 S %1=$L(%Y),%Y=%Y_$E(%X,1,255-%1),%X=$E(%X,256-%1,$L(%X)),%1=$F(%Y,%ZCR) Q:%1'>0 S %2=$E(%Y,$A(%Y)=10+1,%1-2),%Y=$E(%Y,%1,$L(%Y)) D V2CL2 I %Y]"" S %2=$E(%Y,$A(%Y)=10+1,$L(%Y)) D V2CL2 C 2:256 K IO(1,2) D CLOSE^ZISPL1 K %Y,%X,%1,ZOSFV Q V2CL2 S %1=$F(%2,$C(12)) I %1>0 S %=%+1 D LIMIT:%Z1<% Q:%Z1<% S ^XMBS(3.519,XS,2,%,0)="|TOP|",%2=$E(%2,1,%1-2)_$E(%2,%1,$L(%2)) S %=%+1,^XMBS(3.519,XS,2,%,0)=%2 Q ; LIMIT S ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q ; SET ;SET SPECIAL VARIABLES S X=$H X ^%ZOSF("ZD") S DT=$E(Y,7,8)+200_$E(Y,1,2)_$E(Y,4,5) Q GETENV ;Get enviroment (UCI^VOL^NODE) S Y=$P($ZU(0),",",1)_"^"_$P($ZU(0),",",2)_"^^"_$P($ZU(0),",",2) Q VERSION(X) ;return OS version, X=1 - return OS Q $S($G(X):$P($ZV,"Version "),1:$P($ZV,"Version ",2)) V3() ;returns 1=version 3, 0=version 4 Q $P($ZV,"Version ",2)<4 OSTYPE() ;Return 1 = PC/PLUS, 2 = NT, 3 = UNIX N % S %=$$VERSION(1) Q $S(%["MSM-PC/PLUS":1,%["Windows NT":2,1:3) ; SETNM(X) ;Set name, Fall into SETENV SETENV ;Set enviroment Q ZHDIF ;Display dif of two $$ZH^%MSMOPS's S U="^" W !?2,"CPU=",$J($P(%ZH1,U)-$P(%ZH0,U),6,2),?14,"ET=",$J($P(%ZH1,U,7)-$P(%ZH0,U,7),6,2),?25,"PRD=",$J($P(%ZH1,U,3)-$P(%ZH0,U,3),4),?35,"LRD=",$J($P(%ZH1,U,2)-$P(%ZH0,U,2),6),?47,"LWT=",$J($P(%ZH1,U,4)-$P(%ZH0,U,4),5) W ?58,"TI=",$J($P(%ZH1,U,5)-$P(%ZH0,U,5),4),?67,"TO=",$J($P(%ZH1,U,6)-$P(%ZH0,U,6),5) Q LOGRSRC(OPT) ;record resource usage in ^XUCP Q:$$OSTYPE'=1 N C,H,I,J,U S C=",",U="^",%=$$ZH^%MSMOPS,H=$P($H,C)_C_($V(#46C,-3,4)*5.4925\1/100) I $P(H,",",2)\1#100=0 S J=$$HTFM^XLFDT($H,1),I=$$FMADD^XLFDT(J,365)_U_J,^XTMP("XUCP",0)=I S ^XTMP("XUCP",$ZU(0),$P(H,C),$J,$P(H,C,2))=$P(%,U)_U_$P(%,U,3)_U_$P(%,U,2)_U_$P(%,U,4,6)_U_OPT_U_($P(%,U,7)*100\1/100) Q SETTRM(X) ;Set specified terminators. U $I:(::::::::X) Q 1 ZOSVVXD %ZOSV ;SFISC/AC - View commands & special functions. ;12/04/2001 15:30 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**13,65,71,94,107,118,136,215**;Jul 05, 1995 ACTJ() ; # active jobs Q $P($$JOBS^%SY,",",2) ; AVJ() ; # available jobs N Y S Y=$$JOBS^%SY Q +Y-$P(Y,",",2) ; PASSALL ; S Y=$ZC(%SPAWN,"SET TERM/PASTHRU "_$I) U $I:NOTERM Q NOPASS ; S Y=$ZC(%SPAWN,"SET TERM/NOPASTHRU "_$I) U $I:TERM="" Q ; PRGMODE ; W ! S ZTPAC=$S($D(^VA(200,+DUZ,.1))#10:$P(^(.1),"^",5),1:""),XUVOL=^%ZOSF("VOL") S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q K XMB,XMTEXT,XMY S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB I '$$PROGMODE() D UCI S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI ZESCAPE E S $ECODE=",<>," ; PROGMODE() ; Q ($V($V($V(0)))#2=0) ; UCI ; S Y=$ZC(%UCI),Y=$P(Y,",",1)_","_$P(Y,",",4) Q ; UCICHECK(X) ; N %,%1,U,V,Y I '(X?3U!(X?3U1","3U)) Q "" S U=$ZC(%UCI),V=$P(U,",",4),U=$P(U,","),%1=$P(X,",",2),%=$P(X,",") S Y=$ZC(%SETUCI,%,%1),Y=$S(Y:%_","_$S(%1]"":%1,1:V),1:""),V=$ZC(%SETUCI,U,V) Q Y ; GETPEER() ;Get the PEER address N PEER,NL,$ET S NL="",$ET="S $EC=NL Q NL" S PEER=$&%UCXGETPEER Q $A(PEER,1)_"."_$A(PEER,2)_"."_$A(PEER,3)_"."_$A(PEER,4) ; SHARELIC(TYPE) ;See if can share a C/S license DSM Q ;Cache only at this time. Q:$$VERSION<7.2 N %,$ET S $ET="S $EC="""" Q" I TYPE S %=$$GetCSLic^%LICENSE Q I 'TYPE S %=$$ShareLic^%LICENSE S $EC="" Q PRIORITY ; Q ;Q:X>10!(X<1) S X=(X+1)\2-1,Y=$ZC(%SETPRI,X) Q ;Let VSM do it's thing. ; PRIINQ() ; Q $ZC(%GETJPI,0,"PRIB")*2+2 ; BAUD S X="UNKNOWN" Q ; LGR() Q $ZR ;Last global ref. ; EC() Q $ZE ;Error code ; DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X S Y="%" F S Y=$ZSORT(@Y) Q:Y="" D ;code from DEC . I $D(@Y)#2 S @(X_"Y)="_Y) . I $D(@Y)>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR K %X,%Y,Y Q ; ORDER ;SAVE PARTS OF SYMBOL TABLE IN LOCATION SPECIFIED BY X ;PARTS INDICATED BY X1("NAMESPACE*")="" ARRAY I $D(X1("*"))#2 D DOLRO Q S X1="" F S X1=$O(X1(X1)) Q:X1="" D . S (Y,Y1)=$P(X1,"*") I $D(@Y)=0 F S Y=$ZSORT(@Y) Q:Y=""!(Y[Y1) . Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR . F S Y=$ZSORT(@Y) Q:Y=""!(Y'[Y1) S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR . Q K %,%X,%Y,Y,Y1 Q ; PARSIZ ; S X=3 Q ; NOLOG ; S Y=0 Q ; GETENV ;Get environment Return Y='UCI^VOL/DIR^NODE^BOX LOOKUP' S Y=$P($ZU(0),",",1)_"^"_$P($ZU(0),",",2)_"^"_$P($ZC(%GETSYI),",",4) S $P(Y,"^",4)=$P(Y,"^",2)_":"_$P(Y,"^",3) Q VERSION(X) ;return DSM version, X=1 - return OS N % S %=$ZV I %[" V" Q $S($G(X):$P($ZV," V"),1:$P($ZV," V",2)) Q $S($G(X):$P($ZV," ",1,2),1:$P($ZV," ",3)) ; SETNM(X) ;Set name, Trap dup's, Fall into SETENV N $ETRAP S $ETRAP="S $ECODE="""" Q" SETENV ;Set environment X='PROCESS NAME^ ' S %=$ZC(%SETPRN,$P(X,"^")) Q ; T0 ; start RT clock S %ZH0=$ZH,%=$P(%ZH0,",",3) S:$E($ZV,10,12)>5.1 %=$E(%,13,23) S XRT0=+$H_","_($P(%,":")*3600+($P(%,":",2)*60)+$P(%,":",3)) Q ; T1 ; store RT datum w/ZHDIF S %ZH1=$ZH,%=$P(%ZH1,",",3) S:$E($ZV,10,12)>5.1 %=$E(%,13,23) S XRT1=+$H_","_($P(%,":")*3600+($P(%,":",2)*60)+$P(%,":",3)) S ^%ZRTL(3,XRTL,+XRT1,XRTN,$P(XRT1,",",2))=XRT0_"^^"_($P(%ZH1,",")-$P(%ZH0,","))_"^"_($P(%ZH1,",",7)-$P(%ZH0,",",7))_"^"_($P(%ZH1,",",8)-$P(%ZH0,",",8)) K XRT0,%ZH0,%ZH1 Q ; ZHDIF ;Display dif of two $ZH's W !," CPU=",$J($P(%ZH1,",")-$P(%ZH0,","),6,2),?14," ET=",$J($P(%ZH1,",",2)-$P(%ZH0,",",2),6,1),?27," DIO=",$J($P(%ZH1,",",7)-$P(%ZH0,",",7),5),?40," BIO=",$J($P(%ZH1,",",8)-$P(%ZH0,",",8),5),! Q ; ;Code moved to %ZOSVKR, Comment out if needed. LOGRSRC(OPT,TYPE,STATUS) ;record resource usage in ^XTMP("KMPR" Q:'$G(^%ZTSCH("LOGRSRC")) ; quit if RUM not turned on. ; call to RUM routine. D RU^%ZOSVKR($G(OPT),$G(TYPE),$G(STATUS)) Q ; SETTRM(X) ;Turn on specified terminators. U $I:TERM=X Q 1 ; DEVOK ;Check Device Availability. (not complete) ;INPUT: X=Device $I, X1=IOT -- X1 needed for resources ;OUTPUT: Y=0 if available, Y=job # if owned, Y=-1 if device does not exists. S Y=0 Q:X["::" I $G(X1)="RES" G RESOK^%ZIS6 S Y=$ZC(%GETDVI,X,"EXISTS") G DV1:Y D DV2 Q:Y=-1 I Y="TERM" S Y=-1 Q S Y=-2 Q DV1 S Y=$ZC(%GETDVI,X,"PID") I Y=$J!($ZC(%GETDVI,X,"SPL")) S Y=0 Q I Y,$ZC(%GETJPI,X,"MASTER_PID")=Y G DVOPN Q:Y>0 D DV2 G DVOPN:Y="TERM" S Y=$S(Y="DISK":0,Y="MAILBOX":0,Y="TAPE":0,1:-1) Q DV2 S Y=$ZC(%PARSE,X) I Y="" S Y=-1 Q I X]"" S Y=$ZC(%GETDVI,$S(Y]"":Y,1:X),"DEVCLASS") Q Q DVOPN S $ZT="DVERR",Y=0 Q:$D(%ZTIO) L:$D(%ZISLOCK) +@%ZISLOCK:60 O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK:60 Q L:$D(%ZISLOCK) -@%ZISLOCK S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q S:X]"" IO(1,X)="" Q DVERR I $ZE["OPENERR" S Y=-1 Q ZQ ; DEVOPN ;List devices opened. N %,%B,%I,%L,%X,%X1,%X2,%Y S %X1=$V($V(0)+8),%X2=$V(%X1),Y="" F %I=1:1 D D1 S %X2=$V(%X2) Q:%X2=%X1 Q D1 S %X=$V(%X2+8) S %L=$V(%X+4,-1,1),%B=$V(%X+8) S %Y="" F %=1:1:%L S %Y=%Y_$C($V(%B,-1,1)) S %B=%B+1 S Y=Y_%Y_"," Q ; ZTEDIT ZTEDIT ;SF/RWF - VA EDITOR, Generic routine editor ;9/29/92 11:41 ; [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;7.3;TOOLKIT;**16,120**;Apr 25, 1995 ;K ^%Z A S %A=$T(%),^%Z=$P(%A," ",2,256) F %I=1:1 S %A=$T(%+%I),%T=$P(%A," ",1),%B=$P(%A," ",2,256) Q:%T="END" I $L(%T) S ^%Z(%T)=%B D ^ZTEDIT1 S ^%Z("VR")=$P($T(+2),";",3) Q ; This and the other ZTEDIT* routines set up the ^%Z global by ; copying lines into them from within these routines themselves. A ; line here with tag "x" is copied into ^%Z(x), for instance. Untagged ; lines aren't copied, and therefore are comments. ; % N %RN S %NX="LOCK" X ^%Z(0) F %IED=0:0 X ^%Z(%NX) Q:'$D(%NX) 0 S %9=84000,%SL=0,%RM=80,XY="",%S=0,%ST="" X ^%Z("TERM1"),^%Z("TERM3") W !,"%Z Editing: ",$T(+0)," Terminal type: ",%ST I $D(%TG) S %T=%TG X ^%Z("TAG") K:%L="" %TG ;EDIT;Same line; Execute; +N; Absolute N; Global; *Local; -N; Zexecute; .Function; Question; tag-N; Edit line 1 S %NX=2 R !,"Edit: ",%X:%9 2 S %NX=$S(%X="":31,%X?1A1" ".E:"EXEC",%X?1"+".N:10,%X?1"""""+".N:35,%X?1"^".E:"GLO",%X="*":"GT3",%X?1"*".E:"LOCAL",%X?1"-".N:26,%X?1"Z"1A1" ".E:"EXEC",%X?1".".E:"FUNC",%X?1"?".E:"?",%X["-":25,1:"EDIT") ;+ 10 S %NX=32 S:%X="+" %X="+1" I $D(%TG),%TG'?1"+".E S %A=$P(%TG,"+",2)+$E(%X,2,9),%TG=$P(%TG,"+",1),%NX=31 S:%A %TG=%TG_"+"_%A ;- 25 S %NX=27,%B=$P(%X,"-",1),%A=0-$P(%X,"-",2) 26 S %NX=32 S:%X="-" %X="-1" I $D(%TG),%TG'?1"+".E S %A=$P(%TG,"+",2)-$E(%X,2,9),%B=$P(%TG,"+",1),%NX=27 I %A'<0 S %TG=%B,%NX=31 I %A S %TG=%TG_"+"_%A 27 S %NX="what" F %I=1:1 S %C=$T(+%I) Q:%C="" I $P($P(%C," "),"(")=%B S %A=%I+%A S:%A>0 %NX=28 Q 28 S %NX=29,%B=0 F %I=1:1:%A S %C=$P($P($T(+%I)," "),"("),%B=%B+1 I %C]"" S %TG=%C,%B=0 29 S %NX=31 I %B S %TG=%TG_"+"_%B ;SAME LINE 31 S:'$D(%TG) %TG="+1" W " ",%TG S %X=%TG,%NX="EDIT" 32 S:'$D(%TG)&(%X<0) %NX="what" S:'$D(%TG) %TG="" S %TG=%TG+%X S:%TG<0 %NX="what" S:%TG'<0 %TG="+"_%TG,%NX=31 35 S %X=$E(%X,3,99),%NX=$S(%X>0:"EDIT",1:"what") I %X="+0" W !,$T(+0) S %NX=1 LOCK S %NX=1,%RN=$T(+0) Q:'$L(%RN) L +@%RN:1 E S %NX="EXIT" W !,"This routine is being edited by another user." LOCKX I %RN]"" L -@%RN STORE ZR @%TG ZI:%L]"" %L S %A=$P($P(%L," "),"("),%NX=1 S:%A]"" %TG=%A BREAK S %NX="what" W "reak line: " X ^%Z("GTAG") Q:%L="" S %NX="BR2" W:%X'=%T " ",%T S %TG=%T BR2 S %NX=1 R " after characters: ",%R:%9 I %R'="",%L[%R S %LS=$P(%L,%R,2,999),%LS=$E(" ",%LS'?1" ".E)_%LS,%L=$P(%L,%R,1)_%R ZR @%TG ZI %L,%LS W !,%L,!,%LS EXEC W ! S %A=%X_" W *0" X %A,^%Z(0):'$D(%RM) S %NX=1,%IED=0 ;Functions;Insert,Change,Search,Remove,File,Move,Break,Join,X-mode,Action,Terminal FUNC S %A=$E(%X,2),%A=$S(%A?1L:$C($A(%A)-32),1:%A),%NX=$S(%A="":"EXIT",%A="I":"INSERT",%A="C":"CHANGE",%A="S":"SEARCH",%A="R":"REMOVE",%A="F":"FILE",%A="M":"MV",%A="B":"BREAK",1:"FUNC2") FUNC2 S %NX=$S(%A="J":"JOIN",%A="X":"MODE",%A="T":"TERM",%A="A":"ACTION",1:"what") EXIT X ^%Z("LOCKX") S X=%RM+1 X ^%ZOSF("RM") K %,%A,%B,%C,%CTG,%D,%DT,%E,%F,%FI,%GLO,%I,%IED,%J,%K,%L,%LCL,%LO,%LS,%M,%N,%NX,%POP,%R,%RM,%RN,%S,%SL,%ST,%SX,%SY,%T,%W,%X,%XY,%Y,%Z,DX,DY INSERT S %NX=1 W "nsert after: " X ^%Z("GTAG") Q:%L="" ZR @%T ZI %L S %NX="IN2",%TG=%T IN2 S %NX=1 R !,"Line: ",%L:%9 Q:%L="" X ^%Z("LN1") S %NX="IN2" W:%POP *7,!,?5,"[tag syntax]" I '%POP ZI %L S %A=$P(%L," "),%B=$S(%A]"":$P(%A,"("),1:$P(%TG,"+")_"+"_($P(%TG,"+",2)+1)),%TG=%B CHANGE S %NX=1 R "hange every: ",%R:%9 Q:%R="" R " to: ",%W:%9,! X ^%Z("SELALL") S %D=$L(%W)-$L(%R),%NX=$S(%POP:"what",1:"CH2") CH2 S %NX=1 F %A=%A:1:%I S %L=$T(+%A),%F=$F(%L,%R),%X=%F X:%X>0 ^%Z("CH3") S:$P(%L," ")]"" %T=$P(%L," "),%C=0,%B=$P(%T,"(") S %T=$S(%C:%B_"+"_%C,1:%T),%C=%C+1 W:%X>0 !,%T,?6," ",$P(%L," ",2,99) CH3 X ^%Z("CH4") ZR +%A ZI %L CH4 F %IED=0:0 S %L=$E(%L,0,%F-$L(%R)-1)_%W_$E(%L,%F,999),%F=$F(%L,%R,%F+%D) Q:%F<1 END ; ;%T= current tag ;%TG= save last/current tag ;%L= current line ;%LO= save current line for restore ZTEDIT1 ZTEDIT1 ;SF/RWF - VA EDITOR edit single lines ;10/5/89 09:53 ; [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;7.3;TOOLKIT;**16,120**;Apr 25, 1995 F %J=1:1 S %A=$T(%+%J),%T=$P(%A," ",1),%B=$P(%A," ",2,256) Q:%T="END" I $L(%T) S ^%Z(%T)=%B G ^ZTEDIT2 Q % ; GLO S %NX="what" W:%X="^"&$D(%GLO) $E(%GLO,2,99) S:%X="^"&$D(%GLO) %X=%GLO I (%X?1.2P1.8AN)!(%X?1.2P1.8AN1"(".E1")"),$D(@%X)#2 S %GLO=%X,%T=%X,%L=@%X X ^%Z("EDITLINE") S @%GLO=%L,%NX=1 REMOVE W "emove lines: " X ^%Z("SELECT") S %NX="what" Q:%POP R !,"OK to remove lines? ",%R:%9 S %NX=$S(%R?1"Y".E:"R10",%R?1"y".E:"R10",1:"R5") R5 S %NX=1 W " [no change]",! R10 S %NX=1 ZR +%A:+%I W " ...deleted lines",! what W " what?" S %NX=1 what2 W " ??? Just the first letter please. " S %NX="ACTION" EDXY S %N="E1",X=0 X ^%ZOSF("RM"),^%ZOSF("EOFF") F %IED=0:0 X ^%Z(%N) Q:'$D(%N) EXY X ^%Z("EW2"),^%Z("ELONG"):$L(%L)>245 S %N="E1" Q:$L(%L)>255 X ^%ZOSF("EON") S DX=0,DY=%EY,X=%RM+1 X ^%ZOSF("RM"),XY K %EX,%EY,%E1,%E2,DX,DY,%N Q E1 S DX=0,DY=%SL,%A=1,%N="E2" W !!!! X ^%Z("EWL"),^%Z("EW1") E2 S DX=%A-1#%RM,DY=%A-1\%RM+%SL,%EX=$L(%L)#%RM,%EY=$L(%L)\%RM+%SL,%N="E3" E3 S %N="E4" X:DX'<%RM ^%Z("ER") X XY ;E,EE;,EB;,EOL;,E4;,ES;'.',EP;,ERUB;D,EDEL;^R,EUD;>,;<,; E4 R *%X:%9 S %X=$S($C(%X)?1L:%X-32,1:%X),%N=$S(%X=69:"EE",%X=8:"EB",%X=13!(%X=27):"EOL",%A>$L(%L):"E4",%X=32:"ES",%X=46:"EP",%X=127:"ERUB",%X=68:"EDEL",%X=18:"EUD",%X=62:"EL",1:"E4") EL S %N="E3",%A=$S(%A+%RM'>$L(%L):%A+%RM,1:$L(%L)+1),DX=%A-1#%RM,DY=%A\%RM+%SL EP S %A=%A+1,DX=DX+1,%N="E3" ES S %N="E3" F %IED=%A:1:$L(%L) S %A=%A+1,DX=DX+1 Q:$E(%L,%A)=" "!($E(%L,%A)=",") EB S %N="E3" Q:%A=1 S DX=DX-1,%A=%A-1 I DX=-1 S DX=%RM-1,DY=DY-1 ERUB S %IED=%A+1,%N="EDEL2" EDEL2 S %N="E4",%E1=$L(%L),%L=$E(%L,1,%A-1)_$E(%L,%IED,999),%E2=$L(%L),%L=%L_$J("",%E1-%E2) X ^%Z("EWL") S %L=$E(%L,1,%E2) X XY EDEL S %N="EDEL2" F %IED=%A+1:1 S %E=$E(%L,%IED) Q:%E=" "!(%E="")!(%E=",") EE S %C=%A,%B=$E(%L,%A,999),%Y="",%D=0,%N="EEN" EEN X XY R *%X:%9 S %N=$S(%X=127&%D:"EER",%X=13!(%X=27):"EEE",$C(%X)?1C:"EEN",1:"EE1") EE1 W $C(%X) S DX=DX+1,%D=%D+1,%Y=%Y_$C(%X) X:DX'<%RM ^%Z("ERE") X ^%Z("EWL") X XY S %N="EEN" EE4 S:$Y=%EY&(%EX<$X) %EX=$X S %D=%D+1,%Y=%Y_$C(%X),%N="EEN" X XY EEE S %L=$E(%L,1,%A-1)_%Y_$E(%L,%C,999),%N="E2",%A=%A+$L(%Y) X ^%Z("EW2") I $X>%EX,DY=%EY S %EX=$S(%RM>$X:$X,1:%RM) EER S %D=%D-1,%Y=$E(%Y,1,%D),%N=$S(DX:"EER1",1:"EER2") EER1 S DX=DX-1,%N="EEN" X ^%Z("EWL") W " " EER2 S DX=%RM-1,DY=DY-1,%N="EEN" X ^%Z("EWL") W !," " X XY ER S DX=DX#%RM,DY=DY+1 X XY ELONG W !,*7," Line too long for programming standard (",$L(%L),") ",!!! S %N="E1" EOL S %N=$S(%A=1:"EXY",1:"E2"),%A=1 EUD S %L=%LO,%N="E1" ERE S DX=0,DY=DY+1 X XY EWL X XY S %EX=%A,%EY=%RM-DX-1+%A,%=DY-%SL+1 F %=%:1:4 W $E(%L,%EX,%EY) S %EX=%EY+1,%EY=%EY+%RM Q:%EX>$L(%L) W:%<4 ! EW1 S %SX=DX,%SY=DY,DX=0,DY=%SL-1 X XY W "Length: ",$J($L(%L),3) W:$D(%T) " Line: ",%T," " S DX=%SX,DY=%SY X XY EW2 S %SX=DX,%SY=DY,DX=8,DY=%SL-1 X XY W $J($L(%L),3) S DX=%SX,DY=%SY X XY EDITLINE W:XY="" !,%L,! X $S(XY]"":^%Z("EDXY"),1:^%Z("ED")) W:XY="" !,%L EDIT S %T=%X,%NX="what" X ^%Z("TAG") Q:%L="" S %NX=1 W:%X'=%T " ",%T S %TG=%T,%LO=%L X ^%Z("EDITLINE") S %NX="STORE" ED F %IED=0:0 R " r ",%R:%9 Q:%R="" X ^%Z($S(%R="END":"ED16",%L[%R:"ED14",%R["...":"ED20",%R=$C(18):"ED15",1:"ED17")) ED14 R " w ",%W:%9 S %L=$P(%L,%R,1)_%W_$P(%L,%R,2,999) ED15 S %L=%LO W !,"Line restored",!,%L,! ED16 R " w ",%W:%9 S %L=%L_%W ED17 W " ???" ED20 S %A=$P(%R,"...",1),%B=$P(%R,"...",2,999),%J=$F(%L,%A),%C=%J-1-$L(%A),%D=$S(%B="":999,1:$F(%L,%B,%J)) W:%C<0!(%D<1) " ???" Q:%C<0!(%D<1) R " w ",%W:%9 S %L=$E(%L,1,%C)_%W_$E(%L,%D,999) END ; ZTEDIT2 ZTEDIT2 ;SF/RWF - VA EDITOR ;1/19/96 09:45 [ 04/02/2003 8:29 AM ] ;;7.3;TOOLKIT;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;7.3;TOOLKIT;;Apr 25, 1995 F %I=1:1 S %A=$T(%+%I),%T=$P(%A," ",1),%B=$P(%A," ",2,256) Q:%T="END" I $L(%T) S ^%Z(%T)=%B G ^ZTEDIT3 Q % ; ACTION R !,"Action: ",%X:%9 S %X=$S(%X?1".".E:$E(%X,2),1:$E(%X)),%NX=$S(%X="":1,"BCRSV"[%X:"A"_$A(%X),"bcrsv"[%X:"A"_($A(%X)-32),%X="?":"?A",1:"what2") A66 S %NX="A661",%Y=0 F %=1:1 S %X=$T(+%) Q:%X="" S %Y=%Y+2+$L(%X) I $L(%X)>245 W !,"Line '+",%,"' is longer than 245" A661 S %NX="A99" W ?20,"Routine is ",%Y," Bytes in size." A67 X ^%Z("A671") W !,?20,"Checksum is ",%Y S %NX="A99" A671 S %Y=0 F %=1,3:1 S %1=$T(+%),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S %Y=$A(%1,%2)*%2+%Y A83 X ^%Z("MV1"),^%Z("A99") A82 X ^%Z("MV100"),^%Z("A99") A86 W !,"%Z editor version ",^%Z("VR") X ^%Z("A99") A99 S %NX="ACTION" JOIN S %NX=1 W "oin line: " X ^%Z("GTAG") Q:%T="" S %LS=%L,%TG=%T,%T=%D_"+"_(%E+1) X ^%Z("TAG") S %NX=$S(%L="":"what",1:"JO2") JO2 W:%X'=%TG " ",%TG S %NX=1,%X=$L(%LS)+$L(%L)>245 W:%X " ... too long" I '%X ZR @%T,@%TG ZI %LS_%L W !,%LS_%L SEARCH S %NX=1 R "earch for: ",%R:%9 Q:%R="" X ^%Z("SELALL") S %NX=$S(%POP:"what",1:"S55") S55 S %NX=1,%T=$S(%C:%B_"+"_%C,1:%B) F %A=%A:1:%I S %L=$T(+%A) S:$P(%L," ")]"" %T=$P($P(%L," "),"("),%C=0,%B=$P(%T,"(") W:%L[%R !,%T,?6," ",$P(%L," ",2,999),! S %C=%C+1,%T=%B_"+"_%C GTAG W:$D(%TG) %TG,"//" R %X:%9 X ^%Z("GT2"):%X="*" S %L="",%T=$S(%X?1.P:"",%X]"":%X,$D(%TG):%TG,1:"") S:%T="" %NX=1 Q:%T="" X ^%Z("TAG") S:%T]"" %TG=%T GT2 S %D="",%E=0 F %I=1:1 S %L=$T(+%I),%E=%E+1 Q:%L="" S:$P(%L," ")]"" %D=$P($P(%L," "),"("),%E=0 S %X=$S(%E:%D_"+"_%E,1:%D) GT3 X ^%Z("GT2") S %NX="EDIT" TAG S:%T?1"""""+".N %T=$E(%T,3,9) S %L="",%D=$P(%T,"+",1),%E=$P(%T,"+",2) Q:%D'?1.8AN&(%D'?1"%".AN)&(%D]"")!(%E'?.N) S:%D="" %D=$P($P($T(+1)," "),"("),%E=%E-1 X ^("TAG2") TAG2 S %T=%D,%I=%E,%E=-1 F %I=0:1:%I S %E=%E+1,%T=$S(%E>0:%D_"+"_%E,1:%D),@("%L=$T("_%T_")") I $P(%L," ",1)]"" S %D=$P($P(%L," "),"("),%E=0,%T=%D SELECT S %POP=1 W " from line: " X ^%Z("GTAG") Q:%L="" S %ST=%T,%B=%D,%C=%E X ^%Z("SEL3") S %A=%I W " to line: " X ^%Z("GTAG") Q:%L="" X ^%Z("SEL3") S %POP=%A>%I SELALL S %POP=1 R " from line: BEG=> ",%T:%9 S:%T="" %T="+1" X ^%Z("TAG") Q:%L="" S %B=%D,%C=%E X ^%Z("SEL3") S %A=%I R " to line: END=> ",%T:%9 S (%D,%E)="" X ^%Z("TAG"):%T]"" S %POP=%L=""&(%T]"") Q:%POP X ^%Z("SEL3") S %POP=%A>%I SEL3 F %I=1:1 S %L=$T(+%I) Q:%L="" I $P($P(%L," "),"(")=%D,%D]"" S %I=%I+%E Q LN1 S:$P(%L," ")[$C(9) %L=$P(%L,$C(9))_" "_$P(%L,$C(9),2,99) S %T=$P($P(%L," "),"("),%POP=$P(%L," ",2)']"" I '%POP,%T'?.N,%T'?1A.7AN,%T'?1"%".7AN S %POP=1 LOCAL S %NX="what" S:%X'="*" %LCL=$E(%X,2,99) Q:'$D(%LCL) Q:'$D(@%LCL)#2 S %T="*"_%LCL,%L=@%LCL X ^%Z("EDITLINE") S @%LCL=%L,%NX=1 TERM S %NX=1 X ^%Z("TERM1"),^%Z("TERM2"),^%Z("TERM3") TERM1 S %S=$O(^%ZIS(2,"B","C-VT100",0)),%S=$S('($D(DUZ)#2):%S,$D(^XMB(3.7,DUZ,.2)):^(.2),1:%S) I %S'>0 W !,"Terminal Type not found." TERM2 W !,"TERMINAL TYPE: ",$S(%S'>0:"",$D(^%ZIS(2,%S,0)):$P(^(0),"^",1)_"//",1:"") R %X:999 Q:%X="" S %S=$S($D(^%ZIS(2,"B",%X)):$O(^(%X,0)),1:0) TERM3 Q:%S<1 S %ST=$P(^%ZIS(2,%S,0),"^",1),%=^(1),%RM=%-1,%SL=$P(%,"^",3)-4,XY=$P(%,"^",5),DX=0,DY=%SL,X=%RM+1 X ^%ZOSF("RM") X XY W !!! MODE W " mode change" S:XY]"" %XY=XY S %NX=1,XY=$S(XY]"":"",1:$S($D(%XY):%XY,1:"")) W !,$S(XY="":"replace-with",1:"line editor"),! END ; ZTEDIT3 ZTEDIT3 ;SF/RWF - VA EDITOR Transfer lines from one place to another ;8/7/98 08:29 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;7.3;TOOLKIT;**16,120**;Apr 25, 1995 F %I=1:1 S %A=$T(%+%I),%T=$P(%A," ",1),%B=$P(%A," ",2,256) Q:%T="END" I $L(%T) S ^%Z(%T)=%B G ^ZTEDIT4 CHECK ;see if routines and global are the same S S=" ",H="Tag: ",H2=" not the same",A="F %I=1:1 S %A=$T(%+%I),%T=$P(%A,S,1),%B=$P(%A,S,2,256) Q:%T=""END"" I $L(%T),%B'=$S($D(^%Z(%T)):^(%T),1:0) W !,H,%T,H2" F R="ZTEDIT","ZTEDIT1","ZTEDIT2","ZTEDIT3" W !,"Checking ",R X "ZL @R X A" D CHECK^ZTEDIT4 W !,"DONE" Q % ; MV W "ove lines" K %ST,%EN S %NX=1 X ^%Z("MV1") Q:'($D(%ST)&$D(%EN)) ZR @(%ST_":"_%EN) X ^%Z("MV102") W !,$T(@%D+%E),!,$T(@%D+%E+1) MV1 S %POP=0 W !,"Begin: " X ^%Z("GTAG") Q:%T="" K ^TMP("%Z",$J) S %ST=%T X ^%Z("MV2") MV2 W " End:" X ^%Z("GTAG") Q:%T="" S %X=%T X ^%Z($S(%X="*":"MV3",1:"MV20")),^%Z("MV99") MV3 S %J=1,%B=$P(%ST,"+",1),%I=+$P(%ST,"+",2) F %I=%I:1 S %T=%B_"+"_%I,@("%L=$T("_%T_")") Q:%L="" S %EN=%T,^TMP("%Z",$J,%J)=%L,%J=%J+1 MV20 S %T=%X X ^%Z("TAG") Q:%L="" S %EN=%T X ^%Z("MV21") MV21 S %J=1,%B=$P(%ST,"+",1),%I=+$P(%ST,"+",2) F %I=%I:1 S %T=$S(%I:%B_"+"_%I,1:%B),@("%L=$T("_%T_")") X ^%Z("MV22") S:$P(%L," ",1)]"" %B=$P($P(%L," "),"("),%I=0,%T=%B Q:%T=%EN MV22 S ^TMP("%Z",$J,%J)=%L,%J=%J+1 MV99 K %A,%B,%I,%J,%T,%L,%X MV100 S %L="" W !,"Insert after: " X ^%Z("GTAG") Q:%T="" S %TG=%T X ^%Z("MV101"),^%Z("MV99") MV101 I $D(^TMP("%Z",$J,1)) S %A=^(1) ZR @%T ZI %L F %J=1:1 Q:'$D(^TMP("%Z",$J,%J)) S %A=^(%J) ZI %A MV102 X ^%Z("MV100") I $D(%L) W !,"The lines removed have NOT been inserted back into the routine",!,"use the .Action menu to Restore lines." FILE S %NX="F30",%POP=("Ff"[$E(%X_" ",3)),%X=$T(+0) W "ile ",%X I %X]"" X ^%Z("F2"),^%Z("F3") S %NX="F10",%L=$T(+1),$P(%L," ;",3,9)=%D_" "_%C ZR +1 ZI %L ZS F2 S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,%D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1,%DT=%Y_"00"+%M_"00"+%D,%D=%M_"/"_%D_"/"_$E(%Y,2,3) F3 S %A=$P($H,",",2),%=(%A#3600\60)/100+(%A\3600)/100,%DT=%DT+%,%A=$E(%_"0000",2,5) S %C=$E(%A,1,2)_":"_$E(%A,3,4) F10 S %NX=1 X ^%Z("F11") I %A>0 X ^%ZOSF("UCI") S ^DIC(9.8,%A,23,%C,0)=%DT_"^"_$I_"^"_Y_"^"_$S($D(DUZ)#2:DUZ,1:"") X ^%Z("F14") F11 S %A="" Q:'$D(^DIC(9.8,0)) L +^DIC(9.8,0) S %A=$O(^DIC(9.8,"B",%X,0)) X ^%Z("F12"):%A'>0,^%Z("F13") L -^DIC(9.8,0) F12 S %A=$P(^DIC(9.8,0),"^",3)+1,%C=$P(^(0),"^",4)+1 X "F %=0:0 Q:'$D(^DIC(9.8,%A,0)) S %A=%A+1" S $P(^DIC(9.8,0),"^",3,4)=%A_"^"_%C,^DIC(9.8,%A,0)=%X_"^R",^DIC(9.8,"B",%X,%A)="" F13 S:'$D(^DIC(9.8,%A,23,0)) ^(0)="^9.823^^" S %C=1+$P(^DIC(9.8,%A,23,0),"^",3),$P(^(0),"^",3,4)=%C_"^"_(1+$P(^(0),"^",4)) F14 S:$D(DUZ)[0 DUZ=0,DUZ=0,DUZ(0)="" X:'%POP ^%Z("F15") S X="XTVRC1Z" X ^%ZOSF("TEST") D:$T ^XTVRC1Z F15 S DWPK=1,DIC="^DIC(9.8,"_%A_",23,"_%C_",1," W !,"Edit comment:" N %X,%NX,%TG D EN^DIWE W !,"Return" F30 W *7," No name, Can't FILE." S %NX=1 END ; ZTEDIT4 ZTEDIT4 ;SF/RWF - VA EDITOR ? help message ;7/9/90 07:47 ; [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;7.3;TOOLKIT;**16,120**;Apr 25, 1995 K ^%Z("?") S %X=$T(QUES),^%Z("?")=$P(%X," ",2,99),%X=$T(QUESA),^%Z("?A")=$P(%X," ",2,99) F %I=1:1 S %X=$T(%+%I),%Y=$P(%X,";;",2,999) S:%X %Z=+%X,%1=1 Q:%X="" S ^%Z("?",%Z,%1)=%Y,%1=%1+1 Q CHECK W !,"Checking ZTEDIT4" S A="I %Y]"""",%Y'=%X W !,""Tag: ?,"",%I,"","",%I1,"" is not the same""" S %I1=1,%I="",%X=$P($T(QUES)," ",2,99),%Y=$S($D(^%Z("?")):^("?"),1:"") X A F %=1:1 S %Z=$T(%+%) Q:%Z="" S:%Z %I=+%Z,%I1=1 S %X=$P(%Z,";;",2,99),%Y=$S($D(^%Z("?",%I,%I1)):^(%I1),1:" ") X A S %I1=%I1+1 Q QUES S %NX=1 F %X=1,$S(XY]"":2,1:3) F %=0:0 S %=$O(^%Z("?",%X,%)) Q:%="" W !,^(%) QUESA S %NX="ACTION" F %=0:0 S %=$O(^%Z("?",99,%)) Q:%="" W !,^(%) % ;; 1 ;;.ACTION menu .BREAK line .CHANGE every ;;.FILE routine .INSERT after .JOIN lines ;;.MOVE lines .REMOVE lines .SEARCH for ;;.TERMinal type .XY change to/from replace-with ;;. -TO EXIT THE EDITOR ;;""+n Absolute line n +n To advance n lines -n To backup n lines ;; use '*' to get last line ;; ;;^NAME - to edit a GLOBAL node *NAME - to edit a LOCAL variable ;;MUMPS command line (mumps command or Z command ) ;; 2 ;;In the line mode, ;;Spacebar moves to the next space or comma. Dot to the next char. ;;'>' To move forward 80 char or to end of line. ;;Backspace to back up one char. E to enter new char's at the cursor. ;;CR to exit enter mode, return to start of line or EDIT prompt. ;;D to delete from the cursor to the next space or comma. ;;Delete (Rub) to delete the char under the cursor. ;;CTRL-R to restore line and start back at the beginning. ;; 3 ;;In the replace/with mode, ;;SPECIAL STRINGS: ;; END -to add to the END of a line ;; ... -to replace a line ;; A...B -to specify a string that begins with "A" and ends with "B" ;; A... -to specify a string that begins with "A" to the end of the line ;;CTRL-R to restore line. 99 ;;Bytes in routine Checksum Restore lines ;;Save lines Version # ZTER %ZTER ; ISC-SF.SEA/JLI - ERROR TRAP TO LOG ERRORS ;08/17/2000 15:45 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**8,18,32,24,36,63,73,79,86,112,118,162**;JUL 10, 1995 ;I $ZE["-ALLOC,"!($ZE["") D @$S('$D(^%ZOSF("OS")):"^%ET",^("OS")["DTM":"^%errlog",1:"^%ET") D H^XUS I $ZE["-ALLOC,"!($ZE["") K (DUZ,XQY,XQY0,IO,IOST,IOT) S %ZTERZE=$ZE,%ZT("^XUTL(""XQ"",$J)")="" S:'$D(%ZTERLGR) %ZTERLGR=$$LGR^%ZOSV() G:$$SCREEN(%ZTERZE,1) EXIT ;Let site screen errors, count don't show S %ZTERH1=+$H L +^%ZTER(1,%ZTERH1,0):5 S %ZTER11N=$P($G(^%ZTER(1,%ZTERH1,0)),"^",2)+1,^%ZTER(1,%ZTERH1,0)=%ZTERH1_"^"_%ZTER11N,^(1,0)="^3.0751^"_%ZTER11N_"^"_%ZTER11N L -^%ZTER(1,%ZTERH1,0) S ^%ZTER(1,%ZTERH1,1,%ZTER11N,0)=%ZTER11N,^("ZE")=%ZTERZE S:$D(%ZTERLGR) ^("GR")=%ZTERLGR K %ZTERLGR I %ZTER11N=1 S ^%ZTER(1,0)=$P(^%ZTER(1,0),"^",1,2)_"^"_%ZTERH1_"^"_($P(^%ZTER(1,0),"^",4)+1) S %ZTERRT=$NA(^%ZTER(1,%ZTERH1,1,%ZTER11N)) S %ZTER11B="" F %ZTER11I=1:1:$L($ZB) S %ZTER11A=$E($ZB,%ZTER11I),%ZTER11B=%ZTER11B_$S(%ZTER11A?1C:$C($A(%ZTER11A)+32#128),1:%ZTER11A) S %ZTER11I="" I $D(^%ZOSF("UCI")) K %ZTER11A S:$D(Y) %ZTER11A="" S:($D(Y)#2) %ZTER11A=Y X ^%ZOSF("UCI") S %ZTER11I=Y K:'$D(%ZTER11A) Y S:$D(%ZTER11A) Y=%ZTER11A S @%ZTERRT@("H")=$H,^("J")=$J_"^^^"_%ZTER11I_"^"_$J S @%ZTERRT@("I")=$I_"^"_$S($I[":":$ZA,1:"")_"^"_%ZTER11B_"^"_$G(IO("ZIO"))_"^"_$X_"^"_$Y S %ZTERROR=$S($ZE["%DSM-E":$P($P($ZE,"%DSM-E-",2),","),1:$P($P($ZE,"<",2),">")) S %ZTER11C=0 D STACK^%ZTER1 D SAVE("$X $Y",$X_" "_$Y) I ^%ZOSF("OS")["OpenM" D SAVE("$ZU(56,2)",$ZU(56,2)) I ^%ZOSF("OS")["VAX DSM" K %ZTER11A,%ZTER11B D VXD^%ZTER1 I 1 E D . S %ZTERVAR="%" D:$D(%) VAR:$D(%)#2,SUBS:$D(%)>9 . F %ZTER11Z=0:0 S %ZTERVAR=$O(@%ZTERVAR) Q:%ZTERVAR="" D VAR:$D(@%ZTERVAR)#2,SUBS:$D(@%ZTERVAR)>9 D GLOB S:%ZTER11C>0 @%ZTERRT@("ZV",0)="^3.0752^"_%ZTER11C_"^"_%ZTER11C S:'$D(^%ZTER(1,"B",%ZTERH1)) ^(%ZTERH1,%ZTERH1)="" S ^%ZTER(1,%ZTERH1,1,"B",%ZTER11N,%ZTER11N)="" LIN ; S %ZTY=$P($ZE,","),%ZTX=$P(%ZTY,"^") S:%ZTX[">" %ZTX=$P(%ZTX,">",2) I %ZTX'="" S X=$P($P(%ZTY,"^",2),":") I X'="" X ^%ZOSF("TEST") I $T D .S XCNP=0,DIF="^TMP($J,""XTER1""," X ^%ZOSF("LOAD") S %ZTY=$P(%ZTX,"+",1) D ..I %ZTY'="" F X=0:0 S X=$O(^TMP($J,"XTER1",X)) Q:X'>0 I $P(^(X,0)," ")=%ZTY S X=X+$P(%ZTX,"+",2),%ZTZLIN=^TMP($J,"XTER1",X,0) Q ..I %ZTY="" S X=+$P(%ZTX,"+",2) Q:X'>0 S %ZTZLIN=^TMP($J,"XTER1",X,0) K ^TMP($J,"XTER1"),XCNP,DIF,%ZTY,%ZTX,X,Y S:$D(%ZTZLIN) @%ZTERRT@("LINE")=%ZTZLIN K %ZTZLIN I %ZTERROR'="",$D(^%ZTER(2,"B",%ZTERROR)) S %ZTERROR=%ZTERROR_"^"_$P(^%ZTER(2,+$O(^(%ZTERROR,0)),0),"^",2) EXIT K %ZTER11A,%ZTER11B,%ZTER11C,%ZTER11S,%ZTER11Z,%ZTERVAP,%ZTERVAR,%ZTERSUB,%ZTER11I,%ZTER11D,%ZTER11L,%ZTER11Q,%,%ZTER111,%ZTER112,%ZTER11N K OpenMZU,%ZTERRT,%ZTERH1 S:$$NEWERR $EC="" Q ; VAR I ",%ZTERVAR,%ZTER11Z,%ZTER11A,%ZTER11B,%ZTER11C,%ZTER11N,%ZTER11I,%ZTER11L,%ZTER11S,%ZTERVAP,%ZTERSUB,%ZTERRT,"'[(","_%ZTERVAR_",") S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)=%ZTERVAR D . I $L(@%ZTERVAR)'>255 S @%ZTERRT@("ZV",%ZTER11C,"D")=@%ZTERVAR Q . S @%ZTERRT@("ZV",%ZTER11C,"D")=" **** VALUE IS GREATER THAN 255 CHARACTERS (SEE SUBNODES FOR DATA) *** " . N %ZTER11,%ZTER12 . F %ZTER11=1:1 S %ZTER12=$E(@%ZTERVAR,1,245) Q:%ZTER12="" S @%ZTERVAR=$E(@%ZTERVAR,246,$L(@%ZTERVAR)),@%ZTERRT@("ZV",%ZTER11C,"D",%ZTER11)=%ZTER12 . Q Q ; SAVE(%n,%v) ;Save name and value into global, use special variables S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)=%n,@%ZTERRT@("ZV",%ZTER11C,"D")=%v Q ; SUBS S %ZTER11S="" Q:"%ZT("=$E(%ZTERVAR,1,4) Q:",%ZTER11S,%ZTER11L,"[(","_%ZTERVAR_",") S %ZTERVAP=%ZTERVAR_"(",%ZTERSUB="%ZTER11S)" ; DESC S %ZTER11I=%ZTER11I+1,%ZTER11S(%ZTER11I)=%ZTER11S,%ZTER11S="",%ZTER11L(%ZTER11I)=$L(%ZTERSUB)-9 F %ZTER11Z=0:0 S %ZTER11S=$O(@(%ZTERVAP_%ZTERSUB)) Q:%ZTER11S="" D SUBX S %ZTER11S=%ZTER11S(%ZTER11I) K %ZTER11S(%ZTER11I),%ZTER11L(%ZTER11I) S %ZTER11I=%ZTER11I-1 Q ; SUBX I $D(@(%ZTERVAP_%ZTERSUB))#10 S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)=$P(%ZTERVAP_%ZTERSUB,"%ZTER11S",1)_""""_%ZTER11S_""""_$P(%ZTERVAP_%ZTERSUB,"%ZTER11S",2),^("D")=@(%ZTERVAP_%ZTERSUB) I $D(@(%ZTERVAP_%ZTERSUB))\10 S %ZTERSUB=$E(%ZTERSUB,1,%ZTER11L(%ZTER11I))_""""_%ZTER11S_""""_",%ZTER11S)" D DESC S %ZTERSUB=$E(%ZTERSUB,1,%ZTER11L(%ZTER11I))_"%ZTER11S)" Q ; GLOB ; S %ZTER11D="" F %ZTER11I=0:0 S %ZTER11D=$O(%ZT(%ZTER11D)) Q:%ZTER11D="" S %ZTER11A=%ZTER11D S:%ZTER11A["$J" %ZTER11B=$J,%ZTER11A=$P(%ZTER11A,"$J",1)_%ZTER11B_$P(%ZTER11A,"$J",2,99) S %ZTER11B=$P(%ZTER11A,")",1) D LOOP Q ; LOOP ; F %ZTER11I=0:0 S %ZTER11A=$ZO(@%ZTER11A) Q:%ZTER11A'[%ZTER11B S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)=$P(%ZTER11D,")")_$P(%ZTER11A,%ZTER11B,2),@%ZTERRT@("ZV",%ZTER11C,"D")=@%ZTER11A Q ; SCREEN(ERR,%ZT3) ;Screen out certain errors. N %ZTE,%ZTI,%ZTJ S:'$D(ERR) ERR=$$EC^%ZOSV S %ZTE="",%ZTI=0 F %ZTJ=2,1 D Q:%ZTI>0 . F %ZTI=0:0 S %ZTI=$O(^%ZTER(2,"AC",%ZTJ,%ZTI)) Q:%ZTI="" S %ZTE=$S($G(^%ZTER(2,%ZTI,2))]"":^(2),1:$P(^(0),"^")) Q:ERR[%ZTE . Q ;Next see if we should count the error I %ZTI>0 S %ZTE=$G(^%ZTER(2,%ZTI,0)) D Q $P(%ZTE,"^",3)=2 ;See if we skip the recording of the error. . Q:(%ZTJ=1)&('$G(%ZT3)) . I $P(%ZTE,"^",4) L +^%ZTER(2,%ZTI) S ^(3)=$G(^%ZTER(2,%ZTI,3))+1 L -^%ZTER(2,%ZTI) . Q Q 0 ;record error ; UNWIND ;Unwind stack for new error trap. Called by app code. Q:'$$NEWERR() S $ECODE="" S $ETRAP="D UNW^%ZTER Q:'$QUIT Q -9" S $ECODE=",U1," UNW Q:$ESTACK>1 S $ECODE="" Q ; NEWERR() ;Does this OS support the M95 error trapping N % S %=$G(^%ZOSF("OS")) Q:%="" 0 I %["VAX DSM" Q 1 I %["MSM",$P($ZV,"Version ",2)'<4.3 Q 1 I %["OpenM" Q 1 ;For version >7.0 or NexGen or Cache Q 0 ABORT ;Pop the stack all the way. S $ETRAP="Q:$ST>1 S $ECODE="""" Q" Q ZTER1 %ZTER1 ;ISC-SF.SEA/JLI - ERROR TRAP TO LOG ERRORS (VAX LOCAL SYMBOL TABLE) ;06/01/2000 16:57 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**18,24,36,49,112,162**;JUL 10, 1995 VXD ;Record VAX DSM variables S @%ZTERRT@("J")=$J_"^"_$ZC(%GETJPI,0,"PRCNAM")_"^"_$ZC(%GETJPI,0,"USERNAME")_"^"_%ZTER11I_"^"_$ZC(%SYSFAO,"!XL",$J),@%ZTERRT@("I")=$IO_"^"_$ZA_"^"_$ZB_"^"_$ZIO K %ZTER11I S @%ZTERRT@("ZH")=$TR($ZH,",","^") I $STACK>122 G VERR S %ZTER111="%" F D S %ZTER111=$ZSORT(@%ZTER111) Q:%ZTER111="" ;Code from DEC . Q:$E(%ZTER111,1,5)="%ZTER" . I $D(@%ZTER111)#2 D VNXT2 . I $D(@%ZTER111)>9 D VNXT3 . Q Q ; VNXT2 S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)=%ZTER111,^("D")=$E(@%ZTER111,1,255) Q VNXT3 S %ZTER11Q=%ZTER111 F S %ZTER11Q=$Q(@%ZTER11Q) Q:%ZTER11Q="" S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)=%ZTER11Q,^("D")=$E(@%ZTER11Q,1,255) Q ; STACK ;Record the new $STACK variable I $ECODE]"" S $ZE="" S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$ECODE",^("D")=$E($ECODE,1,255) S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$ESTACK",^("D")=$ESTACK S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$ETRAP",^("D")=$ETRAP S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$STACK",^("D")=$STACK S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$QUIT",^("D")=$QUIT N %,%1,%2 S %2=$ST F %=0:1:$ST S %1=$E(1000+%,2,4) Q:$ST(%,"PLACE")["^%ZTER" D . S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$STACK("_%1_")",^("D")=$STACK(%) . S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$STACK("_%1_",""ECODE"")",^("D")=$STACK(%,"ECODE") . S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$STACK("_%1_",""PLACE"")",^("D")=$STACK(%,"PLACE") . S %ZTER11C=%ZTER11C+1,@%ZTERRT@("ZV",%ZTER11C,0)="$STACK("_%1_",""MCODE"")",^("D")=$STACK(%,"MCODE") . S:$STACK(%,"ECODE")]"" %2=% S @%ZTERRT@("LINE")=$STACK(%2,"MCODE") S $ECODE="" Q ; VERR ; S @%ZTERRT@("ZE2")="%DSM-E-ET, Error occurred in %ZTER, "_$ECODE HALT ZTLOAD %ZTLOAD ;ISF/RDS,RWF - TaskMan: Programmer Interface: Entry Points ;10/20/99 08:16 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**67,118,127**;JUL 10, 1995 ; QUEUE ;queue a task (create, schedule) (Entry Point = ^%ZTLOAD) G ^%ZTLOAD1 ; S(MSG) ;Entry Point: extrinsic variable returns boolean: should task stop? I $D(MSG),$G(ZTQUEUED)>.5 S ^%ZTSK(ZTQUEUED,.11)=MSG,$P(^%ZTSK(ZTQUEUED,.1),"^",2)=$H I $G(ZTQUEUED)>.5,$D(^%ZTSCH("TASK",ZTQUEUED)) S ^%ZTSCH("TASK",ZTQUEUED,1)=$H N ZTSTOP S ZTSTOP=0 I $G(ZTQUEUED)>.5,$P($G(^%ZTSK(ZTQUEUED,.1)),"^",10)]"" S ZTSTOP=1 Q ZTSTOP ; TM() ;Entry Point: extrinsic variable returns boolean: is TM running? N ZTH,ZTR S ZTH=$H,ZTR=$G(^%ZTSCH("RUN")) Q ZTH-ZTR*86400+$P(ZTH,",",2)-$P(ZTR,",",2)<500 ; REQ ;Entry Point: requeue a task (edit, reschedule) G ^%ZTLOAD3 ; KILL ;Entry Point: delete a task S ZTSK=$G(ZTSK) K ZTSK(0) S ZTSK(0)=0 I ZTSK>1,$D(^%ZTSK(ZTSK)) D ;could be done! . L +^%ZTSK(ZTSK):20 Q:'$T . ;Don't kill running persistent tasks. . I $D(^%ZTSCH("ZTSK",ZTSK,"P")) L -^%ZTSK(ZTSK) Q . K ^%ZTSK(ZTSK) L -^%ZTSK(ZTSK) S ZTSK(0)=1 Q ; ISQED ;Entry Point: return whether task is pending (scheduled or waiting) G ^%ZTLOAD4 ; STAT ;Entry Point: return status of a task G ^%ZTLOAD5 ; DQ ;Entry Point: dequeue a task (unschedule) G ^%ZTLOAD6 ; DESC(DESC,LST) ;Find tasks with description G DESC^%ZTLOAD5 RTN(RTN,LST) ;Find tasks that call this routine G RTN^%ZTLOAD5 OPTION(OPNM,LST) ;Find tasks for this OPTION. G OPTION^%ZTLOAD5 ; ZTSAVE(%,%1) ;input variables in string delimited by ; to build ZTSAVE array N %2 K:$G(%1) ZTSAVE F %1=1:1 S %2=$P(%,";",%1) Q:%2="" S ZTSAVE(%2)="" Q PSET(ZTM) ;e.f. Set the persistents node D TN Q:'$D(^%ZTSCH("TASK",ZTM)) 0 S ^%ZTSCH("TASK",ZTM,"P")="" Q 1 PCLEAR(ZTM) ;Clear the persistents node D TN Q:'$D(^%ZTSCH("TASK",ZTM)) K ^%ZTSCH("TASK",ZTM,"P") Q ASKSTOP(ZTSK) ;E.F. Ask a task to stop. G ASKSTOP^%ZTLOAD2 Q TN S ZTM=$S($G(ZTM)>0:ZTM,$G(ZTQUEUED)>.9:ZTQUEUED,$G(ZTSK)>0:ZTSK,1:0) Q ZTLOAD1 %ZTLOAD1 ;SEA/RDS-TaskMan: P I: Queue ;06/20/2000 14:53 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**112,118,127,162**;Jul 03, 1995 ;;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/DSD/AEF 10/17/02 ; GET ;get task data N X1,ZT I ("^"[$G(ZTRTN))!($L($G(ZTRTN),"^")>2) G REJECT^%ZTLOAD2 S U="^" I ZTRTN'[U S ZTRTN=U_ZTRTN S ZTC1=$G(DUZ) ;Check Date/Time 1 I $D(ZTDTH)[0 S ZTDTH="" I ZTDTH?7N.".".N S ZTDTH=$$FMTH^%ZTLOAD7(ZTDTH) I $P($G(XQY0),U,18) D RESTRCT^%ZTLOAD2 I ZTDTH'="@",ZTDTH'?1.5N1","1.5N D ASK^%ZTLOAD2 I ZTDTH="" G REJECT^%ZTLOAD2 ; S ZTA1="R",ZTA4="",ZTA5="" I ZTRTN="ZTSK^XQ1" D OPTION^%ZTLOAD2 I ZTA1="" G REJECT^%ZTLOAD2 I ZTA1="R" D . S ZTSAVE("XQY")="",ZTSAVE("XQY0")="",ZTA4=$G(XQY),ZTA5=$P($G(XQY0),U) ; S ZTC2=ZTC1 I ZTC2]"" S ZTC2=$P($G(^VA(200,ZTC2,0)),U) D GETENV^%ZOSV S ZTC34P=Y ;Description 2 I $D(ZTDESC)[0 S ZTDESC="No Description (%ZTLOAD)" ; I $G(ZTKIL)]"" D ZTKIL^%ZTLOAD2 S:$G(ZTUCI)["," ZTUCI=$P(ZTUCI,",") S:$G(ZTCPU)["," ZTCPU=$P(ZTCPU,",",2) DEVICE ;get device data I $D(ZTIO)#2,$G(ION)=$P(ZTIO,";"),$G(IOT)="SPL" D SPOOL^%ZTLOAD2 I $D(ZTIO)[0 S ZTIO=$G(ION) I ZTIO]"" D . S:$G(IOST)]"" $P(ZTIO,";",2)=IOST . I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_IO("DOC") . E I $G(IOM)]"" S ZTIO=ZTIO_";"_IOM I $G(IOSL)]"" S ZTIO=ZTIO_";"_IOSL . Q I $E(ZTIO,1)="`" S $P(ZTIO,";")=$P(^%ZIS(1,+$E(ZTIO,2,99),0),"^") ;Convert `IEN format I $L(ZTIO),$G(IO("P"))]"",ZTIO'[";/",$P(ZTIO,";")=ION S ZTIO=ZTIO_";/"_IO("P") S ZTIO(1)=$S($G(ZTIO(1))'="D":"Q",1:"DIRECT") S ZTIO("H")=$G(IO("HFSIO")) S ZTIO("P")=$G(IOPAR) I $$NOQ^%ZISUTL($P(ZTIO,";")) G BADDEV^%ZTLOAD2 I $E(ZTIO,1,9)="P-MESSAGE" S ZTSAVE("^TMP(""XM-MESS"",$J,")="" ; RECORD ;build record I $D(^%ZTSK(-1))[0 S ^%ZTSK(-1)=$S($P($G(^%ZTSK(0)),U,3):$P(^(0),U,3),1:1000) ;----- BEGIN IHS MODIFICATION - IHS/DSD/AEF 10/17/02 ;THE $INCREMENT FUNCTION DOES NOT WORK WITH MSM. CODE IS ADDED TO ;CHECK WHICH OS IS BEING USED TO DETERMINE WHICH SET OF CODE TO USE ;----- OLD LINES: ;L +^%ZTSK(-1) ;F S (^%ZTSK(-1),ZTSK)=^%ZTSK(-1)+1 Q:'$D(^%ZTSK(ZTSK)) ;S ^%ZTSK(ZTSK,.1)=0 ;L +^%ZTSK(ZTSK),-^%ZTSK(-1) ;S ZTSK=$INCREMENT(^%ZTSK(-1)) ;L +^%ZTSK(ZTSK):0 I '$T!($D(^%ZTSK(ZTSK))) L -^%ZTSK(ZTSK) G RECORD ;----- NEW LINES: N ZTRECORD I $$VERSION^%ZOSV(1)["MSM" D . L +^%ZTSK(-1) . F S (^%ZTSK(-1),ZTSK)=^%ZTSK(-1)+1 Q:'$D(^%ZTSK(ZTSK)) . S ^%ZTSK(ZTSK,.1)=0 . L +^%ZTSK(ZTSK),-^%ZTSK(-1) I $$VERSION^%ZOSV(1)["Cache" D . S ZTSK=$INCREMENT(^%ZTSK(-1)) . L +^%ZTSK(ZTSK):0 I '$T!($D(^%ZTSK(ZTSK))) L -^%ZTSK(ZTSK) S ZTRECORD=1 I $G(ZTRECORD) G RECORD ;----- END IHS MODIFICATION S ^%ZTSK(ZTSK,0)=ZTRTN_U_ZTC1_U_$G(ZTUCI)_U_$H_U_ZTDTH_U_ZTA1_U_ZTA4_U_ZTA5_U_ZTC2_U_$P(ZTC34P,U,1,2)_U_"ZTDESC"_U_$G(ZTCPU)_U_$G(ZTPRI) S ^%ZTSK(ZTSK,.1)=0,^%ZTSK(ZTSK,.03)=ZTDESC S ^%ZTSK(ZTSK,.2)=ZTIO_"^^^^"_ZTIO(1)_U_ZTIO("H") S:$D(ZTSYNC) $P(^%ZTSK(ZTSK,.2),U,7)=ZTSYNC I ZTIO("P")]"" S ^%ZTSK(ZTSK,.25)=ZTIO("P") ; D ZTSAVE ; SCHED ;schedule task and quit S ZTSTAT=$S(ZTDTH'="@":1,1:"K") S ^%ZTSK(ZTSK,.1)=ZTSTAT_U_$H_"^^0^^^^"_$G(ZTKIL)_U I ZTDTH'="@" S ZT=$$H3(ZTDTH),^%ZTSK(ZTSK,.04)=ZT,^%ZTSCH(ZT,ZTSK)="" L -^%ZTSK(ZTSK) S ZTSK("D")=ZTDTH K X1,ZT,ZT1,ZTDTH,ZTKIL,ZTSAVE,ZTSTAT K ^TMP("XM-MESS",$J) ;Clean up the Global Q ; ZTSAVE ;save variables K %H,%T,ZTA1,ZTA4,ZTA5,ZTC1,ZTC2,ZTC34P,ZTCPU,ZTDESC,ZTIO,ZTNOGO,ZTPRI,ZTRTN,ZTUCI,ZTSYNC S ZTSAVE("DUZ(")="" I ^%ZOSF("OS")'["VAX DSM" S ZT1="" F ZT=0:0 S ZT1=$O(ZTSAVE(ZT1)) Q:ZT1="" D EVAL I ^%ZOSF("OS")["VAX DSM" K X1 S ZT1="" F ZT=0:0 S ZT1=$O(ZTSAVE(ZT1)) Q:ZT1="" S:ZT1["*" X1(ZT1)="" I ZT1'["*" D EVAL I ^%ZOSF("OS")["VAX DSM",$D(X1) S X="^%ZTSK(ZTSK,.3," D ORDER^%ZOSV K ^%ZTSK(ZTSK,.3,"DUZ(","NEWCODE") K ^%ZTSK(ZTSK,.3,"ZTSK"),^("ZTSAVE"),^("ZTDTH") K ^%ZTSK(ZTSK,.3,"XQNOGO") Q ; EVAL ;ZTSAVE--evaluate expression I ZT1="*" S X="^%ZTSK(ZTSK,.3," D DOLRO^%ZOSV Q I ZT1["*",$P(ZT1,"*")'["(" S X="^%ZTSK(ZTSK,.3,",Y=ZT1 D ORDER^%ZOSV Q I $S($E(ZT1)="""":1,+ZT1'=ZT1:0,1:ZT1]0),$D(ZTSAVE(ZT1))#2 S @("^%ZTSK(ZTSK,"_ZT1_")=ZTSAVE(ZT1)") Q I $S(ZT1'["(":1,1:$E(ZT1,$L(ZT1))=")"),$S($D(@ZT1)#2:1,1:ZTSAVE(ZT1)]"") S ^%ZTSK(ZTSK,.3,ZT1)=$S(ZTSAVE(ZT1)]"":ZTSAVE(ZT1),1:@ZT1) Q I ZT1["(" S %X=ZT1,%Y="^%ZTSK(ZTSK,.3,ZT1," D %XY^%RCR Q ; H3(%) ;Convert $H to seconds. Q 86400*%+$P(%,",",2) H0(%) ;Covert from seconds to $H Q (%\86400)_","_(%#86400) ZTLOAD2 %ZTLOAD2 ;SEA/RDS-TaskMan: Queue, Part 2 ;06/24/99 15:34 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**1,67,118**;JUL 03, 1995 ; REJECT ;GET--reject bad task I '$D(ZTQUEUED) W !,"QUEUE INFORMATION MISSING - NOT QUEUED" EXIT K ZTA1,ZTA4,ZTC1,ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL,ZTNOGO,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTUCI Q ; BADDEV ;GET--Reject task with bad device I '$D(ZTQUEUED) W !,"Queueing not allowed to device -- NOT QUEUED" G EXIT ; RESTRCT ;GET--flag tasks with output restricted from certain times; check. I $D(ZTQUEUED) Q S ZTNOGO=0 I ZTDTH="@" Q I ZTDTH'?1.5N1","1.5N Q S X=$$HTFM^%ZTLOAD7(ZTDTH) D ^XQ92 I X="" S ZTDTH="" W !,"Sorry--that time is restricted!",!,$C(7) Q ; ASK ;GET--ask for start time N %DT,Y I $D(ZTQUEUED) D:ZTDTH]"" Q . S %DT="FRS",X=ZTDTH D ^%DT . S ZTDTH=$$FMTH^%ZTLOAD7(+Y) I Y'>0 S ZTDTH="" . Q S %DT="AERSX",%DT("A")="Requested Start Time: ",%DT("B")="NOW",%DT(0)="NOW" I $D(ZTNOGO) D I X="" Q . S Y=+XQY D NEXT^XQ92 I X="" W !,"Output is never allowed from this option!",$C(7),$C(7) Q . S %DT("B")=$$FMTE^%ZTLOAD7(X),%DT="AERSX" . Q I $D(ZTNOGO),'$D(XQNOGO) W !,"Output from this option is restricted during certain times." F ZT=0:0 D ^%DT Q:(Y<0)!'$D(ZTNOGO) S ZT=Y,X=Y D ^XQ92 S Y=ZT Q:X]"" W !!,"That is a restricted time!",!,$C(7) S:Y>0 ZTDTH=$$FMTH^%ZTLOAD7(+Y) K %DT,%T,X5,ZT Q ; OPTION ;GET--get option data S ZTA4=$G(ZTSAVE("XQY")) I 'ZTA4 S ZTA4=$G(XQY) I 'ZTA4 S ZTA4="" S ZTA1="O" I 'ZTA4 S ZTA1="" Q S ZTA5=$P($G(^DIC(19,ZTA4,0)),U) Q ; ZTKIL ;GET--convert forget time S ZTKIL=$S(ZTKIL?5N:ZTKIL,ZTKIL?5N1","1.5N:ZTKIL,ZTKIL?7N.".".N:$$FMTH^%ZTLOAD7(ZTKIL),1:"") Q ; SPOOL ;DEVICE--for predefined ZTIO spool device, pick up IO("DOC") if missing I $G(IO("DOC"))="" Q I ZTIO[IO("DOC") Q I $P(ZTIO,";",2)?.N D .S ZTIO=$P(ZTIO,";")_";"_IO("DOC")_";"_$P(ZTIO,";",2,999) E I $P(ZTIO,";",2)?1.2A1"-"1.ANP,$P(ZTIO,";",3)?.N D .S ZTIO=$P(ZTIO,";",1,2)_";"_IO("DOC")_";"_$P(ZTIO,";",3,999) Q ; ASKSTOP ;e.f. Called from ASKSTOP^%ZTLOAD ;Ask a task to stop. Unschedule if not started. N ZT1,ZT2,ZTDTH,%ZTIO L +^%ZTSK(ZTSK):10 I '$T Q "0^Busy" S ZTSK(0)=$G(^%ZTSK(ZTSK,0)),ZTSK(.1)=$G(^(.1)) I ZTSK(0)="" Q "1^Task missing" S $P(^%ZTSK(ZTSK,.1),U,10)=$S($D(ZTNAME)#2:ZTNAME,1:$G(DUZ,.5)) I +ZTSK(.1)=6 Q "1^Finished running" I +ZTSK(.1)=5 Q "2^Asked to stop" S ZTDTH=$$H3^%ZTM($P(ZTSK(0),U,6)) K ^%ZTSCH(ZTDTH,ZTSK) ;Remove from schedule S %ZTIO=$O(^%ZTSK(ZTSK,.26,"")) I %ZTIO]"" D DQ^%ZTM4 ;Remove from device lists. L -^%ZTSK(ZTSK) Q "2^Unscheduled" ZTLOAD3 %ZTLOAD3 ;SEA/RDS - TaskMan: Task Requeue ;06/14/2001 09:49 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**67,127,136,192**;JUL 10, 1995 ; INPUT ;check for error conditions N %H,%T,X,X1,Y,ZT,ZT1,ZT2,ZT3,ZTH,ZTL,ZTOS,ZTREC,ZTREC1,ZTREC2,ZTREC25 S ZTSK=$G(ZTSK) K ZTSK(0),ZTREQ ;Kill ZTREQ so we don't kill the entry L +^%ZTSK(ZTSK) S ZTREC=$G(^%ZTSK(ZTSK,0)) I ZTREC="" G BAD I $D(ZTDTH)#2,ZTDTH]"",ZTDTH'?1.5N1","1.5N,ZTDTH'?7N.".".N,ZTDTH'="@","SHD"'[$E(ZTDTH,$L(ZTDTH)) G BAD ; DQ ;make sure task is not pending D UNSCH^%ZTLOAD6 I $D(^%ZTSK(ZTSK,0))[0 G BAD ; ZTDTH ;determine task's next start time S:$P(ZTREC,"^",16)="" $P(ZTREC,"^",16)=$P(ZTREC,"^",5) ;Save original create time S $P(ZTREC,"^",5)=$H ;Set a new create time I $D(ZTDTH)[0 S ZTDTH=$P(ZTREC,"^",6) G ZTRTN ;Use original time. I ZTDTH="" S ZTDTH=$H G ZTRTN I ZTDTH?1.5N1","1.5N G ZTRTN I ZTDTH?7N.".".N S ZTDTH=$$FMTH^%ZTLOAD7(ZTDTH) G ZTRTN I ZTDTH="@" G ZTRTN S ZTH=$$H3^%ZTM($P(ZTREC,"^",6)),ZTL=$E(ZTDTH,$L(ZTDTH)) ;From start time DT I ZTL="S" S ZTH=ZTH+ZTDTH I ZTL="H" S ZTH=(ZTDTH*3600)+ZTH I ZTL="D" S ZTH=(ZTDTH*86400)+ZTH DTX I ZTH<$$H3^%ZTM($H) G DT S ZTDTH=$$H0^%ZTM(ZTH) ; ZTRTN ;determine whether entry point should change I $D(ZTRTN)[0 G ZTIO I ZTRTN="" G ZTIO I ZTRTN'[U S ZTRTN=U_ZTRTN S ZT=$P(ZTREC,U,1,2) I ZT'=ZTRTN S $P(ZTREC,U,1,2)=ZTRTN I ZT="ZTSK^XQ1" S $P(ZTREC,U,7,9)="R^^" ; ZTIO ;determine whether i/o device should change N ZTREC2,ZTREC25 S ZTREC2=$G(^%ZTSK(ZTSK,.2)),ZT=$P(ZTREC2,U) I $D(ZTIO)[0 G ZTIO1 I ZTIO="" G ZTIO1 I $P(ZTIO,";")'=$P(ZT,";") S $P(ZTREC2,U,6)="",ZTREC25="" I ZTIO="@" S $P(ZTREC2,U)="" G ZTIO1 I ZTIO'=ZT S $P(ZTREC2,U)=ZTIO ; ZTIO1 ;set hunt group suppression flag S $P(ZTREC2,U,5)=$S($D(ZTIO(1))[0:"",ZTIO(1)="D":"DIRECT",1:"") ; ZTDESC ;determine whether description should change I $S($D(ZTDESC)[0:1,ZTDESC="":1,1:0) S ZTDESC=$G(^%ZTSK(ZTSK,.03)) I ZTDESC=""!(ZTDESC="No Description (%ZTLOAD)") S ZTDESC="No Description (REQ~%ZTLOAD)" S ^%ZTSK(ZTSK,.03)=ZTDESC ; RECORD ;record changes in Task File entry I $D(ZTREC2)#2 S ^%ZTSK(ZTSK,.2)=ZTREC2 I $D(ZTREC25)#2 S ^%ZTSK(ZTSK,.25)=ZTREC25 I ZTDTH'="@" S $P(ZTREC,U,6)=ZTDTH ;Reset the Scheduled time piece S ^%ZTSK(ZTSK,0)=ZTREC S $P(^%ZTSK(ZTSK,.1),U,1,3)=$S(ZTDTH'="@":"1^"_$H_"^REQUEUED",1:"H^"_$H_"^EDITED BUT NOT REQUEUED") ; ZTSAVE ;See if new data to save K %H,%T,X,X1,Y,ZT,ZT1,ZT2,ZT3,ZTH,ZTL,ZTOS,ZTREC,ZTREC1,ZTREC2,ZTREC25 K ZTDESC,ZTIO,ZTRTN I $D(ZTSAVE) K:$G(ZTSAVE)="KILL" ^%ZTSK(ZTSK,.3) D ZTSAVE^%ZTLOAD1 SCHED ;schedule task, cleanup, quit I ZTDTH'="@" S ZT=$$H3^%ZTLOAD1(ZTDTH),^%ZTSK(ZTSK,.04)=ZT,^%ZTSCH(ZT,ZTSK)="" K %X,%Y,X,X1,Y,ZT1,ZT2,ZT3,ZTDTH,ZTSAVE L -^%ZTSK(ZTSK) S ZTSK(0)=1 Q ; BAD L -^%ZTSK(ZTSK) S ZTSK(0)=0 Q REQP(ZT1) ;Reschedule a persistent task. Called from ZTM N ZTSK,ZT2,ZT3,ZTDTH,ZTSAVE S ZTDTH=$H,ZTSK=ZT1 L +^%ZTSK(ZTSK):20 Q:'$T I $D(^%ZTSK(ZTSK,0))[0 Q ;SEND ALERT TO USER G SCHED ZTLOAD4 %ZTLOAD4 ;SEA/RDS-TaskMan: P I: Is Queued? ;7/26/91 11:55 ; [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;JUL 10, 1995 ;;7.0; ; INPUT ;check input parameters for error conditions I $D(ZTSK)[0 S ZTSK="" I $D(ZTSK)>1 S ZTLOAD=ZTSK K ZTSK S ZTSK=ZTLOAD K ZTLOAD I ZTSK<1!(ZTSK\1'=ZTSK) S ZTSK="",ZTSK(0)="",ZTSK("E")="IT" G QUIT S ZTSK(0)="",ZTSK("E")="U",X="QUIT^%ZTLOAD3",@^%ZOSF("TRAP") S %ZTVOL=^%ZOSF("VOL") I $D(ZTCPU)[0 S ZTCPU=%ZTVOL I ZTCPU="" S ZTCPU=%ZTVOL I ZTCPU'=%ZTVOL G THERE ; HERE ;lookup task's status on current volume set L +^%ZTSK(ZTSK) I $D(^%ZTSK(ZTSK,0))[0 S ZTSK("E")="I" G QUIT S ZTREC=^%ZTSK(ZTSK,0),ZTD=$P(ZTREC,U,6) S ZTSK("DUZ")=$P(ZTREC,U,3),ZTSK("D")=ZTD I ZTD]"",$D(^%ZTSCH(ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT I ZTD]"",$D(^%ZTSCH("JOB",ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT ; S ZT1="" F ZT=0:0 S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZT1="IO",ZT2="" F ZT=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F ZT=0:0 S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZT1="JOB",ZT2="" F ZT=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZT1="LINK",ZT2="" F ZT=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F ZT=0:0 S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZTSK(0)=0 ; QUIT ;cleanup and quit L:ZTSK -^%ZTSK(ZTSK) K %ZTCPU,%ZTM,%ZTM1,%ZTM2,%ZTMAST,%ZTVOL,X,Y,ZT,ZT1,ZT2,ZT3,ZTCPU,ZTD,ZTREC I ZTSK(0)]"" K ZTSK("E") Q I ZTSK("E")'="U" Q S ZTSK("E",0)=$$EC^%ZOSV Q ; THERE ;rest of code looks up task's status on some other volume set ; FILES ;find TaskMan files on the volume set to be searched S %ZTCPU=$O(^%ZIS(14.5,"B",ZTCPU,"")) I %ZTCPU="" S ZTSK("E")="IS" G QUIT S %ZTM=$P(^%ZOSF("MGR"),",") S %ZTM=$S($D(^%ZIS(14.5,%ZTCPU,0))[0:%ZTM,$P(^(0),U,6)="":%ZTM,1:$P(^(0),U,6)) S X=%ZTM,Y=ZTCPU S ZTSK("E")="LS",ZT=$D(^[X,Y]%ZTSK(0)),ZTSK("E")="U" ; check link ; SEARCH ;find out if task is queued on that volume set I $D(^[X,Y]%ZTSK(ZTSK,0))[0 S ZTSK("E")="I" G QUIT S ZTREC=^[X,Y]%ZTSK(ZTSK,0),ZTD=$P(ZTREC,U,6) S ZTSK("DUZ")=$P(ZTREC,U,3),ZTSK("D")=ZTD I ZTD]"",$D(^[X,Y]%ZTSCH(ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT I ZTD]"",$D(^[X,Y]%ZTSCH("JOB",ZTD,ZTSK))#2 S ZTSK(0)=1 G QUIT ; S ZT1="" F ZT=0:0 S ZT1=$O(^[X,Y]%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZT1="IO",ZT2="" F ZT=0:0 S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F ZT=0:0 S ZT3=$O(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZT1="JOB",ZT2="" F ZT=0:0 S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZT1="LINK",ZT2="" F ZT=0:0 S ZT2=$O(^[X,Y]%ZTSCH(ZT1,ZT2)),ZT3="" Q:ZT2="" F ZT=0:0 S ZT3=$O(^[X,Y]%ZTSCH(ZT1,ZT2,ZT3)) Q:ZT3="" I $D(^(ZT3,ZTSK))#2 S ZTSK(0)=1 G QUIT S ZTSK(0)=0 G QUIT ; ZTLOAD5 %ZTLOAD5 ;SEA/RDS-TaskMan: P I: Task Status ;11/08/96 14:55 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**49**;JUL 10, 1995 ; INPUT ;check input parameters for error conditions N %,ZT1,ZT2,ZT3 S:$D(ZTSK)[0 ZTSK="" I $D(ZTSK)>1 S %=ZTSK K ZTSK S ZTSK=% S ZTSK(0)=0,ZTSK(1)=0,ZTSK(2)="Undefined" I ZTSK<1!('$D(^%ZTSK(ZTSK,0))) Q L +^%ZTSK(ZTSK) D SEARCH L -^%ZTSK(ZTSK) Q ; SEARCH ;search ^%ZTSCH for task I $D(^%ZTSCH("TASK",ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=2,ZTSK(2)="Active: Running" Q S ZT1="" D Q:ZTSK(0) . F S ZT1=$O(^%ZTSCH(ZT1)) Q:ZT1'>0 I $D(^%ZTSCH(ZT1,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q S ZT1="" D Q:ZTSK(0) . F S ZT1=$O(^%ZTSCH("IO",ZT1)),ZT2="" Q:ZT1="" D Q:ZTSK(0) . . F S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q S ZT1="" D Q:ZTSK(0) . F S ZT1=$O(^%ZTSCH("JOB",ZT1)) Q:ZT1="" I $D(^(ZT1,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q S ZT1="" D Q:ZTSK(0) . F S ZT1=$O(^%ZTSCH("LINK",ZT1)),ZT2="" Q:ZT1="" D Q:ZTSK(0) . . F S ZT2=$O(^%ZTSCH("LINK",ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK))#2 S ZTSK(0)=1,ZTSK(1)=1,ZTSK(2)="Active: Pending" Q S ZT1="" D Q:ZTSK(0) . F S ZT1=$O(^%ZTSCH("C",ZT1)) Q:ZT1'>0 I $D(^(ZT1,ZTSK)) S ZTSK(0)=1,ZTSK(2)="Active: Pending" Q ; FLAG ;If we didn't find it in a list, use status flag I $D(^%ZTSK(ZTSK,.1))[0 Q S ZT=$P(^%ZTSK(ZTSK,.1),U),ZTSK(0)=1 I ZT=2!(ZT=4) S ZTSK(1)=1,ZTSK(2)="Active: Pending" Q I ZT=6 S ZTSK(1)=3,ZTSK(2)="Inactive: Finished" Q I ZT="H"!(ZT="K") S ZTSK(1)=4,ZTSK(2)="Inactive: Available" Q S ZTSK(1)=5,ZTSK(2)="Inactive: Interrupted" Q ; DESC ;Find tasks with matching description. ;From %ZTLOAD input param DESC,LST Q:$G(DESC)="" N ZTSK,X D ENV S:'$D(LST) LST="^TMP($J)" S ZTSK=0 F S ZTSK=$O(^%ZTSK(ZTSK)) Q:ZTSK'>0 S X=$G(^%ZTSK(ZTSK,0)) D . Q:$$SKIP() . I $G(^%ZTSK(ZTSK,.03))=DESC S @LST@(ZTSK)="" . Q Q RTN ;Find tasks with matching routines ;From %ZTLOAD input param RTN,LST Q:$G(RTN)="" N ZTSK,X D ENV S:'$D(LST) LST="^TMP($J)" S:RTN'["^" RTN="^"_RTN S ZTSK=0 F S ZTSK=$O(^%ZTSK(ZTSK)) Q:ZTSK'>0 S X=$G(^%ZTSK(ZTSK,0)) D . Q:$$SKIP() . I $P(X,"^",1,2)=RTN S @LST@(ZTSK)="" Q . I "^"_($P(X,"^",2))=RTN S @LST@(ZTSK)="" . Q Q OPTION ;Find tasks with matching option names ;From %ZTLOAD input param OPNM, LST Q:$G(OPNM)="" N ZTSK,X,FLG D ENV S:'$D(LST) LST="^TMP($J)" S ZTSK=0,FLG=(OPNM?1.N1"^"1A.ANP) Q:'FLG&(OPNM'?1A.ANP) F S ZTSK=$O(^%ZTSK(ZTSK)) Q:ZTSK'>0 S X=$G(^%ZTSK(ZTSK,0)) D . Q:$$SKIP() . I FLG,$P(X,"^",8,9)=OPNM S @LST@(ZTSK)="" Q . I $P(X,"^",1,2)="ZTSK^XQ1",$P(X,"^",9)=OPNM S @LST@(ZTSK)="" . Q Q SKIP() ;Screen on ZTKEY, UCI, DUZ, return: 0=OK, 1=Skip Q:ZTKEY 0 Q:($P(X,U,11)_","_$P(X,U,12))'=ZTUCI 1 Q:$P(X,U,3)'=DUZ 1 Q 0 ENV ;Setup S ZTKEY=$D(^XUSEC("ZTMQ",DUZ)),U="^" X ^%ZOSF("UCI") S ZTUCI=Y Q ZTLOAD6 %ZTLOAD6 ;SEA/RDS-TaskMan: P I: Dequeue ;12/29/94 16:02 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;JUL 10, 1995 ; INPUT ;check input parameters for error conditions I $D(ZTSK)[0 S ZTSK="" I $D(ZTSK)>1 S ZTLOAD=ZTSK K ZTSK S ZTSK=ZTLOAD K ZTLOAD I ZTSK<1!(ZTSK\1'=ZTSK) S ZTSK(0)=0 Q L +^%ZTSK(ZTSK) ; D UNSCH QUIT ;cleanup & quit I $D(^%ZTSK(ZTSK)),$D(DUZ)#2,DUZ]"",$D(^VA(200,DUZ,0))#2 S $P(^%ZTSK(ZTSK,.1),U,1,3)="F^"_$H_U_$P(^VA(200,DUZ,0),U) L -^%ZTSK(ZTSK) S ZTSK(0)=1 K ZT,ZT1,ZT2,ZT3 Q ; UNSCH ;search ^%ZTSCH & unschedule task ;Call with task locked. N ZT1,ZT2,ZT3 S ZT1=0 F S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK)) S ZT2=$G(^(ZTSK)) K ^%ZTSCH(ZT1,ZTSK) I ZT2]"" S $P(^%ZTSK(ZTSK,.2),U)=ZT2 L +^%ZTSCH("JOB"):15 S ZT1="" F S ZT1=$O(^%ZTSCH("JOB",ZT1)) Q:ZT1="" I $D(^(ZT1,ZTSK)) K ^%ZTSCH("JOB",ZT1,ZTSK) L -^%ZTSCH("JOB"),+^%ZTSCH("IO"):15 S ZT1="" F S ZT1=$O(^%ZTSCH("IO",ZT1)),ZT2="" Q:ZT1="" F S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK)) D DQ(ZT1,ZT2,ZTSK) L -^%ZTSCH("IO"),+^%ZTSCH("C"):15 S ZT1="" F S ZT1=$O(^%ZTSCH("C",ZT1)),ZT2="" Q:ZT1="" F S ZT2=$O(^%ZTSCH("C",ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK)) K ^%ZTSCH("C",ZT1,ZT2,ZTSK) L -^%ZTSCH("C"),+^%ZTSCH("LINK") S ZT1="" F S ZT1=$O(^%ZTSCH("LINK",ZT1)),ZT2="" Q:ZT1="" F S ZT2=$O(^%ZTSCH("LINK",ZT1,ZT2)) Q:ZT2="" I $D(^(ZT2,ZTSK)) K ^%ZTSCH("LINK",ZT1,ZT2,ZTSK) L -^%ZTSCH("LINK") Q ; DQ(%ZTIO,ZTDTH,ZTSK) ;SEARCH--remove task from Device Waiting List L +^%ZTSCH("IO") D DQ^%ZTM4 L -^%ZTSCH("IO") Q ; ZTLOAD7 %ZTLOAD7 ;ISC-SF/RWF - TASKMAN Utilities ;02/25/98 10:46 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**67**;JUL 10, 1995 ;See XLFDT for notes. HTFM(%H,%F) ;$H to FM N X,%,%Y,%M,%D S:'$D(%F) %F=0 S %=(%H>21608)+(%H>94657)+%H-.1,%Y=%\365.25+141,%=%#365.25\1 S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1 S X=%Y_"00"+%M_"00"+%D,%=$P(%H,",",2) S %=%#60/100+(%#3600\60)/100+(%\3600)/100 S:%&('%F) X=X_% Q X ; FMTH(X,%F) ;FM to $H N %Y,%H S:'$D(%F) %F=0 D H S:%F %H=+%H Q %H H ; N %,%M,%D,%T I X<1410000 S %H=0,%Y=-1 Q S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7) S %T=$E(X_0,9,10)*60+$E(X_"000",11,12)*60+$E(X_"00000",13,14) S %L=%Y+1700 S:%M<3 %L=%L-1 S %L=(%L\4)-(%L\100)+(%L\400)-446 S %H=$P("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D S %=('%M)!('%D),%Y=%Y-141,%H=(%H+(%Y*365)+%L+%)_","_%T,%Y=$S(%:-1,1:%H+4#7) Q ; HTE(%H,%F) ;$H to external Q:%H'>0 %H N Y,%T,%R S %F=$G(%F) S Y=$$HTFM(%H,0) G T2 FMTE(Y,%F) ;FM to external Q:'Y Y N %T,%R S %F=$G(%F) T2 S %T="."_$E($P(Y,".",2)_"000000",1,7) D @("EF"_$S(%F<1:1,%F>4:1,1:+%F\1)) Q %R DOW(X,Y) ;Day of Week N %Y,%M,%D,%H,%T D H I $G(Y) Q %Y Q $P("Sun^Mon^Tues^Wednes^Thurs^Fri^Satur","^",%Y+1)_"day" ; FMDIFF(X1,X2,X3) ;FM diff in two dates in days if x3=1 seconds if x3=2. N %H,%Y,X S:'$D(X3) X3=1 S X=X1 D H S X1=+%H,X1(1)=$P(%H,",",2),X=X2 D H D2 S X=(X1-%H) S:X3>1 X=X*86400+(X1(1)-$P(%H,",",2)) I X3=3 S %=X,X="" S:%>86400 X=(%\86400) S:%#86400 X=X_" "_(%#86400\3600)_":"_$E(%#3600\60+100,2,3)_":"_$E(%#60+100,2,3) Q X HDIFF(X1,X2,X3) ;$H diff in two dates, X3 same as FMDIFF. N X,%H,%T S:'$D(X3) X3=1 S X1(1)=$P(X1,",",2),X1=+X1,%H=X2 G D2 HADD(X,D,H,M,S) ;Add to $H date N %H,%T S %H=+X,%T=$P(X,",",2) D A2 Q %H_","_%T A2 S %H=%H+$G(D),%T=%T+($G(H)*3600)+($G(M)*60)+$G(S) S:%T>86400 %H=%H+(%T\86400),%T=%T#86400 S:%T<0 %H=%H+(%T\86400)-1,%T=%T#86400 Q FMADD(X,D,H,M,S) ;Add to FM date N %H,%T S %H=$$FMTH(X,0),%T=$P(%H,",",2) D A2 Q $$HTFM(%H_","_%T) ; EF1 S %R=$P($T(M)," ",$S($E(Y,4,5):$E(Y,4,5)+2,1:0))_" "_$S($E(Y,6,7):$E(Y,6,7)_", ",1:"")_($E(Y,1,3)+1700) S:$E(%R)=" " %R=$E(%R,2,99) TM N % Q:%T'>0!(%F["D") I %F'["P" S %R=%R_"@"_$E(%T,2,3)_":"_$E(%T,4,5)_$S(%F["M":"",$E(%T,6,7)!(%F["S"):":"_$E(%T,6,7),1:"") I %F["P" D . S %R=%R_" "_$S($E(%T,2,3)>12:$E(%T,2,3)-12,1:+$E(%T,2,3))_":"_$E(%T,4,5)_$S(%F["M":"",$E(%T,6,7)!(%F["S"):":"_$E(%T,6,7),1:"") . S %R=%R_$S($E(%T,2,7)<120000:" am",$E(%T,2,3)=24:" am",1:" pm") . Q Q M ;; Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec EF2 S %R=$J(+$E(Y,4,5),2)_"/"_$J(+$E(Y,6,7),2)_"/"_$E(Y,2,3) I %F'["F" S %R=$TR(%R," ") G TM EF3 S %R=$J(+$E(Y,6,7),2)_"/"_$J(+$E(Y,4,5),2)_"/"_$E(Y,2,3) I %F'["F" S %R=$TR(%R," ") G TM EF4 S %R=$E(Y,2,3)_"/"_$J(+$E(Y,4,5),2)_"/"_$J(+$E(Y,6,7),2) I %F'["F" S %R=$TR(%R," ") G TM ZTM %ZTM ;SEA/RDS-TaskMan: Manager, Part 1 (Main Loop) ;04/13/2000 10:07 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,36,64,67,118,127,136**;JUL 10, 1995 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/MFD 2/24/99 & 2/23/01 ; ;%ZTCHK is set to 1 @ top of SCHQ, set to 0 if send a task to SM LOOP ;Taskman's Main Loop ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THIS LINE WAS COMMENTED OUT AND REPLACED BY A NEW LINE TO ;DO NEW SUBROUTINE SUBU. ;ORIGINAL MODIFICATION BY IHS/MFD 2/24/99 ;F %ZTLOOP=0:1 S %ZTLOOP=%ZTLOOP#16 D CHECK,SCHQ,IDLE:%ZTCHK F %ZTLOOP=0:1 S %ZTLOOP=%ZTLOOP#16 D SUBU,CHECK,SCHQ,IDLE:%ZTCHK ;----- END IHS MODIFICATION S %ZTFALL="" G LOOP ; CHECK ;LOOP--Check Status And Update Loop Data ;Do CHECK if sent a new job or %ZTLOOP=0. Q:%ZTLOOP&$G(%ZTCHK) I $D(^%ZTSCH("STOP","MGR",%ZTPAIR)) G HALT^%ZTM0 S ^%ZTSCH("RUN")=$H,ZTPAIR="",%ZTIME=$$H3($H) I $D(^%ZTSCH("WAIT","MGR"))#2 D STATUS("WAIT","Taskman Waiting") H 5 G CHECK ; I $D(^%ZTSCH("UPDATE",$J))[0 D UPDATE^%ZTM5 I %ZTVLI D STATUS("PAUSE","Logons Inhibited") H 60 G CHECK ;Set in %ZTM5 I @%ZTNLG D INHIBIT^%ZTM5(1),STATUS("PAUSE","No Signons Allowed") H 60 G CHECK I $G(^%ZIS(14.5,"LOGON",%ZTVOL)) D INHIBIT^%ZTM5(0) ;Check field I $D(ZTREQUIR)#2 D STATUS("PAUSE","Required link to "_ZTREQUIR_" is down.") H 60 D REQUIR^%ZTM5 G CHECK ; I $D(^%ZTSCH("LINK"))#2,$$DIFF($H,^("LINK"))>900 D LINK^%ZTM3 ; S %ZTRUN=%ZTVMJ>$$ACTJ^%ZOSV ;Check for job limit ; I %ZTPFLG("BAL")]"" D I ZTOVERLD G CHECK . S ZTOVERLD=0 . Q:%ZTPFLG("LBT")>%ZTIME S %ZTPFLG("LBT")=%ZTIME+%ZTPFLG("BI") . D BALANCE^%ZTM6 Q:'ZTOVERLD . D STATUS("BALANCE","Waiting to balance the load.") . ;Start submanagers for C list work . I $D(^%ZTSCH("C",%ZTPAIR))>9,%ZTRUN D NEWJOB(%ZTUCI,%ZTVOL,"") . N T F T=1:1:%ZTPFLG("BI") H 1 Q:$$STOPWT^%ZTM6() . Q ; I %ZTRUN D STATUS("RUN","Main Loop") E D STATUS("RUN","Taskman Job Limit Reached"),CHECK^%ZTM6 Q ; STATUS(ST,MSG) ;Record TM status S ^%ZTSCH("STATUS",$J)=$H_"^"_ST_"^"_$G(%ZTPAIR)_"^"_MSG Q ; TLOCK(M,T) ;Lock a time node I M>0 L +^%ZTSCH(ZTDTH):0 Q $T L -^%ZTSCH(ZTDTH) Q ; SCHQ ;LOOP--Check Schedule List S %ZTIME=$$H3($H),ZTDTH=0,%ZTCHK=1,IO="" S1 S ZTDTH=$O(^%ZTSCH(ZTDTH)),ZTSK=0 Q:(ZTDTH>%ZTIME) Q:('ZTDTH)!(ZTDTH'?1.N) I +ZTDTH<0 K ^%ZTSCH(ZTDTH) G S1 I '$$TLOCK(1,ZTDTH) G S1 S2 S ZTSK=$O(^%ZTSCH(ZTDTH,ZTSK)) I ZTSK="" D TLOCK(-1,ZTDTH) G S1 S ZTST=$G(^%ZTSCH(ZTDTH,ZTSK)) ;Get task lock then release time lock L +^%ZTSK(ZTSK):0 G S2:'$T K ^%ZTSCH(ZTDTH,ZTSK) D TLOCK(-1,ZTDTH) ;Count tasks S %ZTMON(%ZTMON)=$G(%ZTMON(%ZTMON))+1 I $D(^%ZTSK(ZTSK,0))[0 S:$D(^%ZTSK(ZTSK)) $P(^(ZTSK,.1),U,1,3)="I^"_$H_U_1 L -^%ZTSK(ZTSK) G S2 I $D(^%ZTSK(ZTSK,.1))#2,$P(^(.1),U,10)]"" S $P(^(.1),U,1,3)="D^"_$H_"^1" L -^%ZTSK(ZTSK) G S2 D ^%ZTM1 I %ZTREJCT L -^%ZTSK(ZTSK) G S2 ; SEND ;Send Task To Submanager S %ZTCHK=0,ZTPAIR="" I ZTDVOL'=%ZTVOL D XLINK^%ZTM2 G:'ZTJOBIT SCHX S $P(^%ZTSK(ZTSK,.1),U,1,2)=$S(ZTYPE="C":"M",1:3)_U_$H ;Clear before job cmd I (ZTYPE'="C")&(%ZTNODE[ZTNODE) S ^%ZTSCH("JOB",ZTDTH,ZTSK)=IO ;No other lock on JOB E S ZTPAIR=ZTDVOL_$S(ZTNODE]"":":"_ZTNODE,1:""),^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK)=IO ; L -^%ZTSK(ZTSK) ; ;I '$D(^%ZTSCH("STOP","SUB",%ZTPAIR)),'$$OOS(ZTPAIR) D NEWJOB(ZTUCI,ZTDVOL,ZTNODE,ZTYPE,ZTPAIR) ;I '$D(^%ZTSCH("STOP","SUB",%ZTPAIR)),(ZTYPE="C"!(%ZTRUN&$$NEWSUB)),'$$OOS(ZTPAIR) D ;. I 1 X %ZTJOB H %ZTSLO I '$T X %ZTJOB H %ZTSLO ;. Q I (ZTYPE="C"!(%ZTRUN&$$NEWSUB)),'$$OOS(ZTPAIR) D NEWJOB(ZTUCI,ZTDVOL,ZTNODE) SCHX L K ZTREP Q ; IDLE ;LOOP--DEV Node Maintenance; Backup JOB Commands S (ZTREC,ZTCVOL)="" H 1 ;This is the main hang I %ZTMON("NEXT")'>%ZTIME D MON ;See if time to update %ZTMON Q:'%ZTRUN ;Only do IDLE work if not at job limit I $D(^%ZTSCH("STOP","MGR",%ZTPAIR)) Q ;job off a new submanager if MIN count < # SUBs I $$NEWSUB D NEWJOB(%ZTUCI,%ZTVOL,"") L +^%ZTSCH("IDLE",%ZTPAIR):0 Q:'$T D IDLE1 L -^%ZTSCH("IDLE",%ZTPAIR) Q IDLE1 ;only proceed with idle work if 60 seconds since last check I $$DIFF(%ZTIME,^%ZTSCH("IDLE"),1)<60 Q D I1,I2,I5,I6 S ^%ZTSCH("IDLE")=%ZTIME Q ; I1 ;clear out old DEV nodes N X,%ZTIO S %ZTIO="" F S %ZTIO=$O(^%ZTSCH("DEV",%ZTIO)) Q:%ZTIO="" L ^%ZTSCH("DEV",%ZTIO):0 I $T D L -^%ZTSCH("DEV",%ZTIO) . S X=$G(^%ZTSCH("DEV",%ZTIO)) Q:'$L(X) . I $$DIFF(%ZTIME,X,1)>120 K ^%ZTSCH("DEV",%ZTIO) . Q Q ; I2 ;job new submanagers cross-volume for each unfinished C list I $D(^%ZTSCH("C")) D . N ZTUCI,ZTVOL,ZTNODE,$ETRAP,$ESTACK S $ET="S $EC="""" D ERCL^%ZTM2" . S ZTVOL="" F S ZTVOL=$O(^%ZTSCH("C",ZTVOL)) Q:ZTVOL="" D .. I $O(^%ZTSCH("C",ZTVOL,0))="" Q .. S ZTNODE="",ZTDVOL=ZTVOL S:ZTDVOL[":" ZTNODE=$P(ZTDVOL,":",2),ZTDVOL=$P(ZTDVOL,":") .. S X=$G(^%ZTSCH("C",ZTVOL)) .. I $D(^%ZTSCH("LINK",ZTDVOL))!(X>9)!$$OOS(ZTVOL) Q .. S ^%ZTSCH("C",ZTVOL)=X+1 .. S ZTUCI=$O(^%ZIS(14.6,"AV",ZTDVOL,"")) .. D NEWJOB(ZTUCI,ZTDVOL,ZTNODE) .. Q . Q Q ; I4 ;job off a new submanager if the Job List still has tasks I $D(^%ZTSCH("JOB"))>9 D NEWJOB(%ZTUCI,%ZTVOL,"") Q ; I5 ;Clean up %ZTSCH S ZTDTH="0,0" F S ZTDTH=$O(^%ZTSCH(ZTDTH)) Q:ZTDTH'["," D . N ZTSK,X L +^%ZTSCH(ZTDTH):0 Q:'$T . S ZTSK=$O(^%ZTSCH(ZTDTH,0)) I ZTSK>0 S X=^(ZTSK),^%ZTSCH($$H3(ZTDTH),ZTSK)=X K ^%ZTSCH(ZTDTH,ZTSK) . L -^%ZTSCH(ZTDTH) . Q Q ; I6 ;Check on persistent jobs. S ZTSK=0 F S ZTSK=$O(^%ZTSCH("TASK",ZTSK)) Q:ZTSK'>0 D:$D(^%ZTSCH("TASK",ZTSK,"P")) . L +^%ZTSCH("TASK",ZTSK):0 E Q ;Still running . L -^%ZTSCH("TASK",ZTSK) . D REQP^%ZTLOAD3(ZTSK) ;START NEW TASK. K %ZTVS Q ; MON ;Set Next %ZTMON S %ZTMON=$P($H,",",2)\3600,%ZTMON(%ZTMON)=0 S %ZTMON("NEXT")=($H*86400)+(%ZTMON+1*3600) I %ZTMON("DAY")<+$H D MON^%ZTM5 Q ; NEWJOB(ZTUCI,ZTDVOL,ZTNODE) ;Start a new Job S ZTUCI=$G(ZTUCI),ZTDVOL=$G(ZTDVOL),ZTNODE=$G(ZTNODE) X %ZTJOB H %ZTSLO ;If job doesn't work, will catch next time. Q ; DIFF(N,O,T) ;Diff in sec. Q:$G(T) N-O ;For new seconds times Q N-O*86400-$P(O,",",2)+$P(N,",",2) ; OOS(BV) ;Check if Box-Volume is Out Of Service, Return 1 if OOS. Q:BV="" 0 N % S %=$O(^%ZIS(14.7,"B",BV,0)),%=$G(^%ZIS(14.7,+%,0)) Q:%="" 1 Q $P(%,U,11)=1 ; H3(%) ;Convert $H to seconds. Q 86400*%+$P(%,",",2) H0(%) ;Covert from seconds to $H Q (%\86400)_","_(%#86400) SUBOK() ;Check if sub's are starting, return 1 if OK S ^%ZTSCH("SUB",%ZTPAIR,0)=($G(^%ZTSCH("SUB",%ZTPAIR,0))+1)_"^"_$H Q ^%ZTSCH("SUB",%ZTPAIR,0)<10 ; NEWSUB() ;See if we need a new submanager N SUBS L +^%ZTSCH("SUB",%ZTPAIR):0 S SUBS=^%ZTSCH("SUB",%ZTPAIR) L -^%ZTSCH("SUB",%ZTPAIR) I SUBS<%ZTPFLG("MINSUB") Q 1 Q 0 ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;NEW SUBROUTINE SUBU IS ADDED TO UPDATE THE ^%zmu GLOBAL WITH THE ;MAXIMUM NUMBER OF ACTIVE USERS AND MAXIMUM NUMBER OF ACTIVE JOBS ;ORIGINAL MODIFICATION BY IHS/MFD; REVISED FOR CACHE & MOVED TO ^%zmu ;BY IHS/MFD 2/23/01 ;ALSO REVISED BY IHS/DSD/AEF 10/18/02 SUBU ; N X,Y S X=$S($$VERSION^%ZOSV(1)["MSM":$$ACTUSERS^%SI,1:0),Y=$$ACTJ^%ZOSV I '$D(^%zmu) S ^%zmu="" S $P(^%zmu,"^")=$S($P($G(^%zmu),"^")9 D IOWAIT K X,Y Q ; IOWAIT ;If Device has a queue, Put Task On IO Queue. S %ZTREJCT=1,$P(^%ZTSK(ZTSK,.1),U,1,3)="A^"_$H_U S %ZTIO=IO,ZTIOS=ZTREC21,ZTIOT=IOT D NQ^%ZTM4 Q ; REJCT(MSG) ;Save reject msg, set flag S %ZTREJCT=1,$P(ZTREC1,U,3)=MSG I $G(DUZ)>.9 D . N XQA,XQAMSG,XQADATA,XQAROU,ZTUCI . S XQA(DUZ)="",XQAMSG="Your task #"_ZTSK_" rejected because: "_MSG,XQADATA=ZTSK,XQAROU="XQA^XUTMUTL" . S ZTUCI=$P($P(ZTREC,U,4),","),ZTUCI=$S(ZTUCI]"":ZTUCI,1:$P(ZTREC,U,11)) . N ZTSK,ZTIO,ZTDTH,ZTCPU,ZTREC . S ZTRTN="ALERT^%ZTMS4",ZTDTH=$H,ZTIO="",ZTSAVE("XQA*")="" . D ^%ZTLOAD Q Q ZTM2 %ZTM2 ;SEA/RDS-TaskMan: Manager, Part 4 (Link Handling 1) ;2/12/96 08:39 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,118**;JUL 10, 1995 ; XLINK ;SEND^%ZTM--determine routing of XCPU task S ZTJOBIT=0 S ZTI=$O(^%ZIS(14.5,"B",ZTDVOL,"")) S ZTS=^%ZIS(14.5,ZTI,0) I $P(ZTS,U,4)="Y" G DOWN S ZTM=$P(ZTS,U,6) S ZTN=$P(ZTS,U,7) I ZTN S ZTN=$P(^%ZIS(14.5,ZTN,0),U) I ZTN="" S ZTN=ZTDVOL I ZTN=%ZTVOL S ZTJOBIT=1 Q I $D(^%ZTSCH("LINK",ZTDVOL)) G DOWN I ZTYPE="C" S ZTJOBIT=1 Q ; OCPU ;XLINK--send task to manager on another volume set S X="EROCPU^%ZTM2",@^%ZOSF("TRAP") I '$D(^[ZTM,ZTN]%ZTSCH("RUN")) S ZTT=$H G O1 S ZTT=^[ZTM,ZTN]%ZTSCH("RUN") ; O1 L +^[ZTM,ZTN]%ZTSK(-1):5 S ZTS=^[ZTM,ZTN]%ZTSK(-1)+1 F ZT=0:0 Q:'$D(^[ZTM,ZTN]%ZTSK(ZTS)) S ZTS=ZTS+1 S ^[ZTM,ZTN]%ZTSK(-1)=ZTS ; L -^[ZTM,ZTN]%ZTSK(-1),+^[ZTM,ZTN]%ZTSK(ZTS) S $P(^%ZTSK(ZTSK,.1),U,1,3)=1_U_ZTT_U S %X="^%ZTSK(ZTSK,",%Y="^[ZTM,ZTN]%ZTSK(ZTS," D %XY^%RCR ;Now schedule task. S $P(^[ZTM,ZTN]%ZTSK(ZTS,0),U,6)=ZTT,^[ZTM,ZTN]%ZTSCH($$H3^%ZTM(ZTT),ZTS)="" L -^[ZTM,ZTN]%ZTSK(ZTS) ; S X="",@^%ZOSF("TRAP") K ^%ZTSK(ZTSK,.3) S ^%ZTSK(ZTSK,.1)="6^"_$H_"^Moved to "_ZTM_","_ZTN_" as task number "_ZTS K ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTR,ZTS,ZTT,ZTREP Q ; EROCPU ;OCPU--trap dropped link and reroute task S X="",@^%ZOSF("TRAP") I $D(^%ZTSCH("LINK"))[0 S ^("LINK")=$H S ^%ZTSCH("LINK",ZTDVOL)=1 ; DOWN ;XLINK/EROCPU--reroute XCPU task whose link is down D REQRD I $D(ZTREQUIR) G ORIGNL I ZTIO]"",$D(IOCPU)#2,IOCPU]"" G LIST S ZTREP(ZTDVOL)="" S ZTREP=$P(^%ZIS(14.5,ZTI,0),U,8) I ZTREP S ZTREP=$P(^%ZIS(14.5,ZTREP,0),U) I ZTREP="" G ORIGNL I $D(ZTREP(ZTREP))#2 G ORIGNL D1 ; I $D(^%ZTSK(ZTSK,.01))[0 S ^%ZTSK(ZTSK,.01)=ZTUCI_U_ZTDVOL S Y=$O(^%ZIS(14.6,"AT",ZTUCI,ZTDVOL,ZTREP,"")) I Y="" S Y=ZTUCI S ZTUCI=Y,ZTDVOL=ZTREP I ZTDVOL=%ZTVOL S X=ZTUCI_","_ZTDVOL X ^%ZOSF("UCICHECK") S:0'[Y ZTUCI=Y I 0[Y S %ZTREJCT=1 S $P(^%ZTSK(ZTSK,.02),U)=ZTUCI I ZTDVOL'=%ZTVOL S $P(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL E S $P(^%ZTSK(ZTSK,.02),U,2)="" I %ZTREJCT S $P(^%ZTSK(ZTSK,.1),U,1,3)="B^"_$H_"^BAD DESTINATION UCI" Q I ZTDVOL=%ZTVOL G SEND^%ZTM G XLINK ; REQRD ;DOWN--is dropped link required? S ZTI=$O(^%ZIS(14.5,"B",ZTDVOL,"")) I ZTI="" Q I $D(^%ZIS(14.5,ZTI,0))#2 S ZTS=^(0) E Q I $P(ZTS,U,5)="Y" S ZTREQUIR=ZTDVOL Q ; ORIGNL ;DOWN--give up trying to reroute; make it wait for original destination I $D(^%ZTSK(ZTSK,.01))[0 G LIST S ZTORIGNL=^%ZTSK(ZTSK,.01) S ZTUCI=$P(ZTORIGNL,U) S ZTDVOL=$P(ZTORIGNL,U,2) S $P(^%ZTSK(ZTSK,.02),U)=ZTUCI I ZTDVOL'=%ZTVOL S $P(^%ZTSK(ZTSK,.02),U,2)=ZTDVOL E S $P(^%ZTSK(ZTSK,.02),U,2)="" ; LIST ;DOWN/ORIGNL--place task on waiting list for down volume I $D(^%ZTSCH("LINK"))[0 S ^("LINK")=$H I ZTYPE'="C" S ^%ZTSCH("LINK",ZTDVOL,ZTDTH,ZTSK)="" E D .S ^%ZTSCH("LINK",ZTDVOL)=1 .L +^%ZTSCH("C",ZTDVOL):5 .S ^%ZTSCH("C",ZTDVOL,ZTDTH,ZTSK)="" .L -^%ZTSCH("C",ZTDVOL) .Q S $P(^%ZTSK(ZTSK,.1),U,1,3)="G^"_$H_U L K ZT,ZT1,ZTD,ZTI,ZTM,ZTN,ZTORIGNL,ZTR,ZTS,ZTT,ZTREP Q ; ERCL ;I2^%ZTM - error in C list Q:$$OOS^%ZTM(ZTVOL) N % S %=$O(^%ZIS(14.7,"B",ZTVOL,0)) I %>0 S $P(^%ZIS(14.7,%,0),U,11)=1 Q LKUP(VS) ;Lookup a VS and place in ZTVS N %,%1 S %=$O(^%ZIS(14.5,"B",VS,0)),%1=$G(^%ZIS(14.5,+%,0)) S %ZTVS(VS)=%1,%ZTVS(VS,"IFN")=% Q ZTM4 %ZTM4 ;SEA/RDS-TaskMan: Manager, (Waiting List) ;06/19/2000 09:32 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**1,118,127,162**;Jul 03, 1995 ; ;^%ZTSK(ZTSK) must be locked before call NQ ;enter a task on the busy device waiting lists N ZT,ZT1,ZT2,ZT3,ZT4,ZT5,ZTHG,ZTI K ^%ZTSK(ZTSK,.26) S ZTHG="" ;L +^%ZTSCH("IO") I ZTIOT'="HG" D I ZTIO(1)="DIRECT" G NQX . I $D(^%ZTSCH("IO",%ZTIO))[0 S ^(%ZTIO)=ZTIOT . S ^%ZTSK(ZTSK,.26,%ZTIO)="",^%ZTSCH("IO",%ZTIO,ZTDTH,ZTSK)="" . I (ZTIO(1)="DIRECT")!('$D(^%ZIS(1,"AHG",ZTIOS))) Q . S ZT2="" . F S ZT2=$O(^%ZIS(1,"AHG",ZTIOS,ZT2)) Q:ZT2="" D NAME,ADD . Q I ZTIOT="HG" S ZT2=ZTIOS D ADD I ZTHG]"" S ^%ZTSK(ZTSK,.26)=ZTHG NQX Q ; NAME ;NQ--save name of hunt group S ZTS=$G(^%ZIS(1,ZT2,0)) S ZTN=$P(ZTS,U) I ZTN="" Q I ZTHG="" S ZTHG=ZTN Q S ZTHG=ZTHG_","_ZTN Q ; ADD ;NQ--add the devices in this hunt group to the list the task waits for N ZTI,ZT5 S ZT5="" F S ZT5=$O(^%ZIS(1,ZT2,"HG","B",ZT5)) Q:ZT5="" D .S ZTI=$P($G(^%ZIS(1,ZT5,0)),U,2) ;Get $I .I ZTI="" Q .I $D(^%ZTSCH("IO",ZTI))[0 S ^%ZTSCH("IO",ZTI)=$P($G(^%ZIS(1,ZT5,"TYPE")),"^") ;Get type .S ^%ZTSCH("IO",ZTI,ZTDTH,ZTSK)="",^%ZTSK(ZTSK,.26,ZTI)="" Q ; DQ ;Remove A Task From The Busy Device Waiting Lists, TASK is LOCKED N ZT,ZT1,ZTL K ^%ZTSCH("IO",%ZTIO,ZTDTH,ZTSK) S ZT1="" F S ZT1=$O(^%ZTSK(ZTSK,.26,ZT1)) Q:ZT1="" K ^%ZTSCH("IO",ZT1,ZTDTH,ZTSK) K ^%ZTSK(ZTSK,.26) Q ; KILL ;POST^%ZTMS4, Call To Delete A Task And Unschedule It Completely ;As long as ^%ZTSK(ZTSK) is locked we can remove any reference. N ZTDTH I $D(^%ZTSK(ZTSK,0))[0 K ^%ZTSK(ZTSK) Q ;No task to work on. S ZTDTH=$G(^%ZTSK(ZTSK,.04)) S:ZTDTH="" ZTDTH=$$H3^%ZTM($P(^%ZTSK(ZTSK,0),U,6)) I %ZTIO]"",$D(^%ZTSK(ZTSK,0))#2,$P(^(0),U,6)]"" D DQ K ^%ZTSK(ZTSK) N ZT,ZT1,ZT2 D US Q ; US ;Un-Schedule a task from all lists ;S ZT1="" F S ZT1=$O(^%ZTSCH("JOB",ZT1)) Q:ZT1="" I $D(^(ZT1,ZTSK)) K ^(ZTSK) ;S ZT1="" F S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 I $D(^(ZT1,ZTSK)) K ^(ZTSK) K ^%ZTSCH(ZTDTH,ZTSK),^%ZTSCH("JOB",ZTDTH,ZTSK) S ZT1="" F S ZT1=$O(^%ZTSCH("C",ZT1)) Q:ZT1="" K ^%ZTSCH("C",ZT1,ZTDTH,ZTSK) ;Any others?? Q ZTM5 %ZTM5 ;SEA/RDS-TaskMan: Manager, Part 5 (Short Subroutines) ;06/19/2000 13:27 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,36,118,127,136,162**;JUL 10, 1995 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY TASSC/MFD ; ER ;primary error trap for manager S %ZTERLGR=$$LGR^%ZOSV S $ETRAP="D ER2^%ZTM5" L S ^%ZTSCH("RUN")=$H S ^%ZTSCH("STATUS",$J)=$H_"^ERROR^Recording A Trapped Error." ; S ZTERCODE=$$EC^%ZOSV,ZTE="" I '$$SCREEN^%ZTER(ZTERCODE) D . L ^%ZTSCH("ER") H 1 S ZT=$H . S ^%ZTSCH("ER",+ZT,$P(ZT,",",2))=ZTERCODE . S ^($P(ZT,",",2),1)="Caused by the manager." L . Q ; D ^%ZTER K ZTERCODE ;Lets wait before restarting. ER2 H 10 S $ET="Q:$STACK S $EC="""" G RESTART^%ZTM0" S $EC=",U99," ; UPDATE ;CHECK^%ZTM/LOOKUP^%ZTM0--update TaskMan site parameters L ^%ZTSCH("UPDATE",$J) S %ZTOS=^%ZOSF("OS"),U="^" D GETENV^%ZOSV S %ZTUCI=$P(Y,U),%ZTVOL=$P(Y,U,2),%ZTNODE=$P(Y,U,3),%ZTPAIR=$P(Y,U,4) S %ZTVSN=+$O(^%ZIS(14.5,"B",%ZTVOL,"")),%ZTVSS=$G(^%ZIS(14.5,%ZTVSN,0)) S %ZTVLI=($P(%ZTVSS,U,2)="Y") ;Did site set Inhibit. S %ZTYPE("V")=$P(%ZTVSS,U,10) ;get vol set type U1 ; S %ZTPN=+$O(^%ZIS(14.7,"B",%ZTPAIR,"")),%ZTPS=$G(^%ZIS(14.7,%ZTPN,0)) S %ZTPT=+$P(%ZTPS,U,4) S %ZTSIZ=+$P(%ZTPS,U,5) ;par size I '%ZTSIZ,%ZTOS'["VAX DSM",%ZTOS["DSM" S %ZTSIZ=32 S %ZTRET=+$P(%ZTPS,U,6) S %ZTVMJ=+$P(%ZTPS,U,7) ;TM job limit S %ZTSLO=+$P(%ZTPS,U,8) ;TM slow down S %ZTYPE=$P(%ZTPS,U,9),%ZTPFLG("DCL")=$P(%ZTPS,U,10) ;TM mode, VAX DCL S %ZTPFLG("BAL")=$E($G(^%ZIS(14.7,%ZTPN,2)),1,40) S %ZTPFLG("MINSUB")=$S($P(%ZTPS,U,12):$P(%ZTPS,U,12),1:1) S %ZTPFLG("LBT")=0,%ZTPFLG("BI")=$S($P(%ZTPS,U,14):$P(%ZTPS,U,14),1:30) ;Balance Interval ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THIS LINE IS COMMENTED OUT AND REPLACED BY THE LINE BELOW TO CHANGE ;THE TASKMAN STARTUP DELAY TO 10 SECONDS TO WORK ON CACHE. ;ORIGINAL MODIFICATION BY TASSC/MFD ;S %ZTPFLG("TM-DELAY")=$P($G(^%ZIS(14.5,%ZTVSN,3),"^60"),U,2) S %ZTPFLG("TM-DELAY")=$P($G(^%ZIS(14.5,%ZTVSN,3),"^10"),U,2) ;----- END IHS MODIFICATION S %ZTPFLG("START")=+$H S ^%ZTSCH("UPDATE",$J)=$H S %ZTMON("DAY")=+$H D MON^%ZTM K ^%ZTSCH("LOADA",%ZTPAIR) ;Clear LB in case we stop doing LB. L I "GP"'[%ZTYPE D HALT . K ^%ZTSCH("STATUS") . S ^%ZTSCH("RUN")=%ZTNODE_" is the wrong type of volume set for TaskMan." . Q Q ; MON ;Save off the monitor data N X S X="" F I=0:1:23 S X=X_$G(%ZTMON(I))_"^",%ZTMON(I)=0 S ^%ZTSCH("MON",%ZTPAIR,%ZTMON("DAY"))=X S %ZTMON("DAY")=+$H Q ; REQUIR ;UPDATE/CHECK^%ZTM--ensure required links are available K ZTREQUIR N ZT1,ZTN,ZTS,ZTU S ZT1=0 F S ZT1=$O(^%ZIS(14.5,ZT1)) Q:'ZT1 I $D(^%ZIS(14.5,ZT1,0))#2 S ZTS=^(0) I $P(ZTS,U,5)="Y" D TEST I $D(ZTREQUIR)#2 Q K ZT,ZT1,ZTN,ZTS,ZTU Q ; TEST ;REQUIR--test a required volume set N $ET,$ES,NULL S ZTN=$P(ZTS,U),NULL="" I ZTN="" Q I ZTN=%ZTVOL Q I $P(ZTS,U,3)="N" S ZTREQUIR=ZTN Q I $P(ZTS,U,4)="Y" S ZTREQUIR=ZTN Q S ZTU=$O(^%ZIS(14.6,"AV",ZTN,"")) I ZTU="" Q S $ET="S ZTREQUIR=ZTN,$EC=NULL Q" S X=$D(^[ZTU,ZTN]DIC(0)) L +^%ZTSCH("LINK",ZTN) I $D(^%ZTSCH("LINK",ZTN)) S ^%ZTSCH("LINK")=0 L -^%ZTSCH("LINK",ZTN) Q ; LINK(ZTVOL) ;internal Kernel extrinsic function ;input--volume set where task should run ;output--UCI,volume set where record must be created ;after call check 1--if value is "", the input or file is bad ;after call check 2--if $P(value,",",2) is current volume set then ;...no extended reference should be used ; L0 ;was a volume set passed in? N ZTN,ZTU,ZTV,ZTVD,ZTVN I $G(ZTVOL)'?2.7U Q "" ; L1 ;is this volume set on file? S ZTVN=$O(^%ZIS(14.5,"B",ZTVOL,"")) I ZTVN="" Q "" I $D(^%ZIS(14.5,ZTVN,0))[0 Q "" S ZTVD=^%ZIS(14.5,ZTVN,0) ; L2 ;is there a TaskMan Files Volume Set? if not, skip next section S ZTN=$P(ZTVD,"^",7) I ZTN="" S ZTV=ZTVOL G L4 ; L3 ;if there is a separate TaskMan Files Volume Set, is it on file? I $D(^%ZIS(14.5,ZTN,0))[0 Q "" S ZTVD=^%ZIS(14.5,ZTN,0) S ZTV=$P(ZTVD,"^") I ZTV="" Q "" ; L4 ;if there is a TaskMan Files UCI, return UCI,volume set S ZTU=$P(ZTVD,"^",6) I ZTU="" Q "" Q ZTU_","_ZTV ; ; INHIBIT(Y) ;Set/Clear the Inhibit logon field I Y=1 S $P(^%ZIS(14.5,%ZTVSN,0),U,2)="S",^%ZIS(14.5,"LOGON",%ZTVOL)=1 Q I Y=0 S $P(^%ZIS(14.5,%ZTVSN,0),U,2)="N" K ^%ZIS(14.5,"LOGON",%ZTVOL) Q Q ZTM6 %ZTM6 ;SEA/RDS-TaskMan: Manager, Part 8 (Load Balancing) ;03/27/2000 13:42 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**23,118,127,136**;JUL 10, 1995 ; BALANCE ;CHECK^%ZTM--determine whether cpu should wait for balance ;Return ZTOVERLD =1 if need to wait, 0 to run ;The TM with the largest value sets ^%ZTSCH("LOAD",value)=who^when ;If your value is greater or equal then you run. ;If your value is less you wait unless you set LOAD then you run. L +^%ZTSCH("LOAD"):5 N X,ZTIME,ZTLEFT,ZTPREV N $ES,$ET S $ET="Q:$ES>0 D ER^%ZTM6" S ZTOVERLD=0,ZTPREV=+$O(^%ZTSCH("LOAD",0)),@("ZTLEFT="_%ZTPFLG("BAL")) S ZTIME=$$H3($H),ZTOVERLD=$$COMPARE(%ZTPAIR,ZTLEFT,ZTPREV) ;If we are RUNNING have other submanagers wait I 'ZTOVERLD D . S X="" F S X=$O(^%ZTSCH("LOADA",X)) Q:X="" S $P(^(X),"^")=1 . K ^%ZTSCH("LOAD") S ^("LOAD",ZTLEFT)=%ZTPAIR_"^"_ZTIME ;Now set a value that is used by our %ZTMS to run/wait also S ^%ZTSCH("LOADA",%ZTPAIR)=ZTOVERLD_"^"_ZTLEFT_"^"_ZTIME_"^"_$J L -^%ZTSCH("LOAD") Q ; STOPWT() ;See if we should stop Balance wait L +^%ZTSCH("LOAD"):0 Q:'$T 0 ;Keep waiting if can't get lock N I,J S I="",J=1 F S I=$O(^%ZTSCH("LOADA",I)) Q:I="" I '^(I) S J=0 L -^%ZTSCH("LOAD") Q J ;Return: stop waiting 1, keep waiting 0. ; CHECK ;Called when job limit reached. ;If not doing balancing, remove node and quit N I,J I %ZTPFLG("BAL")="" K ^%ZTSCH("LOADA",%ZTPAIR) Q L +^%ZTSCH("LOAD"):0 Q:'$T ;Get it next time S I=$O(^%ZTSCH("LOAD",0)),J=$G(^%ZTSCH("LOADA",%ZTPAIR)) S I=$P(J,"^",2)4.0,$P($ZVER,"/",2)<4.3 VIEW 1:296:$C(2) ;increase name table allocation ;I ZZSWITCH 256 ;display current namespace ; START ;Start Taskmanager D INIT S ZTMB="START" ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;NEW LINE ADDED TO START UP ON CACHE BY TASSC/MFD I ZTOS["OpenM" J START^%ZTM0:ZTUCI Q ;----- END IHS MODIFICATION I ZTOS["M/SQL-PDP" J START^%ZTM0:ZTUCI Q I ZTOS["DTM" G DTM I ZTOS'["VAX DSM" J START^%ZTM0[ZTUCI] Q I ZTOS["VAX DSM" G VXD W !,"TASKMAN NOT STARTED" Q VXD X "S %=($ZC(%GETJPI,$J,""CURPRIV"")[""SHARE"")" I % W !,"Don't start TaskMan with the SHARE privilege" Q S Z=0,%=$O(^%ZIS(14.7,"B",ZTPAIR,0)),ZTMODE=$P($G(^%ZIS(14.7,+%,0)),U,10) VXD2 I Z,$$EC^%ZOSV["access not authorized"!($$EC^%ZOSV["no privilege") W !!,"You lack the system privilege to start TaskMan." H 2 Q I Z,$$EC^%ZOSV'["duplicate name" W !!,"The following error has prevented TaskMan from starting:",!,$$EC^%ZOSV H 2 Q S X="VXD2",@^%ZOSF("TRAP"),Z=Z+1 I ZTMODE="" S %=ZTMB_"^%ZTM0:(OPTION=""/UCI=""_ZTUCI,NAME=""TaskMan ""_$E(^%ZOSF(""VOL""),1,3)_"" ""_Z)" J @% Q ;Remove the '/NOLOG' if you want a log file for trouble shouting I ZTMODE]"" S %SPAWN="SUBMIT/NOPRINT/NOLOG/USER=TASKMAN/QUEUE=TM$"_ZTNODE_" DHCP$TASKMAN:ZTMWDCL/PARAM=("_ZTMODE_","_(ZTMB["RE")_")" D ^%SPAWN Q ; DTM I ZTMB="START" D NULLDEV F DEV=10:1:19 O DEV:("W":NULLDEV):0 C DEV S Z=0 DTM2 S X="DTM2",@^%ZOSF("TRAP"),Z=Z+1,%=ZTMB_"^%ZTM0:(NSPACE="""_ZTUCI_""":STRSTK=8000:LVMEM=12000:NAME=""TaskMan "_$E(^%ZOSF("VOL"),1,3)_" "_Z_""")" J @% Q ; RESTART ;Restart Taskmanager D INIT I $D(^%ZOSF("SIGNOFF")) X ^("SIGNOFF") I W *7,!,"NOTE THAT THE SYSTEM IS IN A 'SIGNOFF' STATE,",!?4,"WHICH PROBABLY EXPLAINS WHY TASKS ARE NOT RUNNING!!",! S ZTMULT=0 I $S($D(^%ZTSCH("RUN"))[0:0,^("RUN")-$H:0,1:$P($H,",",2)-150'>$P(^("RUN"),",",2)) W !,"TASKMAN IS ALREADY RUNNING" S ZTMULT=1 I ZTOS["VAX DSM" I $ZC(%GETJPI,$J,"CURPRIV")["SHARE" W !,"Don't start TaskMan with the SHARE privilege" Q F %ZTI=0:0 W !,"ARE YOU SURE YOU WANT TO RESTART ",$S(ZTMULT:"ANOTHER ",1:""),"TASKMAN? NO//" R %Y:$S($D(DTIME)#2:DTIME,1:60) S:'$T %Y="^" W:'$T "*TIMEOUT*" Q:"YESyes^NOno"[%Y W:%Y'["?" *7 D HELP1:%Y'["??",HELP2:%Y["??" I %Y=""!("YESyes"'[%Y) W " (NO)",!,*7,"",! Q W " (YES)",!,"Restarting..." S ZTMB="RESTART" ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;NEW LINE ADDED TO START UP ON CACHE BY TASSC/MFD I ZTOS["OpenM" J START^%ZTM0:ZTUCI Q ;----- END IHS MODIFICATION I ZTOS["M/SQL-PDP" J RESTART^%ZTM0:ZTUCI D DONE Q I ZTOS["DTM" G DTM I ZTOS'["VAX DSM" J RESTART^%ZTM0[ZTUCI] D DONE Q I ZTOS["VAX DSM" G VXD W !,"TASKMAN NOT RESTARTED" Q INIT S U="^",ZTOS=^%ZOSF("OS"),ZTUCI=$P(^%ZOSF("MGR"),",") D GETENV^%ZOSV S ZTVOL=$P(Y,U,2),ZTNODE=$P(Y,U,3),ZTPAIR=$P(Y,U,4) ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;NEW SUBROUTINE IHS ADDED TO CHECK FOR ROOT STARTING TM ;ORIGINAL MODIFICATION BY TASSC/MFD TO CHECK FOR ROOT USER IHS ; I $$VERSION^%ZOSV(1)["UNIX" D .S X=$$JOBWAIT^%HOSTCMD("sar -u 1 1 >/dev/null 2>&1") .I X W !,"CANNOT START TASKMAN- You must be the root user" HALT ;----- END IHS MODIFICATION Q ; NULLDEV ;SELECT NULL DEVICE (DTM OS Dependent) D HWTYPE S NULLDEV="NUL" I %HW'="PC" S NULLDEV="[NUL]" K %HW,%HW Q ; HWTYPE ;HARDWARE TYPE(DTM OS Dependent) K %HW S %H=$S($P($ZVER,"/",2)<4:$V(4,3,-1),1:$V(1,3,-1)) ;get hardware type number S %HW=$S(%H<10:"WS",%H<20:"MF",%H<64:"?",%H<129:"PC",1:"?") Q ; HELP1 ;RESTART--improved help for the confirmation prompt. W !!?5,"Answer must be YES or NO." W !?5,"Answer YES to restart ",$S(ZTMULT:"another ",1:""),"TaskMan.",! Q ; HELP2 ;RESTART--??-help for confirmation prompt W !!?5,"TaskMan must be running in each library uci on the system for tasks to run." W !?5,"One TaskMan per library uci should be enough for all but the busiest sites." W !?5,"The System Status option and the Monitor TaskMan option can help determine" W !?5,"whether a TaskMan is running on this volume set." W !!?5,"If you are still uncertain how to respond, answer NO and consult your" W !?5,"documentation or your support ISC.",! Q ; DONE ;RESTART--feedback after restarting TaskMan W "TaskMan restarted!",! Q ; ZTMCHK ZTMCHK ;SEA/RDS-Taskman: Option, ZTMCHECK, Part 1 ;01/12/95 08:12 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;;Jul 10, 1995 ; N ZTF,ZTJ,ZTN,ZTOS,ZTPAIR,ZTPN,ZTPS,ZTPT,ZTRET,ZTS,ZTSIZ,ZTSLO,ZTV,ZTVLI,ZTVMJ,ZTVOL,ZTVSN,ZTVSS,ZTX,DTOUT,DUOUT,X,Y CHECK ;Main Entry Point For Environment Check S U="^",%ZIS="",IOP="HOME" D ^%ZIS W @IOF,!!,"Checking Task Manager's Environment." ; GLOB ;Checking Task Manager's Globals W !!,"Checking Taskman's globals..." F ZT="^%ZTSCH","^%ZTSK","^%ZTSK(-1)","^%ZIS(14.5,0)","^%ZIS(14.6,0)","^%ZIS(14.7,0)" D . W !?5,ZT," is ",$S($D(@ZT):"",1:"not "),"defined!" W:'$D(@ZT) $C(7) . Q ; NODES ;Check Required %ZOSF Nodes W !!,"Checking the ^%ZOSF nodes required by Taskman..." S ZTF=1 F ZTN="ACTJ","AVJ","MAXSIZ","MGR","OS","PROD","TRAP","UCI","UCICHECK","VOL" D . I $D(^%ZOSF(ZTN))[0 W !?5,"^%ZOSF('",ZTN,"') is missing!",$C(7) S ZTF=0 . Q I 'ZTF K ZTF,ZTN Q W !?5,"All ^%ZOSF nodes required by Taskman are defined!" ; D LOOKUP CONT ;program is continued in ZTMCHK1 G ^ZTMCHK1 ; LOOKUP ;lookup TaskMan site parameters N Y D GETENV^%ZOSV S ZTVOL=$P(Y,U,2),ZTPAIR=$P(Y,U,4) S ZTOS=^%ZOSF("OS") S ZTVSN=$O(^%ZIS(14.5,"B",ZTVOL,"")) S ZTVSS=$G(^%ZIS(14.5,+ZTVSN,0)) S ZTVLI=$P(ZTVSS,U,2) ; S ZTPN=$O(^%ZIS(14.7,"B",ZTPAIR,"")),ZTPS=$G(^%ZIS(14.7,+ZTPN,0)) S ZTPT=$P(ZTPS,U,4),ZTSIZ=+$P(ZTPS,U,5) I 'ZTSIZ,ZTOS'["VAX DSM",ZTOS["DSM" S ZTSIZ=32 S ZTRET=+$P(ZTPS,U,6),ZTVMJ=+$P(ZTPS,U,7),ZTSLO=+$P(ZTPS,U,8) Q ; PARAMS ; N ZTF,ZTJ,ZTN,ZTOS,ZTPAIR,ZTPN,ZTPS,ZTPT,ZTRET,ZTS,ZTSIZ,ZTSLO,ZTV,ZTVLI,ZTVMJ,ZTVOL,ZTVSN,ZTVSS,ZTX,DTOUT,DUOUT,X,Y D LOOKUP,INFO^ZTMCHK1 Q ZTMCHK1 ZTMCHK1 ;SEA/RDS-Taskman: Option, ZTMCHECK, Part 2 ;04/19/99 15:25 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**127**;Jul 10, 1995 ; LINKS ;Check Required Volume Sets' Links W !!,"Checking the links to the required volume sets..." S (ZTJ,ZTV)=0 L0 S X="ERLINKS",@^%ZOSF("TRAP") F S ZTV=$O(^%ZIS(14.5,ZTV)) Q:'ZTV S ZTS=$P(^(ZTV,0),U) I $P(^(0),U,5)="Y",ZTS'=ZTVOL D . S ZTJ=ZTJ+1,ZTX=ZTS D MGR S ZTX=$D(^[Y,ZTS]%ZOSF("PROD")) W !?5,"The link to volume set ",ZTS," is present!" . Q S X="",@^%ZOSF("TRAP") I 'ZTJ W !?5,"There are no volume sets whose links are required!" W !!,"Checks completed...Taskman's environment is okay!" ; EOP ;Pause at end of page W ! S Y="" F ZT=0:0 R !,"Press RETURN to continue or '^' to exit: ",Y:$S($D(DTIME)#2:DTIME,1:60) S:'$T DTOUT="" S:Y="^" DUOUT="" Q:Y=""!(Y="^") W !!,"Enter either RETURN or '^'",! W:Y'["?" $C(7) I $D(DUOUT)!$D(DTOUT) W:$D(DTOUT) $C(7) G EXIT ; INFO ;Display Task Manager's Information W @IOF,!!,"Here is the information that Taskman has:" W !?5,"Operating System: ",$P(ZTOS,U) W !?5,"Volume Set: ",ZTVOL W !?5,"Cpu-volume Pair: ",ZTPAIR W !?5,"TaskMan Files UCI and Volume Set: ",$P(ZTVSS,U,6),"," S X=$P(ZTVSS,U,7) W $S(X="":ZTVOL,$D(^%ZIS(14.5,X,0))[0:ZTVOL,$P(^(0),U)="":ZTVOL,1:$P(^(0),U)) K X W !!?5,"Log Tasks? ",$P(ZTPS,U,3) W !?5,"Default Task Priority: ",ZTPT I ZTOS["DSM"&(ZTOS'["VAX"),ZTSIZ]"" W !?5,"Task Partition Size: ",ZTSIZ W !?5,"Submanager Retention Time: ",ZTRET W !?5,"Min Submanager Count: ",$P(ZTPS,U,12) W !?5,"Taskman Hang Between New Jobs: ",ZTSLO W !?5,"TaskMan running as a type: ",$P("^COMPUTE^PRINT^GENERAL^","^",$F("CPG",$P(ZTPS,U,9))) I $P(ZTPS,U,10)]"" W !?5,"TaskMan is using VAX DSM enviroment: ",$P(ZTPS,U,10) I $G(^%ZIS(14.7,+ZTPN,2))]"" W !?5,"TaskMan is using '",^(2)," for load balancing" ; STATUS ;Display Task Manager's Status-Related Information W !!?5,"Logons Inhibited?: ",ZTVLI W !?5,"Taskman Job Limit: ",ZTVMJ I $D(^XTV(8989.3,0)) S %=$O(^XTV(8989.3,1,4,"B",ZTVOL,0)) W !?5,"Max sign-ons: ",$P($G(^XTV(8989.3,1,4,+%,0)),U,3) X ^%ZOSF("ACTJ") W !?5,"Current number of active jobs: ",Y ; DONE ;Prompt To Continue And Quit W ! R !,"End of listing. Press RETURN to continue: ",Y:$S($D(DTIME)#2:DTIME,1:60) S:'$T DTOUT="" S:Y="^" DUOUT="" EXIT Q ; MGR ;LINKS--lookup name of another volume set's library uci S Y=ZTX I Y]"" S Y=$O(^%ZIS(14.5,"B",Y,"")) I Y]"" S Y=$S($D(^%ZIS(14.5,Y,0))#2:$P(^(0),U,6),1:"") I Y="" S Y=$P($P(^%ZIS(14.5,ZTVSN,0),U,6),",") Q ; ERLINKS ;Error Trap For LINKS Code W !?5,"The link to volume set ",ZTS," appears to be down!",$C(7) G L0 ; ZTMDCL ZTMDCL ;SFISC/RWF - Run Taskman with a DCL context. ;05/17/96 07:47 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24**;JUL 03, 1995 ;This assumes that TM was started with a DCL context. N QUEUE S QUEUE=$S(ZTNODE]"":ZTNODE,1:%ZTNODE) ;Use the next line if you want/need log files ;S %SPAWN="SUBMIT/NOPRINT/NOKEEP/QUEUE=TM$"_QUEUE_" ZTMSWDCL.COM/PARAM=("_%ZTPFLG("DCL")_","_ZTUCI_","_ZTDVOL_")" ;Use the next line if you don't need log files. S %SPAWN="SUBMIT/NOPRINT/NOLOG/QUEUE=TM$"_QUEUE_" ZTMSWDCL.COM/PARAM=("_%ZTPFLG("DCL")_","_ZTUCI_","_ZTDVOL_")" S %=$ZC(%SPAWN,%SPAWN) I 1 Q ZTMGRSET ZTMGRSET ;SF/RWF SET UP THE MGR ACCOUNT FOR THE SYSTEM ;03/30/2000 16:44 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**34,36,69,94,121,127,136**;Dec 30, 1993 ;THIS ROUTINE CONTAINS IHS MODIFICATION BY TASSC/MFD N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR S ZTMODE=0 A W !!,"ZTMGRSET Version ",$P($T(+2),";",3)," ",$P($T(+2),";",5),!,"HELLO! I exist to assist you in correctly initializing the MGR account",!,"or to update the current account." I $D(^%ZOSF("UCI")) X ^%ZOSF("UCI") I Y'["MG" W $C(7),!!,"THIS MAY NOT BE THE MANAGER UCI.",!," I think it is ",Y,". Should I continue anyway? N//" R X:120 G A:"YNyn"'[$E(X) Q:"Nn"[$E(X) S ZTOS=$$OS() I ZTOS'>0 W !,"Can't determine the OS type." Q I ZTMODE D I (PCNM<1)!(PCNM>999) W !,"Need a Patch number to load." Q . R !!,"Patch number to load: ",PCNM:120 Q:(PCNM<1)!(PCNM>999) . S SCR="I $P($T(+2^@X),"";"",5)?.E1P1"_$C(34)_PCNM_$C(34)_"1P.E" . Q ; K ^%ZOSF("MASTER"),^("SIGNOFF") ;Remove old nodes. DOIT W !!,"I will now rename a group of routines specific to your operating system." D @ZTOS,ALL,GLOBALS:'ZTMODE W !,"ALL DONE" Q ; RELOAD ;Reload any patched routines N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR S ZTMODE=1 G A Q OS() ;Select the OS N Y,X1,X S U="^",SCR="I 1" F I=1:1:20 S X=$T(@I) Q:X="" S OSMAX=I B S Y=0,ZTOS=0 I $D(^%ZOSF("OS")) D . S X1=$P(^%ZOSF("OS"),U),ZTOS=$$OSNUM W !,"I think you are using ",X1 W !,"Which MUMPS system should I install?",! F I=1:1:OSMAX W !,I," = ",$P($T(@I),";",3) W !,"System: " W:ZTOS ZTOS,"//" R X:300 S:X="" X=ZTOS I X<1!(X>OSMAX) W !,"NOT A VALID CHOICE" Q:X[U 0 G B Q X OSNUM() ;Return the OS number N I,X1,X2,Y S Y=0,X1=$P($G(^%ZOSF("OS")),"^") F I=1:1 S X2=$T(@I) Q:X2="" I X2[X1 S Y=I Q Q Y ALL W !!,"Now to load routines common to all systems." D TM,ETRAP,DEV,OTHER W !,"Installing ^%Z editor" D ^ZTEDIT I 'ZTMODE W !,"Setting ^%ZIS('C')" K ^%ZIS("C") S ^%ZIS("C")="G ^%ZISC" Q ; TM S %S="ZTLOAD^ZTLOAD1^ZTLOAD2^ZTLOAD3^ZTLOAD4^ZTLOAD5^ZTLOAD6^ZTLOAD7^ZTM^ZTM0^ZTM1^ZTM2^ZTM3^ZTM4^ZTM5^ZTM6^ZTMS^ZTMS0^ZTMS1^ZTMS2^ZTMS3^ZTMS4^ZTMS7^ZTMSH" S %D="%ZTLOAD^%ZTLOAD1^%ZTLOAD2^%ZTLOAD3^%ZTLOAD4^%ZTLOAD5^%ZTLOAD6^%ZTLOAD7^%ZTM^%ZTM0^%ZTM1^%ZTM2^%ZTM3^%ZTM4^%ZTM5^%ZTM6^%ZTMS^%ZTMS0^%ZTMS1^%ZTMS2^%ZTMS3^%ZTMS4^%ZTMS7^%ZTMSH" D MOVE Q ETRAP S %S="ZTER^ZTER1",%D="%ZTER^%ZTER1" D MOVE Q OTHER S %S="ZTPP^ZTP1^ZTPTCH^ZTRDEL^ZTMOVE",%D="%ZTPP^%ZTP1^%ZTPTCH^%ZTRDEL^%ZTMOVE" D MOVE ; Q DEV S %S="ZIS^ZIS1^ZIS2^ZIS3^ZIS5^ZIS6^ZIS7^ZISC^ZISP^ZISS^ZISS1^ZISS2^ZISTCP^ZISUTL" S %D="%ZIS^%ZIS1^%ZIS2^%ZIS3^%ZIS5^%ZIS6^%ZIS7^%ZISC^%ZISP^%ZISS^%ZISS1^%ZISS2^%ZISTCP^%ZISUTL" D MOVE Q RUM ;Build the routines for Capacity Management (CM) S %S="" I ZTOS=1 S %S="ZOSVKRV^ZOSVKSVE^ZOSVKSVS^ZOSVKSD" ;DSM I ZTOS=2 S %S="ZOSVKRM^ZOSVKSME^ZOSVKSMS^ZOSVKSD" ;MSM I ZTOS=3 S %S="ZOSVKRO^ZOSVKSOE^ZOSVKSOS^ZOSVKSD" ;OpenM S %D="%ZOSVKR^%ZOSVKSE^%ZOSVKSS^%ZOSVKSD" D MOVE Q ZOSF(X) ; X SCR I $T D @(U_X) Q 1 ;;VAX DSM(V6), VAX DSM(V7) S %S="ZOSVVXD^ZTBKCVXD^ZIS4VXD^ZISFVXD^ZISHVXD^XUCIVXD^ZISETVXD" D DES,MOVE S %S="ZOSV2VXD^ZTMDCL",%D="%ZOSV2^%ZTMDCL" D MOVE,RUM,ZOSF("ZOSFVXD") Q 2 ;;MSM-PC/PLUS, MSM for NT or UNIX W !,"- Use autostart to do ZTMB don't resave as STUSER." ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;IHS/OIRM/DSD/AEF/1/22/03 - THE LINE BELOW IS COMMENTED OUT AND ;REPLACED BY A NEW LINE TO SAVE IHS ROUTINE ZISHMNT INSTEAD OF ;ZISHMSM AS %ZISH ;S %S="ZOSVMSM^ZTBKCMSM^ZIS4MSM^ZISFMSM^ZISHMSM^XUCIMSM^ZISETMSM" S %S="ZOSVMSM^ZTBKCMSM^ZIS4MSM^ZISFMSM^ZISHMNT^XUCIMSM^ZISETMSM" ;----- END IHS MODIFICATION D DES,MOVE S %S="ZOSV2MSM",%D="%ZOSV2" D MOVE,RUM,ZOSF("ZOSFMSM") I $$VERSION^%ZOSV(1)["UNIX" S %S="ZISHMSU",%D="%ZISH" D MOVE Q 3 ;;OpenM for NT, Cache S %S="ZOSVONT^^ZIS4ONT^ZISFONT^ZISHONT^XUCIONT" D DES,MOVE S %S="ZISTCPS",%D="%ZISTCPS" D MOVE,RUM,ZOSF("ZOSFONT") Q 4 ;;Datatree, DTM-PC, DT-MAX S %S="ZOSVDTM^ZTBKCDTM^ZIS4DTM^ZISFDTM^ZISHDTM^XUCIDTM^ZISETDTM" D DES,MOVE S %S="ZOSV1DTM^ZTMB",%D="%ZOSV1^%ustart" D MOVE,ZOSF("ZOSFDTM") Q 5 ;;MVX,ISM VAX S %S="ZOSVMSQ^ZTBKCMSQ^ZIS4MSQ^ZISFMSQ^ZISHMSQ^XUCIMSQ^ZISETMSQ" D DES,MOVE S %S="ZTMB",%D="ZSTU" D MOVE,ZOSF("ZOSFMSQ") Q 6 ;;ISM (UNIX, Open VMS) S %S="ZOSVIS2^^ZIS4IS2^ZISFIS2^ZISHIS2^XUCIIS2^ZISETIS2" D DES,MOVE S %S="ZTMB",%D="ZSTU" D MOVE,ZOSF("ZOSFIS2") Q 10 ;;NOT SUPPORTED Q MOVE ; F %=1:1:$L(%D,"^") S X=$P(%S,U,%),Y=$P(%D,U,%) W !,"Routine: ",X I X]"",Y]"",$T(^@X)]"" X SCR I $T W ?20," Loaded, " B:X="ZOSVKRM" X "ZL @X ZS @Y" W ?20,"Saved as ",Y Q DES S %D="%ZOSV^%ZTBKC1^%ZIS4^%ZISF^%ZISH^%XUCI^ZISETUP" Q ; GLOBALS ;Set node zero of file #3.05 & #3.07 W !!,"Now, I will check your % globals." W ".........." F %="^%ZIS","^%ZISL","^%ZTER","^%ZUA" S:'$D(@%) @%="" S:$D(^%ZTSK(0))[0 ^%ZTSK(-1)=100,^%ZTSCH="" S Z1=$G(^%ZTSK(-1),-1),Z2=$G(^%ZTSK(0)) I Z1'=$P(Z2,"^",3) S:Z1'>0 ^%ZTSK(-1)=+Z2 S ^%ZTSK(0)="TASK'S^14.4^"_^%ZTSK(-1) S:$D(^%ZUA(3.05,0))[0 ^%ZUA(3.05,0)="FAILED ACCESS ATTEMPTS LOG^3.05^^" S:$D(^%ZUA(3.07,0))[0 ^%ZUA(3.07,0)="PROGRAMMER MODE LOG^3.07^^" ;----- BEGIN IHS MODIFICATION - XU*8.0*1007 ;THREE LINES WERE ADDED TO SET %ZRTL NODES IF NOT THERE, AND SET ;^%ZTER NODE - ORIGINAL MODIFICATION BY TASSC/MFD S:'$D(^%ZRTL(1,0)) ^%ZRTL(1,0)="RESPONSE TIME^3.091P^^" S:'$D(^%ZRTL(2,0)) ^%ZRTL(2,0)="RT DATE_UCI,VOL^3.092^^" S:'$D(^%ZRTL(4,0)) ^%ZRTL(4,0)="RT RAWDATA^3.094D^^" S:'$D(^%ZTER(1,0)) ^%ZTER(1,0)="ERROR LOG^3.075^^" ;----- END IHS MODIFICATION Q NAME ;Setup the static names for this system 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 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")=Y 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 W ! Q ZTMKU ZTMKU ;SEA/RDS-Taskman: Option, ZTMWAIT/RUN/STOP ;11/04/99 15:05 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**118,127**;Jul 10, 1995 ; Q SSUB(NODE) ;Stop sub-managers D SS(1,"SUB",NODE) Q SMAN(NODE) ;stop managers D SS(1,"MGR",NODE) Q ; SS(MD,GR,NODE) ;Set/clear STOP nodes. S GR=$G(GR,"MGR") S:"MGR_SUB_"'[GR GR="MGR" I MD=1 S ^%ZTSCH("STOP",GR,NODE)=$H D WS(0,GR) I MD=0 K ^%ZTSCH("STOP",GR,NODE) Q ; WS(MD,GR) ;Set/Clear Wait state S GR=$G(GR,"MGR") S:"MGR_SUB_"'[GR GR="MGR" I MD=1 S ^%ZTSCH("WAIT",GR)=$H ;set wait state I MD=0 K ^%ZTSCH("WAIT",GR) ;Clear wait Q ; GROUP(CALL) ;Do CALL for each node, use NODE as the parameter N J,ND,NODE F J=0:0 S J=$O(^%ZTSCH("STATUS",J)) Q:J="" S ND=$G(^(J)),NODE=$P(ND,"^",3) D @CALL Q ; OPT(MD) ;Disable/Enable option prosessing I MD=1 S ^%ZTSCH("NO-OPTION")="" I MD=0 K ^%ZTSCH("NO-OPTION") Q ; RUN ;Remove Task Managers From WAIT State D WS(0,"MGR"),WS(0,"SUB") K ^%ZTSCH("STOP") W !,"Done!",! Q ; UPDATE ;Have Managers Do an parameter Update K ^%ZTSCH("UPDATE") W !,"Done!",! Q ; WAIT ;Put Task Managers In WAIT State D WS(1,"MGR") W !,"TaskMan now in 'WAIT STATE'",$C(7) D QSUB Q ; STOP ;Shut Down Task Managers N ZTX,ND,J F R !!,"Are you sure you want to stop TaskMan? NO// ",ZTX:$S($D(DTIME)#2:DTIME,1:60) Q:'$T!("^YESyesNOno"[ZTX) W:ZTX'["?" $C(7) W !,"Answer YES to shut down all Task Managers on current the volume set." I "^NOno"[ZTX W !,"TaskMan NOT shut down." Q W !,"Shutting down TaskMan." D GROUP("SMAN(NODE)") ;. F J=0:0 S J=$O(^%ZTSCH("STATUS",J)) Q:J="" S ND=$G(^(J)) D SMAN($P(ND,U,3)) ;. Q D QSUB Q ; QSUB N ZTX,ND F R !!,"Should active submanagers shut down after finishing their current tasks? NO// ",ZTX:$S($D(DTIME)#2:DTIME,1:60) Q:'$T!("^"[ZTX)!("YESyesNOno"[ZTX) W:ZTX'["?" $C(7) W !,"Please answer YES or NO." D:"YESyes"[ZTX&(ZTX]"") W !,"Okay!",! D GROUP("SSUB(NODE)") Q ; QUERY ;Query Status Of A Task Manager Q:$D(%ZTX)[0 Q:%ZTX="" S %ZTY=0 I $D(^%ZTSCH("STATUS",%ZTX))#2 S %ZTY=^%ZTSCH("STATUS",%ZTX) K %ZTX Q ; NODES ;Return Task Manager Status Nodes S %ZTX="" F %ZTY=0:0 S %ZTX=$O(^%ZTSCH("STATUS",%ZTX)) Q:%ZTX="" S %ZTY=%ZTY+1,%ZTY(%ZTY)=%ZTX K %ZTX Q ; LIVE ;Return Whether A Task Manager Is Live Q:$D(%ZTX)[0 Q:%ZTX="" S %ZTY=0,U="^",%ZTX1=$H,%ZTX2=$P(%ZTX,U) S %ZTX3=%ZTX1-%ZTX2*86400+$P(%ZTX1,",",2)-$P(%ZTX2,",",2) I %ZTX3'<0 S %ZTY=$S($D(^%ZTSCH("RUN"))[0&(%ZTX'["WAIT"):0,%ZTX3<30:1,%ZTX3<120&(%ZTX["PAUSE"):1,1:0) K %ZTX,%ZTX1,%ZTX2,%ZTX3 Q ; TABLE ;Display Task Manager Table W !,"NUMBER",?15,"STATUS",?25,"DESCRIPTION",?55,"LAST UPDATED",?75,"LIVE" W !,"------",?15,"------",?25,"-----------",?55,"------------",?75,"----" D NODES S %ZTZ=%ZTY,%ZTZ1=0,U="^",%H=$H D YMD^%DTC S DT=X F %ZTI=1:1:%ZTZ S %ZTX=%ZTY(%ZTI) D QUERY I %ZTY'=0 W !,%ZTY(%ZTI),?15,$P(%ZTY,U,2),?25,$P(%ZTY,U,3),?55 S %ZTT=$P(%ZTY,U) D T S %ZTX=%ZTY D LIVE W ?75,$S(%ZTY:"YES",1:"NO") I %ZTY S %ZTZ1=%ZTZ1+1 W !?6,"Total:",$J(%ZTZ,3),!?6,"Live :",$J(%ZTZ1,3) K %ZTI,%ZTT,%ZTY,%ZTZ Q ; CLEAN ;Cleanup Status Node K ^%ZTSCH("STATUS") W !,"Done!",! Q PURGE ;Purge the TASK list of running tasks. N TSK S TSK=0 F S TSK=$O(^%ZTSCH("TASK",TSK)) Q:TSK'>0 I '$D(^%ZTSCH("TASK",TSK,"P")) K ^%ZTSCH("TASK",TSK) W !,"Done!",! Q ; ZTM ;Return Number Of Live Task Managers D NODES S %ZTZ=%ZTY,%ZTZ1=0 F %ZTI=1:1:%ZTZ S %ZTX=%ZTY(%ZTI) D QUERY I %ZTY'=0 S %ZTX=%ZTY D LIVE I %ZTY S %ZTZ1=%ZTZ1+1 S %ZTY=%ZTZ1 K %ZTI,%ZTZ,%ZTZ1 Q ; T ;Print Informal-format Conversion Of $H-format Date ; Input: %ZTT, DT. S %H=%ZTT D 7^%DTC W $S(DT=X:"TODAY",DT+1=X:"TOMORROW",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3))_" AT " S X=$P(%ZTT,",",2)\60,%H=X\60 W $E(%H+100,2,3)_":"_$E(X#60+100,2,3) K %,%D,%H,%M,%Y,X Q ; Output: %ZTT, DT. ; ZTMON ZTMON ;SEA/RDS-TaskMan: Option, ZTMON, Part 1 (Main Loop) ;03/09/2000 14:09 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**118,127,136**;Jul 10, 1995 ; ENV ;Main Entry Point For Taskman Status Monitor D EN(1) ;Long mode Q EN(MODE) ; D HOME^%ZIS N %,%H,X,Y,Z,ZT,ZT1,ZT2,ZT3,ZT4,ZTC,ZTCO,ZTD,ZTENV,ZTH,ZTR,ZTUCI,ZTX,ZTY S U="^" X ^%ZOSF("UCI") S ZTUCI=Y W @IOF MON D RUN,STATUS,SCHQ ;Continued in ZTMON1 G ^ZTMON1 ; EN2 ;A shorter monitor D EN(0) Q ; RUN ;Evaluate RUN-Node W @IOF,!!,"Checking Taskman." S ZTH=$H,ZTR=$G(^%ZTSCH("RUN")) I ZTR]"" S ZTD=$$DIFF^%ZTM(ZTH,ZTR,0) S ZTY=$S(ZTR="":0,ZTD>20:0,1:1) W ?20,"Current $H=",ZTH," (",$$HTE^%ZTLOAD7(ZTH),")" W !,?22,"RUN NODE=",$S(ZTR]"":ZTR,1:"") I ZTR]"" W " (",$$HTE^%ZTLOAD7(ZTR),")" W !,"Taskman is ",$S(ZTY:"current.",ZTR]"":"late by "_(ZTD-15)_" seconds."_$C(7),1:"") W:$D(^%ZTSCH("STOP")) " shutting down" W:'$D(^%ZTSCH("STATUS")) " not running."_$C(7) W "." Q ; STATUS ;Evaluate Status List K X,ZTC S ZT="",ZTH=$$H3^%ZTM($H),ZT2="" M ZTC("S")=^%ZTSCH("STATUS"),ZTC("L")=^%ZTSCH("LOADA") F S ZT=$O(ZTC("S",ZT)) Q:ZT="" S X=ZTC("S",ZT),ZTC("D",$P(X,U,3),ZT)=ZT W !,"Checking the Status List:",!," Node weight status",?32,"time",?42," $J" S ZT="" F S ZT=$O(ZTC("D",ZT)),ZT1="" Q:ZT="" F S ZT1=$O(ZTC("D",ZT,ZT1)) Q:ZT1="" D . S %=ZTC("S",ZT1),ZT2=1 . W !?1,ZT W ?13,$S($D(ZTC("L",ZT)):$J($P(ZTC("L",ZT),U,2),3),1:""),?20,$P(%,U,2),?29,$$STIME($P(%,U)) W ?42,ZT1,?52,$P(%,U,4) . Q I 'ZT2 W !?5,"The Status List is ",$S(ZTY:"temporarily ",1:""),"empty." Q ; SCHQ ;Evaluate Schedule List N X,ZTL W !!,"Checking the Schedule List:" S ZT1=0,ZTCO=0,ZTC=0,ZTH=$$H3^%ZTM($H) S X=$O(^%ZTSCH(0)),ZTL=$$DIFF(ZTH,X,1) F S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 D . F ZT2=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:ZT2="" S ZTC=ZTC+1 I $$DIFF(ZTH,ZT1,1)>0 S ZTCO=ZTCO+1 W !?5,"Taskman has ",$S('ZTC:"no",1:ZTC)," task",$S(ZTC'=1:"s",1:"")," scheduled." I ZTC=1 W !?5,"It is ",$S('ZTCO:"not ",1:""),"overdue." I ZTC>1 W !?5,$S('ZTCO:"None",ZTCO=ZTC&(ZTCO=2):"Both",ZTCO=ZTC:"All",1:ZTCO)," of them ",$S(ZTCO=1:"is",1:"are")," overdue." W:ZTCO>10 *7 I ZTC>0,ZTL>0 W " First task is ",ZTL," seconds late." Q ; DIFF(N,O,T) ;Diff in sec. Q:$G(T) N-O ;For new seconds times Q N-O*86400-$P(O,",",2)+$P(N,",",2) ; STIME(%H) ;Status time I +$H=+%H Q "T@"_$P($$HTE^%ZTLOAD7(%H),"@",2) Q "T-"_($H-%H)_"@"_$P($$HTE^%ZTLOAD7(%H),"@",2) ZTMON1 ZTMON1 ;SEA/RDS-TaskMan: Option, ZTMON, Part 2 (Main Loop) ;11/04/99 15:05 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**36,118,127**;Jul 10, 1995 MON D IO:MODE,JOB,SUB G DONE ; IO ;Evaluate Waiting Lists N X,X1 S ZT1=$$H3($H),ZT2=$G(^%ZTSCH("IO")),ZT=$$DIFF^%ZTMS1(ZT1,+ZT2,1) W !!,"Checking the IO Lists:" I $D(^%ZTSCH("IO"))>2 W:+ZT2 " Last TM scan: ",ZT," sec, " W:$P(ZT2,"^",2)]"" "Last Dev: ",$P(ZT2,"^",2) S ZT1="",ZTT=0 I1 S ZT1=$O(^%ZTSCH("IO",ZT1)) I ZT1="" W:ZTT=0 !?5,"There are no tasks waiting for devices." Q I $D(^%ZTSCH("IO",ZT1))<9 G I1 ;Skip devices without tasks W !?5,"Device: ",ZT1 S Y=1 I ZT1'=$I S X=ZT1,X1=$G(^%ZTSCH("IO",ZT1)) D DEVOK^%ZOSV W $S(Y:" is not available,",$D(^%ZTSCH("DEV",ZT1)):" is allocated,",1:" is AVAILABLE,") S ZTC=0,ZT2="" F ZT=0:0 S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)),ZT3="" Q:'ZT2 F ZT=0:0 S ZT3=$O(^%ZTSCH("IO",ZT1,ZT2,ZT3)) Q:ZT3="" S ZTC=ZTC+1,ZTT=1 W " with ",$S(ZTC=1:"one task",1:ZTC_" tasks")," waiting." W:ZTC>50 $C(7) G I1 ; JOB ;Evaluate Job List W !!,"Checking the Job List:" S ZTC=0,ZT1="" F ZT=0:0 S ZT1=$O(^%ZTSCH("JOB",ZT1)),ZT2=0 Q:ZT1="" F ZT=0:0 S ZT2=$O(^%ZTSCH("JOB",ZT1,ZT2)) Q:'ZT2 S ZTC=ZTC+1 W !?5,"There ",$S(ZTC=0:"are no tasks",ZTC=1:"is 1 task",1:"are "_ZTC_" tasks")," waiting for ",$S(ZTC'=1:"partitions.",1:"a partition.") W:ZTC>20 $C(7) ; C ;Evaluate Cross CPU list S ZT1="" F S ZT1=$O(^%ZTSCH("C",ZT1)) Q:ZT1="" S ZTC=+$G(^(ZT1)) D . S ZTCO=0,ZT2="" . F S ZT2=$O(^%ZTSCH("C",ZT1,ZT2)),ZT3=0 Q:ZT2="" F S ZT3=$O(^%ZTSCH("C",ZT1,ZT2,ZT3)) Q:ZT3="" S ZTCO=ZTCO+1 . W !?5,"For ",ZT1," there ",$S(ZTCO=1:"is ",1:"are "),ZTCO," tasks. " . W $S(ZTC>8:"Not responding",$$OOS^%ZTM(ZT1):"Out Of Service",'$D(^%ZIS(14.7,"B",ZT1)):"Not defined",1:"") . Q TASK ;Evaluate Task List W !!,"Checking the Task List:" S ZTC=0 F ZT1=0:0 S ZT1=$O(^%ZTSCH("TASK",ZT1)) Q:'ZT1 S ZTC=ZTC+1 W !?5,"There ",$S(ZTC=0:"are no tasks",ZTC=1:"is 1 task",1:"are "_ZTC_" tasks")," currently running." Q ; SUB ;Look for idle submanagers N %N,ZT1,ZT2,ZT3,ZT4 L +^%ZTSCH("SUB"):1 I $D(^%ZTSCH("WAIT","SUB")) W !,"Sub-Managers told to Wait." S %N="",ZT3=$$H3($H) F S %N=$O(^%ZTSCH("SUB",%N)) Q:%N="" D . S %=0,ZT1=0,ZT4=+$G(^%ZTSCH("LOADA",%N)) . F S ZT1=$O(^%ZTSCH("SUB",%N,ZT1)) Q:ZT1'>0 D . . S %=%+1,ZT2=$$H3($G(^(ZT1))) . . I (ZT2+30)5 W !?10,"SUB-MANAGERS ARE NOT STARTING." . Q L -^%ZTSCH("SUB") Q ; DONE ;Prompt to Quit Or Continue W !!,"Enter monitor action: UPDATE// " R ZTR:$S($D(DTIME)#2:DTIME,1:60) S:ZTR="" ZTR="U" I "Uu"[$E(ZTR) G MON^ZTMON I "Ee"[$E(ZTR) Q:$$CALL("LIST^XUTMKE") G DONE I "Ss"[$E(ZTR) W @IOF X ^%ZOSF("SS") G DONE I "Pp"[$E(ZTR) W @IOF D PARAMS^ZTMCHK G DONE I "Rr"[$E(ZTR) W @IOF D RES G DONE I "Tt"[$E(ZTR) S MODE='MODE W !,"Mode set to ",$S(MODE:"normal",1:"short") G DONE I ZTR="^"!(ZTR="@") Q I ZTR'["?" G MON^ZTMON I ZTR="??" Q:$$CALL("SELECT^XUTMONH") G MON^ZTMON W !!?5,"Enter to update the monitor screen." W !?5,"Enter ^ to exit the monitor." W !?5,"Enter E to inspect the TaskMan Error file." W !?5,"Enter P to see taskman parameters." W !?5,"Enter R to see busy Resource slots." W !?5,"Enter S to see a system status listing." W !?5,"Enter ? to see this message." W !?5,"Enter ?? to inspect the tasks in the monitor's lists." G DONE ; H3(%) ;Convert $H to seconds. Q 86400*%+$P(%,",",2) ; CALL(RTN) ;Check for called routine N DUOUT I $D(^DIC(19,0))[0 W !,"In the wrong account." Q 0 D @RTN Q $D(DUOUT) ; RES ;Check on resource devices N ZT1,ZT2,ZT3,ZTIM,X S ZT1="" F S ZT1=$O(^%ZTSCH("IO",ZT1)) Q:ZT1="" I ^%ZTSCH("IO",ZT1)="RES" D . ;Q:$D(^%ZTSCH("IO",ZT1))<9 . S ZT2=$O(^%ZISL(3.54,"B",ZT1,0)),ZT3=0 Q:ZT2'>0 . S X=$G(^%ZISL(3.54,ZT2,0)) . W !,"Resource ",ZT1," Aval. Slots: ",$P(X,U,2) . F S ZT3=$O(^%ZISL(3.54,ZT2,1,ZT3)) Q:ZT3'>0 D . . S X=^%ZISL(3.54,ZT2,1,ZT3,0),ZTIM=$P(X,U,5) I ZTIM]"",ZTIM'["," S ZTIM=$$H0^%ZTM(ZTIM) . . W !,?10,"Slot: ",$J(ZT3,2)," Job: ",$P(X,U,3)," Task: ",$P(X,U,4) . . W " time: ",$$HDIFF^%ZTLOAD7($H,ZTIM,2) . . Q . Q Q ZTMS %ZTMS ;SEA/RDS-TaskMan: Submanager, (Entry & Trap) ;06/20/2000 11:34 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**2,18,24,36,67,94,118,127,136,162**;Jul 10, 1995 ; START ;Bottom level of submanager S $ETRAP="D ERROR^%ZTMS HALT" D NOW^%DTC S ZTQUEUED=0,U="^",DT=X D SETNM^%ZOSV("Sub "_$J) D KMPR("$STRT ZTMS$") D PARAMS G:$D(ZTOUT) QUIT S ^%ZTSCH("SUB",ZTPFLG("HOME"),0)=0 I $D(^%ZTSCH("STOP","SUB",ZTPAIR)) G QUIT G SUBMGR^%ZTMS1 ; KMPR(TAG) ;Call KMPR to log data N Y I +$G(^%ZTSCH("LOGRSRC")) S Y="" X $G(^%ZOSF("UCI")) I Y[^%ZOSF("PROD") D LOGRSRC^%ZOSV(TAG) Q QUIT D KMPR("$STOP ZTMS$") Q PARAMS ; ;START--lookup parameters X ^%ZOSF("PRIINQ") S %ZTMS("PRIO")=Y ;Get starting priority D GETENV^%ZOSV S ZTCPU=$P(Y,U,2),ZTNODE=$P(Y,U,3),ZTPAIR=$P(Y,U,4),ZTUCI=$P(Y,U)_$S(ZTCPU]"":","_ZTCPU,1:"") S:ZTPAIR[":" ZTNODE=$P(ZTPAIR,":",2) S ZTPFLG("RT")=0,ZTPFLG("MIN")=1,ZTYPE="",ZTPFLG("ZTREQ")=0 S ZTPN=$O(^%ZIS(14.7,"B",ZTPAIR,0)),ZTPFLG("ZTPN")=ZTPN I ZTPN>0 S %=$G(^%ZIS(14.7,ZTPN,0)) D . S ZTPFLG("RT")=+$P(%,U,6),ZTYPE=$P(%,U,9) S:$P(%,U,12)>1 ZTPFLG("MIN")=$P(%,U,12) . S ZTPFLG("HOME")=$S($P(%,U,13):$P(^%ZIS(14.7,+$P(%,U,13),0),U),1:ZTPAIR) . S ZTPFLG("ZTREQ")=+$G(^%ZIS(14.7,ZTPN,3)) . Q K ZTMLOG ;Set to log msg about locks I "FO"[ZTYPE S ZTOUT=1 Q ;SM only run on C,P,G types Q ERROR ;START--trap I $ZE["STKOVR"!($ZE["STACK") S $ET="Q:$ST>"_($ST-8)_" D ERR2^%ZTMS" Q ;set backup trap, prepare to handle error. ERR2 S $ETRAP="D ERROR2^%ZTMS0 HALT" S %ZTERLGR=$$LGR^%ZOSV S %ZTME=$$EC^%ZOSV,ZTERROH=$H S %ZTMETSK=$S($D(%ZTTV)#2:$P(%ZTTV,"^",4),$G(ZTSK)>0:ZTSK,1:0) I %ZTMETSK L ^%ZTSK(%ZTMETSK) ;Unlock all other locks I $G(IO)]"" L +^%ZTSCH("DEV",IO) ;Keep other tasks from IO device. ;Check if to record error I '$$SCREEN^%ZTER(%ZTME) D . D ^%ZTER ;Kernel error file . ;log error and context in TaskMan Error file . L +^%ZTSCH("ER") H 1 S ZTERROH=$H . S ^%ZTSCH("ER",+ZTERROH,$P(ZTERROH,",",2))=%ZTME . D XREF^%ZTMS0 . S ^%ZTSCH("ER",+ZTERROH,$P(ZTERROH,",",2),1)=ZTERROX1 . L -^%ZTSCH("ER") . Q ; I $D(ZTDEVOK) S $P(^%ZTSCH("IO"),U,2)=ZTDEVOK ;Have others skip dev. ;Update Task file entry I $G(ZTQUEUED),%ZTMETSK,$D(^%ZTSK(%ZTMETSK)) D STATUS^%ZTMS0 ; ;D KMPR("$ETRP ZTMS$") I ZTQUEUED>.9,%ZTMETSK>0,$G(DUZ)>.9,$D(^DD(8992,.01,0)) D . S XQA(DUZ)="",XQAMSG="Your task #"_%ZTMETSK_" stopped because of an error",XQADATA=%ZTMETSK,XQAROU="XQA^XUTMUTL" . D SETUP^XQALERT Q ; CLEAN ;clean up global data related to this process I $G(ZTQUEUED)>.9,'$D(^%ZTSCH("TASK",ZTQUEUED,"P")) K ^%ZTSCH("TASK",ZTQUEUED) K ^TMP($J),^UTILITY($J),^XUTL("XQ",$J) I '$G(ZTQUEUED) D SUB^%ZTMS1(-1) I $D(ZTDEVN)#2,$D(%ZTIO)#2,%ZTIO]"" D DEVLK^%ZTMS1(-1,%ZTIO) I $D(ZTDEVOK)#2 D DEVBAD^%ZTMS0 I $G(ZTSYNCFL)]"" S X=$$SYNCFLG^%ZTMS2("S",ZTSYNCFL,"","Stopped because of an error") ; CLOSE ;close i/o device after error D ERCLOZ^%ZTMS0 I $G(IO)]"" C IO H 5 ;In case of a port problem give it time to reset. ; D KMPR("$STOP ZTMS$") I ZTQUEUED=.5,%ZTMETSK>0,$P($G(^%ZTSK(%ZTMETSK,.12)),"^")<5 D ;Only try 5 times . S $P(^(.12),"^")=^%ZTSK(%ZTMETSK,.12)+1 . S ^%ZTSCH($$NEWH^%ZTMS2($H,600),%ZTMETSK)="" HALT ;Start a new process to continue ZTMS0 %ZTMS0 ;SEA/RDS-TaskMan: Submanager, Part 2 (Trap Functions) ;06/15/99 16:32 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**24,118**;JUL 10, 1995 ; ERROR2 ;ERROR--trap L ^%ZTSCH("ER") H 1 S ZTH=$H S ^%ZTSCH("ER",+ZTH,$P(ZTH,",",2))=$$EC^%ZOSV S ^%ZTSCH("ER",+ZTH,$P(ZTH,",",2),1)="Caused by the submanager while trapping an error." L HALT ; STATUS ;ERROR--update task's status in Task File, Call w/ ^%ZTSK locked S ZTE=$E(%ZTME,1,70) S ZTE=$TR(ZTE,"^","~") S $P(^%ZTSK(%ZTMETSK,.1),"^",1,3)=$S(ZTQUEUED>.5:"C^",1:"L^")_$H_"^"_ZTE S $P(^%ZTSK(%ZTMETSK,.12),"^",2,9)=ZTERROH_"^"_%ZTME S ^%ZTSK(%ZTMETSK,.12,ZTERROH)=%ZTME Q ; DEVBAD ;ERROR--dequeue all entries for a bad device N ZT,ZT1,ZT2,ZT3,ZT4 Q:'$$DEVLK^%ZTMS1(1,ZTDEVOK) L +^%ZTSCH("IO"):5 G DBX:'$T S $P(^%ZTSCH("IO"),"^")=$$H3^%ZTM($H) S ZT2=ZTDEVOK,ZT3="" F S ZT3=$O(^%ZTSCH("IO",ZT2,ZT3)),ZT4="" Q:ZT3="" F S ZT4=$O(^%ZTSCH("IO",ZT2,ZT3,ZT4)) Q:ZT4="" L +^%ZTSK(ZT4) D DQ L -^%ZTSK(ZT4) K ^%ZTSCH("IO",ZTDEVOK) I $O(^%ZTSCH("IO",""))="" K ^%ZTSCH("IO") L -^%ZTSCH("IO") DBX D DEVLK^%ZTMS1(-1,ZTDEVOK) Q ; DQ ;DEVBAD--remove a task from the waiting list for a bad device K ^%ZTSCH("IO",ZT2,ZT3,ZT4) S $P(^%ZTSK(ZT4,.1),"^",1,3)="B^"_$H_"^BAD IO DEVICE "_ZT2 K ^%ZTSK(ZT4,.26,ZT2) I $O(^%ZTSK(ZT4,.26,""))]"" Q K ^%ZTSK(ZT4,.26) Q ; ERCLOZ ;ERROR--close device after error I %ZTME["data set hang-up" Q I %ZTME["CLOSERR" Q I %ZTME["DSCON" Q I '$D(ZTQUEUED) Q:$D(IO)[0 Q:IO="" C:$O(^%ZISL(3.54,"B",IO,""))="" IO Q I '$D(%ZTTV) Q S IOS=$P(%ZTTV,"^",2),(IO,IO(0))=$P(%ZTTV,"^",5),IOT=$P(%ZTTV,"^",6),IOF=$P(%ZTTV,"^",11),IOST=$P(%ZTTV,"^",12),IO("C")="" D ^%ZISC Q ; XREF ;ERROR--cross-reference TaskMan Error file entry by context of error S ZTERROX=$S('%ZTMETSK:"an unknown task.",1:"Task # "_%ZTMETSK_".") S ZTQUEUED=$G(ZTQUEUED) I ZTQUEUED=0 S ZTERROX1="Caused by the submanager." Q I ZTQUEUED=.5 S ZTERROX1="Caused by the submanager while preparing "_ZTERROX Q I ZTQUEUED=.6 S ZTERROX1="Caused by submanager after "_ZTERROX Q S ZTERROX1="Caused by "_ZTERROX Q ; ZTMS1 %ZTMS1 ;SEA/RDS-TaskMan: Submanager, (Loop & Get Task) ;04/13/2000 09:58 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**36,49,104,118,127,136**;JUL 10, 1995 ; SUBMGR ;START--outer submanager loop D GETTASK G:ZTSK'>0 QUIT^%ZTMS ;task locked D PROCESS^%ZTMS2 G:$D(ZTQUIT) QUIT^%ZTMS G SUBMGR ; GETTASK ;SUBMGR--retain the partition; check Waiting Lists every 1 seconds D SUB(1) S ZTSK=0 ; F ZRT=0:0 D Q:$$EXIT S %=$S($O(^%ZTSCH("JOB",0))>0:1,1:$R(1+$$SUB(0))+1),ZRT=ZRT+% H % ;Space out the SM loop . I $D(^%ZTSCH("WAIT","SUB")) H 5 Q ;Wait . S %ZTIME=$$H3($H),ZTSK=0 I $D(^%ZTSCH("STOP","SUB",ZTPAIR)) Q . D C Q:ZTSK!(ZTYPE="C") ;Do directed work before check for balance . I $$BALANCE S ZRT=ZRT-.4 Q ;Wait for balance, Slow ZRT rise. . D JOB,IOQ:'ZTSK ;Look at last 2 lists . Q Q ; EXIT() ;GETTASK--decide whether to exit retention loop I ZTSK,$D(^%ZTSCH("NO-OPTION")),$P(^%ZTSK(ZTSK,0),"^",1,2)="ZTSK^XQ1" D . D SCHTM^%ZTMS2(ZTDTH+60) S ZTSK=0 . Q I ZTSK G YES I $D(^%ZTSCH("STOP","SUB",ZTPAIR)) G YES I ZTPFLG("RT")>ZRT G NO ;Retention time check I $$SUB(0)>ZTPFLG("MIN") G YES ;Let extras go NO ;EXIT--Don't exit S ^%ZTSCH("SUB",ZTPFLG("HOME"),$J)=$H ;Keep our node current L Q 0 ; YES ;EXIT--adjust counter and set flags D SUB(-1) Q 1 ; C ;GETTASK--On C type volume sets, get tasks from Cross-Volume Job List I $O(^%ZTSCH("C",ZTPAIR,0))="" Q L +^%ZTSCH("C",ZTPAIR):1 I '$T D:$D(ZTMLOG) LOG^%ZTMS7("No Lock C") S ZTDTH="",^%ZTSCH("C",ZTPAIR)=0 F S ZTDTH=$O(^%ZTSCH("C",ZTPAIR,ZTDTH)),ZTSK=0 Q:ZTDTH="" D Q:ZTSK . F S ZTSK=$O(^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK)),ZX=0 Q:ZTSK="" D Q:ZX .. I $D(^%ZTSK(ZTSK,0))[0!'ZTSK D Q ... I ZTSK'=0,$D(^%ZTSK(ZTSK)) S $P(^(ZTSK,.1),U,1,3)="I^"_$H_"^G" ... K ^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK) S ZTSK=0 ... Q .. S %ZTIO=^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK),ZTQUEUED=.5 .. I %ZTIO]"" S ZTDEVN=1 .. L +^%ZTSK(ZTSK):0 Q:'$T .. K ^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK) .. S ZTREC1=$G(^%ZTSK(ZTSK,.1)) .. I $P(ZTREC1,U,10)]"" S $P(^%ZTSK(ZTSK,.1),U,1,3)="D^"_$H_"^G" .. S ZX=1 Q . Q ;I $D(^%ZTSCH("C",ZTPAIR))=1 K ^%ZTSCH("C",ZTPAIR) L -^%ZTSCH("C",ZTPAIR) Q ; BALANCE() ;GETTASK--check load balance, and wait while Manager waits Q:ZTPAIR="" 0 I $G(^%ZTSCH("LOADA",ZTPAIR)) Q 1 Q 0 ; JOB ;GETTASK--search Partition Waiting List S ZTSK=0,ZTDTH=0 L +^%ZTSCH("JOBQ"):1 I '$T D:$D(ZTMLOG) LOG^%ZTMS7("No Lock JOBQ") Q J2 S ZTDTH=$O(^%ZTSCH("JOB",ZTDTH)),ZTSK=0 I ZTDTH="" L -^%ZTSCH("JOBQ") Q J3 S ZTSK=$O(^%ZTSCH("JOB",ZTDTH,ZTSK)) I ZTSK'>0 G J2 L +^%ZTSK(ZTSK):0 G J3:'$T I $D(^%ZTSCH("JOB",ZTDTH,ZTSK))[0 L -^%ZTSK(ZTSK) G J3 I $D(^%ZTSK(ZTSK,0))[0 D BADTASK L -^%ZTSK(ZTSK) G J3 S %ZTIO=^%ZTSCH("JOB",ZTDTH,ZTSK),ZTQUEUED=.5 K ^%ZTSCH("JOB",ZTDTH,ZTSK) L -^%ZTSCH("JOBQ") ;Now can release JOBQ ;try and only pick up work for this node. S ZTREC=$G(^%ZTSK(ZTSK,0)),%=$P(ZTREC,U,14) I %[":",%'[ZTNODE D G J3 . S ^%ZTSCH("C",%,ZTDTH,ZTSK)=%ZTIO,ZTQUEUED=0 . Q I $D(^%ZTSK(ZTSK,.1))#2,$P(^(.1),U,10)]"" S $P(^(.1),U,1,3)="D^"_$H_"^3",ZTQUEUED=0 L -^%ZTSK(ZTSK) G J3 I %ZTIO]"" S ZTDEVN=1 Q ; BADTASK ;JOB--unschedule tasks with bad numbers or incomplete records S %ZTIO=^%ZTSCH("JOB",ZTDTH,ZTSK) I %ZTIO]"" S ZTDEVN=1 I ZTSK'=0,$D(^%ZTSK(ZTSK)) S $P(^(ZTSK,.1),U,1,3)="I^"_$H_U_3 S ZTQUEUED=.5 K ^%ZTSCH("JOB",ZTDTH,ZTSK) I %ZTIO]"" D DEVLK(-1,%ZTIO) Q ; IOQ ;GETTASK--search Device Waiting List, Lock IO then DEV. S ZTSK=0 I '$D(^%ZTSCH("IO")) Q ;Lock to just to get last scan L +^%ZTSCH("IO"):0 I '$T D:$D(ZTMLOG) LOG^%ZTMS7("No Lock IO") S ZTI=$G(^%ZTSCH("IO")),ZTH=%ZTIME ;Keep 5 sec apart I $TR($$DIFF(%ZTIME,+ZTI,1),"-")'>5 L -^%ZTSCH("IO") D:$D(ZTMLOG) LOG^%ZTMS7("IO TIME") Q S $P(^%ZTSCH("IO"),"^")=%ZTIME,%ZTIO=$P(ZTI,"^",2) L -^%ZTSCH("IO") I2 S %ZTIO=$O(^%ZTSCH("IO",%ZTIO)),ZTDTH="" I %ZTIO="" G IOX I $D(^%ZTSCH("IO",%ZTIO))<9 G I2 S IOT=^%ZTSCH("IO",%ZTIO) I IOT'["RES" G I2:'$$DEVLK(1,%ZTIO) ;lock device if not RES. I '$D(^%ZTSCH("DEVTRY",%ZTIO)) S ^%ZTSCH("DEVTRY",%ZTIO)=%ZTIME ;Set problem device check S X=%ZTIO,X1=IOT,ZTDEVOK=X D DEVOK^%ZOSV I Y D DEVLK(-1,%ZTIO) G I2 I3 S ZTDTH=$O(^%ZTSCH("IO",%ZTIO,ZTDTH)),ZTSK=0 I ZTDTH="" D DEVLK(-1,%ZTIO) G I2 I5 S ZTSK=$O(^%ZTSCH("IO",%ZTIO,ZTDTH,ZTSK)) I ZTSK'>0 G I3 L +^%ZTSK(ZTSK):0 G I5:('$T) S ZTQUEUED=.5 D DQ^%ZTM4 I $G(^%ZTSK(ZTSK,0))="" L -^%ZTSK(ZTSK) G I5 I $P($G(^%ZTSK(ZTSK,.1)),U,10)]"" S $P(^(.1),U,1,3)="D^"_$H_"^A" S ZTQUEUED=0 L -^%ZTSK(ZTSK) G I5 ;Stop requested S ZTH=%ZTIME-20 ;Leave ^%ZTSCH("DEV",io) locked, Released in %ZTMS2 IOX L +^%ZTSCH("IO"):0 S ^%ZTSCH("IO")=ZTH_"^"_%ZTIO L -^%ZTSCH("IO") ;Update anyway K ZTDEVOK,%ZISCHK Q ; DEVLK(X,ZIO,TO) ;1=Lock/-1=unlock the ^%ZTSCH("DEV",ZIO) node. I X<0 L -^%ZTSCH("DEV",ZIO) Q L +^%ZTSCH("DEV",ZIO):(+$G(TO)) I '$T Q 0 Q 1 ; SUB(X) ;Inc/Dec SUB or return SUB count N % L +^%ZTSCH("SUB",ZTPFLG("HOME")):5 S %=+$G(^%ZTSCH("SUB",ZTPFLG("HOME"))) S:%<1 %=0 I X>0 S ^%ZTSCH("SUB",ZTPFLG("HOME"))=%+1,^%ZTSCH("SUB",ZTPFLG("HOME"),$J)=$H I X<0 S ^%ZTSCH("SUB",ZTPFLG("HOME"))=$S(%>0:%-1,1:0) K ^%ZTSCH("SUB",ZTPFLG("HOME"),$J) L -^%ZTSCH("SUB",ZTPFLG("HOME")) Q:X=0 % Q ; DIFF(N,O,T) ;Diff in sec. Q:$G(T) N-O ;For new seconds times Q N-O*86400-$P(O,",",2)+$P(N,",",2) ; H3(%) ;Convert $H to seconds. Q 86400*%+$P(%,",",2) H0(%) ;Covert from seconds to $H Q (%\86400)_","_(%#86400) ; ZTMS2 %ZTMS2 ;SEA/RDS-TaskMan: Submanager, Part 4 (Unload, Get Device) ;05/07/2001 13:50 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**2,18,23,36,67,118,127,163,167,175,199**;Jul 10, 1995 ;^%ZTSK(ZTSK),^%ZTSCH("DEV",IO) is locked on entry or return from GETNEXT PROCESS ;SUBMGR--process task and all others waiting for same device L +^%ZTSCH("TASK",ZTSK):1 I '$T Q ;Only allow one copy of a task at one time D LOOKUP I $D(ZTREJECT) Q D DEVICE I POP L Q ;Release all locks I ZTSYNCFL]"",'$$SYNCFLG("A",ZTSYNCFL,%ZTIO) D Q . D SYNCQ(ZTSYNCFL,%ZTIO,ZTDTH,ZTSK),^%ZISC L ;Release all locks . Q ;Go run task D TASK^%ZTMS3 I ZTYPE="C"!$D(ZTNONEXT) Q D GETNEXT^%ZTMS7 I $D(ZTNONEXT)!$D(ZTQUIT) Q G PROCESS ; LOOKUP ;PROCESS--unload task, switch ucis, and test entry routine K (%ZTIME,%ZTIO,DT,IO,U,ZTCPU,ZTDEVN,ZTDTH,ZTNODE,ZTPAIR,ZTPFLG,ZTQUEUED,ZTSK,ZTUCI,ZTYPE) D TSTAT(4,"") S ZTREC=^%ZTSK(ZTSK,0),ZTREC02=^(.02) S ZTREC2=^%ZTSK(ZTSK,.2),ZTREC21=^(.21),ZTREC25=^(.25) S ZTSYNCFL=$P(ZTREC2,"^",7),DUZ=+$P(ZTREC,U,3),DUZ(0)="@" S X=$P(ZTREC02,U)_","_$P(ZTREC02,U,2) I $P(ZTREC02,U,4) S $P(X,",",2)=ZTCPU ;should do a check to see if X is OK, Should check UCI mapping. I X'=ZTUCI S ZTUCI=X D SWAP^%XUCI S X=$P($P(ZTREC,U,2),"("),ZTRTN=$P(ZTREC,U,1,2) I $E(X)'="%" X ^%ZOSF("TEST"):X]"" I X=""!'$T D REJECT S ZTREJECT="" Q ; REJECT ;LOOKUP--entry routine isn't here; reject task N Y X ^%ZOSF("UCI") D TSTAT("B","No routine at destination "_Y_".") I $D(ZTDEVN) D DEVLK^%ZTMS1(-1,%ZTIO) K ZTDEVN L Q ;Clear all locks ; DEVICE ;PROCESS--prepare requested device; if can't, make task wait ;First clean-up all IO variables that could influence the device K %ZIS,IO,IOCPU,IOHG,IOPAR,IOUPAR,IOS ;If don't need a device, Setup minimum. S ZTIO=$P(ZTREC2,U),ZTIOT=$P(ZTREC2,U,3) I ZTIO="" S (IO,IO(0),IOF,IOM,ION,IOS,IOSL,IOST,IOT)="",POP=0 Q ; ;setup call S %ZIS="LRS0"_$S($P(ZTREC2,U,5)="DIRECT":"D",1:"") S:ZTIOT="HFS" %ZIS("HFSIO")=$P(ZTREC2,U,6),%ZIS("IOPAR")=ZTREC25 S:ZTIOT="MT" %ZIS("IOPAR")=ZTREC25 S (IO,IO(0))=%ZTIO,IOP=ZTIO S:'$D(^%ZTSCH("DEVTRY",$P(ZTIO,";"))) ^($P(ZTIO,";"))=%ZTIME ;Set problem device check K ^XUTL("XQ",$J),IO("ERROR") ; S:$P(ZTREC2,U,4)["MINIOUT" %ZISLOCK="^%ZTSCH(""NETMAIL"",IO)" ;The hang is on the close ;call S %ZISTO=3 D ^%ZIS K %ZISTO,%ZISLOCK ;See that we use a timeout. I %ZTIO]"" D DEVLK^%ZTMS1(-1,%ZTIO) K ZTDEVN I 'POP K ^%ZTSCH("DEVTRY",IO),^($P(ZTIO,";")) ;Clear problem device check ;Reset %ZTIO if IO doesn't match I 'POP,%ZTIO]"",IO'=%ZTIO C %ZTIO K IO(1,%ZTIO),^%ZTSCH("DEVTRY",$P(%ZTIO,";")) S %ZTIO=IO ; ;results I POP,(ZTYPE'="C"),(ZTIOT="TRM")!(ZTIOT="RES")!(ZTIOT="HG") D IONQ Q ;only add to IO queue if not type C. I POP D SCHNQ Q I IOT'="RES",IOT'="HG" U IO S IO(0)=IO I $P(^%ZIS(1,+IOS,0),U,7)="y" D ^%ZTMSH Q ; IONQ ;DEVICE--put task on Device Waiting List ;L +^%ZTSCH("IO"):5 I $D(^%ZTSK(ZTSK,0))[0 D TSTAT("I",4) G IOQX D TSTAT("A","") S ZTIO(1)=$P(ZTREC2,U,5),ZTIOS=ZTREC21 D NQ^%ZTM4 IOQX L Q ;Clear all Locks ; SCHNQ ;DEVICE--if HFS or SPL or TYPE'=C, reschedule task 10 min in future (try later) S ZTH=$$NEWH($H,300) D TSTAT(1,"rescheduled for busy device") S $P(^%ZTSK(ZTSK,.2),U,8)=$P(^%ZTSK(ZTSK,.2),U,8)+1 ;ReQ count D SCHTM(ZTH) I $L($G(IO("ERROR"))) S $P(^%ZTSK(ZTSK,.12),U,2,9)=$H_U_IO("ERROR") ;May tell why couldn't get device L Q ;Clear all locks ; SCHTM(ZTDTH) ;Set a new schedule time, See that task is updated S $P(^%ZTSK(ZTSK,0),U,6)=$$H0^%ZTM(ZTDTH),^%ZTSK(ZTSK,.04)=ZTDTH,^%ZTSCH(ZTDTH,ZTSK)="" Q NEWH(%H,%Y) ;Build a new schedule time, Return $H3 time. N % I %H["," S %H=$$H3^%ZTM(%H) Q (%H+%Y) ; SYNCFLG(ACT,FLAG,ZIO,STAT) ;Allocate/deallocate sync flag N X,DA,SYNC L +^%ZISL(14.8):30 E Q 0 S X=0,SYNC=FLAG_"~"_ZIO,DA=$O(^%ZISL(14.8,"B",SYNC,0)) I ACT["A" D . I DA S X=0 Q . ;I $D(^%ZTSCH("SYNC",ZIO,FLAG)) S X=0 Q . S X=$P(^%ZISL(14.8,0),"^",3)+1 F Q:'$D(^%ZISL(14.8,X)) S X=X+1 . S $P(^(0),"^",3,4)=X_"^"_($P(^%ZISL(14.8,0),"^",4)+1),^%ZISL(14.8,X,0)=SYNC,^%ZISL(14.8,"B",SYNC,X)="" . S X=1 Q I ACT["D" D S X=1 . Q:DA'>0 . K ^%ZISL(14.8,DA),^%ZISL(14.8,"B",SYNC,DA) . S $P(^(0),"^",3,4)=(DA-1)_"^"_($P(^%ZISL(14.8,0),"^",4)-1) . Q I ACT["S" D S X=1 . Q:DA'>0 . S ^%ZISL(14.8,DA,1)=$G(STAT) . Q I ACT["?" S X=(DA)!($D(^%ZTSCH("SYNC",ZIO,FLAG))) L -^%ZISL(14.8) Q X ; SYNCQ(FLAG,ZIO,ZTH,ZTSK) ;Put task on sync flag waiting list L +^%ZTSCH("SYNC") S ^%ZTSCH("SYNC",ZIO,FLAG,ZTSK)=ZTH L -^%ZTSCH("SYNC") Q SCHSYNC(FLAG,ZIO) ;put a waiting task in IO queue L +^%ZTSCH("SYNC") I $D(^%ZTSCH("SYNC",ZIO,FLAG)) N ZTH,ZTSK D . S ZTSK=$O(^(FLAG,0)),ZTH=$G(^(+ZTSK)) Q:ZTSK="" S:$D(^%ZTSCH("IO",ZIO))[0 ^(ZIO)=IOT . S ^%ZTSCH("IO",ZIO,ZTH,ZTSK)="" . K ^%ZTSCH("SYNC",ZIO,FLAG,ZTSK) . Q L -^%ZTSCH("SYNC") Q TSTAT(CODE,TXT) ;Record status Q:$D(^%ZTSK(ZTSK,.1))[0 S $P(^%ZTSK(ZTSK,.1),U,1,3)=CODE_U_$H_U_TXT Q ; POST ;Post INIT cleanup for patch XU*8*167 N T S T=0 F S T=$O(^%ZTSCH(T)) Q:T'>0 I $D(^%ZTSCH(T,0)) K ^%ZTSCH(T,0) Q ZTMS3 %ZTMS3 ;SEA/RDS-TaskMan: Submanager, Part 5 (Run Task) ;10/02/2000 14:06 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**1,18,36,49,64,67,94,118,127,136,175**;Jul 03, 1995 ; TASK ;SUBMGR--prepare and run task; cleanup after ; BEFORE ;prepare task ;submanager's variables S ZTDEF="" S X=$O(^%ZIS(14.7,"B",ZTPAIR,"")) I X]"",$D(^%ZIS(14.7,X,0))#2 S ZTDEF=^(0) S DUZ=+$P(ZTREC,U,3) S %ZTTV=ZTUCI_U_IOS_U_U_ZTSK_U_IO_U_IOT_U_ZTCPU_U_ZTNODE_U_DUZ_U_U_IOF_U_IOST_U_ZTPAIR_U_ZTYPE_U S %ZTTV(0)=ZTRTN_U_$P(ZTREC,U,8,9)_U_$P(ZTREC,U,6)_U_ION_U_ZTUCI_U_$P(ZTREC,U,5)_U_$S($P(ZTREC,U,10)]"":$P(ZTREC,U,10),1:$P(ZTREC,U,3))_U_$J_U_ZTSYNCFL_U_ZTPAIR_U ;S %ZTTV(2)=ZTPFLG("HOME")_U_ZTPFLG("MIN")_U_ZTPFLG("RT") I +$G(^%ZTSCH("LOGRSRC")) S %ZTTV(1)="!"_$S($P(ZTREC,U,9)="":$P(ZTREC,U,2),1:$P(ZTREC,U,9)) ; ;external calls D NOW^%DTC S DT=% ;DT is Date.time at this point. 1 D SETNM^%ZOSV($E("BTask ",(ZTIO]"")+1,6)_(ZTSK#100000000)) ; ;priority S X=$P(ZTREC,U,15) S X=$S(+X'=X:0,X'<1&(X'>10):X\1,1:0) S Y=$S(IOS="":0,$D(^%ZIS(1,+IOS,0))[0:0,1:+$P(^(0),U,5)) S Y=$S(Y'<1&(Y'>10):Y\1,1:0) S X=$S(Y:Y,X:X,$P(ZTDEF,U,4):$P(ZTDEF,U,4),1:10) X ^%ZOSF("PRIORITY") ; 2 ;restore saved variables S X=$O(^XTV(8989.3,1,4,"B",ZTCPU,0)) S:$P($G(^XTV(8989.3,1,4,+X,0)),U,6)="y" XRTL=ZTUCI K %,%H,%I,%ZTI,%ZTIO,IO("C"),IO("T"),X,Y,ZTCPU,ZTDEF,ZTIOST,ZTIOT,ZTNODE,ZTPAIR,ZTREC,ZTREC2,ZTREC21,ZTREC25,ZTUCI,^TMP($J),^UTILITY($J),^XUTL("XQ",$J) S DUZ(0)="" D RESTORE^%ZTMS4 ; ;force values S DUZ=+DUZ,DTIME=0,ZTDESC=$G(^%ZTSK(ZTSK,.03)),ZTDTH=$H I DUZ(0)="" S DUZ(0)=$S($D(^VA(200,DUZ,0))#2:$P(^(0),U,4),1:"") I $D(DUZ(2))[0 S DUZ(2)=$S($D(^VA(200,DUZ,2,0)):$O(^(0)),1:0) S ^XUTL("XQ",$J,0)=DT,^("ZTSK")=ZTDESC,^("ZTSKNUM")=ZTSK S X="DUZ" F S X=$Q(@X) Q:X="" I $D(@X) S ^XUTL("XQ",$J,$TR(X,""""))=@X F X="DUZ","IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","XQVOL" I $D(@X) S ^XUTL("XQ",$J,X)=@X 3 ; ;final checks & sets I '$D(^%ZTSK(ZTSK)) S ZTTASK=0 D AFTER Q I $S($D(^%ZTSK(ZTSK,.1))[0:0,1:$P(^(.1),U,10)]"") S $P(^%ZTSK(ZTSK,.1),U,1,3)="D^"_$H_"^4",ZTTASK=0 D AFTER Q S $P(^%ZTSK(ZTSK,.1),U,1,3)=5_U_$H_U S ZTQUEUED=ZTSK,ZTSTAT="1 General error" S ^%ZTSCH("TASK",ZTSK)=%ZTTV(0)_$H ; 4 ;run task I ^%ZOSF("OS")["MSM" D . I $P($ZV,"Version ",2)]]"4.3.0" D PURGELST^%MSMOPS Q . Q L L +^%ZTSCH("TASK",ZTSK) ;establish a lock on the task to be used to indicate that it is active ;Persistent task get set in ZTSK^XQ1 I $P(^%ZIS(14.7,ZTPFLG("ZTPN"),0),U,3)="Y" D LOGIN^%ZTMS4 I $D(%ZTTV(1)) D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV(%ZTTV(1)) S DT=DT\1 S:ZTPFLG("ZTREQ") ZTREQ="@" D RUN ;X "N %ZTTV,ZTPFLG D @ZTRTN" I $D(%ZTTV(1)) D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$AFTR ZTMS$") I $P(^%ZIS(14.7,ZTPFLG("ZTPN"),0),"^",3)="Y" D LOGOUT^%ZTMS4 ; AFTER ;cleanup after task; reset partition S U="^",ZTSK=$P(%ZTTV,U,4) D PCLEAR^%ZTLOAD(ZTSK) ;Clear persistent flag L ;Clear all user locks. L +^%ZTSK(ZTSK) I $D(ZTTASK)[0 K ^%ZTSCH("TASK",ZTSK) S ZTQUEUED=.6,ZTTASK=1 S X=10 X ^%ZOSF("PRIORITY") D SETNM^%ZOSV("Sub "_$J) ;Change name back S ZTUCI=$P(%ZTTV,U),IOS=$P(%ZTTV,U,2),(IO,IO(0),%ZTIO)=$P(%ZTTV,U,5),IOT=$P(%ZTTV,U,6),ZTCPU=$P(%ZTTV,U,7),ZTNODE=$P(%ZTTV,U,8) S IOF=$P(%ZTTV,U,11),IOST=$P(%ZTTV,U,12),ZTPAIR=$P(%ZTTV,U,13),ZTYPE=$P(%ZTTV,U,14),ZTSYNCFL=$P(%ZTTV(0),U,11) ;S ZTPFLG("HOME")=$P(%ZTTV(2),U,1),ZTPFLG("MIN")=$P(%ZTTV(2),U,2),ZTPFLG("RT")=$P(%ZTTV(2),U,3) I $G(ZTSYNCFL)]"" S X=$$SYNCFLG^%ZTMS2($S($G(ZTSTAT):"S",1:"D"),ZTSYNCFL,IO,$G(ZTSTAT)) D SCHSYNC^%ZTMS2(ZTSYNCFL,IO):'$G(ZTSTAT) D POST^%ZTMS4:ZTTASK,CLOSE K ^TMP($J),^UTILITY($J),^XUTL("XQ",$J) I $T(XUTL^XUSCLEAN)]"" D XUTL^XUSCLEAN K (%ZTIO,%ZTTV,DT,IO,IOF,IOS,IOST,IOT,U,ZTCPU,ZTNODE,ZTNONEXT,ZTPAIR,ZTPFLG,ZTQUEUED,ZTREQ,ZTSTOP,ZTUCI,ZTYPE) K IO("C"),IO("T"),IO("ERROR"),IO("LASTERR"),IO("DOC"),IO("P"),IO("HFSIO") S DUZ=0,DUZ(0)="@",ZTQUEUED=0 L ;Clear all locks, -^%ZTSK(ZTSK) Q ; RUN ; N %ZTTV,ZTPFLG D @ZTRTN Q ; CLOSE ;RUN--close &/or close execute I %ZTIO="" S ZTNONEXT=1 G CLX N ZTUCI,ZTCPU,ZTNODE,IOCPU,%IO I IOT="HFS"!(IOT="SPL") S ZTNONEXT=1 K IO("C") S:IOT'="TRM" IO("C")=1 S:$D(IO("CLOSE")) IO("T")=1 I IOT="RES" K ZTNONEXT Q ;For a Resource, don't close. ;Here is the Lock and hang to allow IDCU ports to reset. See %ZTMS2. I IOST["MINIOUT" S IO("C")=1,%IO=1 L +^%ZTSCH("NETMAIL",%ZTIO):8 I $D(IO(1,IO))#2 D ^%ZISC I $G(%IO) H 6 ;Wait for terminal server to reset. ;Unlock of all locks is done in clean ;See that all devices are closed. CLX S %IO="" F S %IO=$O(IO(1,%IO)) Q:%IO="" I %IO'=IO K IO(1,%IO) C %IO Q ; ZTMS4 %ZTMS4 ;SEA/RDS-TaskMan: Submanager, Part 6 (Setup, Cleanup) ;03/31/2000 07:39 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1007**;APR 1, 2003 ;;8.0;KERNEL;**136**;JUL 10, 1995 ; RESTORE ;RUN--restore saved variables ;prepare for restore, Call w/ task locked. N %ZTTV,DT,IO,IOBS,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY,POP,U,XY,ZTDTH,ZTIO,ZTQUEUED,ZTRTN ; ;restore from old node K ^%ZTSK(ZTSK,0,"ZTSK"),^("ZT3") S ZT3="" F ZT=0:0 S ZT3=$O(^%ZTSK(ZTSK,0,ZT3)) Q:ZT3="" I +ZT3'=ZT3 S:$D(^(ZT3))#2 @ZT3=^(ZT3) I $D(^(ZT3))>9 S %X="^%ZTSK(ZTSK,0,ZT3,",%Y=ZT3_$E("(",ZT3'["(") D %XY^%RCR ; A ;restore from new node K ^%ZTSK(ZTSK,.3,"ZTSK"),^("ZT3") S ZT3="" F ZT=0:0 S ZT3=$O(^%ZTSK(ZTSK,.3,ZT3)) Q:ZT3="" I +ZT3'=ZT3 S:$D(^(ZT3))#2 @ZT3=^(ZT3) I $D(^(ZT3))>9 S %X="^%ZTSK(ZTSK,.3,ZT3,",%Y=ZT3_$E("(",ZT3'["(") D %XY^%RCR ; ;cleanup K %A,%B,%C,%X,%Y,%Z,ZT,ZT3 Q ; POST ;RUN--post-execution commands, Call w/ task locked. I $G(ZTSTOP)=1 S $P(^%ZTSK(ZTSK,.1),U,1,3)="D^"_$H_"^5" Q S $P(^%ZTSK(ZTSK,.1),U,1,3)="6^"_$H_U_$J,X=^(.1) ;Get keep till. I $S($P(X,U,8)>$H:0,$D(^%ZTSK(ZTSK,0))[0:1,$G(ZTREQ)="@":1,1:0) D KILL^%ZTM4 Q N ZTUCI,ZTCPU,ZTNODE,ZTPAIR,ZTYPE,ZTRTN,ZTDESC,ZTIO,ZTDTH ;Protect current values. I $D(ZTREQ)#2 S ZTDTH=$P(ZTREQ,U),ZTIO=$P(ZTREQ,U,2),ZTDESC=$P(ZTREQ,U,3),ZTRTN=$P(ZTREQ,U,4,5),ZTIO(1)=$P(ZTREQ,U,6) S:$P(ZTRTN,U,2)="" ZTRTN=$P(ZTRTN,U) D REQ^%ZTLOAD Q Q ; ; LOGIN ;RUN--enter task in signon log Q:$D(^XUSEC(0,0))[0 ;No Sign-on log N XL1,I S XL1=DT ;I $T(SLOG^XUS1)]"" S I=$$SLOG^XUS1($P(%ZTTV,U,7),1,IOS,$P($P(%ZTTV,U),","),$P(%ZTTV,U,8)) F I=XL1:.00000001 L +^XUSEC(0,I):0 Q:$T&'$D(^XUSEC(0,I)) L -^XUSEC(0,I) S ^XUSEC(0,I,0)=DUZ_U_IO_U_$J_U_U_$P(%ZTTV,U,7)_"^1^"_IOS_U_$P($P(%ZTTV,U),",")_U_$S($D(IO("ZIO"))#2:IO("ZIO"),1:"")_U_$P(%ZTTV,U,8)_U L -^XUSEC(0,I) S $P(^XUSEC(0,0),U,3,4)=I_U_(1+$P(^XUSEC(0,0),U,4)) S $P(%ZTTV,U,10)=I Q ; LOGOUT ;RUN--set signoff time for task in signon log N ZT ;S ZT=$P(%ZTTV,"^",10) Q:ZT'>0 D LOUT^XUSCLEAN(ZT) S DUZ=$P(%ZTTV,"^",9),ZT=$P(%ZTTV,"^",10) Q:ZT'>0 ;Didn't make an entry. I $D(^XUSEC(0,ZT,0))#2 S $P(^XUSEC(0,ZT,0),"^",4)=$$NOW^XLFDT() Q ; ALERT ;Send a alert for rejected tasks. I $G(DUZ)>.9,$D(^DD(8992,.01,0)) D . D SETUP^XQALERT ;S ZTREQ="@" Q ZTMS7 %ZTMS7 ;SEA/RDS-TaskMan: Submanager, (GetNext) ;04/13/2000 10:00 [ 04/02/2003 8:29 AM ] ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003 ;;8.0;KERNEL;**1,118,127,136**;Jul 10, 1995 ; GETNEXT ;PROCESS--search Device Waiting List for next task waiting for %ZTIO ;check stop node, and claim ownership of Device Waiting List S %ZTIME=$$H3^%ZTM($H) I $D(^%ZTSCH("STOP","SUB",ZTPAIR)) S ZTQUIT=1 G DEALOC8 I $D(^%ZTSCH("WAIT","SUB")) G DEALOC8 I $O(^%ZTSCH("IO",%ZTIO,0))<1 G DEALOC8 S %=$G(^%ZTSCH("IO",%ZTIO)) I %'["RES" S X=$$DEVLK^%ZTMS1(1,%ZTIO,3) D:$D(ZTMLOG) LOG("No Lock "_%ZTIO) I 'X G DEALOC8 I %["RES" D ^%ZISC ;If a RES close now so open will update S ZTDTH="" ; ;look for task G3 S ZTDTH=$O(^%ZTSCH("IO",%ZTIO,ZTDTH)),ZTSK="" I ZTDTH="" G DEALOC8 G5 S ZTSK=$O(^%ZTSCH("IO",%ZTIO,ZTDTH,ZTSK)) I ZTSK="" G G3 L +^%ZTSK(ZTSK):0 G G5:'$T I $D(^%ZTSCH("IO",%ZTIO,ZTDTH,ZTSK))[0 L -^%ZTSK(ZTSK) G G5 D DQ^%ZTM4 ;Remove from lists I $D(^%ZTSK(ZTSK,0))[0!'ZTSK S:ZTSK>0&$D(^%ZTSK(ZTSK)) $P(^%ZTSK(ZTSK,.1),U,1,3)="I^"_$H_"^A" L -^%ZTSK(ZTSK) G G5 I $P($G(^%ZTSK(ZTSK,.1)),U,10)]"" S $P(^(.1),U,1,3)="D^"_$H_"^A" L -^%ZTSK(ZTSK) G G5 S ZTQUEUED=.5 D:$D(ZTMLOG) LOG("Got "_%ZTIO) Q ;Quit w/ ^%ZTSK(ZTSK) locked ; DEALOC8 ;GETNEXT--deallocate device, and set ZTNONEXT D DEVLK^%ZTMS1(-1,%ZTIO) S IO("C")="",IO("T")=1 D ^%ZISC K IO("T"),IO("C") S ZTNONEXT=1,%ZTIO="" L ;Quit w/ all locks clear. Q ; LOG(M) ;Log a msg N % S %=$G(^%ZTSCH("L",$J))+1,^($J)=% S ^%ZTSCH("L",$J,%)=M_" ^"_$H Q