- 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 ;
