INHUT3 ;WFH,JPD; 27 Nov 95 11:42; Tools Interface ZIS front-end function
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
ZIS(INRTN,INZVARS,INZIOM,INASK) ; Ask op for device, do ZTRTN.
; INRTN(req)=Name of routine does report output."^rou" or "label^rou".
; INZVARS(op)=Names of variables to pass ZTRTN. Separate names
; with "^". Example: "INBEG^INHEAD(^INTYPE". Or can be array by
; ref. like the ZTSAVE taskman array.
; INZIOM(op)=Width. Def 80. Avoids(disregards)interaction about width
; INASK = If 0, ask for device
; If 1, overwrite flatfile INHSYS.RPT with new data
; If 2, append output to INHSYS.RPT
; If 3, no output
;
S INASK=+$G(INASK) S:'$G(INZIOM) INZIOM=80
F Q:$$ZISASK W !?5,"Try again.",!
Q
; Query device. False to ask again.
ZISASK() N %,%ZIS,IO,IOP,POP S %ZIS="NP"
S (INZLIM("POP"),INZLIM("ZTSK"))=0
; If user needs to define a device, call ^%ZIS w/o open.
; If timeout or "^", reset to terminal & quit
I 'INASK D ^%ZIS I POP S IOP="",%ZIS="" D ^%ZIS K DTOUT Q 1
I INASK,INASK'=3 S IO=$G(INRPTNM) I IO="" W *7,!,?5,"Invalid Flat File Name!" Q 0
; force to specified length, even if user said otherwise
S IOM=INZIOM
; user said slave, but not allowed
I $D(IO("S")) D Q 0
.W *7,!?5,"Sorry, this report cannot be sent to slave."
; user said queue to something - should not occur from value
; of %ZIS above
I $D(IO("Q")) W *7,!?5,"This report cannot be queued!" Q 0
; user input "passed muster"; do variable setup
S IOP=ION_";"_IOM_";"_IOSL
; not queing: open device, do report, close, & quit
I INASK'=3 D OPENIT Q:POP 0
N INZDEF,INZIOM,INZOPTN,INZLIM,INZPRMPT,INZVARS
D:INRTN]"" @INRTN I $E(IOST)="C",IOM>80,$D(IOA(80)) W @IOA(80)
; Close Flat File or device
Q:INASK=3 1 I INASK D
.I $$CLOSESEQ^%ZTFS1(IO)
E D ^%ZISC
Q 1
;
RUNTSK U IO D @INRTN D:$G(ZTSK) CLNUP^%ZTLOAD(ZTSK) D ^%ZISC Q
;
; Internal routine to open device
OPENIT I INASK N RNAME S RNAME=$$OPENSEQ^%ZTFS1(IO,"W"_$S(INASK=1:"B",1:"A")),POP=0 U IO Q
S POP=0,%ZIS="" D ^%ZIS
I POP S IOP="" D ^%ZIS W *7,!?5,"Device busy."
U IO I $E(IOST)="C",IOM>80,$D(IOA(132)) W @IOA(132)
Q
RMRTN(%FIND) ;Clean up IB routines used
; INPUT: %FIND - Prefix of routines to remove
; i.e., IBxxxx
Q:$E(%FIND,1,2)'="IB" N I,X,EX S I=0,EX=^%ZOSF("DEL")
F S I=$$HEXUP^INHSYS04(I),X=%FIND_$S($L(I)<2:"0"_I,1:I) Q:'$$ROUTEST^%ZTF(X) X EX
S X=%FIND_"W" I $$ROUTEST^%ZTF(X) X EX
Q
; Internal routine to setup taskman array
ZTSAVE N I K ZTSAVE
I $D(INZVARS)<10 S INZVARS=$G(INZVARS) D Q
.F I=1:1 S %=$P(INZVARS,U,I) Q:%="" S ZTSAVE(%)=""
S I="" F S I=$O(INZVARS(I)) Q:I="" S ZTSAVE(I)=INZVARS(I)
Q
ORDER(GL,VAR,ST,END,EX) ;MOVE TO %ZTF
; Perform indirect $Order and execute line for each
; Inputs:
; GL - Global name VAR - Variable to use for $O
; ST - Starting place in Global
; END - Ending condition EX - Excutable code for each node
Q:$G(EX)=""!($G(END)="")!($G(ST)="")!($G(VAR)="")!($G(GL)="")
N @VAR,C S @VAR=ST,C=$E(GL,$L(GL)) Q:C=")"
I C'=",",C'="(" S GL=GL_"("
S GL=GL_VAR_")"
;S GL=GL_"("_VAR_")"
12 S @VAR=$O(@GL) I @END Q
X EX G 12
;===========================================
TR(X) ; Calculate Valid VMS filename for TRANSACTION TYPE by translating
; " " to "_", all other invalid characters to "-"
; Input should be the TRANSACTION TYPE NAME field
; Extention must be added by calling routine
Q $TR(X," .;()/*#@^&%<>,?[]{}|\`~':""","_--------------------------")
INHUT3 ;WFH,JPD; 27 Nov 95 11:42; Tools Interface ZIS front-end function
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
ZIS(INRTN,INZVARS,INZIOM,INASK) ; Ask op for device, do ZTRTN.
+1 ; INRTN(req)=Name of routine does report output."^rou" or "label^rou".
+2 ; INZVARS(op)=Names of variables to pass ZTRTN. Separate names
+3 ; with "^". Example: "INBEG^INHEAD(^INTYPE". Or can be array by
+4 ; ref. like the ZTSAVE taskman array.
+5 ; INZIOM(op)=Width. Def 80. Avoids(disregards)interaction about width
+6 ; INASK = If 0, ask for device
+7 ; If 1, overwrite flatfile INHSYS.RPT with new data
+8 ; If 2, append output to INHSYS.RPT
+9 ; If 3, no output
+10 ;
+11 SET INASK=+$GET(INASK)
IF '$GET(INZIOM)
SET INZIOM=80
+12 FOR
IF $$ZISASK
QUIT
WRITE !?5,"Try again.",!
+13 QUIT
+14 ; Query device. False to ask again.
ZISASK() NEW %,%ZIS,IO,IOP,POP
SET %ZIS="NP"
+1 SET (INZLIM("POP"),INZLIM("ZTSK"))=0
+2 ; If user needs to define a device, call ^%ZIS w/o open.
+3 ; If timeout or "^", reset to terminal & quit
+4 IF 'INASK
DO ^%ZIS
IF POP
SET IOP=""
SET %ZIS=""
DO ^%ZIS
KILL DTOUT
QUIT 1
+5 IF INASK
IF INASK'=3
SET IO=$GET(INRPTNM)
IF IO=""
WRITE *7,!,?5,"Invalid Flat File Name!"
QUIT 0
+6 ; force to specified length, even if user said otherwise
+7 SET IOM=INZIOM
+8 ; user said slave, but not allowed
+9 IF $DATA(IO("S"))
Begin DoDot:1
+10 WRITE *7,!?5,"Sorry, this report cannot be sent to slave."
End DoDot:1
QUIT 0
+11 ; user said queue to something - should not occur from value
+12 ; of %ZIS above
+13 IF $DATA(IO("Q"))
WRITE *7,!?5,"This report cannot be queued!"
QUIT 0
+14 ; user input "passed muster"; do variable setup
+15 SET IOP=ION_";"_IOM_";"_IOSL
+16 ; not queing: open device, do report, close, & quit
+17 IF INASK'=3
DO OPENIT
IF POP
QUIT 0
+18 NEW INZDEF,INZIOM,INZOPTN,INZLIM,INZPRMPT,INZVARS
+19 IF INRTN]""
DO @INRTN
IF $EXTRACT(IOST)="C"
IF IOM>80
IF $DATA(IOA(80))
WRITE @IOA(80)
+20 ; Close Flat File or device
+21 IF INASK=3
QUIT 1
IF INASK
Begin DoDot:1
+22 IF $$CLOSESEQ^%ZTFS1(IO)
End DoDot:1
+23 IF '$TEST
DO ^%ZISC
+24 QUIT 1
+25 ;
RUNTSK USE IO
DO @INRTN
IF $GET(ZTSK)
DO CLNUP^%ZTLOAD(ZTSK)
DO ^%ZISC
QUIT
+1 ;
+2 ; Internal routine to open device
OPENIT IF INASK
NEW RNAME
SET RNAME=$$OPENSEQ^%ZTFS1(IO,"W"_$SELECT(INASK=1:"B",1:"A"))
SET POP=0
USE IO
QUIT
+1 SET POP=0
SET %ZIS=""
DO ^%ZIS
+2 IF POP
SET IOP=""
DO ^%ZIS
WRITE *7,!?5,"Device busy."
+3 USE IO
IF $EXTRACT(IOST)="C"
IF IOM>80
IF $DATA(IOA(132))
WRITE @IOA(132)
+4 QUIT
RMRTN(%FIND) ;Clean up IB routines used
+1 ; INPUT: %FIND - Prefix of routines to remove
+2 ; i.e., IBxxxx
+3 IF $EXTRACT(%FIND,1,2)'="IB"
QUIT
NEW I,X,EX
SET I=0
SET EX=^%ZOSF("DEL")
+4 FOR
SET I=$$HEXUP^INHSYS04(I)
SET X=%FIND_$SELECT($LENGTH(I)<2:"0"_I,1:I)
IF '$$ROUTEST^%ZTF(X)
QUIT
XECUTE EX
+5 SET X=%FIND_"W"
IF $$ROUTEST^%ZTF(X)
XECUTE EX
+6 QUIT
+7 ; Internal routine to setup taskman array
ZTSAVE NEW I
KILL ZTSAVE
+1 IF $DATA(INZVARS)<10
SET INZVARS=$GET(INZVARS)
Begin DoDot:1
+2 FOR I=1:1
SET %=$PIECE(INZVARS,U,I)
IF %=""
QUIT
SET ZTSAVE(%)=""
End DoDot:1
QUIT
+3 SET I=""
FOR
SET I=$ORDER(INZVARS(I))
IF I=""
QUIT
SET ZTSAVE(I)=INZVARS(I)
+4 QUIT
ORDER(GL,VAR,ST,END,EX) ;MOVE TO %ZTF
+1 ; Perform indirect $Order and execute line for each
+2 ; Inputs:
+3 ; GL - Global name VAR - Variable to use for $O
+4 ; ST - Starting place in Global
+5 ; END - Ending condition EX - Excutable code for each node
+6 IF $GET(EX)=""!($GET(END)="")!($GET(ST)="")!($GET(VAR)="")!($GET(GL)="")
QUIT
+7 NEW @VAR,C
SET @VAR=ST
SET C=$EXTRACT(GL,$LENGTH(GL))
IF C=")"
QUIT
+8 IF C'=","
IF C'="("
SET GL=GL_"("
+9 SET GL=GL_VAR_")"
+10 ;S GL=GL_"("_VAR_")"
12 SET @VAR=$ORDER(@GL)
IF @END
QUIT
+1 XECUTE EX
GOTO 12
+2 ;===========================================
TR(X) ; Calculate Valid VMS filename for TRANSACTION TYPE by translating
+1 ; " " to "_", all other invalid characters to "-"
+2 ; Input should be the TRANSACTION TYPE NAME field
+3 ; Extention must be added by calling routine
+4 QUIT $TRANSLATE(X," .;()/*#@^&%<>,?[]{}|\`~':""","_--------------------------")
