- 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 Feb 18, 2025@23:35:04 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