- 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," .;()/*#@^&%<>,?[]{}|\`~':""","_--------------------------")
