ZIS3.m

%ZIS3 ;SFISC/AC,RWF -- DEVICE HANDLER(DEVICE TYPES & PARAMETERS) ;06/09/10  17:47

 ;;8.0;KERNEL;**18,36,69,104,391,440,499,546,1018**;JUL 10, 1995;Build 8

 ;Per VHA Directive 2004-038, this routine should not be modified

 ;Call with a Go from ^%ZIS2

 I %ZIS'["T",$G(^%ZIS(1,+%E,"POX"))]"" D XPOX^ZISX(%E) ;Pre-Open

 I $D(%ZISQUIT) S POP=1 K %ZISQUIT

 S %ZISCHK=1

 ;See if need to lock.

 K %ZISLOCK

 I %ZIS'["T",+$G(^%ZIS(1,+%E,"GBL")) S %ZISLOCK=$NA(^%ZIS("lock",IO))

 ;

 I 'POP G TRM:(%ZTYPE["TRM"),@(%ZTYPE_"^%ZIS6") ;Jump to next part

 ;

Q ;%ZIS6 Returns here

 ;See if need to un-lock.

 I $D(%ZISUOUT) K %ZISUOUT,%ZISHP,%ZISHPOP Q

 I POP S:%ZIS'["T" IO=""

 Q  ;Return to %ZIS1

 ;

VTRM ;Virtual terminal type

