ZISHMSMD ; IHS/DSM/MFD - HOST COMMANDS FOR DOS (MSMD); [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007,1017**;APR 1, 2003;Build 3
;;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^<file not specified>"
; 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
;
ZISHMSMD ; IHS/DSM/MFD - HOST COMMANDS FOR DOS (MSMD); [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007,1017**;APR 1, 2003;Build 3
+2 ;;8.0;KERNEL;;JUL 10, 1995
+3 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ADC/GTH 06/03/96; IHS/AAO/RPL; IHS/HQW/JLB 3/1/99
+4 ;
+5 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+6 ;
OPEN(ZISH1,ZISH2,ZISH3) ; ----- Open DOS file.
+1 ; S Y=$$OPEN^%ZISH("\directory\","filename","R")
+2 ;error 1=no dev
+3 ; 2=open new fl with 'R'
+4 ; 3=passes fls by ref
+5 ; 4=invalid fl len
+6 ;
+7 ; ---------------------------------------------------------------
+8 ; PROGRAMMERS NOTE: IHS/ADC/GTH - 06-03-96
+9 ; The VA's K8 version of %ZISH added another parameter to $$OPEN,
+10 ; the "handle name" of the file, but put the parameter at the
+11 ; beginning of the formal parameter list, instead of at the end,
+12 ; causing backwards incompatibility problems.
+13 ; This version is the IHS's version, with three parameters.
+14 ; ZISHMSMD resides in the production UCI and is called by %ZISH
+15 ; on DOS-based machines.
+16 ; ---------------------------------------------------------------
+17 ;
+18 NEW ZISHDF,ZISHIOP,%ZIS,POP,ZISHQ
+19 ;
+20 ; -- Directory format.
+21 DO DF(.ZISH1)
+22 ;
+23 ; -- Pass by value or quit.
+24 IF $ORDER(ZISH2(0))
SET ZISHX=3
QUIT ZISHX
+25 ;
+26 ; -- Check filename length.
+27 DO FL(.ZISH2)
IF ZISH2=4
QUIT ZISH2
+28 ;
+29 SET ZISHDF=$SELECT(ZISH1'="":ZISH1_ZISH2,1:ZISH2)
+30 ;
+31 ; -- Open MSM host.
+32 FOR ZISHIOP=51:1:54
IF '$DATA(IO(1,ZISHIOP))
SET IOP=ZISHIOP
SET %ZIS("IOPAR")="("""_ZISHDF_""":"""_ZISH3_""")"
DO ^%ZIS
IF 'POP
QUIT
+33 IF POP
QUIT 1
+34 ;
+35 ; -- Check new file with "R" privileges.
+36 IF ZISH3="R"
Begin DoDot:1
+37 USE IO
IF $ZA=-1
SET ZISHQ=2
DO ^%ZISC
End DoDot:1
+38 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+39 ;
+40 IF '$DATA(ZISHQ)
IF '$DATA(ZTQUEUED)
USE IO(0)
+41 QUIT $SELECT($DATA(ZISHQ):ZISHQ,1:0)
+42 ;
DEL(ZISH1,ZISH2) ; ----- Delete file(s).
+1 ; S Y=$$DEL^%ZISH("\directory\","filename")
+2 ; ,.array)
+3 ;error 1=attempted wild card * del
+4 ;
+5 NEW ZISHDA,ZISHF,ZISHX,ZISHQ,ZISHDF,ZISHC,ZISHNUM
+6 ;
+7 ; -- Directory format.
+8 DO DF(.ZISH1)
+9 ;
+10 ; -- Set array if filename(s) are passed by value.
+11 IF '$ORDER(ZISH2(0))
SET ZISH2(1)=ZISH2
+12 ;
+13 ; -- Get file(s) to act on.
+14 ; -- No '*' allowed.
+15 FOR ZISHDA=0:0
SET ZISHDA=$ORDER(ZISH2(ZISHDA))
IF 'ZISHDA
QUIT
SET ZISHF=ZISH2(ZISHDA)
IF ZISHF["*"
SET ZISHX=1
SET ZISHQ=1
QUIT
+16 IF $DATA(ZISHQ)
QUIT ZISHX
+17 FOR ZISHDA=0:0
SET ZISHDA=$ORDER(ZISH2(ZISHDA))
IF 'ZISHDA
QUIT
SET ZISHF=ZISH2(ZISHDA)
Begin DoDot:1
+18 IF ZISH1'=""
SET ZISHDF=ZISH1_ZISHF
+19 SET ZISHC=$SELECT(ZISH1'="":ZISHDF,1:ZISHF)
+20 SET ZISHNUM=2
+21 DO JW
+22 QUIT
End DoDot:1
+23 QUIT ZISHX
+24 ;
FROM(ZISH1,ZISH2,ZISH3,ZISH4,ZISH5) ; ----- Get DOS file(s) from.
+1 ; S Y=$$FROM^%ZISH("\dir\","fl","mach","qlfr","\dir\")
+2 ; "fl*"
+3 ; .array
+4 QUIT 20
+5 ;
SEND(ZISH1,ZISH2,ZISH3) ; ----- Send DOS file(s). (MV to export directory.)
+1 ; S Y=$$SEND^%ZISH("\dir\","fl","mach")
+2 ; "fl*"
+3 ; .array
+4 NEW Y,ZISH,ZISHPARM
+5 IF '$LENGTH($GET(ZISH2))
QUIT "1^<file not specified>"
+6 ; Put array of files in ZISH2()
+7 SET Y=$$LIST(.ZISH1,ZISH2,.ZISH2)
+8 FOR ZISH=1:1
IF '$DATA(ZISH2(ZISH))
QUIT
SET Y=$$MV(ZISH1,ZISH2(ZISH),"\EXPORT\",ZISH2(ZISH))
+9 QUIT Y
+10 ;
+11 ;
LIST(ZISH1,ZISH2,ZISH3) ; ----- Create local array holding filename(s).
+1 ; S Y=$$LIST^%ZISH("\dir\","fl",".return array")
+2 ; "fl*",
+3 ; .array,
+4 ;
+5 NEW ZISHC,ZISHDA,ZISHDF,ZISHX,ZISHF,X,Y,ZISHCNT
+6 ;
+7 ; -- Set array counter for pass back array.
+8 SET ZISHCNT=0
+9 ;
+10 ; -- Directory format.
+11 DO DF(.ZISH1)
+12 ;
+13 ;
+14 ; -- Set array if filename(s) are passed by value.
+15 IF '$ORDER(ZISH2(0))
SET ZISH2(1)=ZISH2
+16 ;
+17 ; -- Get filename(s) to act on.
+18 FOR ZISHDA=0:0
SET ZISHDA=$ORDER(ZISH2(ZISHDA))
IF 'ZISHDA
QUIT
SET ZISHF=ZISH2(ZISHDA)
Begin DoDot:1
+19 IF $PIECE(ZISHF,".",2)=""
SET ZISHF=ZISHF_".*"
+20 SET ZISHDF=$SELECT(ZISH1'="":ZISH1_ZISHF,1:ZISHF)
+21 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+22 SET ZISHCNT=ZISHCNT+1
SET ZISHX=$ZOS(12,ZISHDF,32+16+4+1)
IF $PIECE(ZISHX,U)'=""
IF $PIECE(ZISHX,U)'<0
SET ZISH3(ZISHCNT)=$PIECE(ZISHX,U)
+23 ;Above line fixed 12/17 'I $P...'<0'
+24 FOR
SET ZISHCNT=ZISHCNT+1
SET ZISHX=$ZOS(13,ZISHX)
IF $PIECE(ZISHX,U)=""!(ZISHX<0)
QUIT
SET ZISH3(ZISHCNT)=$PIECE(ZISHX,U)
+25 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+26 QUIT
End DoDot:1
+27 QUIT ZISHX
+28 ;
+29 ;
MV(ZISH1,ZISH2,ZISH3,ZISH4) ; ----- Rename a file(s).
+1 ; S Y=$$MV^%ZISH("\dir\","fl","\dir\","fl")
+2 ;
+3 NEW ZISHC,ZISHX
+4 ;
+5 ; -- Directory format.
+6 DO DF(.ZISH1)
+7 DO DF(.ZISH3)
+8 ;
+9 ; -- Check for pass by value, or quit.
+10 IF $ORDER(ZISH2(0))!($ORDER(ZISH4(0)))
SET ZISHX=3
QUIT ZISHX
+11 ;
+12 ; -- Check for 'from' and 'to' directory.
+13 SET ZISH2=$SELECT(ZISH1="":ZISH2,1:ZISH1_ZISH2)
+14 SET ZISH4=$SELECT(ZISH3="":ZISH4,1:ZISH3_ZISH4)
+15 ;
+16 SET ZISHX=$ZOS(3,ZISH2,ZISH4)
+17 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+18 QUIT ZISHX
+19 ;
PWD(ZISH1) ; ----- Print working directory.
+1 ; S Y=$$PWD^%ZISH(.return array)
+2 ;
+3 ; ---------------------------------------------------------------
+4 ; PROGRAMMERS NOTE: IHS/ADC/GTH - 06-03-96
+5 ; The VA's K 8 version makes $$PWD a parameter-less extrinsic, which
+6 ; makes it backwards incompatible with IHS. This is the IHS's
+7 ; version of $$PWD.
+8 ; ---------------------------------------------------------------
+9 ;
+10 NEW X,Y
+11 SET ZISH1(1)=$ZOS(11,"C")
+12 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+13 ; WAS Q ZISH(1) AND GAVE UNDEF ON ZISH(1) ;IHS/AAO/RPL
QUIT ZISH1(1)
+14 ;
JW ; ----- Call DOS $ZOS.
+1 SET ZISHX=$ZOS(ZISHNUM,ZISHC)
+2 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+3 QUIT
+4 ;
DF(X) ; ----- Directory format.
+1 IF X=""
QUIT
+2 SET X=$TRANSLATE(X,"/","\")
+3 IF $EXTRACT(X,$LENGTH(X))'="\"
SET X=X_"\"
+4 QUIT
+5 ;
STATUS() ; -----EndOfFile flag.
+1 QUIT $ZC
+2 ; Excepted from SAC 6.1.5, 6.1.2.2 and 6.1.2.3 memo dated 16Nov93.
+3 ;
FL(X) ; ----- Check for filename length.
+1 NEW ZISHP1,ZISHP2
+2 SET ZISHP1=$PIECE(X,".")
SET ZISHP2=$PIECE(X,".",2)
+3 ; Don't really care about filename length for NT systems IHS/HQW/JLB 3/1/99
+4 ;I $L(ZISHP1)>8 S X=4 Q IHS/HQW/JLB 3/1/99
+5 ;I $L(ZISHP2)>3 S X=4 Q IHS/HQW/JLB 3/1/99
+6 QUIT
+7 ;
