Changeset 636 for FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZIS1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZIS1.m (modified) (8 diffs)

FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZIS1.m

@@ -1 @@
-%ZIS1 ;SFISC/AC,RWF -- DEVICE HANDLER (DEVICE INPUT) ;1/24/08  16:06
- ;;8.0;KERNEL;**18,49,69,104,112,199,391,440**;JUL 10, 1995;Build 13
- ;Per VHA Directive 2004-038, this routine should not be modified
+%ZIS1 ;SFISC/AC,RWF -- DEVICE HANDLER (DEVICE INPUT) ;07/07/2005  15:48
+ ;;8.0;KERNEL;**18,49,69,104,112,199,391**;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
@@ -7 +6 @@
  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) !,$C(7),"OUTPUT IS NEVER ALLOWED FOR THIS OPTION" G EXIT
+ 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)
@@ -16 +16 @@
  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 ;Call
+ 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 POP G EX2 ;Did not get the device.
- ;For type[TRM reset $X & $Y
- I %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
  ;Do count of number of times device opened.  Field 51.
- I $L($G(IO)),$D(IO(1,IO))#2,$G(%ZISIOS) D
+ I $L($G(IO)),$D(IO(1,IO))#2,'POP,$G(%ZISIOS) D
  . S $P(^(5),"^",1)=$P($G(^%ZIS(1,%ZISIOS,5)),"^",1)+1
- I %ZIS["H" S IO(0)=IO,IO("HOME")=%ZISIOS_"^"_IO ;Make home device
- I '$D(IO("Q")),$D(%ZISLOCK) S ^XUTL("XQ",$J,"lock",%ZISIOS)=%ZISLOCK
- I $D(IO)#2,IO]"",$D(IO(1,IO))#2,$D(%Z1),$P(%Z1,"^",11) S IO(1,IO,"NOFF")=1
-EX2 ;
+ 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
@@ -37 +33 @@
  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 !,$C(7),"AT THIS TIME, OUTPUT MUST BE QUEUED"
+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)
@@ -60 +56 @@
  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 $C(7) S DTOUT=1 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)
@@ -66 +62 @@
 LOW(%) Q $TR(%,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
 UP(%) Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;
- ;Call/Return % = 1 (yes), 2 (no) -1 (^)
-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 $C(7)
+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 $C(7),"??",!?4,"ANSWER 'Yes' OR 'No': " G RYN
- W:$X>73 ! W $P("  (Yes)^  (No)",U,%)
- Q
-MSG1 I '$D(IOP) W ?20,$C(7),"  [DEVICE DOES NOT EXIST]"
+ 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
@@ -84 +77 @@
  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
+ K IOCPU S:$D(%ZISCPU) IOCPU=%ZISCPU G KIL
  ;
 KILVAR ;Come here to restore the calling variables
@@ -97 +89 @@
  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
- K %ZISIOF,%ZISIOSL,%ZISIOBS,%ZISIOST,%ZISIOST(0),%ZISTO,%ZISTP,%ZISHG,%ZISSIO,%ZISOPEN,%ZISOPAR,%ZISUPAR
- K %ZISMY,%ZISQUIT,%ZISLOCK
+ 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