MCARDHLP ;WISC/DCB-HELP FOR SCREEN INPUT ;8/27/96 10:06
;;2.3;Medicine;;09/13/1996
Q
START ;
N SPACE,X,Y S MCARGDA=DJDN
N VAL,MCERR,FLAG,TMP,XHOLD
N SPACE S SPACE="" S $P(SPACE," ",80)=""
I $D(MCDID) S DX=1,DY=1 X XY W SPACE
Q:'$D(DJJ(+V))
S @$P(DJJ(V),U,2) X XY
I $D(MCHELPSW),('$D(MCHELPS2)) D FUNC^MCARDNQ2 K MCMASS D SKIP Q
I $D(MCDID),$D(MCHELPSW),'$D(MCHELPS2) Q
I (DJ4["200")!(DJ4["690") D FUNC Q
S VAL=$P(DJ0,U,2)
I VAL["F" G FUNC
I VAL["S" D SETH(DJDD,DJAT,DJ0) D SKIP Q
I DJ4["M" D MULT(DJDD,DJAT,DJDN,.FLAG)
I VAL["P" D POINTER(DJDD,DJAT) D FUNC:$D(MCERR),SKIP Q
I DJ4["M",VAL["D" D Q ; New line & dot block DAD 7-23-96
. N %DT,DJAT,DJDD,DJX,MCMASS,X
. S DJDD=+$P(DJ0,U,2),DJAT=.01
. S X=$P($P(DJ0,U,5)," D ^%DT") S:X="" X="S %DT=""E""" X X
. I $D(DJCP) X DJCP X XY W DJLIN
. D HELP^MCARDNQ,FUNC
. Q
I DJ4["M",$TR(VAL,"aeAIM")=+VAL D Q ; New line & dot block DAD 8-14-96
. N DJAT,DJDD
. S DJDD=+$P(DJ0,U,2),DJAT=.01
. I $D(DJCP) X DJCP X XY W DJLIN
. D FUNC
. Q
FUNC ;
D NUMBER(DJDD,DJAT)
I $G(MCERR) D FUNC^MCARDNQ2
SKIP ;
S MCDID=1
S @$P(DJJ(V),U,2) X XY Q
POINTER(XFILE,FLD) ;
N LINE,PTER,SUB,GL,XFLD,HOLD S HOLD=XFILE
S LINE=$G(^DD(XFILE,FLD,0)) I LINE="" S MCERR=0 Q
S GL=$P(LINE,U,3),LINE=$P(LINE,U,2)
I GL'="" S PTER=+$P(LINE,"P",2)
E S XFILE=+LINE,XFLD=.01,PTER=+$P($P($G(^DD(XFILE,XFLD,0)),U,2),"P",2)
I +PTER=0 S MCERR=0 Q
I PTER=200 S MCERR=0 Q
D POINTERH(XFILE,PTER,FLD,HOLD)
Q
POINTERH(XFILE,MFILE,FLD,HOLD) ;
N DIC,TMP,REC,LOOP,TOTAL,LEN,GLOBAL,Y,SETLOC
N FIELDS,TYPE,EXC,TEMP,ERROR,X,XREF,SWITCH
D RTNELM^MCDBELM(MFILE,1,".01","","","E","",.TEMP,.ERROR)
S GLOBAL=TEMP("DIC"),XREF=GLOBAL_"""B"")"
S GLOBAL=TEMP("GLO")
S REC=+$P($G(@GLOBAL@(0)),U,4) I REC>200!(REC<1) S MCERR=1 Q
S SETLOC=$$SCRN(HOLD,FLD),LOOP=0,D0=DJDN,HOLD=""
W !
F S HOLD=$O(@XREF@(HOLD)) Q:HOLD="" D
.S Y=$O(@XREF@(HOLD,0))
.S TEP=$G(@GLOBAL@(Y,0)),REC=Y X SETLOC
.I $T D
..S $P(TEMP(1),U,2)=Y D GETDATA^MCDBSAVE(.TEMP,.ERROR)
..S XHOLD=$D(XHOLD(REC)),LOOP=LOOP+1
..S TMP(TEMP("FLD",.01))=XHOLD S SWITCH=XHOLD
I (LOOP<1) S MCERR=1 Q
I (LOOP>70) D:SWITCH'=0 ADJUST
D HEADER("{Current choices}")
D POINTER2(LOOP)
Q
ADJUST ;
N %X,%Y,HOLD,TOTAL,XTEMP S XTEMP(1)="CURENTLY IN LIST",TOTAL=1
F HOLD=1:1:LOOP D
.I $D(TMP(HOLD,0)) S TOTAL=TOTAL+1,XTEMP(TOTAL)=TMP(HOLD,0)
S LOOP=TOTAL K TMP
S %X="XTEMP(",%Y="TMP(" D %XY^%RCR
Q
POINTER2(TOTAL) ;Help display for pointers
N MAX,COL,SP,VAL,TYPE S VAL=""
I TOTAL=0 S MCERR=1 Q
S SP=" ",$P(SP," ",80)="",CT=0,COL=(TOTAL\7)
S:(TOTAL/7)'=(TOTAL\7) COL=COL+1
S MAX=80\COL,MLEN=MAX-2,COL=COL-1
I $D(DJCP) X DJCP X XY W DJLIN
F LOOP=1:1:TOTAL S VAL=$O(TMP(VAL)) Q:VAL="" D
.S TYPE=TMP(VAL)
.I CT>COL S CT=0 W !
.I $G(VAL)'="" D
..S CT=CT+1
..W $S(TYPE:$G(DJHIN),1:"")_$E($E(VAL,1,MLEN)_SP,1,MAX)_$S(TYPE:$G(DJLIN),1:"")
Q
SETH(FILE,FIELD,TEMP) ;
N DIC,LOOP,ITEMS,TMP,LOP,MAX,MLEN1,MLEN2,TOTAL
I +$P(TEMP,U,2)'=0 S FILE=+$P(TEMP,U,2),FIELD=.01,TEMP=""
S:$P($G(TEMP),U,3)="" TEMP=$G(^DD(FILE,FIELD,0))
S TMP=$P(TEMP,U,3),MLEN1=0,MLEN2=0
S DIC("S")=$$SCRN(FILE,FIELD),LOOP(0)=0,ITEMS=""
Q:TMP=""
F LOOP=1:1:$L(TMP,";") S MAX=$P(TMP,";",LOOP) Q:MAX="" D
.I $G(DIC("S"))]"" S Y=$P(MAX,":") I Y]"" X DIC("S") Q:'$T
.S LOOP(0)=LOOP(0)+1,ITEMS=ITEMS_MAX_";"
.S LEN1=$L($P(MAX,":",1)) S:LEN1>MLEN1 MLEN1=LEN1
.S LEN2=$L($P(MAX,":",2)) S:LEN2>MLEN2 MLEN2=LEN2
S TOTAL=LOOP(0) D SET2(ITEMS,TOTAL,MLEN1,MLEN2)
Q
SET2(TMP,TOTAL,MLEN1,MLEN2) ;
N MAX,COL,CT,LOOP,F1,F2,SP,Y
S SP="",$P(SP," ",80)="",MLEN=MLEN1+3+MLEN2+2,CT=0
S COL=(TOTAL\7) S:(TOTAL/7)'=(TOTAL\7) COL=COL+1
S MAX=80\COL,MAX=MAX-2 S:MAX<MLEN MLEN=MAX
S COL=COL-1
S:COL=3&(TOTAL<8) COL=1 I $D(DJCP) X DJCP X XY W DJLIN
F LOOP=1:1:TOTAL D
.S TEMP=$P(TMP,";",LOOP),F1=$P(TEMP,":",1),F2=$P(TEMP,":",2)
.S F1=$E(F1_SP,1,MLEN1),F2=$E(F2_SP,1,MLEN2)
.I CT>COL S CT=0 W !
.W $G(DJHIN),F1,$G(DJLIN)," - ",F2," "
.S CT=CT+1
D HEADER("{Help prompt for Set of Codes}")
Q
NUMBER(FILE,FIELD) ;
N VAL
S VAL=$G(^DD(FILE,FIELD,3)) I VAL="" S MCERR=1 Q
D HEADER("{Help prompt}")
I $D(DJCP) X DJCP X XY W DJLIN
W !!,VAL
Q
MULT(FILE,FIELD,XREC,FLAG) ;
N FIELDS,REC,EXC,DATA,TYPE,USER,TEMP,ERROR,LOOP,TOTAL,GLO,LEVEL
S LEVEL=1,FIELDS=FIELD,REC=""
D MAIN(FILE,.FIELDS,.LEVEL)
I LEVEL>1 F LOOP=1:1:LEVEL S REC=REC_^TMP($J,"DJST",LOOP,"DA")_U
E S REC=XREC_U,FIELDS=FIELD_U
S REC=REC_1,FIELDS=FIELDS_".01"
;; ***ORIGINAL*** ;; S:$D(^DD(FILE,0,"UP")) FILE=^DD(FILE,0,"UP")
F S FILE(0)=$G(^DD(FILE,0,"UP")) Q:FILE(0)'>0 S FILE=FILE(0) ;DAD81496
D RTNELM^MCDBELM(FILE,REC,FIELDS,"","","E","",.TEMP,.ERROR)
S GLO=TEMP("GLO")
F LOOP=0:0 S LOOP=+$O(@GLO@(LOOP)) Q:LOOP=0 D
.S REC=+$P($G(@GLO@(LOOP,0)),U,1),XHOLD(REC)=""
Q
MAIN(FILE,FIELDS,LEVEL) ;
N HOLD,NAME
S HOLD=$G(^DD(FILE,0,"UP"))
I HOLD="" S FIELDS=$$REORDER(FIELDS,LEVEL) Q
S NAME=$O(^DD(FILE,0,"NM","")),LEVEL=LEVEL+1
S FIELDS=$G(FIELDS)_U_+$O(^DD(HOLD,"B",NAME,0))
D MAIN(HOLD,.FIELDS,LEVEL)
Q
REORDER(FIELDS,LEVEL) ;
N LOOP,HOLD S HOLD="" I LEVEL<2 Q ""
F LOOP=LEVEL:-1:1 D
.S HOLD=HOLD_$P(FIELDS,U,LOOP)_U
Q HOLD
N SPACE,TEMP,TMP S SPACE="",$P(SPACE," ",80)=" "
S DX=1,DY=1 X XY
S TMP=40-$L(MCHELP)
S TEMP=$E(SPACE,1,TMP)_MCHELP
W DJHIN,"*** Commands: ^C ",$S($D(DJTOGGLE):"or KP1 ",1:""),"***",?40,TEMP,DJLIN
Q
SCRN(SFILE,SFLD) ;
N SCREEN
I $G(^DD(SFILE,SFLD,12.1))'="" D SCSET
I '$D(SCREEN) D
.S SFILE=+$P(^DD(SFILE,SFLD,0),U,2),SFLD=.01
.I 'SFILE?1N.N1".".N S SFILE=+$P(SFILE,"P",2)
.I $G(^DD(SFILE,SFLD,12.1))'="" D SCSET
Q $S($D(SCREEN):SCREEN,1:"I 1")
SCSET ;
I ^DD(SFILE,SFLD,12.1)["S DIC(""S"")" X ^(12.1) S SCREEN=DIC("S") K DIC("S") Q
S SCREEN=^DD(SFILE,SFLD,12.1) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARDHLP 5843 printed Nov 22, 2024@17:22:38 Page 2
MCARDHLP ;WISC/DCB-HELP FOR SCREEN INPUT ;8/27/96 10:06
+1 ;;2.3;Medicine;;09/13/1996
+2 QUIT
START ;
+1 NEW SPACE,X,Y
SET MCARGDA=DJDN
+2 NEW VAL,MCERR,FLAG,TMP,XHOLD
+3 NEW SPACE
SET SPACE=""
SET $PIECE(SPACE," ",80)=""
+4 IF $DATA(MCDID)
SET DX=1
SET DY=1
XECUTE XY
WRITE SPACE
+5 if '$DATA(DJJ(+V))
QUIT
+6 SET @$PIECE(DJJ(V),U,2)
XECUTE XY
+7 IF $DATA(MCHELPSW)
IF ('$DATA(MCHELPS2))
DO FUNC^MCARDNQ2
KILL MCMASS
DO SKIP
QUIT
+8 IF $DATA(MCDID)
IF $DATA(MCHELPSW)
IF '$DATA(MCHELPS2)
QUIT
+9 IF (DJ4["200")!(DJ4["690")
DO FUNC
QUIT
+10 SET VAL=$PIECE(DJ0,U,2)
+11 IF VAL["F"
GOTO FUNC
+12 IF VAL["S"
DO SETH(DJDD,DJAT,DJ0)
DO SKIP
QUIT
+13 IF DJ4["M"
DO MULT(DJDD,DJAT,DJDN,.FLAG)
+14 IF VAL["P"
DO POINTER(DJDD,DJAT)
if $DATA(MCERR)
DO FUNC
DO SKIP
QUIT
+15 ; New line & dot block DAD 7-23-96
IF DJ4["M"
IF VAL["D"
Begin DoDot:1
+16 NEW %DT,DJAT,DJDD,DJX,MCMASS,X
+17 SET DJDD=+$PIECE(DJ0,U,2)
SET DJAT=.01
+18 SET X=$PIECE($PIECE(DJ0,U,5)," D ^%DT")
if X=""
SET X="S %DT=""E"""
XECUTE X
+19 IF $DATA(DJCP)
XECUTE DJCP
XECUTE XY
WRITE DJLIN
+20 DO HELP^MCARDNQ
DO FUNC
+21 QUIT
End DoDot:1
QUIT
+22 ; New line & dot block DAD 8-14-96
IF DJ4["M"
IF $TRANSLATE(VAL,"aeAIM")=+VAL
Begin DoDot:1
+23 NEW DJAT,DJDD
+24 SET DJDD=+$PIECE(DJ0,U,2)
SET DJAT=.01
+25 IF $DATA(DJCP)
XECUTE DJCP
XECUTE XY
WRITE DJLIN
+26 DO FUNC
+27 QUIT
End DoDot:1
QUIT
FUNC ;
+1 DO NUMBER(DJDD,DJAT)
+2 IF $GET(MCERR)
DO FUNC^MCARDNQ2
SKIP ;
+1 SET MCDID=1
+2 SET @$PIECE(DJJ(V),U,2)
XECUTE XY
QUIT
POINTER(XFILE,FLD) ;
+1 NEW LINE,PTER,SUB,GL,XFLD,HOLD
SET HOLD=XFILE
+2 SET LINE=$GET(^DD(XFILE,FLD,0))
IF LINE=""
SET MCERR=0
QUIT
+3 SET GL=$PIECE(LINE,U,3)
SET LINE=$PIECE(LINE,U,2)
+4 IF GL'=""
SET PTER=+$PIECE(LINE,"P",2)
+5 IF '$TEST
SET XFILE=+LINE
SET XFLD=.01
SET PTER=+$PIECE($PIECE($GET(^DD(XFILE,XFLD,0)),U,2),"P",2)
+6 IF +PTER=0
SET MCERR=0
QUIT
+7 IF PTER=200
SET MCERR=0
QUIT
+8 DO POINTERH(XFILE,PTER,FLD,HOLD)
+9 QUIT
POINTERH(XFILE,MFILE,FLD,HOLD) ;
+1 NEW DIC,TMP,REC,LOOP,TOTAL,LEN,GLOBAL,Y,SETLOC
+2 NEW FIELDS,TYPE,EXC,TEMP,ERROR,X,XREF,SWITCH
+3 DO RTNELM^MCDBELM(MFILE,1,".01","","","E","",.TEMP,.ERROR)
+4 SET GLOBAL=TEMP("DIC")
SET XREF=GLOBAL_"""B"")"
+5 SET GLOBAL=TEMP("GLO")
+6 SET REC=+$PIECE($GET(@GLOBAL@(0)),U,4)
IF REC>200!(REC<1)
SET MCERR=1
QUIT
+7 SET SETLOC=$$SCRN(HOLD,FLD)
SET LOOP=0
SET D0=DJDN
SET HOLD=""
+8 WRITE !
+9 FOR
SET HOLD=$ORDER(@XREF@(HOLD))
if HOLD=""
QUIT
Begin DoDot:1
+10 SET Y=$ORDER(@XREF@(HOLD,0))
+11 SET TEP=$GET(@GLOBAL@(Y,0))
SET REC=Y
XECUTE SETLOC
+12 IF $TEST
Begin DoDot:2
+13 SET $PIECE(TEMP(1),U,2)=Y
DO GETDATA^MCDBSAVE(.TEMP,.ERROR)
+14 SET XHOLD=$DATA(XHOLD(REC))
SET LOOP=LOOP+1
+15 SET TMP(TEMP("FLD",.01))=XHOLD
SET SWITCH=XHOLD
End DoDot:2
End DoDot:1
+16 IF (LOOP<1)
SET MCERR=1
QUIT
+17 IF (LOOP>70)
if SWITCH'=0
DO ADJUST
+18 DO HEADER("{Current choices}")
+19 DO POINTER2(LOOP)
+20 QUIT
ADJUST ;
+1 NEW %X,%Y,HOLD,TOTAL,XTEMP
SET XTEMP(1)="CURENTLY IN LIST"
SET TOTAL=1
+2 FOR HOLD=1:1:LOOP
Begin DoDot:1
+3 IF $DATA(TMP(HOLD,0))
SET TOTAL=TOTAL+1
SET XTEMP(TOTAL)=TMP(HOLD,0)
End DoDot:1
+4 SET LOOP=TOTAL
KILL TMP
+5 SET %X="XTEMP("
SET %Y="TMP("
DO %XY^%RCR
+6 QUIT
POINTER2(TOTAL) ;Help display for pointers
+1 NEW MAX,COL,SP,VAL,TYPE
SET VAL=""
+2 IF TOTAL=0
SET MCERR=1
QUIT
+3 SET SP=" "
SET $PIECE(SP," ",80)=""
SET CT=0
SET COL=(TOTAL\7)
+4 if (TOTAL/7)'=(TOTAL\7)
SET COL=COL+1
+5 SET MAX=80\COL
SET MLEN=MAX-2
SET COL=COL-1
+6 IF $DATA(DJCP)
XECUTE DJCP
XECUTE XY
WRITE DJLIN
+7 FOR LOOP=1:1:TOTAL
SET VAL=$ORDER(TMP(VAL))
if VAL=""
QUIT
Begin DoDot:1
+8 SET TYPE=TMP(VAL)
+9 IF CT>COL
SET CT=0
WRITE !
+10 IF $GET(VAL)'=""
Begin DoDot:2
+11 SET CT=CT+1
+12 WRITE $SELECT(TYPE:$GET(DJHIN),1:"")_$EXTRACT($EXTRACT(VAL,1,MLEN)_SP,1,MAX)_$SELECT(TYPE:$GET(DJLIN),1:"")
End DoDot:2
End DoDot:1
+13 QUIT
SETH(FILE,FIELD,TEMP) ;
+1 NEW DIC,LOOP,ITEMS,TMP,LOP,MAX,MLEN1,MLEN2,TOTAL
+2 IF +$PIECE(TEMP,U,2)'=0
SET FILE=+$PIECE(TEMP,U,2)
SET FIELD=.01
SET TEMP=""
+3 if $PIECE($GET(TEMP),U,3)=""
SET TEMP=$GET(^DD(FILE,FIELD,0))
+4 SET TMP=$PIECE(TEMP,U,3)
SET MLEN1=0
SET MLEN2=0
+5 SET DIC("S")=$$SCRN(FILE,FIELD)
SET LOOP(0)=0
SET ITEMS=""
+6 if TMP=""
QUIT
+7 FOR LOOP=1:1:$LENGTH(TMP,";")
SET MAX=$PIECE(TMP,";",LOOP)
if MAX=""
QUIT
Begin DoDot:1
+8 IF $GET(DIC("S"))]""
SET Y=$PIECE(MAX,":")
IF Y]""
XECUTE DIC("S")
if '$TEST
QUIT
+9 SET LOOP(0)=LOOP(0)+1
SET ITEMS=ITEMS_MAX_";"
+10 SET LEN1=$LENGTH($PIECE(MAX,":",1))
if LEN1>MLEN1
SET MLEN1=LEN1
+11 SET LEN2=$LENGTH($PIECE(MAX,":",2))
if LEN2>MLEN2
SET MLEN2=LEN2
End DoDot:1
+12 SET TOTAL=LOOP(0)
DO SET2(ITEMS,TOTAL,MLEN1,MLEN2)
+13 QUIT
SET2(TMP,TOTAL,MLEN1,MLEN2) ;
+1 NEW MAX,COL,CT,LOOP,F1,F2,SP,Y
+2 SET SP=""
SET $PIECE(SP," ",80)=""
SET MLEN=MLEN1+3+MLEN2+2
SET CT=0
+3 SET COL=(TOTAL\7)
if (TOTAL/7)'=(TOTAL\7)
SET COL=COL+1
+4 SET MAX=80\COL
SET MAX=MAX-2
if MAX<MLEN
SET MLEN=MAX
+5 SET COL=COL-1
+6 if COL=3&(TOTAL<8)
SET COL=1
IF $DATA(DJCP)
XECUTE DJCP
XECUTE XY
WRITE DJLIN
+7 FOR LOOP=1:1:TOTAL
Begin DoDot:1
+8 SET TEMP=$PIECE(TMP,";",LOOP)
SET F1=$PIECE(TEMP,":",1)
SET F2=$PIECE(TEMP,":",2)
+9 SET F1=$EXTRACT(F1_SP,1,MLEN1)
SET F2=$EXTRACT(F2_SP,1,MLEN2)
+10 IF CT>COL
SET CT=0
WRITE !
+11 WRITE $GET(DJHIN),F1,$GET(DJLIN)," - ",F2," "
+12 SET CT=CT+1
End DoDot:1
+13 DO HEADER("{Help prompt for Set of Codes}")
+14 QUIT
NUMBER(FILE,FIELD) ;
+1 NEW VAL
+2 SET VAL=$GET(^DD(FILE,FIELD,3))
IF VAL=""
SET MCERR=1
QUIT
+3 DO HEADER("{Help prompt}")
+4 IF $DATA(DJCP)
XECUTE DJCP
XECUTE XY
WRITE DJLIN
+5 WRITE !!,VAL
+6 QUIT
MULT(FILE,FIELD,XREC,FLAG) ;
+1 NEW FIELDS,REC,EXC,DATA,TYPE,USER,TEMP,ERROR,LOOP,TOTAL,GLO,LEVEL
+2 SET LEVEL=1
SET FIELDS=FIELD
SET REC=""
+3 DO MAIN(FILE,.FIELDS,.LEVEL)
+4 IF LEVEL>1
FOR LOOP=1:1:LEVEL
SET REC=REC_^TMP($JOB,"DJST",LOOP,"DA")_U
+5 IF '$TEST
SET REC=XREC_U
SET FIELDS=FIELD_U
+6 SET REC=REC_1
SET FIELDS=FIELDS_".01"
+7 ;; ***ORIGINAL*** ;; S:$D(^DD(FILE,0,"UP")) FILE=^DD(FILE,0,"UP")
+8 ;DAD81496
FOR
SET FILE(0)=$GET(^DD(FILE,0,"UP"))
if FILE(0)'>0
QUIT
SET FILE=FILE(0)
+9 DO RTNELM^MCDBELM(FILE,REC,FIELDS,"","","E","",.TEMP,.ERROR)
+10 SET GLO=TEMP("GLO")
+11 FOR LOOP=0:0
SET LOOP=+$ORDER(@GLO@(LOOP))
if LOOP=0
QUIT
Begin DoDot:1
+12 SET REC=+$PIECE($GET(@GLO@(LOOP,0)),U,1)
SET XHOLD(REC)=""
End DoDot:1
+13 QUIT
MAIN(FILE,FIELDS,LEVEL) ;
+1 NEW HOLD,NAME
+2 SET HOLD=$GET(^DD(FILE,0,"UP"))
+3 IF HOLD=""
SET FIELDS=$$REORDER(FIELDS,LEVEL)
QUIT
+4 SET NAME=$ORDER(^DD(FILE,0,"NM",""))
SET LEVEL=LEVEL+1
+5 SET FIELDS=$GET(FIELDS)_U_+$ORDER(^DD(HOLD,"B",NAME,0))
+6 DO MAIN(HOLD,.FIELDS,LEVEL)
+7 QUIT
REORDER(FIELDS,LEVEL) ;
+1 NEW LOOP,HOLD
SET HOLD=""
IF LEVEL<2
QUIT ""
+2 FOR LOOP=LEVEL:-1:1
Begin DoDot:1
+3 SET HOLD=HOLD_$PIECE(FIELDS,U,LOOP)_U
End DoDot:1
+4 QUIT HOLD
+1 NEW SPACE,TEMP,TMP
SET SPACE=""
SET $PIECE(SPACE," ",80)=" "
+2 SET DX=1
SET DY=1
XECUTE XY
+3 SET TMP=40-$LENGTH(MCHELP)
+4 SET TEMP=$EXTRACT(SPACE,1,TMP)_MCHELP
+5 WRITE DJHIN,"*** Commands: ^C ",$SELECT($DATA(DJTOGGLE):"or KP1 ",1:""),"***",?40,TEMP,DJLIN
+6 QUIT
SCRN(SFILE,SFLD) ;
+1 NEW SCREEN
+2 IF $GET(^DD(SFILE,SFLD,12.1))'=""
DO SCSET
+3 IF '$DATA(SCREEN)
Begin DoDot:1
+4 SET SFILE=+$PIECE(^DD(SFILE,SFLD,0),U,2)
SET SFLD=.01
+5 IF 'SFILE?1N.N1".".N
SET SFILE=+$PIECE(SFILE,"P",2)
+6 IF $GET(^DD(SFILE,SFLD,12.1))'=""
DO SCSET
End DoDot:1
+7 QUIT $SELECT($DATA(SCREEN):SCREEN,1:"I 1")
SCSET ;
+1 IF ^DD(SFILE,SFLD,12.1)["S DIC(""S"")"
XECUTE ^(12.1)
SET SCREEN=DIC("S")
KILL DIC("S")
QUIT
+2 SET SCREEN=^DD(SFILE,SFLD,12.1)
QUIT
