YSLXDG2 ;ALB/RBD - Select ICD DIAGNOSIS FROM LEXICON UTILITY LIST;10 May 2013 9:46 AM
;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
;
; Based on ZZLXDG2
;
; Input
;
; X Length of list to display (default 5)
; .YSSRL Local array passed by reference
;
; YSSRL() Input Array from ICDSRCH^LEX10CS
;
; YSSRL(0)=# found ^ Pruning Indicator
; YSSRL(1,0)=Code ^ Code IEN ^ date
; YSSRL(1,"IDL")=ICD-9/10 Description, Long
; YSSRL(1,"IDL",1)=ICD-9/10 IEN ^ date
; YSSRL(1,"IDS")=ICD-9/10 Description, Short
; YSSRL(1,"IDS",1)=ICD-9/10 IEN ^ date
; YSSRL(1,"LEX")=Lexicon Description
; YSSRL(1,"LEX",1)=Expression IEN ^ date
; YSSRL(1,"SYN",1)=Synonym #1
; YSSRL(1,"SYN",m)=Synonym #m
; ...
;
; Output
;
; $$SEL Two Piece "^" delimited string same as
; Fileman's Y output variable
;
; 1 Lexicon IEN
; 2 Lexicon Term
;
; YSSRL Local array passed by reference
;
; YSSRL(0)=Code ^ Code IEN ^ date
; YSSRL("IDL")=ICD-9/10 Description, Long
; YSSRL("IDL",1)=ICD-9/10 IEN ^ date
; YSSRL("IDS")=ICD-9/10 Description, Short
; YSSRL("IDS",1)=ICD-9/10 IEN ^ date
; YSSRL("LEX")=Lexicon Description
; YSSRL("LEX",1)=Expression IEN ^ date
;
; or ^ on error
; or -1 for non-selection
; or -2 if "^" was entered
;
SEL(YSSRL,X) ; Select from List
N YSGOUP S YSGOUP=0
S X=+($G(X))
S:X'>0 X=5
S X=$$ASK(.YSSRL,X)
I YSGOUP=1 Q -2
Q X
;
ASK(YSSRL,X) ; Ask for Selection
N DTOUT,DUOUT,DIROUT
N YSLIT,YSLL,YSLTOT
S YSLL=+($G(X))
S:YSLL'>0 YSLL=5
S YSLIT=0,YSLTOT=$O(YSSRL(" "),-1)
Q:+YSLTOT'>0 "^"
K X
S:+YSLTOT=1 X=$$ONE(YSLL,.YSSRL)
S:+YSLTOT>1 X=$$MUL(.YSSRL,YSLL)
S:'$D(DTOUT)&('$D(DUOUT))&('$D(DIROUT))&(+($G(X))'>0) X=-1
Q X
ONE(X,YSSRL) ; One Entry Found
Q:+($G(YSLIT))>0 "^^"
N DIR,YSLC,YSLEX,YSLFI,YSLIT,YSLSO,YSLNC
N YSLSP,YSLTX,YSLC,YSNXTLIN,Y
S YSLFI=$O(YSSRL(0)) Q:+YSLFI'>0 "^" S YSLSP=$J(" ",11)
S YSLSO=$P(YSSRL(1,0),"^",1),YSLNC=$P(YSSRL(1,0),"^",3)
S:+YSLNC>0 YSLNC=" ("_YSLNC_")" S YSLEX=$G(YSSRL(1,"MENU"))
S YSLC=$S($D(YSSRL(1,"CAT")):"-",1:"")
S YSLTX(1)=YSLSO_YSLC_$J(" ",(9-$L(YSLSO)))_" "_YSLEX_YSLNC
D PR(.YSLTX,64) S DIR("A",1)=" One match found",DIR("A",2)=" "
S DIR("A",3)=" "_$G(YSLTX(1)),YSLC=3 I $L($G(YSLTX(2))) D
. F YSNXTLIN=2:1 Q:$G(YSLTX(YSNXTLIN))="" D
.. S YSLC=YSLC+1,DIR("A",YSLC)=YSLSP_$G(YSLTX(YSNXTLIN))
S YSLC=YSLC+1,DIR("A",YSLC)=" ",YSLC=YSLC+1
S DIR("A")=" OK? (Yes/No) ",DIR("B")="Yes",DIR(0)="YAO" W !
D ^DIR Q:'$D(DTOUT)&('$D(DUOUT))&('$D(DIROUT))&(+($G(Y))'>0) -1
S:X["^^"!($D(DTOUT)) YSLIT=1
I X["^^"!(+($G(YSLIT))>0) K YSSRL Q "^^"
S X=$S(+Y>0:$$X(1,.YSSRL),1:-1)
Q X
MUL(YSSRL,Y) ; Multiple Entries Found
Q:+($G(YSLIT))>0 "^^"
N YSSRLE,YSLL,YSLMAX,YSLSS,YSLX,X
S (YSLMAX,YSLSS,YSLIT)=0,YSLL=+($G(Y)),U="^" S:+($G(YSLL))'>0 YSLL=5
S YSLX=$O(YSSRL(" "),-1),YSLSS=0
G:+YSLX=0 MULQ W ! W:+YSLX>1 !," ",YSLX," matches found"
F YSSRLE=1:1:YSLX Q:((YSLSS>0)&(YSLSS<(YSSRLE+1))) Q:YSLIT D Q:YSLIT
. W:YSSRLE#YSLL=1 ! D MULW
. S YSLMAX=YSSRLE W:YSSRLE#YSLL=0 !
. S:YSSRLE#YSLL=0 YSLSS=$$MULS(YSLMAX,YSSRLE,.YSSRL) S:YSLSS["^" YSLIT=1
I YSSRLE#YSLL'=0,+YSLSS<=0 D
. W ! S YSLSS=$$MULS(YSLMAX,YSSRLE,.YSSRL) S:YSLSS["^" YSLIT=1
G MULQ
Q X
MULW ; Write Multiple
N YSLEX,YSLI1,YSLSO,YSLNC,YSLT2,YSLTX S YSLSO=$P(YSSRL(+YSSRLE,0),"^",1)
S YSLNC=$P(YSSRL(+YSSRLE,0),"^",3) S:+YSLNC>0 YSLNC=" ("_YSLNC_")"
S YSLEX=$G(YSSRL(+YSSRLE,"MENU")),YSLTX(1)=YSLSO
S YSLTX(1)=YSLTX(1)_$S($D(YSSRL(+YSSRLE,"CAT")):"-",1:" ")_$J(" ",(9-$L(YSLSO)))_" "_YSLEX_YSLNC
D PR(.YSLTX,60) W !,$J(YSSRLE,5),". ",$G(YSLTX(1))
F YSLI1=2:1:5 S YSLT2=$G(YSLTX(YSLI1)) W:$L(YSLT2) !,$J(" ",19),YSLT2
Q
MULS(X,Y,YSSRL) ; Select from Multiple Entries
N DIR,DIRB,YSLFI,YSLHLP,YSLLST,YSLMAX,YSLS1 ;@#$ not sure YSLS1 is needed here
Q:+($G(YSLIT))>0 "^^" S YSLMAX=+($G(X)),YSLLST=+($G(Y))
Q:YSLMAX=0 -1 S YSLFI=$O(YSSRL(0)) Q:+YSLFI'>0 -1
I +($O(YSSRL(+YSLLST)))>0 D
. S DIR("A")=" Press <RETURN> for more, ""^"" to exit, or Select 1-"
. S DIR("A")=DIR("A")_YSLMAX_": "
I +($O(YSSRL(+YSLLST)))'>0 D
. S DIR("A")=" Select 1-"_YSLMAX_": "
S YSLHLP=" Answer must be from 1 to "
S YSLHLP=YSLHLP_YSLMAX_", or <Return> to continue"
S DIR("PRE")="S:X[""?"" X=""??"""
S (DIR("?"),DIR("??"))="^D MULSH^YSLXDG2"
S DIR(0)="NAO^1:"_YSLMAX_":0" D ^DIR
S:X="^" YSGOUP=1
Q:'$D(DTOUT)&('$D(DUOUT))&('$D(DIROUT))&(+($G(Y))'>0) -1
S:X["^^"!($D(DTOUT)) YSLIT=1,X="^^" I X["^^"!(+($G(YSLIT))>0) Q "^^"
K DIR Q:$D(DTOUT)!(X[U) "^^"
Q $S(+Y>0:+Y,1:"-1")
MULSH ; Select from Multiple Entries Help
I $L($G(YSLHLP)) W !,$G(YSLHLP) Q
Q
MULQ ; Quit Multiple
I +YSLSS'>0,$G(YSLSS)="^" Q "^"
S X=-1 S:+($G(YSLIT))'>0 X=$$X(+YSLSS,.YSSRL)
Q X
X(X,YSSRL) ; Set X and Output Array
N YSLEX,YSSRFI,YSLIEN,YSLN1,YSLNC,YSLNN,YSLRN,YSLS1,YSLSO
S YSLS1=+($G(X))
S YSSRFI=$O(YSSRL(0)) ;@#$ not used?
S YSLSO=$P($G(YSSRL(YSLS1,0)),"^",1),YSLEX=$G(YSSRL(YSLS1,"MENU"))
S YSLIEN=$S($D(YSSRL(YSLS1,"CAT")):"99:CAT;"_$P($G(YSSRL(YSLS1,0)),"^"),1:$P($G(YSSRL(YSLS1,"LEX",1)),"^")_";"_$P($G(YSSRL(YSLS1,0)),"^")) Q:'$L(YSLSO) "^"
Q:'$L(YSLEX) "^" Q:+YSLIEN'>0 "^" S X=YSLIEN_"^"_YSLEX
S YSLNN="YSSRL("_+YSLS1_")",YSLNC="YSSRL("_+YSLS1_","
F S YSLNN=$Q(@YSLNN) Q:'$L(YSLNN)!(YSLNN'[YSLNC) D
. S YSLRN="YSLN1("_$P(YSLNN,"(",2,299) S @YSLRN=@YSLNN
K YSSRL S YSLNN="YSLN1("_+YSLS1_")",YSLNC="YSLN1("_+YSLS1_","
F S YSLNN=$Q(@YSLNN) Q:'$L(YSLNN)!(YSLNN'[YSLNC) D
. S YSLRN="YSSRL("_$P(YSLNN,"(",2,299),@YSLRN=@YSLNN
Q X
;
; Miscellaneous
CL ; Clear
K YSLIT
Q
PR(YSSRL,X) ; Parse Array
N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,I,Z,%,%D,YSLC,YSLI1,YSLL
K ^UTILITY($J,"W")
Q:'$D(YSSRL)
S YSLL=+($G(X))
S:+YSLL'>0 YSLL=79
S YSLC=+($G(YSSRL))
S:+($G(YSLC))'>0 YSLC=$O(YSSRL(" "),-1)
Q:+YSLC'>0
S DIWL=1,DIWF="C"_+YSLL
S YSLI1=0
F S YSLI1=$O(YSSRL(YSLI1)) Q:+YSLI1=0 S X=$G(YSSRL(YSLI1)) D ^DIWP
K YSSRL
S (YSLC,YSLI1)=0
F S YSLI1=$O(^UTILITY($J,"W",1,YSLI1)) Q:+YSLI1=0 D
. S YSSRL(YSLI1)=$$TM($G(^UTILITY($J,"W",1,YSLI1,0))," "),YSLC=YSLC+1
S:$L(YSLC) YSSRL=YSLC
K ^UTILITY($J,"W")
Q
TM(X,Y) ; Trim Character Y - Default " "
S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSLXDG2 6652 printed Dec 13, 2024@02:14:42 Page 2
YSLXDG2 ;ALB/RBD - Select ICD DIAGNOSIS FROM LEXICON UTILITY LIST;10 May 2013 9:46 AM
+1 ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
+2 ;
+3 ; Based on ZZLXDG2
+4 ;
+5 ; Input
+6 ;
+7 ; X Length of list to display (default 5)
+8 ; .YSSRL Local array passed by reference
+9 ;
+10 ; YSSRL() Input Array from ICDSRCH^LEX10CS
+11 ;
+12 ; YSSRL(0)=# found ^ Pruning Indicator
+13 ; YSSRL(1,0)=Code ^ Code IEN ^ date
+14 ; YSSRL(1,"IDL")=ICD-9/10 Description, Long
+15 ; YSSRL(1,"IDL",1)=ICD-9/10 IEN ^ date
+16 ; YSSRL(1,"IDS")=ICD-9/10 Description, Short
+17 ; YSSRL(1,"IDS",1)=ICD-9/10 IEN ^ date
+18 ; YSSRL(1,"LEX")=Lexicon Description
+19 ; YSSRL(1,"LEX",1)=Expression IEN ^ date
+20 ; YSSRL(1,"SYN",1)=Synonym #1
+21 ; YSSRL(1,"SYN",m)=Synonym #m
+22 ; ...
+23 ;
+24 ; Output
+25 ;
+26 ; $$SEL Two Piece "^" delimited string same as
+27 ; Fileman's Y output variable
+28 ;
+29 ; 1 Lexicon IEN
+30 ; 2 Lexicon Term
+31 ;
+32 ; YSSRL Local array passed by reference
+33 ;
+34 ; YSSRL(0)=Code ^ Code IEN ^ date
+35 ; YSSRL("IDL")=ICD-9/10 Description, Long
+36 ; YSSRL("IDL",1)=ICD-9/10 IEN ^ date
+37 ; YSSRL("IDS")=ICD-9/10 Description, Short
+38 ; YSSRL("IDS",1)=ICD-9/10 IEN ^ date
+39 ; YSSRL("LEX")=Lexicon Description
+40 ; YSSRL("LEX",1)=Expression IEN ^ date
+41 ;
+42 ; or ^ on error
+43 ; or -1 for non-selection
+44 ; or -2 if "^" was entered
+45 ;
SEL(YSSRL,X) ; Select from List
+1 NEW YSGOUP
SET YSGOUP=0
+2 SET X=+($GET(X))
+3 if X'>0
SET X=5
+4 SET X=$$ASK(.YSSRL,X)
+5 IF YSGOUP=1
QUIT -2
+6 QUIT X
+7 ;
ASK(YSSRL,X) ; Ask for Selection
+1 NEW DTOUT,DUOUT,DIROUT
+2 NEW YSLIT,YSLL,YSLTOT
+3 SET YSLL=+($GET(X))
+4 if YSLL'>0
SET YSLL=5
+5 SET YSLIT=0
SET YSLTOT=$ORDER(YSSRL(" "),-1)
+6 if +YSLTOT'>0
QUIT "^"
+7 KILL X
+8 if +YSLTOT=1
SET X=$$ONE(YSLL,.YSSRL)
+9 if +YSLTOT>1
SET X=$$MUL(.YSSRL,YSLL)
+10 if '$DATA(DTOUT)&('$DATA(DUOUT))&('$DATA(DIROUT))&(+($GET(X))'>0)
SET X=-1
+11 QUIT X
ONE(X,YSSRL) ; One Entry Found
+1 if +($GET(YSLIT))>0
QUIT "^^"
+2 NEW DIR,YSLC,YSLEX,YSLFI,YSLIT,YSLSO,YSLNC
+3 NEW YSLSP,YSLTX,YSLC,YSNXTLIN,Y
+4 SET YSLFI=$ORDER(YSSRL(0))
if +YSLFI'>0
QUIT "^"
SET YSLSP=$JUSTIFY(" ",11)
+5 SET YSLSO=$PIECE(YSSRL(1,0),"^",1)
SET YSLNC=$PIECE(YSSRL(1,0),"^",3)
+6 if +YSLNC>0
SET YSLNC=" ("_YSLNC_")"
SET YSLEX=$GET(YSSRL(1,"MENU"))
+7 SET YSLC=$SELECT($DATA(YSSRL(1,"CAT")):"-",1:"")
+8 SET YSLTX(1)=YSLSO_YSLC_$JUSTIFY(" ",(9-$LENGTH(YSLSO)))_" "_YSLEX_YSLNC
+9 DO PR(.YSLTX,64)
SET DIR("A",1)=" One match found"
SET DIR("A",2)=" "
+10 SET DIR("A",3)=" "_$GET(YSLTX(1))
SET YSLC=3
IF $LENGTH($GET(YSLTX(2)))
Begin DoDot:1
+11 FOR YSNXTLIN=2:1
if $GET(YSLTX(YSNXTLIN))=""
QUIT
Begin DoDot:2
+12 SET YSLC=YSLC+1
SET DIR("A",YSLC)=YSLSP_$GET(YSLTX(YSNXTLIN))
End DoDot:2
End DoDot:1
+13 SET YSLC=YSLC+1
SET DIR("A",YSLC)=" "
SET YSLC=YSLC+1
+14 SET DIR("A")=" OK? (Yes/No) "
SET DIR("B")="Yes"
SET DIR(0)="YAO"
WRITE !
+15 DO ^DIR
if '$DATA(DTOUT)&('$DATA(DUOUT))&('$DATA(DIROUT))&(+($GET(Y))'>0)
QUIT -1
+16 if X["^^"!($DATA(DTOUT))
SET YSLIT=1
+17 IF X["^^"!(+($GET(YSLIT))>0)
KILL YSSRL
QUIT "^^"
+18 SET X=$SELECT(+Y>0:$$X(1,.YSSRL),1:-1)
+19 QUIT X
MUL(YSSRL,Y) ; Multiple Entries Found
+1 if +($GET(YSLIT))>0
QUIT "^^"
+2 NEW YSSRLE,YSLL,YSLMAX,YSLSS,YSLX,X
+3 SET (YSLMAX,YSLSS,YSLIT)=0
SET YSLL=+($GET(Y))
SET U="^"
if +($GET(YSLL))'>0
SET YSLL=5
+4 SET YSLX=$ORDER(YSSRL(" "),-1)
SET YSLSS=0
+5 if +YSLX=0
GOTO MULQ
WRITE !
if +YSLX>1
WRITE !," ",YSLX," matches found"
+6 FOR YSSRLE=1:1:YSLX
if ((YSLSS>0)&(YSLSS<(YSSRLE+1)))
QUIT
if YSLIT
QUIT
Begin DoDot:1
+7 if YSSRLE#YSLL=1
WRITE !
DO MULW
+8 SET YSLMAX=YSSRLE
if YSSRLE#YSLL=0
WRITE !
+9 if YSSRLE#YSLL=0
SET YSLSS=$$MULS(YSLMAX,YSSRLE,.YSSRL)
if YSLSS["^"
SET YSLIT=1
End DoDot:1
if YSLIT
QUIT
+10 IF YSSRLE#YSLL'=0
IF +YSLSS<=0
Begin DoDot:1
+11 WRITE !
SET YSLSS=$$MULS(YSLMAX,YSSRLE,.YSSRL)
if YSLSS["^"
SET YSLIT=1
End DoDot:1
+12 GOTO MULQ
+13 QUIT X
MULW ; Write Multiple
+1 NEW YSLEX,YSLI1,YSLSO,YSLNC,YSLT2,YSLTX
SET YSLSO=$PIECE(YSSRL(+YSSRLE,0),"^",1)
+2 SET YSLNC=$PIECE(YSSRL(+YSSRLE,0),"^",3)
if +YSLNC>0
SET YSLNC=" ("_YSLNC_")"
+3 SET YSLEX=$GET(YSSRL(+YSSRLE,"MENU"))
SET YSLTX(1)=YSLSO
+4 SET YSLTX(1)=YSLTX(1)_$SELECT($DATA(YSSRL(+YSSRLE,"CAT")):"-",1:" ")_$JUSTIFY(" ",(9-$LENGTH(YSLSO)))_" "_YSLEX_YSLNC
+5 DO PR(.YSLTX,60)
WRITE !,$JUSTIFY(YSSRLE,5),". ",$GET(YSLTX(1))
+6 FOR YSLI1=2:1:5
SET YSLT2=$GET(YSLTX(YSLI1))
if $LENGTH(YSLT2)
WRITE !,$JUSTIFY(" ",19),YSLT2
+7 QUIT
MULS(X,Y,YSSRL) ; Select from Multiple Entries
+1 ;@#$ not sure YSLS1 is needed here
NEW DIR,DIRB,YSLFI,YSLHLP,YSLLST,YSLMAX,YSLS1
+2 if +($GET(YSLIT))>0
QUIT "^^"
SET YSLMAX=+($GET(X))
SET YSLLST=+($GET(Y))
+3 if YSLMAX=0
QUIT -1
SET YSLFI=$ORDER(YSSRL(0))
if +YSLFI'>0
QUIT -1
+4 IF +($ORDER(YSSRL(+YSLLST)))>0
Begin DoDot:1
+5 SET DIR("A")=" Press <RETURN> for more, ""^"" to exit, or Select 1-"
+6 SET DIR("A")=DIR("A")_YSLMAX_": "
End DoDot:1
+7 IF +($ORDER(YSSRL(+YSLLST)))'>0
Begin DoDot:1
+8 SET DIR("A")=" Select 1-"_YSLMAX_": "
End DoDot:1
+9 SET YSLHLP=" Answer must be from 1 to "
+10 SET YSLHLP=YSLHLP_YSLMAX_", or <Return> to continue"
+11 SET DIR("PRE")="S:X[""?"" X=""??"""
+12 SET (DIR("?"),DIR("??"))="^D MULSH^YSLXDG2"
+13 SET DIR(0)="NAO^1:"_YSLMAX_":0"
DO ^DIR
+14 if X="^"
SET YSGOUP=1
+15 if '$DATA(DTOUT)&('$DATA(DUOUT))&('$DATA(DIROUT))&(+($GET(Y))'>0)
QUIT -1
+16 if X["^^"!($DATA(DTOUT))
SET YSLIT=1
SET X="^^"
IF X["^^"!(+($GET(YSLIT))>0)
QUIT "^^"
+17 KILL DIR
if $DATA(DTOUT)!(X[U)
QUIT "^^"
+18 QUIT $SELECT(+Y>0:+Y,1:"-1")
MULSH ; Select from Multiple Entries Help
+1 IF $LENGTH($GET(YSLHLP))
WRITE !,$GET(YSLHLP)
QUIT
+2 QUIT
MULQ ; Quit Multiple
+1 IF +YSLSS'>0
IF $GET(YSLSS)="^"
QUIT "^"
+2 SET X=-1
if +($GET(YSLIT))'>0
SET X=$$X(+YSLSS,.YSSRL)
+3 QUIT X
X(X,YSSRL) ; Set X and Output Array
+1 NEW YSLEX,YSSRFI,YSLIEN,YSLN1,YSLNC,YSLNN,YSLRN,YSLS1,YSLSO
+2 SET YSLS1=+($GET(X))
+3 ;@#$ not used?
SET YSSRFI=$ORDER(YSSRL(0))
+4 SET YSLSO=$PIECE($GET(YSSRL(YSLS1,0)),"^",1)
SET YSLEX=$GET(YSSRL(YSLS1,"MENU"))
+5 SET YSLIEN=$SELECT($DATA(YSSRL(YSLS1,"CAT")):"99:CAT;"_$PIECE($GET(YSSRL(YSLS1,0)),"^"),1:$PIECE($GET(YSSRL(YSLS1,"LEX",1)),"^")_";"_$PIECE($GET(YSSRL(YSLS1,0)),"^"))
if '$LENGTH(YSLSO)
QUIT "^"
+6 if '$LENGTH(YSLEX)
QUIT "^"
if +YSLIEN'>0
QUIT "^"
SET X=YSLIEN_"^"_YSLEX
+7 SET YSLNN="YSSRL("_+YSLS1_")"
SET YSLNC="YSSRL("_+YSLS1_","
+8 FOR
SET YSLNN=$QUERY(@YSLNN)
if '$LENGTH(YSLNN)!(YSLNN'[YSLNC)
QUIT
Begin DoDot:1
+9 SET YSLRN="YSLN1("_$PIECE(YSLNN,"(",2,299)
SET @YSLRN=@YSLNN
End DoDot:1
+10 KILL YSSRL
SET YSLNN="YSLN1("_+YSLS1_")"
SET YSLNC="YSLN1("_+YSLS1_","
+11 FOR
SET YSLNN=$QUERY(@YSLNN)
if '$LENGTH(YSLNN)!(YSLNN'[YSLNC)
QUIT
Begin DoDot:1
+12 SET YSLRN="YSSRL("_$PIECE(YSLNN,"(",2,299)
SET @YSLRN=@YSLNN
End DoDot:1
+13 QUIT X
+14 ;
+15 ; Miscellaneous
CL ; Clear
+1 KILL YSLIT
+2 QUIT
PR(YSSRL,X) ; Parse Array
+1 NEW DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,I,Z,%,%D,YSLC,YSLI1,YSLL
+2 KILL ^UTILITY($JOB,"W")
+3 if '$DATA(YSSRL)
QUIT
+4 SET YSLL=+($GET(X))
+5 if +YSLL'>0
SET YSLL=79
+6 SET YSLC=+($GET(YSSRL))
+7 if +($GET(YSLC))'>0
SET YSLC=$ORDER(YSSRL(" "),-1)
+8 if +YSLC'>0
QUIT
+9 SET DIWL=1
SET DIWF="C"_+YSLL
+10 SET YSLI1=0
+11 FOR
SET YSLI1=$ORDER(YSSRL(YSLI1))
if +YSLI1=0
QUIT
SET X=$GET(YSSRL(YSLI1))
DO ^DIWP
+12 KILL YSSRL
+13 SET (YSLC,YSLI1)=0
+14 FOR
SET YSLI1=$ORDER(^UTILITY($JOB,"W",1,YSLI1))
if +YSLI1=0
QUIT
Begin DoDot:1
+15 SET YSSRL(YSLI1)=$$TM($GET(^UTILITY($JOB,"W",1,YSLI1,0))," ")
SET YSLC=YSLC+1
End DoDot:1
+16 if $LENGTH(YSLC)
SET YSSRL=YSLC
+17 KILL ^UTILITY($JOB,"W")
+18 QUIT
TM(X,Y) ; Trim Character Y - Default " "
+1 SET X=$GET(X)
if X=""
QUIT X
SET Y=$GET(Y)
if '$LENGTH(Y)
SET Y=" "
+2 FOR
if $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 FOR
if $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 QUIT X
