LEXQO ;ISL/KER - Query - Output ;05/23/2017
;;2.0;LEXICON UTILITY;**62,103**;Sep 23, 1996;Build 2
;
; 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) I $D(LEXCAP) D DSPI N LEXCAP Q
D HOME^%ZIS,DEV N LEXCAP
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) I $D(LEXCAP) D DSPI N LEXCAP Q
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(LEXCAP) ! 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:'$D(LEXCAP) @IOF W:IOST["P-"&('$D(LEXCAP)) !,"< Not queued, printing code lookup >",! U:IOST["P-" IO D @ZTRTN,^%ZISC,HOME^%ZIS Q
QUE ; Task queued to print user defaults
K IO("Q") D ^%ZTLOAD W:'$D(LEXCAP) !,$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(LEXCAP)&('$D(LEXDNC))&($L($G(IOF))) @IOF I '$D(^TMP(LEXID,$J)) W:'$D(LEXCAP) !,"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:'$D(LEXCAP) !,^TMP(LEXID,$J,LEXI) S LEXCF=0 D LF Q:+($G(LEXEXIT))>0 Q:LEXCONT["^"
. I $D(LEXCAP) D
. . N LEXII S LEXII=$O(LEXCAP(" "),-1)+1 S LEXCAP(LEXII)=$G(^TMP(LEXID,$J,LEXI))
S:$D(ZTQUEUED) ZTREQ="@" I +($G(LEXEXIT))>0 K ^TMP(LEXID,$J) Q
D:'LEXCF EOP K ^TMP(LEXID,$J) W:'$D(LEXCAP)&($G(IOST)["P-")&($L($G(IOF))) @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:'$D(LEXCAP)&(IOST["P-")&($L($G(IOF))) @IOF Q:IOST["P-" W:'$D(LEXCAP) !! S LEXCONT=$$CONT
Q
CONT(X) ; Ask to Continue
Q:$D(LEXCAP) "" 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:'$D(LEXCAP) !," Enter either RETURN or '^'."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXQO 3126 printed Oct 16, 2024@18:09:42 Page 2
LEXQO ;ISL/KER - Query - Output ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**62,103**;Sep 23, 1996;Build 2
+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
+2 SET LEXID=$GET(X)
if '$LENGTH(LEXID)
QUIT
IF $DATA(LEXCAP)
DO DSPI
NEW LEXCAP
QUIT
+3 DO HOME^%ZIS
DO DEV
NEW LEXCAP
+4 QUIT
+5 ;
+6 ; 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
IF $DATA(LEXCAP)
DO DSPI
NEW LEXCAP
QUIT
+3 SET %ZIS("A")=" Device: "
SET ZTRTN="DSPI^LEXQO"
SET ZTDESC="Display/Print Code Lookup"
+4 SET ZTIO=ION
SET ZTDTH=$HOROLOG
SET %ZIS="Q"
SET ZTSAVE("^TMP("""_LEXID_""",$J,")=""
SET ZTSAVE("LEXID")=""
if '$DATA(LEXCAP)
WRITE !
DO ^%ZIS
IF POP
SET LEXEXIT=1
QUIT
+5 SET ZTIO=ION
IF $DATA(IO("Q"))
DO QUE
DO ^%ZISC
DO HOME^%ZIS
QUIT
+6 DO NOQUE
QUIT
NOQUE ; Do not que task
+1 if '$DATA(LEXCAP)
WRITE @IOF
if IOST["P-"&('$DATA(LEXCAP))
WRITE !,"< Not queued, printing code lookup >",!
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
if '$DATA(LEXCAP)
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-"
+2 if '$DATA(LEXCAP)&('$DATA(LEXDNC))&($LENGTH($GET(IOF)))
WRITE @IOF
IF '$DATA(^TMP(LEXID,$JOB))
if '$DATA(LEXCAP)
WRITE !,"Text not Found"
+3 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))
+4 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
+5 if '$DATA(LEXCAP)
WRITE !,^TMP(LEXID,$JOB,LEXI)
SET LEXCF=0
DO LF
if +($GET(LEXEXIT))>0
QUIT
if LEXCONT["^"
QUIT
+6 IF $DATA(LEXCAP)
Begin DoDot:2
+7 NEW LEXII
SET LEXII=$ORDER(LEXCAP(" "),-1)+1
SET LEXCAP(LEXII)=$GET(^TMP(LEXID,$JOB,LEXI))
End DoDot:2
End DoDot:1
if +($GET(LEXEXIT))>0
QUIT
+8 if $DATA(ZTQUEUED)
SET ZTREQ="@"
IF +($GET(LEXEXIT))>0
KILL ^TMP(LEXID,$JOB)
QUIT
+9 if 'LEXCF
DO EOP
KILL ^TMP(LEXID,$JOB)
if '$DATA(LEXCAP)&($GET(IOST)["P-")&($LENGTH($GET(IOF)))
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 '$DATA(LEXCAP)&(IOST["P-")&($LENGTH($GET(IOF)))
WRITE @IOF
if IOST["P-"
QUIT
if '$DATA(LEXCAP)
WRITE !!
SET LEXCONT=$$CONT
+2 QUIT
CONT(X) ; Ask to Continue
+1 if $DATA(LEXCAP)
QUIT ""
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 if '$DATA(LEXCAP)
WRITE !," Enter either RETURN or '^'."
+2 QUIT
