LEXQO ;ISL/KER - Query - Output ;10/30/2008
;;2.0;LEXICON UTILITY;**62**;Sep 23, 1996;Build 10
;
; Global Variables
; ^TMP( SACC 2.3.2.5.1
;
; External References
; ^%ZIS ICR 10086
; HOME^%ZIS ICR 10086
; ^%ZISC ICR 10089
; ^%ZTLOAD ICR 10063
; ^DIR ICR 10026
;
Q
DSP(X) ; Display ^TMP(X,$J)
N %ZIS,LEXCF,LEXCONT,LEXDNC,LEXEOP,LEXI,LEXID,LEXLC,POP,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK S LEXID=$G(X) Q:'$L(LEXID)
D HOME^%ZIS,DEV Q
;
; Device
DEV ; Select a device
N %ZIS,LEXE,LEXCF,LEXCONT,LEXDNC,LEXEOP,LEXI,LEXLC,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
S LEXID=$G(LEXID) Q:'$L(LEXID) S %ZIS("A")=" Device: ",ZTRTN="DSPI^LEXQO",ZTDESC="Display/Print Code Lookup"
S ZTIO=ION,ZTDTH=$H,%ZIS="Q",ZTSAVE("^TMP("""_LEXID_""",$J,")="",ZTSAVE("LEXID")="" W ! D ^%ZIS I POP S LEXEXIT=1 Q
S ZTIO=ION I $D(IO("Q")) D QUE,^%ZISC,HOME^%ZIS Q
D NOQUE Q
NOQUE ; Do not que task
W @IOF W:IOST["P-" !,"< Not queued, printing code lookup >",! H 2 U:IOST["P-" IO D @ZTRTN,^%ZISC,HOME^%ZIS Q
QUE ; Task queued to print user defaults
K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),! H 2 Q
Q
;
DSPI ; Display
N LEXEXIT S LEXEXIT=0,LEXID=$G(LEXID) Q:'$L(LEXID) I '$D(ZTQUEUED),$G(IOST)'["P-" W:'$D(LEXDNC) # I '$D(^TMP(LEXID,$J)) W !,"Text not Found"
U:IOST["P-" IO G:'$D(^TMP(LEXID,$J)) DSPQ N LEXCONT,LEXI,LEXLC,LEXEOP,LEXCF S LEXCF=0,LEXCONT="",(LEXLC,LEXI)=0,LEXEOP=+($G(IOSL))
S:LEXEOP=0 LEXEOP=24 F S LEXI=$O(^TMP(LEXID,$J,LEXI)) Q:+LEXI=0!(LEXCONT["^") Q:+($G(LEXEXIT))>0 D Q:+($G(LEXEXIT))>0
. W !,^TMP(LEXID,$J,LEXI) S LEXCF=0 D LF Q:+($G(LEXEXIT))>0 Q:LEXCONT["^"
S:$D(ZTQUEUED) ZTREQ="@" I +($G(LEXEXIT))>0 K ^TMP(LEXID,$J) Q
D:'LEXCF EOP K ^TMP(LEXID,$J) W:$G(IOST)["P-" @IOF
DSPQ ; Quit Display
Q
;
; Miscellaneous
LF ; Line Feed
S LEXLC=LEXLC+1 D:IOST["P-"&(LEXLC>(LEXEOP-7)) EOP D:IOST'["P-"&(LEXLC>(LEXEOP-4)) EOP
Q
EOP ; End of Page
S LEXCF=1 S LEXLC=0 W:IOST["P-" @IOF Q:IOST["P-" W !! S LEXCONT=$$CONT
Q
CONT(X) ; Ask to Continue
Q:+($G(LEXEXIT))>0 "^^" N DIR,DIROUT,DIRUT,DUOUT,DTOUT,Y S DIR(0)="EAO",DIR("A")=" Enter RETURN to continue or '^' to exit: "
S DIR("PRE")="S:X[""?"" X=""??"" S:X[""^"" X=""^""",(DIR("?"),DIR("??"))="^D CONTH^LEXQO"
D ^DIR S:X["^^"!($D(DTOUT)) X="^^",LEXEXIT=1 Q:X["^^"!(+($G(LEXEXIT))>0) "^^" Q:$D(DIROUT)!($D(DIRUT))!($D(DUOUT))!($D(DTOUT)) "^"
Q:X["^^" "^^" Q:X["^" "^"
Q ""
CONTH ; Ask to Continue Help
W !," Enter either RETURN or '^'."
Q
LEXQO ;ISL/KER - Query - Output ;10/30/2008
+1 ;;2.0;LEXICON UTILITY;**62**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^TMP( SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; ^%ZIS ICR 10086
+8 ; HOME^%ZIS ICR 10086
+9 ; ^%ZISC ICR 10089
+10 ; ^%ZTLOAD ICR 10063
+11 ; ^DIR ICR 10026
+12 ;
+13 QUIT
DSP(X) ; Display ^TMP(X,$J)
+1 NEW %ZIS,LEXCF,LEXCONT,LEXDNC,LEXEOP,LEXI,LEXID,LEXLC,POP,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
SET LEXID=$GET(X)
IF '$LENGTH(LEXID)
QUIT
+2 DO HOME^%ZIS
DO DEV
QUIT
+3 ;
+4 ; Device
DEV ; Select a device
+1 NEW %ZIS,LEXE,LEXCF,LEXCONT,LEXDNC,LEXEOP,LEXI,LEXLC,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
+2 SET LEXID=$GET(LEXID)
IF '$LENGTH(LEXID)
QUIT
SET %ZIS("A")=" Device: "
SET ZTRTN="DSPI^LEXQO"
SET ZTDESC="Display/Print Code Lookup"
+3 SET ZTIO=ION
SET ZTDTH=$HOROLOG
SET %ZIS="Q"
SET ZTSAVE("^TMP("""_LEXID_""",$J,")=""
SET ZTSAVE("LEXID")=""
WRITE !
DO ^%ZIS
IF POP
SET LEXEXIT=1
QUIT
+4 SET ZTIO=ION
IF $DATA(IO("Q"))
DO QUE
DO ^%ZISC
DO HOME^%ZIS
QUIT
+5 DO NOQUE
QUIT
NOQUE ; Do not que task
+1 WRITE @IOF
IF IOST["P-"
WRITE !,"< Not queued, printing code lookup >",!
HANG 2
IF IOST["P-"
USE IO
DO @ZTRTN
DO ^%ZISC
DO HOME^%ZIS
QUIT
QUE ; Task queued to print user defaults
+1 KILL IO("Q")
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued",1:"Request Cancelled"),!
HANG 2
QUIT
+2 QUIT
+3 ;
DSPI ; Display
+1 NEW LEXEXIT
SET LEXEXIT=0
SET LEXID=$GET(LEXID)
IF '$LENGTH(LEXID)
QUIT
IF '$DATA(ZTQUEUED)
IF $GET(IOST)'["P-"
IF '$DATA(LEXDNC)
WRITE #
IF '$DATA(^TMP(LEXID,$JOB))
WRITE !,"Text not Found"
+2 IF IOST["P-"
USE IO
IF '$DATA(^TMP(LEXID,$JOB))
GOTO DSPQ
NEW LEXCONT,LEXI,LEXLC,LEXEOP,LEXCF
SET LEXCF=0
SET LEXCONT=""
SET (LEXLC,LEXI)=0
SET LEXEOP=+($GET(IOSL))
+3 IF LEXEOP=0
SET LEXEOP=24
FOR
SET LEXI=$ORDER(^TMP(LEXID,$JOB,LEXI))
IF +LEXI=0!(LEXCONT["^")
QUIT
IF +($GET(LEXEXIT))>0
QUIT
Begin DoDot:1
+4 WRITE !,^TMP(LEXID,$JOB,LEXI)
SET LEXCF=0
DO LF
IF +($GET(LEXEXIT))>0
QUIT
IF LEXCONT["^"
QUIT
End DoDot:1
IF +($GET(LEXEXIT))>0
QUIT
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
IF +($GET(LEXEXIT))>0
KILL ^TMP(LEXID,$JOB)
QUIT
+6 IF 'LEXCF
DO EOP
KILL ^TMP(LEXID,$JOB)
IF $GET(IOST)["P-"
WRITE @IOF
DSPQ ; Quit Display
+1 QUIT
+2 ;
+3 ; Miscellaneous
LF ; Line Feed
+1 SET LEXLC=LEXLC+1
IF IOST["P-"&(LEXLC>(LEXEOP-7))
DO EOP
IF IOST'["P-"&(LEXLC>(LEXEOP-4))
DO EOP
+2 QUIT
EOP ; End of Page
+1 SET LEXCF=1
SET LEXLC=0
IF IOST["P-"
WRITE @IOF
IF IOST["P-"
QUIT
WRITE !!
SET LEXCONT=$$CONT
+2 QUIT
CONT(X) ; Ask to Continue
+1 IF +($GET(LEXEXIT))>0
QUIT "^^"
NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,Y
SET DIR(0)="EAO"
SET DIR("A")=" Enter RETURN to continue or '^' to exit: "
+2 SET DIR("PRE")="S:X[""?"" X=""??"" S:X[""^"" X=""^"""
SET (DIR("?"),DIR("??"))="^D CONTH^LEXQO"
+3 DO ^DIR
IF X["^^"!($DATA(DTOUT))
SET X="^^"
SET LEXEXIT=1
IF X["^^"!(+($GET(LEXEXIT))>0)
QUIT "^^"
IF $DATA(DIROUT)!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DTOUT))
QUIT "^"
+4 IF X["^^"
QUIT "^^"
IF X["^"
QUIT "^"
+5 QUIT ""
CONTH ; Ask to Continue Help
+1 WRITE !," Enter either RETURN or '^'."
+2 QUIT
