- 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