TRM ;Terminal type

 D MARGN:'POP,SETPAR:'POP ;Terminal type

 I 'POP,%ZIS'["T",%ZISB=1,'$D(IOP),IO'=IO(0),'$D(IO("Q")),%ZIS["Q" D AQUE

 D W("")

 I '$D(IO("Q")),'POP,%ZISB,%ZIS'["T" D O^%ZIS4

 G Q

DEVOK N X,Y,X1 ;Not sure this is needed

 S X=IO,X1=%ZTYPE

 D DEVOK^%ZOSV I Y=-99!(Y=0)!(Y=$J) Q

 I Y>0 S POP=1 D:(%ZIS["D") W($C(7)_"[Device Unavailable]") Q

 I Y=-1 S IO="",POP=1 D:(%ZIS["D") W($C(7)_"[Device does not Exist or Unavailable]") Q

 Q

 ;

MARGN ;Get the margin and page length

 S %A=$P(%Y,";",1)

 I %A?1A.ANP D SUBIEN(.%A,1) I $D(^%ZIS(2,%A,1)) K %Z91 D ST(1) S %Y=$P(%Y,";",2,9),%ZISMY=$P(%ZISMY,";",2,9) G MARGN

 I %A>3 S $P(%Z91,"^")=$S(%A>255:255,1:+%A)

 I $P(%Y,";",2) S $P(%Z91,"^",3)=+$S($P(%Y,";",2)>65534:65534,1:$P(%Y,";",2)) ;Cache fix for $Y#65535 wrap

 ;

ALTP I '$D(IO("P")) Q:%A>3  G ASKMAR:%ZTYPE["TRM" Q

 S %X=$F(IO("P"),"M") I %X S %A=+$E(IO("P"),%X,99),$P(%Z91,"^")=$S(%A>255:255,1:%A)

 S %X=$F(IO("P"),"L") I %X S $P(%Z91,"^",3)=+$E(IO("P"),%X,99)

 Q:%A>3!(%ZTYPE'["TRM")

ASKMAR I %ZIS["M",'$D(IOP),$S(%E=%H:+$P(%Z,"^",3),1:1),$P(%Z,"^",4) W "    Right Margin: " W:$P(%Z91,"^")]"" +%Z91,"// "

 E  Q

 ;----- BEGIN IHS MODIFICATION - XU*8.0*1007, RE-ADDED XU*8.0*1018

 ;THE LINE BELOW IS COMMENTED OUT AND REPLACED BY A NEW LINE TO ALLOW

 ;FOR SLAVED DEVICES WITH A $I OF 0. ORIG MOD BY IHS/ANMC/CLS 12/10/96

 ;D SBR^%ZIS1 I '$D(DTOUT)&'$D(DUOUT) S:%X=""&($P(%Z91,"^")]"") %X=+%Z91 G ASKMAR:%X'?1.N S $P(%Z91,"^")=$S(%X>255:255,1:%X) Q

 D SBR^%ZIS1 I '$D(DTOUT)&'$D(DUOUT) S:%X=""&($P(%Z91,"^")]"") %X=+%Z91 G ASKMAR:(%X'?1.N)!(%X<1) S $P(%Z91,"^")=$S(%X>255:255,1:%X) Q

 ;----- END IHS MODIFICATION

 S POP=1 I %ZISB&(%ZTYPE["TRM") D C Q

 Q

 ;

W(%) ;Write text

 Q:$D(IOP)

 W !,%

 Q

 ;

C ;Close open device

 I IO'=$G(IO(0)),$D(IO(1,IO)) C IO K IO(1,IO)

 Q

 ;

SETPAR S:$L(%ZISOPAR)&($E(%ZISOPAR)'="(") %ZISOPAR="("_%ZISOPAR_")"

 Q

 ;

AQUE ;Ask about Queueing

 W ! S %=$S($D(IO("Q")):1,1:2)

 I $D(IO("Q")) W !,"Previously, you have selected queueing."

 W !,"Do you "_$S($D(IO("Q")):"STILL ",1:"")_"want your output QUEUED"

 D YN^%ZIS1 G AQUE:%=0 Q:$D(IO("Q"))

 I %=-1 S POP=1,%ZISHPOP=1,%ZISUOUT=1 D C Q

 I %=1 S IO("Q")=1 D C Q

 Q

 ;

ST(%ZISTP) ;

 S %ZISIOST(0)=%A,%ZISIOST=$P($G(^%ZIS(2,%A,0)),"^")

 S:'$D(%Z91) %Z91=$P($G(^%ZIS(2,%A,1),"132^#^60^$C(8)"),"^",1,4),$P(%Z91,"^",5)=$G(^("XY"))

 Q:%ZISTP

STP N %B ;%E is a pointer to the Device file

 S %B=$G(^%ZIS(1,%E,91))

 S:$P(%B,"^")]"" $P(%Z91,"^")=+%B S:$P(%B,"^",3)]"" $P(%Z91,"^",3)=$P(%B,"^",3) ;S $P(%Z91,"^",5)=$G(^%ZIS(2,%ZISIOST(0),"XY"))

 Q

SUBIEN(%1,%) ;Return Subtype ien. %1 is call by Ref.

 N %XX,%YY

 I $D(^%ZIS(2,"B",%1))>9 S %1=+$O(^%ZIS(2,"B",%1,0)) Q

 I '$G(%) S X="" Q

 S %XX=%1 D 2^%ZIS5 S %1=+%YY

 Q

SUBTYPE(%A) ;Called from %ZISH

 N %ZISIOST,%Z91

 S:$G(%A)="" %A="P-OTHER"

 D SUBIEN(.%A),ST(1)

 S IOM=$P(%Z91,U,1),IOF=$P(%Z91,U,2),IOSL=$P(%Z91,U,3),IOST=%ZISIOST,IOST(0)=%ZISIOST(0),IOBS="$C(8)"

 S:IOST="" IOST="P-OTHER",IOST(0)=0

 Q

%ZIS3     ;SFISC/AC,RWF -- DEVICE HANDLER(DEVICE TYPES & PARAMETERS) ;06/09/10  17:47

 +1       ;;8.0;KERNEL;**18,36,69,104,391,440,499,546,1018**;JUL 10, 1995;Build 8

 +2       ;Per VHA Directive 2004-038, this routine should not be modified

 +3       ;Call with a Go from ^%ZIS2

 +4       ;Pre-Open

           IF %ZIS'["T"

               IF $GET(^%ZIS(1,+%E,"POX"))]""

                   DO XPOX^ZISX(%E)

 +5        IF $DATA(%ZISQUIT)

               SET POP=1

               KILL %ZISQUIT

 +6        SET %ZISCHK=1

 +7       ;See if need to lock.

 +8        KILL %ZISLOCK

 +9        IF %ZIS'["T"

               IF +$GET(^%ZIS(1,+%E,"GBL"))

                   SET %ZISLOCK=$NAME(^%ZIS("lock",IO))

 +10      ;

 +11      ;Jump to next part

           IF 'POP

               IF (%ZTYPE["TRM")

                   GOTO TRM

               GOTO @(%ZTYPE_"^%ZIS6")

 +12      ;

Q         ;%ZIS6 Returns here

 +1       ;See if need to un-lock.

 +2        IF $DATA(%ZISUOUT)

               KILL %ZISUOUT,%ZISHP,%ZISHPOP

               QUIT 

 +3        IF POP

               IF %ZIS'["T"

                   SET IO=""

 +4       ;Return to %ZIS1

           QUIT 

 +5       ;

VTRM      ;Virtual terminal type

TRM       ;Terminal type

 +1       ;Terminal type

           IF 'POP

               DO MARGN

           IF 'POP

               DO SETPAR

 +2        IF 'POP

               IF %ZIS'["T"

                   IF %ZISB=1

                       IF '$DATA(IOP)

                           IF IO'=IO(0)

                               IF '$DATA(IO("Q"))

                                   IF %ZIS["Q"

                                       DO AQUE

 +3        DO W("")

 +4        IF '$DATA(IO("Q"))

               IF 'POP

                   IF %ZISB

                       IF %ZIS'["T"

                           DO O^%ZIS4

 +5        GOTO Q

DEVOK     ;Not sure this is needed

           NEW X,Y,X1

 +1        SET X=IO

           SET X1=%ZTYPE

 +2        DO DEVOK^%ZOSV

           IF Y=-99!(Y=0)!(Y=$JOB)

               QUIT 

 +3        IF Y>0

               SET POP=1

               IF (%ZIS["D")

                   DO W($CHAR(7)_"[Device Unavailable]")

               QUIT 

 +4        IF Y=-1

               SET IO=""

               SET POP=1

               IF (%ZIS["D")

                   DO W($CHAR(7)_"[Device does not Exist or Unavailable]")

               QUIT 

 +5        QUIT 

 +6       ;

MARGN     ;Get the margin and page length

 +1        SET %A=$PIECE(%Y,";",1)

 +2        IF %A?1A.ANP

               DO SUBIEN(.%A,1)

               IF $DATA(^%ZIS(2,%A,1))

                   KILL %Z91

                   DO ST(1)

                   SET %Y=$PIECE(%Y,";",2,9)

                   SET %ZISMY=$PIECE(%ZISMY,";",2,9)

                   GOTO MARGN

 +3        IF %A>3

               SET $PIECE(%Z91,"^")=$SELECT(%A>255:255,1:+%A)

 +4       ;Cache fix for $Y#65535 wrap

           IF $PIECE(%Y,";",2)

               SET $PIECE(%Z91,"^",3)=+$SELECT($PIECE(%Y,";",2)>65534:65534,1:$PIECE(%Y,";",2))

 +5       ;

ALTP       IF '$DATA(IO("P"))

               IF %A>3

                   QUIT 

               IF %ZTYPE["TRM"

                   GOTO ASKMAR

               QUIT 

 +1        SET %X=$FIND(IO("P"),"M")

           IF %X

               SET %A=+$EXTRACT(IO("P"),%X,99)

               SET $PIECE(%Z91,"^")=$SELECT(%A>255:255,1:%A)

 +2        SET %X=$FIND(IO("P"),"L")

           IF %X

               SET $PIECE(%Z91,"^",3)=+$EXTRACT(IO("P"),%X,99)

 +3        IF %A>3!(%ZTYPE'["TRM")

               QUIT 

ASKMAR     IF %ZIS["M"

               IF '$DATA(IOP)

                   IF $SELECT(%E=%H:+$PIECE(%Z,"^",3),1:1)

                       IF $PIECE(%Z,"^",4)

                           WRITE "    Right Margin: "

                           IF $PIECE(%Z91,"^")]""

                               WRITE +%Z91,"// "

 +1       IF '$TEST

               QUIT 

 +2       ;----- BEGIN IHS MODIFICATION - XU*8.0*1007, RE-ADDED XU*8.0*1018

 +3       ;THE LINE BELOW IS COMMENTED OUT AND REPLACED BY A NEW LINE TO ALLOW

 +4       ;FOR SLAVED DEVICES WITH A $I OF 0. ORIG MOD BY IHS/ANMC/CLS 12/10/96

 +5       ;D SBR^%ZIS1 I '$D(DTOUT)&'$D(DUOUT) S:%X=""&($P(%Z91,"^")]"") %X=+%Z91 G ASKMAR:%X'?1.N S $P(%Z91,"^")=$S(%X>255:255,1:%X) Q

 +6        DO SBR^%ZIS1

           IF '$DATA(DTOUT)&'$DATA(DUOUT)

               IF %X=""&($PIECE(%Z91,"^")]"")

                   SET %X=+%Z91

               IF (%X'?1.N)!(%X<1)

                   GOTO ASKMAR

               SET $PIECE(%Z91,"^")=$SELECT(%X>255:255,1:%X)

               QUIT 

 +7       ;----- END IHS MODIFICATION

 +8        SET POP=1

           IF %ZISB&(%ZTYPE["TRM")

               DO C

               QUIT 

 +9        QUIT 

 +10      ;

W(%)      ;Write text

 +1        IF $DATA(IOP)

               QUIT 

 +2        WRITE !,%

 +3        QUIT 

 +4       ;

C         ;Close open device

 +1        IF IO'=$GET(IO(0))

               IF $DATA(IO(1,IO))

                   CLOSE IO

                   KILL IO(1,IO)

 +2        QUIT 

 +3       ;

SETPAR     IF $LENGTH(%ZISOPAR)&($EXTRACT(%ZISOPAR)'="(")

               SET %ZISOPAR="("_%ZISOPAR_")"

 +1        QUIT 

 +2       ;

AQUE      ;Ask about Queueing

 +1        WRITE !

           SET %=$SELECT($DATA(IO("Q")):1,1:2)

 +2        IF $DATA(IO("Q"))

               WRITE !,"Previously, you have selected queueing."

 +3        WRITE !,"Do you "_$SELECT($DATA(IO("Q")):"STILL ",1:"")_"want your output QUEUED"

 +4        DO YN^%ZIS1

           IF %=0

               GOTO AQUE

           IF $DATA(IO("Q"))

               QUIT 

 +5        IF %=-1

               SET POP=1

               SET %ZISHPOP=1

               SET %ZISUOUT=1

               DO C

               QUIT 

 +6        IF %=1

               SET IO("Q")=1

               DO C

               QUIT 

 +7        QUIT 

 +8       ;

ST(%ZISTP) ;

 +1        SET %ZISIOST(0)=%A

           SET %ZISIOST=$PIECE($GET(^%ZIS(2,%A,0)),"^")

 +2        IF '$DATA(%Z91)

               SET %Z91=$PIECE($GET(^%ZIS(2,%A,1),"132^#^60^$C(8)"),"^",1,4)

               SET $PIECE(%Z91,"^",5)=$GET(^("XY"))

 +3        IF %ZISTP

               QUIT 

STP       ;%E is a pointer to the Device file

           NEW %B

 +1        SET %B=$GET(^%ZIS(1,%E,91))

 +2       ;S $P(%Z91,"^",5)=$G(^%ZIS(2,%ZISIOST(0),"XY"))

           IF $PIECE(%B,"^")]""

               SET $PIECE(%Z91,"^")=+%B

           IF $PIECE(%B,"^",3)]""

               SET $PIECE(%Z91,"^",3)=$PIECE(%B,"^",3)

 +3        QUIT 

SUBIEN(%1,%) ;Return Subtype ien. %1 is call by Ref.

 +1        NEW %XX,%YY

 +2        IF $DATA(^%ZIS(2,"B",%1))>9

               SET %1=+$ORDER(^%ZIS(2,"B",%1,0))

               QUIT 

 +3        IF '$GET(%)

               SET X=""

               QUIT 

 +4        SET %XX=%1

           DO 2^%ZIS5

           SET %1=+%YY

 +5        QUIT 

SUBTYPE(%A) ;Called from %ZISH

 +1        NEW %ZISIOST,%Z91

 +2        IF $GET(%A)=""

               SET %A="P-OTHER"

 +3        DO SUBIEN(.%A)

           DO ST(1)

 +4        SET IOM=$PIECE(%Z91,U,1)

           SET IOF=$PIECE(%Z91,U,2)

           SET IOSL=$PIECE(%Z91,U,3)

           SET IOST=%ZISIOST

           SET IOST(0)=%ZISIOST(0)

           SET IOBS="$C(8)"

 +5        IF IOST=""

               SET IOST="P-OTHER"

               SET IOST(0)=0

 +6        QUIT