- YTQAPI15 ;ASF/ALB MHA XML ;Nov 19, 2020@15:02
- ;;5.01;MENTAL HEALTH;**85,97,119,171**;Dec 30, 1994;Build 3
- Q
- MAIN ;
- N N,G,YSCN,ICN,Y,YSA,YSAD,YSB,YSC,YSCN,YSCODE,YSD,YSDFN,YSDG,YSE,YSEA
- N YSER,YSF,YSFIELD,YSFILE,YSIENS,YSJ,YSLOC,YSOD,YSQNUMB,YSQTEXT,YSR
- N DFN,DIRUT,L1,L2,CNT,IDX,LEN,DUOUT,DTOUT,YSQUIT,POP,YSOUT
- S YSQUIT=0
- D SELAD
- ;YS*5.01*171: quit if user entered "^" at previous prompts or timeout occurred
- Q:$G(DIRUT) Q:$G(DUOUT) Q:$G(DTOUT)
- Q:YSQUIT
- DEV S %ZIS="QM" D ^%ZIS Q:IO=""
- ;YS*5.01*171: POP = user entered "^" at device prompt.
- I $G(POP) Q
- I '$D(IO("Q")) W !,"Please Queue this job",! G DEV
- D D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q ;-->out
- .S ZTRTN="ENQ^YTQAPI15",ZTDESC="MHA3 XML Export",ZTSAVE("YS*")=""
- .S ZTIO=ION_";"_IOST
- .I $D(IO("DOC"))#2,IO("DOC")]"" S ZTIO=ZTIO_";"_IO("DOC") Q
- .I IOM S ZTIO=ZTIO_";"_IOM
- .I IOSL S ZTIO=ZTIO_";"_IOSL
- ;
- ENQ ;taskman entry
- K ^TMP("YSXML",$J),^TMP("YSAD",$J)
- S N=0
- D SI:YSF="I",SP:YSF="P",SO:YSF="O",SL:YSF="L",SD:YSF="D"
- I '$D(^TMP("YSAD",$J)) S ^TMP("YSXML",$J,1)="[ERROR]^no data" Q ;-->out
- S N=N+1,^TMP("YSXML",$J,N)="<?xml version='1.0' encoding='UTF-8'?>"
- S N=N+1,^TMP("YSXML",$J,N)="<Export>"
- D ADMIN
- S N=N+1,^TMP("YSXML",$J,N)="</Export>"
- U IO S N=0 F S N=$O(^TMP("YSXML",$J,N)) Q:N'>0 W ^(N),!
- D ^%ZISC
- Q ;-->out
- SELAD ;administation filter
- W @IOF,!!,"MHA XML Export"
- K DIR S DIR(0)="S^D:Date Only;I:Instrument;L:Location;P:Patient;O:Ordered By"
- S DIR("A")="Filter By" D ^DIR
- Q:$D(DIRUT)
- S YSF=Y
- K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="Begin date/time: ",DIR("B")="T-1M" D ^DIR
- Q:$D(DIRUT)
- S YSB=Y
- K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="End date/time: ",DIR("B")="NOW" D ^DIR
- Q:$D(DIRUT)
- S YSE=Y
- K DIR S DIR(0)="Y",DIR("A")="Export Answers",DIR("B")="No" D ^DIR
- Q:$D(DIRUT)
- S YSEA=Y
- K DIR S DIR(0)="Y",DIR("A")="Export Results",DIR("B")="No" D ^DIR
- Q:$D(DIRUT)
- S YSER=Y
- K DIC
- N YTTLKUP S YTTLKUP=1 ; suppress filter
- I YSF="I" D Q
- . S DIC(0)="AEQ",DIC="^YTT(601.71,"
- . D ^DIC
- . I Y'>0 S YSQUIT=1 Q
- . S YSCODE=$P(Y,U,2)
- I YSF="P" D Q
- . D ^YSLRP
- . I $G(DFN)'>0 S YSQUIT=1
- I YSF="O" D Q
- . S DIC("A")="Ordered By: "
- . S DIC(0)="AEQ",DIC="^VA(200,"
- . D ^DIC
- . I Y'>0 S YSQUIT=1 Q
- . S YSOD=+Y
- ;YS*5.01*171: corrected line below to validate against file 44 instead of file 42
- I YSF="L" D
- . S DIC(0)="AEMQZ",DIC=44
- . D ^DIC
- . I Y'>0 S YSQUIT=1 Q
- . S YSLOC=+Y
- Q
- SI ;select by instrument
- S YSCN=$O(^YTT(601.71,"B",YSCODE,-1))
- S YSD=YSB-.00001 F S YSD=$O(^YTT(601.84,"AC",YSCN,YSD)) Q:(YSD'>0)!(YSD>YSE) D
- . S YSAD=0 F S YSAD=$O(^YTT(601.84,"AC",YSCN,YSD,YSAD)) Q:YSAD'>0 S ^TMP("YSAD",$J,YSAD)=""
- Q
- SP ;select by patient
- S YSAD=0 F S YSAD=$O(^YTT(601.84,"C",YSDFN,YSAD)) Q:YSAD'>0 D
- . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
- . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
- Q
- SD ;select by Date Only
- S YSAD=0 F S YSAD=$O(^YTT(601.84,"B",YSAD)) Q:YSAD'>0 D
- . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
- . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
- Q
- SO ;select by Ordered by
- S YSAD=0 F S YSAD=$O(^YTT(601.84,"AO",YSOD,YSAD)) Q:YSAD'>0 D
- . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
- . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
- Q
- SL ;select by location
- S YSAD=0 F S YSAD=$O(^YTT(601.84,"AL",YSLOC,YSAD)) Q:YSAD'>0 D
- . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
- . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
- Q
- ADMIN ;extract the data into an XML global
- S YSAD=0 F S YSAD=$O(^TMP("YSAD",$J,YSAD)) Q:YSAD'>0 D
- . S N=N+1,^TMP("YSXML",$J,N)="<Admin>"
- . S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
- . D FORM("Patient",601.84,YSAD,1)
- . S DFN=$P(^YTT(601.84,YSAD,0),U,2),ICN=$$GETICN^MPIF001(DFN),N=N+1,^TMP("YSXML",$J,N)="<ICN>"_ICN_"</ICN>"
- . D FORM("Instrument",601.84,YSAD,2)
- . D FORM("Given",601.84,YSAD,3)
- . D FORM("Saved",601.84,YSAD,4)
- . D FORM("Ordered",601.84,YSAD,5)
- . D FORM("Complete",601.84,YSAD,8)
- . D FORM("Location",601.84,YSAD,13)
- . D QUEST:YSEA
- . D RESULT:YSER
- . S N=N+1,^TMP("YSXML",$J,N)="</Admin>"
- Q
- FORM(YSTAG,YSFILE,YSIENS,YSFIELD) ;xml entry
- N G,Y1,Y2
- S N=N+1
- S Y1=$$GET1^DIQ(YSFILE,YSIENS_",",YSFIELD)
- S Y2=$$CONVSTR(Y1)
- S G="<"_YSTAG_">"_Y2_"</"_YSTAG_">"
- S ^TMP("YSXML",$J,N)=G
- Q
- QUEST ;answers out
- S YSA=0,YSJ=0 F S YSA=$O(^YTT(601.85,"AD",YSAD,YSA)) Q:YSA'>0 D
- . S N=N+1,^TMP("YSXML",$J,N)="<Quest>"
- . S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
- . S YSQNUMB=$P(^YTT(601.85,YSA,0),U,3)
- . S N=N+1,^TMP("YSXML",$J,N)="<Qnumb>"_YSQNUMB_"</Qnumb>"
- . S YSQTEXT=$G(^YTT(601.72,YSQNUMB,1,1,0))
- . S N=N+1,^TMP("YSXML",$J,N)="<Qtext>"_YSQTEXT_"</Qtext>"
- . S N=N+1,YSJ=YSJ+1,^TMP("YSXML",$J,N)="<Seq>"_YSJ_"</Seq>"
- . D FORM("Choice",601.85,YSA,4)
- . S N=N+1
- . S YSC=$P(^YTT(601.85,YSA,0),U,4)
- . S YSCN=$S(YSC?1N.N:^YTT(601.75,YSC,1),1:"???")
- . S:$D(^YTT(601.85,YSA,1,1,0)) YSCN=^YTT(601.85,YSA,1,1,0)
- . S ^TMP("YSXML",$J,N)="<Ans>"_YSCN_"</Ans>"
- . S N=N+1,^TMP("YSXML",$J,N)="</Quest>"
- Q
- RESULT ;results out
- S YSR=0
- F S YSR=$O(^YTT(601.92,"AC",YSAD,YSR)) Q:YSR'>0 D
- . S N=N+1,^TMP("YSXML",$J,N)="<Score>"
- . S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
- . D FORM("Scale",601.92,YSR,2)
- . D FORM("Raw",601.92,YSR,3)
- . D FORM("Trans1",601.92,YSR,4)
- . S N=N+1,^TMP("YSXML",$J,N)="</Score>"
- Q
- HEAD ;
- ;
- CONVSTR(YSIN) ;convert string to valid xml
- S L1(1)="&",L2(1)="&" ; Keep "&" first
- S L1(2)=">",L2(2)=">"
- S L1(3)="<",L2(3)="<"
- S L1(4)="'",L2(4)="'"
- S L1(5)="""",L2(5)="""
- S YSOUT=YSIN
- F CNT=1:1:5 D
- .S LEN=$L(L1(CNT))+1
- .S IDX=0
- .F S IDX=$F(YSOUT,L1(CNT),IDX) Q:IDX=0 D
- .. S YSOUT=$E(YSOUT,1,IDX-LEN)_L2(CNT)_$E(YSOUT,IDX,250)
- .. S IDX=IDX-(LEN-2)
- Q YSOUT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI15 5847 printed Feb 18, 2025@23:44:27 Page 2
- YTQAPI15 ;ASF/ALB MHA XML ;Nov 19, 2020@15:02
- +1 ;;5.01;MENTAL HEALTH;**85,97,119,171**;Dec 30, 1994;Build 3
- +2 QUIT
- MAIN ;
- +1 NEW N,G,YSCN,ICN,Y,YSA,YSAD,YSB,YSC,YSCN,YSCODE,YSD,YSDFN,YSDG,YSE,YSEA
- +2 NEW YSER,YSF,YSFIELD,YSFILE,YSIENS,YSJ,YSLOC,YSOD,YSQNUMB,YSQTEXT,YSR
- +3 NEW DFN,DIRUT,L1,L2,CNT,IDX,LEN,DUOUT,DTOUT,YSQUIT,POP,YSOUT
- +4 SET YSQUIT=0
- +5 DO SELAD
- +6 ;YS*5.01*171: quit if user entered "^" at previous prompts or timeout occurred
- +7 if $GET(DIRUT)
- QUIT
- if $GET(DUOUT)
- QUIT
- if $GET(DTOUT)
- QUIT
- +8 if YSQUIT
- QUIT
- DEV SET %ZIS="QM"
- DO ^%ZIS
- if IO=""
- QUIT
- +1 ;YS*5.01*171: POP = user entered "^" at device prompt.
- +2 IF $GET(POP)
- QUIT
- +3 IF '$DATA(IO("Q"))
- WRITE !,"Please Queue this job",!
- GOTO DEV
- +4 ;-->out
- Begin DoDot:1
- +5 SET ZTRTN="ENQ^YTQAPI15"
- SET ZTDESC="MHA3 XML Export"
- SET ZTSAVE("YS*")=""
- +6 SET ZTIO=ION_";"_IOST
- +7 IF $DATA(IO("DOC"))#2
- IF IO("DOC")]""
- SET ZTIO=ZTIO_";"_IO("DOC")
- QUIT
- +8 IF IOM
- SET ZTIO=ZTIO_";"_IOM
- +9 IF IOSL
- SET ZTIO=ZTIO_";"_IOSL
- End DoDot:1
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL IO("Q")
- QUIT
- +10 ;
- ENQ ;taskman entry
- +1 KILL ^TMP("YSXML",$JOB),^TMP("YSAD",$JOB)
- +2 SET N=0
- +3 if YSF="I"
- DO SI
- if YSF="P"
- DO SP
- if YSF="O"
- DO SO
- if YSF="L"
- DO SL
- if YSF="D"
- DO SD
- +4 ;-->out
- IF '$DATA(^TMP("YSAD",$JOB))
- SET ^TMP("YSXML",$JOB,1)="[ERROR]^no data"
- QUIT
- +5 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<?xml version='1.0' encoding='UTF-8'?>"
- +6 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Export>"
- +7 DO ADMIN
- +8 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="</Export>"
- +9 USE IO
- SET N=0
- FOR
- SET N=$ORDER(^TMP("YSXML",$JOB,N))
- if N'>0
- QUIT
- WRITE ^(N),!
- +10 DO ^%ZISC
- +11 ;-->out
- QUIT
- SELAD ;administation filter
- +1 WRITE @IOF,!!,"MHA XML Export"
- +2 KILL DIR
- SET DIR(0)="S^D:Date Only;I:Instrument;L:Location;P:Patient;O:Ordered By"
- +3 SET DIR("A")="Filter By"
- DO ^DIR
- +4 if $DATA(DIRUT)
- QUIT
- +5 SET YSF=Y
- +6 KILL DIR
- SET DIR(0)="DA^2961001:NOW:TX"
- SET DIR("A")="Begin date/time: "
- SET DIR("B")="T-1M"
- DO ^DIR
- +7 if $DATA(DIRUT)
- QUIT
- +8 SET YSB=Y
- +9 KILL DIR
- SET DIR(0)="DA^2961001:NOW:TX"
- SET DIR("A")="End date/time: "
- SET DIR("B")="NOW"
- DO ^DIR
- +10 if $DATA(DIRUT)
- QUIT
- +11 SET YSE=Y
- +12 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Export Answers"
- SET DIR("B")="No"
- DO ^DIR
- +13 if $DATA(DIRUT)
- QUIT
- +14 SET YSEA=Y
- +15 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Export Results"
- SET DIR("B")="No"
- DO ^DIR
- +16 if $DATA(DIRUT)
- QUIT
- +17 SET YSER=Y
- +18 KILL DIC
- +19 ; suppress filter
- NEW YTTLKUP
- SET YTTLKUP=1
- +20 IF YSF="I"
- Begin DoDot:1
- +21 SET DIC(0)="AEQ"
- SET DIC="^YTT(601.71,"
- +22 DO ^DIC
- +23 IF Y'>0
- SET YSQUIT=1
- QUIT
- +24 SET YSCODE=$PIECE(Y,U,2)
- End DoDot:1
- QUIT
- +25 IF YSF="P"
- Begin DoDot:1
- +26 DO ^YSLRP
- +27 IF $GET(DFN)'>0
- SET YSQUIT=1
- End DoDot:1
- QUIT
- +28 IF YSF="O"
- Begin DoDot:1
- +29 SET DIC("A")="Ordered By: "
- +30 SET DIC(0)="AEQ"
- SET DIC="^VA(200,"
- +31 DO ^DIC
- +32 IF Y'>0
- SET YSQUIT=1
- QUIT
- +33 SET YSOD=+Y
- End DoDot:1
- QUIT
- +34 ;YS*5.01*171: corrected line below to validate against file 44 instead of file 42
- +35 IF YSF="L"
- Begin DoDot:1
- +36 SET DIC(0)="AEMQZ"
- SET DIC=44
- +37 DO ^DIC
- +38 IF Y'>0
- SET YSQUIT=1
- QUIT
- +39 SET YSLOC=+Y
- End DoDot:1
- +40 QUIT
- SI ;select by instrument
- +1 SET YSCN=$ORDER(^YTT(601.71,"B",YSCODE,-1))
- +2 SET YSD=YSB-.00001
- FOR
- SET YSD=$ORDER(^YTT(601.84,"AC",YSCN,YSD))
- if (YSD'>0)!(YSD>YSE)
- QUIT
- Begin DoDot:1
- +3 SET YSAD=0
- FOR
- SET YSAD=$ORDER(^YTT(601.84,"AC",YSCN,YSD,YSAD))
- if YSAD'>0
- QUIT
- SET ^TMP("YSAD",$JOB,YSAD)=""
- End DoDot:1
- +4 QUIT
- SP ;select by patient
- +1 SET YSAD=0
- FOR
- SET YSAD=$ORDER(^YTT(601.84,"C",YSDFN,YSAD))
- if YSAD'>0
- QUIT
- Begin DoDot:1
- +2 SET YSDG=$PIECE(^YTT(601.84,YSAD,0),U,4)
- +3 if (YSDG'<YSB)&(YSDG'>(YSE+.9))
- SET ^TMP("YSAD",$JOB,YSAD)=""
- End DoDot:1
- +4 QUIT
- SD ;select by Date Only
- +1 SET YSAD=0
- FOR
- SET YSAD=$ORDER(^YTT(601.84,"B",YSAD))
- if YSAD'>0
- QUIT
- Begin DoDot:1
- +2 SET YSDG=$PIECE(^YTT(601.84,YSAD,0),U,4)
- +3 if (YSDG'<YSB)&(YSDG'>(YSE+.9))
- SET ^TMP("YSAD",$JOB,YSAD)=""
- End DoDot:1
- +4 QUIT
- SO ;select by Ordered by
- +1 SET YSAD=0
- FOR
- SET YSAD=$ORDER(^YTT(601.84,"AO",YSOD,YSAD))
- if YSAD'>0
- QUIT
- Begin DoDot:1
- +2 SET YSDG=$PIECE(^YTT(601.84,YSAD,0),U,4)
- +3 if (YSDG'<YSB)&(YSDG'>(YSE+.9))
- SET ^TMP("YSAD",$JOB,YSAD)=""
- End DoDot:1
- +4 QUIT
- SL ;select by location
- +1 SET YSAD=0
- FOR
- SET YSAD=$ORDER(^YTT(601.84,"AL",YSLOC,YSAD))
- if YSAD'>0
- QUIT
- Begin DoDot:1
- +2 SET YSDG=$PIECE(^YTT(601.84,YSAD,0),U,4)
- +3 if (YSDG'<YSB)&(YSDG'>(YSE+.9))
- SET ^TMP("YSAD",$JOB,YSAD)=""
- End DoDot:1
- +4 QUIT
- ADMIN ;extract the data into an XML global
- +1 SET YSAD=0
- FOR
- SET YSAD=$ORDER(^TMP("YSAD",$JOB,YSAD))
- if YSAD'>0
- QUIT
- Begin DoDot:1
- +2 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Admin>"
- +3 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
- +4 DO FORM("Patient",601.84,YSAD,1)
- +5 SET DFN=$PIECE(^YTT(601.84,YSAD,0),U,2)
- SET ICN=$$GETICN^MPIF001(DFN)
- SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<ICN>"_ICN_"</ICN>"
- +6 DO FORM("Instrument",601.84,YSAD,2)
- +7 DO FORM("Given",601.84,YSAD,3)
- +8 DO FORM("Saved",601.84,YSAD,4)
- +9 DO FORM("Ordered",601.84,YSAD,5)
- +10 DO FORM("Complete",601.84,YSAD,8)
- +11 DO FORM("Location",601.84,YSAD,13)
- +12 if YSEA
- DO QUEST
- +13 if YSER
- DO RESULT
- +14 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="</Admin>"
- End DoDot:1
- +15 QUIT
- FORM(YSTAG,YSFILE,YSIENS,YSFIELD) ;xml entry
- +1 NEW G,Y1,Y2
- +2 SET N=N+1
- +3 SET Y1=$$GET1^DIQ(YSFILE,YSIENS_",",YSFIELD)
- +4 SET Y2=$$CONVSTR(Y1)
- +5 SET G="<"_YSTAG_">"_Y2_"</"_YSTAG_">"
- +6 SET ^TMP("YSXML",$JOB,N)=G
- +7 QUIT
- QUEST ;answers out
- +1 SET YSA=0
- SET YSJ=0
- FOR
- SET YSA=$ORDER(^YTT(601.85,"AD",YSAD,YSA))
- if YSA'>0
- QUIT
- Begin DoDot:1
- +2 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Quest>"
- +3 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
- +4 SET YSQNUMB=$PIECE(^YTT(601.85,YSA,0),U,3)
- +5 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Qnumb>"_YSQNUMB_"</Qnumb>"
- +6 SET YSQTEXT=$GET(^YTT(601.72,YSQNUMB,1,1,0))
- +7 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Qtext>"_YSQTEXT_"</Qtext>"
- +8 SET N=N+1
- SET YSJ=YSJ+1
- SET ^TMP("YSXML",$JOB,N)="<Seq>"_YSJ_"</Seq>"
- +9 DO FORM("Choice",601.85,YSA,4)
- +10 SET N=N+1
- +11 SET YSC=$PIECE(^YTT(601.85,YSA,0),U,4)
- +12 SET YSCN=$SELECT(YSC?1N.N:^YTT(601.75,YSC,1),1:"???")
- +13 if $DATA(^YTT(601.85,YSA,1,1,0))
- SET YSCN=^YTT(601.85,YSA,1,1,0)
- +14 SET ^TMP("YSXML",$JOB,N)="<Ans>"_YSCN_"</Ans>"
- +15 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="</Quest>"
- End DoDot:1
- +16 QUIT
- RESULT ;results out
- +1 SET YSR=0
- +2 FOR
- SET YSR=$ORDER(^YTT(601.92,"AC",YSAD,YSR))
- if YSR'>0
- QUIT
- Begin DoDot:1
- +3 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Score>"
- +4 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
- +5 DO FORM("Scale",601.92,YSR,2)
- +6 DO FORM("Raw",601.92,YSR,3)
- +7 DO FORM("Trans1",601.92,YSR,4)
- +8 SET N=N+1
- SET ^TMP("YSXML",$JOB,N)="</Score>"
- End DoDot:1
- +9 QUIT
- HEAD ;
- +1 ;
- CONVSTR(YSIN) ;convert string to valid xml
- +1 ; Keep "&" first
- SET L1(1)="&"
- SET L2(1)="&"
- +2 SET L1(2)=">"
- SET L2(2)=">"
- +3 SET L1(3)="<"
- SET L2(3)="<"
- +4 SET L1(4)="'"
- SET L2(4)="'"
- +5 SET L1(5)=""""
- SET L2(5)="""
- +6 SET YSOUT=YSIN
- +7 FOR CNT=1:1:5
- Begin DoDot:1
- +8 SET LEN=$LENGTH(L1(CNT))+1
- +9 SET IDX=0
- +10 FOR
- SET IDX=$FIND(YSOUT,L1(CNT),IDX)
- if IDX=0
- QUIT
- Begin DoDot:2
- +11 SET YSOUT=$EXTRACT(YSOUT,1,IDX-LEN)_L2(CNT)_$EXTRACT(YSOUT,IDX,250)
- +12 SET IDX=IDX-(LEN-2)
- End DoDot:2
- End DoDot:1
- +13 QUIT YSOUT