Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXQO

LEXQO.m

Go to the documentation of this file.
  1. LEXQO ;ISL/KER - Query - Output ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**62,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^TMP( SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; ^%ZIS ICR 10086
  1. ; HOME^%ZIS ICR 10086
  1. ; ^%ZISC ICR 10089
  1. ; ^%ZTLOAD ICR 10063
  1. ; ^DIR ICR 10026
  1. ;
  1. Q
  1. DSP(X) ; Display ^TMP(X,$J)
  1. N %ZIS,LEXCF,LEXCONT,LEXDNC,LEXEOP,LEXI,LEXID,LEXLC,POP,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
  1. S LEXID=$G(X) Q:'$L(LEXID) I $D(LEXCAP) D DSPI N LEXCAP Q
  1. D HOME^%ZIS,DEV N LEXCAP
  1. Q
  1. ;
  1. ; Device
  1. DEV ; Select a device
  1. N %ZIS,LEXE,LEXCF,LEXCONT,LEXDNC,LEXEOP,LEXI,LEXLC,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
  1. S LEXID=$G(LEXID) Q:'$L(LEXID) I $D(LEXCAP) D DSPI N LEXCAP Q
  1. S %ZIS("A")=" Device: ",ZTRTN="DSPI^LEXQO",ZTDESC="Display/Print Code Lookup"
  1. S ZTIO=ION,ZTDTH=$H,%ZIS="Q",ZTSAVE("^TMP("""_LEXID_""",$J,")="",ZTSAVE("LEXID")="" W:'$D(LEXCAP) ! D ^%ZIS I POP S LEXEXIT=1 Q
  1. S ZTIO=ION I $D(IO("Q")) D QUE,^%ZISC,HOME^%ZIS Q
  1. D NOQUE Q
  1. NOQUE ; Do not que task
  1. W:'$D(LEXCAP) @IOF W:IOST["P-"&('$D(LEXCAP)) !,"< Not queued, printing code lookup >",! U:IOST["P-" IO D @ZTRTN,^%ZISC,HOME^%ZIS Q
  1. QUE ; Task queued to print user defaults
  1. K IO("Q") D ^%ZTLOAD W:'$D(LEXCAP) !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),! H 2 Q
  1. Q
  1. ;
  1. DSPI ; Display
  1. N LEXEXIT S LEXEXIT=0,LEXID=$G(LEXID) Q:'$L(LEXID) I '$D(ZTQUEUED),$G(IOST)'["P-"
  1. W:'$D(LEXCAP)&('$D(LEXDNC))&($L($G(IOF))) @IOF I '$D(^TMP(LEXID,$J)) W:'$D(LEXCAP) !,"Text not Found"
  1. 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))
  1. 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
  1. . W:'$D(LEXCAP) !,^TMP(LEXID,$J,LEXI) S LEXCF=0 D LF Q:+($G(LEXEXIT))>0 Q:LEXCONT["^"
  1. . I $D(LEXCAP) D
  1. . . N LEXII S LEXII=$O(LEXCAP(" "),-1)+1 S LEXCAP(LEXII)=$G(^TMP(LEXID,$J,LEXI))
  1. S:$D(ZTQUEUED) ZTREQ="@" I +($G(LEXEXIT))>0 K ^TMP(LEXID,$J) Q
  1. D:'LEXCF EOP K ^TMP(LEXID,$J) W:'$D(LEXCAP)&($G(IOST)["P-")&($L($G(IOF))) @IOF
  1. DSPQ ; Quit Display
  1. Q
  1. ;
  1. ; Miscellaneous
  1. LF ; Line Feed
  1. S LEXLC=LEXLC+1 D:IOST["P-"&(LEXLC>(LEXEOP-7)) EOP D:IOST'["P-"&(LEXLC>(LEXEOP-4)) EOP
  1. Q
  1. EOP ; End of Page
  1. S LEXCF=1 S LEXLC=0 W:'$D(LEXCAP)&(IOST["P-")&($L($G(IOF))) @IOF Q:IOST["P-" W:'$D(LEXCAP) !! S LEXCONT=$$CONT
  1. Q
  1. CONT(X) ; Ask to Continue
  1. 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: "
  1. S DIR("PRE")="S:X[""?"" X=""??"" S:X[""^"" X=""^""",(DIR("?"),DIR("??"))="^D CONTH^LEXQO"
  1. D ^DIR S:X["^^"!($D(DTOUT)) X="^^",LEXEXIT=1 Q:X["^^"!(+($G(LEXEXIT))>0) "^^" Q:$D(DIROUT)!($D(DIRUT))!($D(DUOUT))!($D(DTOUT)) "^"
  1. Q:X["^^" "^^" Q:X["^" "^"
  1. Q ""
  1. CONTH ; Ask to Continue Help
  1. W:'$D(LEXCAP) !," Enter either RETURN or '^'."
  1. Q