| 1 | YSPROSE ;SLC/RWF,SLC/DKG,SLC/TGA-PROSE TEXT GENERATOR ; 7/5/89 11:47 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | L1 ;
|
|---|
| 4 | S YSPTF=YSX_YSPGI_",0)",YSPX=@YSPTF G SKC:YSPTRUE,CMD:$A(YSPX)=124 ;"|"
|
|---|
| 5 | D JU
|
|---|
| 6 | L2 ;
|
|---|
| 7 | S YSPGI=YSPGI+1 G CL:YSPGI>YSPGL,L1
|
|---|
| 8 | ;
|
|---|
| 9 | CMD ;
|
|---|
| 10 | S YSPCMD=YSPX,YSPX=$P(YSPX,"|") G CMDQ:YSPX=""
|
|---|
| 11 | I $E(YSPX)=" " S YSPX=$E(YSPX,2,999) D JU G CMDQ
|
|---|
| 12 | S YSPY=+$E(YSPX,1,2) I YSPY S YSPX=$E(YSPX,$E(YSPX,3)?1P+3,255) G CMD2
|
|---|
| 13 | S YSPY=$F("TAB,BLA,TOP,MAR,FIL, , ,NEW,PAR",$E(YSPX,1,3))\4+9 S:YSPY<10 YSPY=0 S:YSPY YSPX=$P(YSPX," ",2,256)
|
|---|
| 14 | CMD2 G CMDQ:YSPY=0,IR:YSPY=1,DIR:YSPY=2,SKIP:YSPY=5,DO:YSPY=7,XQT:YSPY=8,CL:YSPY=19
|
|---|
| 15 | S YSPY=$P("VT,TAB,BL,TOP,MAR,FILL,PAGE,SPACE,OUT,PAR,,PGN",",",YSPY-8)
|
|---|
| 16 | D:YSPY]"" @YSPY G CMDQ
|
|---|
| 17 | D JU
|
|---|
| 18 | CMDQ ;
|
|---|
| 19 | Q:'$D(YSPCMD) S YSPX=$P(YSPCMD,"|",2,99) G CMD:YSPX]"" K YSPCMD G L2
|
|---|
| 20 | JU ;
|
|---|
| 21 | G JU1:YSPJU=1,JU2:YSPJU>1
|
|---|
| 22 | S YSPOL=YSPOL_YSPX G OUT
|
|---|
| 23 | RL ;
|
|---|
| 24 | S YSPI=1
|
|---|
| 25 | F ;
|
|---|
| 26 | S J=YSPTRM-YSPLM-$L(YSPOL),L=J I J<$L(YSPX) F J=J:-1:YSPI Q:$E(YSPX,J)=" "
|
|---|
| 27 | I J'>YSPI S J=YSPTRM-YSPLM+YSPI W J ;DEBUG
|
|---|
| 28 | D OUT:$L(YSPOL)+YSPLM+J-YSPI>YSPTRM S YSPOL=YSPOL_$E(YSPX,YSPI,J)_$E(" ",J=L),YSPI=J+1
|
|---|
| 29 | G F:$L(YSPX)>YSPI Q
|
|---|
| 30 | JU1 ;
|
|---|
| 31 | S YSPI=1
|
|---|
| 32 | J S J=$F(YSPX," ",YSPI),L=$E(YSPX,YSPI,$S(J:J-1,1:$L(YSPX))),YSPI=J I 'J S L=L_" "
|
|---|
| 33 | I $E(YSPX,YSPI)'=" ",".?!"[$E(L,$L(L)-1),$L(L)>4 S L=L_" "
|
|---|
| 34 | I YSPLM+$L(L)+$L(YSPOL)>YSPTRM D OUT
|
|---|
| 35 | S YSPOL=YSPOL_L G J:J K I,J,YSPX Q
|
|---|
| 36 | JU2 ;
|
|---|
| 37 | Q:YSPX="" S L=$P(YSPX," "),YSPX=$P(YSPX," ",2,255)
|
|---|
| 38 | G JU2:L?." "
|
|---|
| 39 | I YSPLM+$L(L)+$L(YSPOL)>YSPTRM D OUT S YSPWC=0
|
|---|
| 40 | I $L(L)>3,".?!"[$E(L,$L(L)) S L=L_" "
|
|---|
| 41 | S YSPOL=YSPOL_L_" " G JU2 ;%WC=YSPWC+1 G JU2
|
|---|
| 42 | OUT ;
|
|---|
| 43 | I $Y>YSPPL D H
|
|---|
| 44 | I YSPOL]"" W @($E("!!!!",1,YSPSKC)),?YSPLM,YSPOL S YSPOL=""
|
|---|
| 45 | I YSPPS S YSPLM=YSPPS,YSPPS=0
|
|---|
| 46 | Q
|
|---|
| 47 | IR ;
|
|---|
| 48 | S @("YSPX="_YSPX) D JU G CMDQ
|
|---|
| 49 | G CMDQ
|
|---|
| 50 | DIR ;
|
|---|
| 51 | S YSPY=$P(YSPX,U),YSPZ=$P(YSPX,U,2) S:YSPY="" YSPY="^"_YSPZ,YSPZ=$P(YSPX,U,3) I $D(@YSPY) S YSPX=$P(@YSPY,U,+YSPZ) D JU
|
|---|
| 52 | G CMDQ
|
|---|
| 53 | SKIP ;
|
|---|
| 54 | S YSPSV=$P(YSPX,":",2),YSPX=$P(YSPX,":") I @YSPX G SK2
|
|---|
| 55 | G CMDQ
|
|---|
| 56 | SK2 ;
|
|---|
| 57 | S YSPTRUE=$T,YSPST=YSPSV?1A.AN G L2
|
|---|
| 58 | SKC ;
|
|---|
| 59 | I YSPST,$E(YSPX,1,2)="|0",$E(YSPX,5,99)=YSPSV S YSPTRUE=0 G L2
|
|---|
| 60 | I 'YSPST,$E(YSPX,1,2)="|0" S YSPSV=YSPSV-1 I YSPSV=0 S YSPTRUE=0 G L2
|
|---|
| 61 | G L2
|
|---|
| 62 | DO ;
|
|---|
| 63 | D @YSPX G CMDQ
|
|---|
| 64 | XQT ;
|
|---|
| 65 | X YSPX G CMDQ
|
|---|
| 66 | VT ;
|
|---|
| 67 | D OUT S YSPX=$S(YSPX>YSPPL:YSPPL,1:YSPX) F YSPI=$Y:1:+YSPX W !
|
|---|
| 68 | Q
|
|---|
| 69 | BL ;
|
|---|
| 70 | D OUT,H:$Y+YSPX>YSPPL Q:YSLFT F YSPI=1:1:+YSPX W !
|
|---|
| 71 | K YSPI Q
|
|---|
| 72 | TOP ;
|
|---|
| 73 | Q:$D(YSNOFORM) D ENHD^YSFORM Q
|
|---|
| 74 | MAR ;
|
|---|
| 75 | D OUT S YSPLM=$P(YSPX,U),YSPTRM=$P(YSPX,U,2) Q
|
|---|
| 76 | FILL ;
|
|---|
| 77 | D OUT S YSPJU=+YSPX S:YSPJU>3 YSPJU=2 Q
|
|---|
| 78 | PAGE ;
|
|---|
| 79 | S YSPPL=+YSPX I (YSPPL<3)!(YSPPL>66) S YSPPL=50
|
|---|
| 80 | Q
|
|---|
| 81 | SPACE ;
|
|---|
| 82 | D OUT S YSPSKC=+YSPX Q
|
|---|
| 83 | TAB ;
|
|---|
| 84 | S YSPY=+YSPX,YSPZ=$P(YSPX,U,2),YSPX=$L(YSPOL)+YSPLM S:'YSPY YSPY=80-$L(YSPZ)\2 F YSPI=YSPX:1:YSPY-1 S YSPOL=YSPOL_" "
|
|---|
| 85 | S YSPX=YSPZ K YSPI,YSPZ G JU
|
|---|
| 86 | PAR ;
|
|---|
| 87 | D OUT S YSPOL=" " D OUT S YSPPS=YSPLM I YSPX?1P,"+-"[YSPX S @("YSPLM=YSPLM"_YSPX_"5") Q
|
|---|
| 88 | Q
|
|---|
| 89 | PGN ;
|
|---|
| 90 | S:YSPX YSPPGN=YSPX K:'YSPX YSPPGN Q
|
|---|
| 91 | E S:YSPX?.N YSPLM=+YSPX Q
|
|---|
| 92 | CL ;
|
|---|
| 93 | D OUT Q
|
|---|
| 94 | H ;
|
|---|
| 95 | I $D(YSNOFORM) D:'YST WAIT W @IOF Q
|
|---|
| 96 | S:YST YSCON=1 D ENFT^YSFORM:YST,WAIT:'YST Q:YSLFT D:YST ENHD^YSFORM Q
|
|---|
| 97 | WAIT ;
|
|---|
| 98 | F I0=1:1:IOSL-$Y-2 W !
|
|---|
| 99 | W:$Y+1<IOSL !
|
|---|
| 100 | N DTOUT,DUOUT,DIRUT
|
|---|
| 101 | S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
|
|---|
| 102 | W @IOF Q:'YSLFT S YSPGI=YSPGL,(YSPCMD,YSPOL,YSPX,L)=""
|
|---|
| 103 | Q
|
|---|
| 104 | EN1 ; Called by routine YSPHYR, YSPP7
|
|---|
| 105 | S (YSCON,YSLFT)=0,YSPTF=YSX_"YSPGI)",YSPGI=0,YSPGL=$P(@YSPTF,U,4),YSPGI=1,YSPTRM=78,YSPOL="",YSPJU=1,YSPLM=0,YSPSKC=1,YSPPS=0,YSPWC=0,YSPTRUE=0,YST=$S(IOST?1"P".E:1,1:0),YSPPL=$S(YST:IOSL-8,1:IOSL-3) U IO D L1
|
|---|
| 106 | K YSPCMD,YSPGI,YSPGL,YSPJU,YSPLM,YSPOL,YSPPS,YSPSKC,YSPTF,YSPTRM,YSPTRUE,YSPWC,YSPX Q
|
|---|
