LAKDIFF1 ;DALOI/RWF/LL/RES - KEYBOARD DIFF PART 2 ; 7/14/87 08:02
;;5.2;AUTOMATED LAB INSTRUMENTS;**52**;Sep 27, 1994
; WBC DIFF CELL COUNTER
;
A ;
N LAI
;
K KEY,NC,TY,T1,T2
;
S KEY="",LAI=0
F S LAI=$O(^TMP($J,"W",LAI)) Q:LAI="" D
. S K=^TMP($J,"W",LAI),KEY(K)=LAI,KEY=KEY_K,TY(K)=""
. I $D(^TMP($J,"NC",LAI)) S NC(K)=""
;
F LAI=1:1:27 D Q:$O(^TMP($J,"W",LAI))=""
. S X=$G(^TMP("LA",$J,LAI,4))
. S Y=$G(^TMP("LA",$J,LAI,.1))
. S ^TMP($J,"A",LAI\9+1,LAI#9)=X_"^"_Y,T2=LAI
;
S T1=1,(T1(1),T2(1))=""
;
F LAI=1:1:T2 D
. S X=^TMP($J,"A",LAI\9+1,LAI#9)
. S T1(T1)=T1(T1)_$J($P(X,U,1),8)
. S T2(T1)=T2(T1)_$J($P(X,U,2),8)
. I '(LAI#9) S T1=T1+1,(T1(T1),T2(T1))=""
;
S (TOTAL,FLAG,STORE)=0
D HD1,HD4,HD2
;
F Q:TOTAL=200!FLAG!STORE D
. N DTOUT
. D SAY^XGF(IOSL-1,0,"WBC: ")
. S TYPE=$$READ^XGF(1,DTIME)
. I TYPE="^"!($D(DTOUT)) S FLAG=1 Q
. S LINE=$S(TYPE="":"STOP",TYPE="-":"MINUS",TYPE="!":"COM",KEY'[TYPE:"HELP",1:"COUNT")
. D @LINE
;
D STORE:(TOTAL=200)!(STORE)
;
K TEMP,T1,T2,KEY,NC,CONT,J,L,TOTAL,CHK,STORE
Q
;
COUNT ; Add key to cell count
;
; Count key
I '$D(NC(TYPE)) S TOTAL=TOTAL+1
;
S TY(TYPE)=TY(TYPE)+1
I LAUPDATE D SHOWCNT
D HD3
I '$D(NC(TYPE)),(TOTAL=100!(TOTAL=200)) D EVAL
Q
;
HELP ;
;
I TYPE'="?" D Q
. D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
. D SAY^XGF(IOSL-1,0,$C(7)_"INVALID WBC CELL KEY")
. H 2
. D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
. D HD3
;
D SHOWCNT,HD3
Q
;
SHOWCNT ; Display current cell count
;
N I,I1,X,K
;
S $Y=LRDY
F I1=1:9:T2 D
. S $Y=$Y+3,$X=6
. F I=I1:1:I1+8 Q:I>T2 D
. . S X=$G(^TMP($J,"W",I),"^"),K=$G(TY(X))
. . I '$L(K) S $X=$X+8
. . E D SAY^XGF($Y,$X+(9-$L(K)),K,"R1")
. S $Y=$Y+1
Q
;
STOP ;
D EVAL
;
N DIR,DIROUT,DTOUT,DUOUT,X,Y
;
S DIR(0)="YO",DIR("B")="Y"
I TOTAL<100 S DIR("A",1)=$C(7)_"* You have counted "_TOTAL_" CELLS *"
S DIR("A")="Are you finished with the WBC cell count"
D ^DIR
I $D(DIRUT) S FLAG=1 Q
I Y=1 S STORE=1
I FLAG=STORE D HD1,HD4,HD2,SHOWCNT
Q
;
EVAL ;
N LAI
;
W $C(7) D HD1
I TOTAL<100 W $C(7),!,"NOTE: ONLY ",TOTAL," CELLS COUNTED",!! Q:TOTAL=0
W !,"Test",?11,"Count Value"
S LAI=0
F S LAI=$O(^TMP($J,"W",LAI)) Q:LAI="" D
. S K=^TMP($J,"W",LAI)
. W !,$$LJ^XLFSTR(^TMP("LA",$J,LAI,.1),11,".")
. S V=TY(K)
. W $J(V,5)," "
. X ^TMP("LA",$J,LAI,2)
. W $J(V,5)
;
W !,$$LJ^XLFSTR("Total",11,".")," ",$J(TOTAL,5),!
I '(TOTAL=100!(TOTAL=200)) Q
I TOTAL=100 D TWO
Q
;
TWO ;
N DIR,DIROUT,DTOUT,DUOUT,X,Y
;
; Flush buffer
F S X=$$READ^XGF(1,1) Q:$D(DTOUT)
;
S DIR(0)="SBO^C:CONTINUE;S:STOP"
S DIR("A",1)="100 Cells counted"
S DIR("A")="CONTINUE counting to 200 or STOP"
S DIR("B")="STOP"
D ^DIR
I $D(DIRUT) S FLAG=1 Q
I Y="S" S STORE=1
I Y="C" D
. N TYPE
. D HD1,HD4,HD2
. I LAUPDATE S TYPE="?" D HELP
;
Q
;
STORE ;
N LAI
;
S LAI=0
F S LAI=$O(^TMP($J,"W",LAI)) Q:LAI="" D
. S K=^(LAI),V=TY(K)
. X ^TMP("LA",$J,LAI,2)
. S @^TMP("LA",$J,LAI,1)=V
Q
;
MINUS ;
; Clear line on screen display
D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
;
D SAY^XGF(IOSL-1,0,"SUBTRACT WHICH CELL TYPE: ")
;
S TYPE=$$READ^XGF(1,DTIME)
;
; Clear line on screen display
D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
;
I $D(DTOUT) S FLAG=1 Q
I $L(TYPE) D
. I KEY'[TYPE D Q
. . D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
. . D SAY^XGF(IOSL-1,0,"INVALID WBC CELL KEY")
. . H 2
. . D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
. I TY(TYPE)>0 D
. . S TY(TYPE)=TY(TYPE)-1
. . I '$D(NC(TYPE)),TOTAL>0 S TOTAL=TOTAL-1
;
D HD1,HD4,HD2
I LAUPDATE D SHOWCNT
Q
;
HD1 ;
W IOEDALL
D SAY^XGF(0,0,"Patient name: "_PNM)
D SAY^XGF(0,45,"SSN: "_SSN)
Q
;
HD2 ;
D SAY^XGF("+2",0,"CELL DIFFERENTIAL ('?' = DISPLAY, '!' = COMMENTS, '-' = MINUS, <RETURN> = EXIT)")
S LRDY=$Y
F I=1:1:T1 D
. D SAY^XGF("+",0,$$LJ^XLFSTR("KEY",7)_T1(I))
. D SAY^XGF("+",0,$$LJ^XLFSTR("TEST",7)_T2(I))
. S $Y=$Y+2
;
HD3 ;
; Clear line on screen display
D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
;
D SAY^XGF(IOSL-1,18,"TOTAL: ")
D SAY^XGF(IOSL-1,$X+(3-$L(TOTAL)),TOTAL,"R1")
Q
;
HD4 ;
N C,I,LADY,LAPN,LAQUIT,LAROW,LAYOFF,X,Y,V
;
K ^TMP("LADATA",$J)
;
D SAY^XGF($Y+1,0,$$CJ^XLFSTR("> CBC PROFILE *=unverified <",IOM))
S LADY=$Y+1
;
; Find unverified results in LAH
S C=1
F S C=$O(^LAH(LWL,1,ISQN,C)) Q:C<1 D
. S V=^LAH(LWL,1,ISQN,C)
. S LAPN=$$PN(C)
. S ^TMP("LADATA",$J,C)="*"_$$LJ^XLFSTR(LAPN,8,".")_" "_$P(V,U,1)_" "_$P(V,U,2)
;
; Find verified results in LR, overwrite any LAH unverified results.
S C=1
F S C=$O(^LR(LRDFN,"CH",LRIDT,C)) Q:C<1 D
. S V=^LR(LRDFN,"CH",LRIDT,C)
. S LAPN=$$PN(C)
. S ^TMP("LADATA",$J,C)=" "_$$LJ^XLFSTR(LAPN,8,".")_" "_$P(V,U,1)_" "_$P(V,U,2)
;
; Determine number of key rows and screen cutoff
S LAROW=$O(T1(""),-1)
S LAYOFF=$P("8^13^17","^",LAROW)
;
S C=1,(I,LAQUIT)=0
F S C=$O(^TMP("LADATA",$J,C)) Q:'C D Q:LAQUIT
. S V=^TMP("LADATA",$J,C)
. D SAY^XGF(LADY,I*25,V)
. S I=I+1
. I I>2 D
. . S I=0,LADY=LADY+1
. . I (IOSL-LAYOFF)<LADY,$O(^TMP("LADATA",$J,C)) D
. . . D SAY^XGF(LADY,0,$$CJ^XLFSTR("*** RESULTS TRUNCATED - INSUFFICIENT DISPLAY SPACE ***",IOM))
. . . S LAQUIT=1
;
K ^TMP("LADATA",$J)
Q
;
PN(LA60) ; get print name for result
; Call with LA60 = ien of file #63 dataname
; Returns print name
;
N LAPN,X
;
S LAPN=""
;
S X=$O(^LAB(60,"C","CH;"_LA60_";1",0))
I X>0 D
. S LAPN=$P($G(^LAB(60,X,.1)),"^")
. ; If no print name use full name
. I LAPN="" S LAPN=$P($G(^LAB(60,X,0)),"^")
;
Q LAPN
;
COM ;
D COM1
D HD1,HD4,HD2
I LAUPDATE D SHOWCNT
Q
;
COM1 ;
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
S DIR(0)="FO^1:68",DIR("A")="Comment"
I $L($G(RMK)) S DIR("B")=RMK
D ^DIR
I $D(DIRUT) D Q
. I X="@" S RMK=""
S RMK=Y
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAKDIFF1 5917 printed Dec 13, 2024@01:42:50 Page 2
LAKDIFF1 ;DALOI/RWF/LL/RES - KEYBOARD DIFF PART 2 ; 7/14/87 08:02
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**52**;Sep 27, 1994
+2 ; WBC DIFF CELL COUNTER
+3 ;
A ;
+1 NEW LAI
+2 ;
+3 KILL KEY,NC,TY,T1,T2
+4 ;
+5 SET KEY=""
SET LAI=0
+6 FOR
SET LAI=$ORDER(^TMP($JOB,"W",LAI))
if LAI=""
QUIT
Begin DoDot:1
+7 SET K=^TMP($JOB,"W",LAI)
SET KEY(K)=LAI
SET KEY=KEY_K
SET TY(K)=""
+8 IF $DATA(^TMP($JOB,"NC",LAI))
SET NC(K)=""
End DoDot:1
+9 ;
+10 FOR LAI=1:1:27
Begin DoDot:1
+11 SET X=$GET(^TMP("LA",$JOB,LAI,4))
+12 SET Y=$GET(^TMP("LA",$JOB,LAI,.1))
+13 SET ^TMP($JOB,"A",LAI\9+1,LAI#9)=X_"^"_Y
SET T2=LAI
End DoDot:1
if $ORDER(^TMP($JOB,"W",LAI))=""
QUIT
+14 ;
+15 SET T1=1
SET (T1(1),T2(1))=""
+16 ;
+17 FOR LAI=1:1:T2
Begin DoDot:1
+18 SET X=^TMP($JOB,"A",LAI\9+1,LAI#9)
+19 SET T1(T1)=T1(T1)_$JUSTIFY($PIECE(X,U,1),8)
+20 SET T2(T1)=T2(T1)_$JUSTIFY($PIECE(X,U,2),8)
+21 IF '(LAI#9)
SET T1=T1+1
SET (T1(T1),T2(T1))=""
End DoDot:1
+22 ;
+23 SET (TOTAL,FLAG,STORE)=0
+24 DO HD1
DO HD4
DO HD2
+25 ;
+26 FOR
if TOTAL=200!FLAG!STORE
QUIT
Begin DoDot:1
+27 NEW DTOUT
+28 DO SAY^XGF(IOSL-1,0,"WBC: ")
+29 SET TYPE=$$READ^XGF(1,DTIME)
+30 IF TYPE="^"!($DATA(DTOUT))
SET FLAG=1
QUIT
+31 SET LINE=$SELECT(TYPE="":"STOP",TYPE="-":"MINUS",TYPE="!":"COM",KEY'[TYPE:"HELP",1:"COUNT")
+32 DO @LINE
End DoDot:1
+33 ;
+34 if (TOTAL=200)!(STORE)
DO STORE
+35 ;
+36 KILL TEMP,T1,T2,KEY,NC,CONT,J,L,TOTAL,CHK,STORE
+37 QUIT
+38 ;
COUNT ; Add key to cell count
+1 ;
+2 ; Count key
+3 IF '$DATA(NC(TYPE))
SET TOTAL=TOTAL+1
+4 ;
+5 SET TY(TYPE)=TY(TYPE)+1
+6 IF LAUPDATE
DO SHOWCNT
+7 DO HD3
+8 IF '$DATA(NC(TYPE))
IF (TOTAL=100!(TOTAL=200))
DO EVAL
+9 QUIT
+10 ;
HELP ;
+1 ;
+2 IF TYPE'="?"
Begin DoDot:1
+3 DO CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
+4 DO SAY^XGF(IOSL-1,0,$CHAR(7)_"INVALID WBC CELL KEY")
+5 HANG 2
+6 DO CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
+7 DO HD3
End DoDot:1
QUIT
+8 ;
+9 DO SHOWCNT
DO HD3
+10 QUIT
+11 ;
SHOWCNT ; Display current cell count
+1 ;
+2 NEW I,I1,X,K
+3 ;
+4 SET $Y=LRDY
+5 FOR I1=1:9:T2
Begin DoDot:1
+6 SET $Y=$Y+3
SET $X=6
+7 FOR I=I1:1:I1+8
if I>T2
QUIT
Begin DoDot:2
+8 SET X=$GET(^TMP($JOB,"W",I),"^")
SET K=$GET(TY(X))
+9 IF '$LENGTH(K)
SET $X=$X+8
+10 IF '$TEST
DO SAY^XGF($Y,$X+(9-$LENGTH(K)),K,"R1")
End DoDot:2
+11 SET $Y=$Y+1
End DoDot:1
+12 QUIT
+13 ;
STOP ;
+1 DO EVAL
+2 ;
+3 NEW DIR,DIROUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET DIR(0)="YO"
SET DIR("B")="Y"
+6 IF TOTAL<100
SET DIR("A",1)=$CHAR(7)_"* You have counted "_TOTAL_" CELLS *"
+7 SET DIR("A")="Are you finished with the WBC cell count"
+8 DO ^DIR
+9 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+10 IF Y=1
SET STORE=1
+11 IF FLAG=STORE
DO HD1
DO HD4
DO HD2
DO SHOWCNT
+12 QUIT
+13 ;
EVAL ;
+1 NEW LAI
+2 ;
+3 WRITE $CHAR(7)
DO HD1
+4 IF TOTAL<100
WRITE $CHAR(7),!,"NOTE: ONLY ",TOTAL," CELLS COUNTED",!!
if TOTAL=0
QUIT
+5 WRITE !,"Test",?11,"Count Value"
+6 SET LAI=0
+7 FOR
SET LAI=$ORDER(^TMP($JOB,"W",LAI))
if LAI=""
QUIT
Begin DoDot:1
+8 SET K=^TMP($JOB,"W",LAI)
+9 WRITE !,$$LJ^XLFSTR(^TMP("LA",$JOB,LAI,.1),11,".")
+10 SET V=TY(K)
+11 WRITE $JUSTIFY(V,5)," "
+12 XECUTE ^TMP("LA",$JOB,LAI,2)
+13 WRITE $JUSTIFY(V,5)
End DoDot:1
+14 ;
+15 WRITE !,$$LJ^XLFSTR("Total",11,".")," ",$JUSTIFY(TOTAL,5),!
+16 IF '(TOTAL=100!(TOTAL=200))
QUIT
+17 IF TOTAL=100
DO TWO
+18 QUIT
+19 ;
TWO ;
+1 NEW DIR,DIROUT,DTOUT,DUOUT,X,Y
+2 ;
+3 ; Flush buffer
+4 FOR
SET X=$$READ^XGF(1,1)
if $DATA(DTOUT)
QUIT
+5 ;
+6 SET DIR(0)="SBO^C:CONTINUE;S:STOP"
+7 SET DIR("A",1)="100 Cells counted"
+8 SET DIR("A")="CONTINUE counting to 200 or STOP"
+9 SET DIR("B")="STOP"
+10 DO ^DIR
+11 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+12 IF Y="S"
SET STORE=1
+13 IF Y="C"
Begin DoDot:1
+14 NEW TYPE
+15 DO HD1
DO HD4
DO HD2
+16 IF LAUPDATE
SET TYPE="?"
DO HELP
End DoDot:1
+17 ;
+18 QUIT
+19 ;
STORE ;
+1 NEW LAI
+2 ;
+3 SET LAI=0
+4 FOR
SET LAI=$ORDER(^TMP($JOB,"W",LAI))
if LAI=""
QUIT
Begin DoDot:1
+5 SET K=^(LAI)
SET V=TY(K)
+6 XECUTE ^TMP("LA",$JOB,LAI,2)
+7 SET @^TMP("LA",$JOB,LAI,1)=V
End DoDot:1
+8 QUIT
+9 ;
MINUS ;
+1 ; Clear line on screen display
+2 DO CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
+3 ;
+4 DO SAY^XGF(IOSL-1,0,"SUBTRACT WHICH CELL TYPE: ")
+5 ;
+6 SET TYPE=$$READ^XGF(1,DTIME)
+7 ;
+8 ; Clear line on screen display
+9 DO CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
+10 ;
+11 IF $DATA(DTOUT)
SET FLAG=1
QUIT
+12 IF $LENGTH(TYPE)
Begin DoDot:1
+13 IF KEY'[TYPE
Begin DoDot:2
+14 DO CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
+15 DO SAY^XGF(IOSL-1,0,"INVALID WBC CELL KEY")
+16 HANG 2
+17 DO CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
End DoDot:2
QUIT
+18 IF TY(TYPE)>0
Begin DoDot:2
+19 SET TY(TYPE)=TY(TYPE)-1
+20 IF '$DATA(NC(TYPE))
IF TOTAL>0
SET TOTAL=TOTAL-1
End DoDot:2
End DoDot:1
+21 ;
+22 DO HD1
DO HD4
DO HD2
+23 IF LAUPDATE
DO SHOWCNT
+24 QUIT
+25 ;
HD1 ;
+1 WRITE IOEDALL
+2 DO SAY^XGF(0,0,"Patient name: "_PNM)
+3 DO SAY^XGF(0,45,"SSN: "_SSN)
+4 QUIT
+5 ;
HD2 ;
+1 DO SAY^XGF("+2",0,"CELL DIFFERENTIAL ('?' = DISPLAY, '!' = COMMENTS, '-' = MINUS, <RETURN> = EXIT)")
+2 SET LRDY=$Y
+3 FOR I=1:1:T1
Begin DoDot:1
+4 DO SAY^XGF("+",0,$$LJ^XLFSTR("KEY",7)_T1(I))
+5 DO SAY^XGF("+",0,$$LJ^XLFSTR("TEST",7)_T2(I))
+6 SET $Y=$Y+2
End DoDot:1
+7 ;
HD3 ;
+1 ; Clear line on screen display
+2 DO CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
+3 ;
+4 DO SAY^XGF(IOSL-1,18,"TOTAL: ")
+5 DO SAY^XGF(IOSL-1,$X+(3-$LENGTH(TOTAL)),TOTAL,"R1")
+6 QUIT
+7 ;
HD4 ;
+1 NEW C,I,LADY,LAPN,LAQUIT,LAROW,LAYOFF,X,Y,V
+2 ;
+3 KILL ^TMP("LADATA",$JOB)
+4 ;
+5 DO SAY^XGF($Y+1,0,$$CJ^XLFSTR("> CBC PROFILE *=unverified <",IOM))
+6 SET LADY=$Y+1
+7 ;
+8 ; Find unverified results in LAH
+9 SET C=1
+10 FOR
SET C=$ORDER(^LAH(LWL,1,ISQN,C))
if C<1
QUIT
Begin DoDot:1
+11 SET V=^LAH(LWL,1,ISQN,C)
+12 SET LAPN=$$PN(C)
+13 SET ^TMP("LADATA",$JOB,C)="*"_$$LJ^XLFSTR(LAPN,8,".")_" "_$PIECE(V,U,1)_" "_$PIECE(V,U,2)
End DoDot:1
+14 ;
+15 ; Find verified results in LR, overwrite any LAH unverified results.
+16 SET C=1
+17 FOR
SET C=$ORDER(^LR(LRDFN,"CH",LRIDT,C))
if C<1
QUIT
Begin DoDot:1
+18 SET V=^LR(LRDFN,"CH",LRIDT,C)
+19 SET LAPN=$$PN(C)
+20 SET ^TMP("LADATA",$JOB,C)=" "_$$LJ^XLFSTR(LAPN,8,".")_" "_$PIECE(V,U,1)_" "_$PIECE(V,U,2)
End DoDot:1
+21 ;
+22 ; Determine number of key rows and screen cutoff
+23 SET LAROW=$ORDER(T1(""),-1)
+24 SET LAYOFF=$PIECE("8^13^17","^",LAROW)
+25 ;
+26 SET C=1
SET (I,LAQUIT)=0
+27 FOR
SET C=$ORDER(^TMP("LADATA",$JOB,C))
if 'C
QUIT
Begin DoDot:1
+28 SET V=^TMP("LADATA",$JOB,C)
+29 DO SAY^XGF(LADY,I*25,V)
+30 SET I=I+1
+31 IF I>2
Begin DoDot:2
+32 SET I=0
SET LADY=LADY+1
+33 IF (IOSL-LAYOFF)<LADY
IF $ORDER(^TMP("LADATA",$JOB,C))
Begin DoDot:3
+34 DO SAY^XGF(LADY,0,$$CJ^XLFSTR("*** RESULTS TRUNCATED - INSUFFICIENT DISPLAY SPACE ***",IOM))
+35 SET LAQUIT=1
End DoDot:3
End DoDot:2
End DoDot:1
if LAQUIT
QUIT
+36 ;
+37 KILL ^TMP("LADATA",$JOB)
+38 QUIT
+39 ;
PN(LA60) ; get print name for result
+1 ; Call with LA60 = ien of file #63 dataname
+2 ; Returns print name
+3 ;
+4 NEW LAPN,X
+5 ;
+6 SET LAPN=""
+7 ;
+8 SET X=$ORDER(^LAB(60,"C","CH;"_LA60_";1",0))
+9 IF X>0
Begin DoDot:1
+10 SET LAPN=$PIECE($GET(^LAB(60,X,.1)),"^")
+11 ; If no print name use full name
+12 IF LAPN=""
SET LAPN=$PIECE($GET(^LAB(60,X,0)),"^")
End DoDot:1
+13 ;
+14 QUIT LAPN
+15 ;
COM ;
+1 DO COM1
+2 DO HD1
DO HD4
DO HD2
+3 IF LAUPDATE
DO SHOWCNT
+4 QUIT
+5 ;
COM1 ;
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 ;
+4 SET DIR(0)="FO^1:68"
SET DIR("A")="Comment"
+5 IF $LENGTH($GET(RMK))
SET DIR("B")=RMK
+6 DO ^DIR
+7 IF $DATA(DIRUT)
Begin DoDot:1
+8 IF X="@"
SET RMK=""
End DoDot:1
QUIT
+9 SET RMK=Y
+10 ;
+11 QUIT
