YTQAPI2 ;ASF/ALB - MHAX REMOTE PROCEDURES cont ;10/17/16 13:37
;;5.01;MENTAL HEALTH;**85,96,119,121,123,130,217,235,240**;Dec 30, 1994;Build 10
;
; Reference to ^DPT in ICR #10035
; Reference to LIST^DIC in ICR #2051
; Reference to $$VFILE^DILFD,$$VFIELD^DILFD in ICR #2055
; Reference to $$GET1^DIQ in ICR #2056
;
Q
LISTER(YSDATA,YS) ;list entries
;entry point for YTQ GENERIC LISTER rpc
;input: CODE as test name
;output: Field^Value
N YSFIELD,YSFILEN,N,C,YSNUMBER,YSFLAG,YSFROM,YSINDEX,YTTLKUP
S YTTLKUP=1 ; suppress filter on 601.71
S YSFILEN=$G(YS("FILEN"),0) S X=$$VFILE^DILFD(YSFILEN) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FILE N" Q ;--->out
S YSFIELD=$G(YS("FIELD"),0) S X=$$VFIELD^DILFD(YSFILEN,YSFIELD) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FIELD N" Q ;--->out
S YSFLAG=$G(YS("FLAG"))
S YSNUMBER=$G(YS("NUMBER"),500)
S YSFROM("IEN")=$G(YS("FROM"))
S YSINDEX=$G(YS("INDEX"))
D LIST^DIC(YSFILEN,,YSFIELD,YSFLAG,YSNUMBER,.YSFROM,,YSINDEX)
I $D(^TMP("DIERR",$J)) S YSDATA(1)="[ERROR]",YSDATA(2)=$G(^TMP("DIERR",$J,1,"TEXT",1)) Q ;--> out
S YSDATA(1)="[DATA]"
S YSDATA(2)=^TMP("DILIST",$J,0)
S C=2,N=0
F S N=$O(^TMP("DILIST",$J,2,N)) Q:N'>0 D
. S C=C+1
. S YSDATA(C)=^TMP("DILIST",$J,2,N)_U_$G(^TMP("DILIST",$J,"ID",N,YSFIELD))
K ^TMP("DILIST",$J)
Q
ALLANS(YSDATA,YS) ;get all answers
;entry point for YTQ ALL ANSWERS rpc
;input:AD = ADMINISTRATION #
;output: [DATA]
; ADMIN ID^DFN^INSTRUMENT^DATE GIVEN^IS COMPLETE
;QUESTION #^seq^ANSWER
N G,G1,N,YSAD,YSQN,YSTSTN,YSEQ,YSICON
N IEN71,YSRTN,YSRTN71 ; llh patch 123
S YSAD=$G(YS("AD"))
I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q ;-->out
I '$D(^YTT(601.85,"AC",YSAD)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q ;-->out
S YSTSTN=$P(^YTT(601.84,YSAD,0),U,3)
S YSDATA(1)="[DATA]"
S YSDATA(2)=YSAD_U_$$GET1^DIQ(601.84,YSAD_",",1,"I")_U_$$GET1^DIQ(601.84,YSAD_",",2,"E")_U_$$GET1^DIQ(601.84,YSAD_",",3,"I")_U_$$GET1^DIQ(601.84,YSAD_",",8,"I")
S YSQN=0,N=2
F S YSQN=$O(^YTT(601.85,"AC",YSAD,YSQN)) Q:YSQN'>0 S G=0 D
.S G=$O(^YTT(601.85,"AC",YSAD,YSQN,G)) Q:G'>0 S G1=0 D
..S YSICON=$O(^YTT(601.76,"AF",YSTSTN,YSQN,0))
..S YSEQ=1
..I YSICON?1N.N S YSEQ=$P(^YTT(601.76,YSICON,0),U,3)
..S:$P(^YTT(601.85,G,0),U,4)?1N.N N=N+1,YSDATA(N)=YSQN_U_YSEQ_U_$P(^YTT(601.85,G,0),U,4)
..F S G1=$O(^YTT(601.85,G,1,G1)) Q:G1'>0 S N=N+1,YSDATA(N)=YSQN_U_YSEQ_";"_G1_U_$G(^YTT(601.85,G,1,G1,0))
I $P(^YTT(601.84,YSAD,0),U,9)'="Y" QUIT ; chk special proc only if complete
;llh patch 123, check for special processing of complex instruments
S IEN71=$O(^YTT(601.71,"B",$P(YSDATA(2),U,3),0))
S YSRTN71=$$GET1^DIQ(601.71,IEN71_",",92)
I (YSRTN71'=""),(YSRTN71'="YTSCORE") D
.N RPRIV S RPRIV=$P($G(^YTT(601.71,IEN71,2)),U) ; wrap for note
.S YSRTN="DLLSTR^"_YSRTN71_"(.YSDATA,.YS,2)"
.I $L($T(@("DLLSTR^"_YSRTN71))) D @YSRTN D:'$L(RPRIV) WRAP(80)
D SPECIAL^YTQAPI2A(.YSDATA,N,YSAD,YSTSTN)
Q
SETANS(YSDATA,YS) ;save an answer
;entry point for YTQ SET ANSWER rpc
;input: AD = ADMINISTRATION #
;input: QN= QUESTION #
;input: CHOICE= Choice ID [optional]
;input: YS(1) thru YS(N) WP entries
;output: [DATA] vs [ERROR]
N N,N1,YSIENS,YSAD,YSQN,YSCI,YSCODE,YSOP
S YSDATA(1)="[ERROR]"
S YSAD=$G(YS("AD"))
S YSQN=$G(YS("QN"))
S YSCI=$G(YS("CHOICE"))
I YSAD'?1N.N S YSDATA(2)="bad ad num" Q ;-->out
I YSQN'?1N.N S YSDATA(2)="bad quest num" Q ;-->out
I $D(^YTT(601.85,"AC",YSAD,YSQN)) S YSIENS=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
I '$D(^YTT(601.85,"AC",YSAD,YSQN)) D ; set new entry
. S YSIENS=""
. S YSIENS=$$NEW^YTQAPI17(601.85)
. Q:YSIENS'?1N.N
. L +^YTT(601.85,YSIENS):DILOCKTM I '$T S YSDATA(2)="time out" Q
. S ^YTT(601.85,YSIENS,0)=YSIENS_U_YSAD_U_YSQN
. S ^YTT(601.85,"B",YSIENS,YSIENS)=""
. S ^YTT(601.85,"AC",YSAD,YSQN,YSIENS)=""
. S ^YTT(601.85,"AD",YSAD,YSIENS)=""
. L -^YTT(601.85,YSIENS)
Q:$D(YSDATA(2))
;enter or delete Answers
S $P(^YTT(601.85,YSIENS,0),U,4)=YSCI
K ^YTT(601.85,YSIENS,1)
S N=0,N1=0
F S N=$O(YS(N)) Q:N'>0 S N1=N1+1,^YTT(601.85,YSIENS,1,N1,0)=YS(N)
S:N1 ^YTT(601.85,YSIENS,1,0)=U_U_N1_U_N1_U_DT_U
S YSDATA(1)="[DATA]",YSDATA(2)="OK"
D UPANS^YTQEVNT(+$G(YSAD),"saveone") ; publish admin update event
;set has been operational
S YSCODE=$P(^YTT(601.84,YSAD,0),U,3)
S YSOP=$P($G(^YTT(601.71,YSCODE,2)),U,2)
S:YSOP="Y" $P(^YTT(601.71,YSCODE,2),U,5)="Y"
Q
ADMINS(YSDATA,YS) ;administration retrieval
;entry point for YTQ GET ADMINISTRATIONS rpc
;input : DFN
;output:AdministrationID=InstrumentName^DateGiven^DateSaved^OrderedBy^AdministeredBy^Signed^IsComplete^NumberOfQuestionsAnswered
N N,G,DFN,YSIENS
S DFN=$G(YS("DFN"))
I DFN'?1N.NP S YSDATA(1)="[ERROR]",YSDATA(2)="bad DFN" Q ;-->out asf 2/22/08
I '$D(^DPT(DFN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt" Q ;-->out
S YSIENS=0,N=2
S YSDATA(1)="[DATA]"
F S YSIENS=$O(^YTT(601.84,"C",DFN,YSIENS)) Q:YSIENS'>0 D
. S N=N+1
. S G=$G(^YTT(601.84,YSIENS,0))
. I G="" S YSDATA(1)="[ERROR]",YSDATA(2)=YSIENS_" bad ien in 84" Q ;-->out
. S YSDATA(N)=YSIENS_"="_$$GET1^DIQ(601.84,YSIENS_",",2)_U_$P(G,U,4)_U_$P(G,U,5)
. S YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",5,"I")_U_$$GET1^DIQ(601.84,YSIENS_",",6,"I")
. S YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",7)_U_$$GET1^DIQ(601.84,YSIENS_",",8)_U_$$GET1^DIQ(601.84,YSIENS_",",9)
S:YSDATA(1)="[DATA]" YSDATA(2)=(N-2)_" administrations"
Q
CCALL(YSDATA) ;all choices returned
;entry point for YTQ ALL CHOICES rpc
;output: 601.75(1) CHOICETYPE ID^SEQUENCE^CHOICE IFN^CHOICE TEXT
N N,YSCDA,YSN,YSN1
S YSN=0,N=1
S YSDATA(1)="[DATA]"
F S YSN=$O(^YTT(601.751,YSN)) Q:YSN'>0 D
. S YSN1=0 F S YSN1=$O(^YTT(601.751,"AC",YSN,YSN1)) Q:YSN1'>0 D
.. S YSCDA=0 F S YSCDA=$O(^YTT(601.751,"AC",YSN,YSN1,YSCDA)) Q:YSCDA'>0 D
... S N=N+1
... S YSDATA(N)=YSN_U_YSN1_U_YSCDA_U_$G(^YTT(601.75,YSCDA,1))
Q
WRAP(MAX) ; Make sure DLLStr is wrapped by adding | chars
; expects YSDATA
N LN,TX,OUT,I,J,X,Y,YNEW
S LN=$O(YSDATA(9999999999),-1)
S TX=$P(YSDATA(LN),U,3,99)
F I=1:1:$L(TX,"|") S X=$P(TX,"|",I) D
. I $L(X)'>MAX D ADDOUT(X) QUIT
. S Y=""
. F J=1:1:$L(X," ") D
. . S YNEW=Y_$S(J=1:"",1:" ")_$P(X," ",J)
. . I $L(YNEW)>MAX D ADDOUT(Y) S Y=$P(X," ",J) I 1
. . E S Y=YNEW
. D ADDOUT(Y) ; add any remaining
S X="",I=0 F S I=$O(OUT(I)) Q:'I S X=X_$S(I=1:"",1:"|")_OUT(I)
S $P(YSDATA(LN),U,3)=X
Q
ADDOUT(S) ; add string to out array (expects OUT)
S OUT=+$G(OUT)+1,OUT(OUT)=S
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI2 6563 printed Dec 13, 2024@02:18:13 Page 2
YTQAPI2 ;ASF/ALB - MHAX REMOTE PROCEDURES cont ;10/17/16 13:37
+1 ;;5.01;MENTAL HEALTH;**85,96,119,121,123,130,217,235,240**;Dec 30, 1994;Build 10
+2 ;
+3 ; Reference to ^DPT in ICR #10035
+4 ; Reference to LIST^DIC in ICR #2051
+5 ; Reference to $$VFILE^DILFD,$$VFIELD^DILFD in ICR #2055
+6 ; Reference to $$GET1^DIQ in ICR #2056
+7 ;
+8 QUIT
LISTER(YSDATA,YS) ;list entries
+1 ;entry point for YTQ GENERIC LISTER rpc
+2 ;input: CODE as test name
+3 ;output: Field^Value
+4 NEW YSFIELD,YSFILEN,N,C,YSNUMBER,YSFLAG,YSFROM,YSINDEX,YTTLKUP
+5 ; suppress filter on 601.71
SET YTTLKUP=1
+6 ;--->out
SET YSFILEN=$GET(YS("FILEN"),0)
SET X=$$VFILE^DILFD(YSFILEN)
IF X=0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD FILE N"
QUIT
+7 ;--->out
SET YSFIELD=$GET(YS("FIELD"),0)
SET X=$$VFIELD^DILFD(YSFILEN,YSFIELD)
IF X=0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD FIELD N"
QUIT
+8 SET YSFLAG=$GET(YS("FLAG"))
+9 SET YSNUMBER=$GET(YS("NUMBER"),500)
+10 SET YSFROM("IEN")=$GET(YS("FROM"))
+11 SET YSINDEX=$GET(YS("INDEX"))
+12 DO LIST^DIC(YSFILEN,,YSFIELD,YSFLAG,YSNUMBER,.YSFROM,,YSINDEX)
+13 ;--> out
IF $DATA(^TMP("DIERR",$JOB))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)=$GET(^TMP("DIERR",$JOB,1,"TEXT",1))
QUIT
+14 SET YSDATA(1)="[DATA]"
+15 SET YSDATA(2)=^TMP("DILIST",$JOB,0)
+16 SET C=2
SET N=0
+17 FOR
SET N=$ORDER(^TMP("DILIST",$JOB,2,N))
if N'>0
QUIT
Begin DoDot:1
+18 SET C=C+1
+19 SET YSDATA(C)=^TMP("DILIST",$JOB,2,N)_U_$GET(^TMP("DILIST",$JOB,"ID",N,YSFIELD))
End DoDot:1
+20 KILL ^TMP("DILIST",$JOB)
+21 QUIT
ALLANS(YSDATA,YS) ;get all answers
+1 ;entry point for YTQ ALL ANSWERS rpc
+2 ;input:AD = ADMINISTRATION #
+3 ;output: [DATA]
+4 ; ADMIN ID^DFN^INSTRUMENT^DATE GIVEN^IS COMPLETE
+5 ;QUESTION #^seq^ANSWER
+6 NEW G,G1,N,YSAD,YSQN,YSTSTN,YSEQ,YSICON
+7 ; llh patch 123
NEW IEN71,YSRTN,YSRTN71
+8 SET YSAD=$GET(YS("AD"))
+9 ;-->out
IF YSAD'?1N.N
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad ad num"
QUIT
+10 ;-->out
IF '$DATA(^YTT(601.85,"AC",YSAD))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no such reference"
QUIT
+11 SET YSTSTN=$PIECE(^YTT(601.84,YSAD,0),U,3)
+12 SET YSDATA(1)="[DATA]"
+13 SET YSDATA(2)=YSAD_U_$$GET1^DIQ(601.84,YSAD_",",1,"I")_U_$$GET1^DIQ(601.84,YSAD_",",2,"E")_U_$$GET1^DIQ(601.84,YSAD_",",3,"I")_U_$$GET1^DIQ(601.84,YSAD_",",8,"I")
+14 SET YSQN=0
SET N=2
+15 FOR
SET YSQN=$ORDER(^YTT(601.85,"AC",YSAD,YSQN))
if YSQN'>0
QUIT
SET G=0
Begin DoDot:1
+16 SET G=$ORDER(^YTT(601.85,"AC",YSAD,YSQN,G))
if G'>0
QUIT
SET G1=0
Begin DoDot:2
+17 SET YSICON=$ORDER(^YTT(601.76,"AF",YSTSTN,YSQN,0))
+18 SET YSEQ=1
+19 IF YSICON?1N.N
SET YSEQ=$PIECE(^YTT(601.76,YSICON,0),U,3)
+20 if $PIECE(^YTT(601.85,G,0),U,4)?1N.N
SET N=N+1
SET YSDATA(N)=YSQN_U_YSEQ_U_$PIECE(^YTT(601.85,G,0),U,4)
+21 FOR
SET G1=$ORDER(^YTT(601.85,G,1,G1))
if G1'>0
QUIT
SET N=N+1
SET YSDATA(N)=YSQN_U_YSEQ_";"_G1_U_$GET(^YTT(601.85,G,1,G1,0))
End DoDot:2
End DoDot:1
+22 ; chk special proc only if complete
IF $PIECE(^YTT(601.84,YSAD,0),U,9)'="Y"
QUIT
+23 ;llh patch 123, check for special processing of complex instruments
+24 SET IEN71=$ORDER(^YTT(601.71,"B",$PIECE(YSDATA(2),U,3),0))
+25 SET YSRTN71=$$GET1^DIQ(601.71,IEN71_",",92)
+26 IF (YSRTN71'="")
IF (YSRTN71'="YTSCORE")
Begin DoDot:1
+27 ; wrap for note
NEW RPRIV
SET RPRIV=$PIECE($GET(^YTT(601.71,IEN71,2)),U)
+28 SET YSRTN="DLLSTR^"_YSRTN71_"(.YSDATA,.YS,2)"
+29 IF $LENGTH($TEXT(@("DLLSTR^"_YSRTN71)))
DO @YSRTN
if '$LENGTH(RPRIV)
DO WRAP(80)
End DoDot:1
+30 DO SPECIAL^YTQAPI2A(.YSDATA,N,YSAD,YSTSTN)
+31 QUIT
SETANS(YSDATA,YS) ;save an answer
+1 ;entry point for YTQ SET ANSWER rpc
+2 ;input: AD = ADMINISTRATION #
+3 ;input: QN= QUESTION #
+4 ;input: CHOICE= Choice ID [optional]
+5 ;input: YS(1) thru YS(N) WP entries
+6 ;output: [DATA] vs [ERROR]
+7 NEW N,N1,YSIENS,YSAD,YSQN,YSCI,YSCODE,YSOP
+8 SET YSDATA(1)="[ERROR]"
+9 SET YSAD=$GET(YS("AD"))
+10 SET YSQN=$GET(YS("QN"))
+11 SET YSCI=$GET(YS("CHOICE"))
+12 ;-->out
IF YSAD'?1N.N
SET YSDATA(2)="bad ad num"
QUIT
+13 ;-->out
IF YSQN'?1N.N
SET YSDATA(2)="bad quest num"
QUIT
+14 IF $DATA(^YTT(601.85,"AC",YSAD,YSQN))
SET YSIENS=$ORDER(^YTT(601.85,"AC",YSAD,YSQN,0))
+15 ; set new entry
IF '$DATA(^YTT(601.85,"AC",YSAD,YSQN))
Begin DoDot:1
+16 SET YSIENS=""
+17 SET YSIENS=$$NEW^YTQAPI17(601.85)
+18 if YSIENS'?1N.N
QUIT
+19 LOCK +^YTT(601.85,YSIENS):DILOCKTM
IF '$TEST
SET YSDATA(2)="time out"
QUIT
+20 SET ^YTT(601.85,YSIENS,0)=YSIENS_U_YSAD_U_YSQN
+21 SET ^YTT(601.85,"B",YSIENS,YSIENS)=""
+22 SET ^YTT(601.85,"AC",YSAD,YSQN,YSIENS)=""
+23 SET ^YTT(601.85,"AD",YSAD,YSIENS)=""
+24 LOCK -^YTT(601.85,YSIENS)
End DoDot:1
+25 if $DATA(YSDATA(2))
QUIT
+26 ;enter or delete Answers
+27 SET $PIECE(^YTT(601.85,YSIENS,0),U,4)=YSCI
+28 KILL ^YTT(601.85,YSIENS,1)
+29 SET N=0
SET N1=0
+30 FOR
SET N=$ORDER(YS(N))
if N'>0
QUIT
SET N1=N1+1
SET ^YTT(601.85,YSIENS,1,N1,0)=YS(N)
+31 if N1
SET ^YTT(601.85,YSIENS,1,0)=U_U_N1_U_N1_U_DT_U
+32 SET YSDATA(1)="[DATA]"
SET YSDATA(2)="OK"
+33 ; publish admin update event
DO UPANS^YTQEVNT(+$GET(YSAD),"saveone")
+34 ;set has been operational
+35 SET YSCODE=$PIECE(^YTT(601.84,YSAD,0),U,3)
+36 SET YSOP=$PIECE($GET(^YTT(601.71,YSCODE,2)),U,2)
+37 if YSOP="Y"
SET $PIECE(^YTT(601.71,YSCODE,2),U,5)="Y"
+38 QUIT
ADMINS(YSDATA,YS) ;administration retrieval
+1 ;entry point for YTQ GET ADMINISTRATIONS rpc
+2 ;input : DFN
+3 ;output:AdministrationID=InstrumentName^DateGiven^DateSaved^OrderedBy^AdministeredBy^Signed^IsComplete^NumberOfQuestionsAnswered
+4 NEW N,G,DFN,YSIENS
+5 SET DFN=$GET(YS("DFN"))
+6 ;-->out asf 2/22/08
IF DFN'?1N.NP
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad DFN"
QUIT
+7 ;-->out
IF '$DATA(^DPT(DFN,0))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no pt"
QUIT
+8 SET YSIENS=0
SET N=2
+9 SET YSDATA(1)="[DATA]"
+10 FOR
SET YSIENS=$ORDER(^YTT(601.84,"C",DFN,YSIENS))
if YSIENS'>0
QUIT
Begin DoDot:1
+11 SET N=N+1
+12 SET G=$GET(^YTT(601.84,YSIENS,0))
+13 ;-->out
IF G=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)=YSIENS_" bad ien in 84"
QUIT
+14 SET YSDATA(N)=YSIENS_"="_$$GET1^DIQ(601.84,YSIENS_",",2)_U_$PIECE(G,U,4)_U_$PIECE(G,U,5)
+15 SET YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",5,"I")_U_$$GET1^DIQ(601.84,YSIENS_",",6,"I")
+16 SET YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",7)_U_$$GET1^DIQ(601.84,YSIENS_",",8)_U_$$GET1^DIQ(601.84,YSIENS_",",9)
End DoDot:1
+17 if YSDATA(1)="[DATA]"
SET YSDATA(2)=(N-2)_" administrations"
+18 QUIT
CCALL(YSDATA) ;all choices returned
+1 ;entry point for YTQ ALL CHOICES rpc
+2 ;output: 601.75(1) CHOICETYPE ID^SEQUENCE^CHOICE IFN^CHOICE TEXT
+3 NEW N,YSCDA,YSN,YSN1
+4 SET YSN=0
SET N=1
+5 SET YSDATA(1)="[DATA]"
+6 FOR
SET YSN=$ORDER(^YTT(601.751,YSN))
if YSN'>0
QUIT
Begin DoDot:1
+7 SET YSN1=0
FOR
SET YSN1=$ORDER(^YTT(601.751,"AC",YSN,YSN1))
if YSN1'>0
QUIT
Begin DoDot:2
+8 SET YSCDA=0
FOR
SET YSCDA=$ORDER(^YTT(601.751,"AC",YSN,YSN1,YSCDA))
if YSCDA'>0
QUIT
Begin DoDot:3
+9 SET N=N+1
+10 SET YSDATA(N)=YSN_U_YSN1_U_YSCDA_U_$GET(^YTT(601.75,YSCDA,1))
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
WRAP(MAX) ; Make sure DLLStr is wrapped by adding | chars
+1 ; expects YSDATA
+2 NEW LN,TX,OUT,I,J,X,Y,YNEW
+3 SET LN=$ORDER(YSDATA(9999999999),-1)
+4 SET TX=$PIECE(YSDATA(LN),U,3,99)
+5 FOR I=1:1:$LENGTH(TX,"|")
SET X=$PIECE(TX,"|",I)
Begin DoDot:1
+6 IF $LENGTH(X)'>MAX
DO ADDOUT(X)
QUIT
+7 SET Y=""
+8 FOR J=1:1:$LENGTH(X," ")
Begin DoDot:2
+9 SET YNEW=Y_$SELECT(J=1:"",1:" ")_$PIECE(X," ",J)
+10 IF $LENGTH(YNEW)>MAX
DO ADDOUT(Y)
SET Y=$PIECE(X," ",J)
IF 1
+11 IF '$TEST
SET Y=YNEW
End DoDot:2
+12 ; add any remaining
DO ADDOUT(Y)
End DoDot:1
+13 SET X=""
SET I=0
FOR
SET I=$ORDER(OUT(I))
if 'I
QUIT
SET X=X_$SELECT(I=1:"",1:"|")_OUT(I)
+14 SET $PIECE(YSDATA(LN),U,3)=X
+15 QUIT
ADDOUT(S) ; add string to out array (expects OUT)
+1 SET OUT=+$GET(OUT)+1
SET OUT(OUT)=S
+2 QUIT
