RAUTL11 ;HISC/CAH,FPT,GJC,SS-Utility File Maintenance ;4/21/97 11:59
;;5.0;Radiology/Nuclear Medicine;**18,35,34**;Mar 16, 1998
;
;Last modification : by SS, SEP 30,2000 for P18
HEAD ; Header
I $E(IOST,1,2)="C-"!(RAPG>0) W:$Y>0 @IOF
S RAPG=RAPG+1
W !?62,"Page: ",RAPG,!?62,"Date: ",RADATE
W !!?(IOM-$L(RAHDR)\2),RAHDR,!,RALINE,!
Q
ORDELSH ;Called by the 'List Exams with Inactive/Invalid Statuses' option.
;Exams with statuses whose 'Order' field is blank are printed
N RADATE,RAHDR,RALINE,RAOUT,RAPG,Y
S RAHDR="Exams with Inactive/Invalid Statuses"
S (RAPG,RAOUT)=0,$P(RALINE,"=",(IOM+1))="",Y=DT
X ^DD("DD") S RADATE=Y
K %ZIS S %ZIS="MQ" W ! D ^%ZIS I POP D Q2 Q
I $D(IO("Q")) D W ! Q
. S ZTDESC="Rad/Nuc Med List Exams with Inactive/Invalid Statuses",ZTSAVE("RA*")=""
. S ZTRTN="2^RAUTL11" D ^%ZTLOAD
. W !?5,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
. Q
D 2
Q
2 ;
N A,B,C,D,E,F,FT,G,H,HD,I,J,K,L,LN,RACASE,RAEXDT,RAPAT,RAPROC,RARPT
N RASSN,X,Y,Y1,Y2 D HEAD
S (A,F)=0,FT="No evidence of inactive/invalid exams was detected."
S HD(1)="Exam Status: ",HD(2)="Imaging Type: "
S $P(LN(1),"*",($L(HD(1))-1))="",$P(LN(2),"*",($L(HD(2))-1))=""
F S A=$O(^RA(72,A)) Q:A'>0 D Q:RAOUT
. S B=$G(^RA(72,A,0)) Q:B']""
. S C=$P(B,U),D=$P(B,U,3),E=$P($G(^RA(79.2,+$P(B,U,7),0)),U)
. I D']"",($D(^RADPT("AS",A))) D
.. I $Y'<(IOSL-4) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD
.. W !,HD(1),C
.. W ?45,HD(2),$E($S(E]"":E,1:"Unknown"),1,20),!,LN(1),?45,LN(2),!
.. S F=1,G=0
.. F S G=$O(^RADPT("AS",A,G)) Q:G'>0 S H=0 D Q:RAOUT
... S J=$G(^RADPT(G,0))
... F S H=$O(^RADPT("AS",A,G,H)) Q:H'>0 S I=0 D Q:RAOUT
.... S K=$G(^RADPT(G,"DT",H,0))
.... F S I=$O(^RADPT("AS",A,G,H,I)) Q:I'>0 D Q:RAOUT
..... S L=$G(^RADPT(G,"DT",H,"P",I,0))
..... S RAPAT=$P($G(^DPT(+$P(J,U),0)),U)
..... S RASSN=$P($G(^DPT(+$P(J,U),0)),U,9),RARPT=+$P(L,U,17)
..... I RARPT D
...... S Y1=$P($G(^RARPT(RARPT,0)),U,5)
...... S Y2=$P($G(^DD(74,5,0)),U,2)
...... S RARPT("STAT")=$$XTERNAL^RAUTL5(Y1,Y2)
...... Q
..... S Y=$P(K,U) X ^DD("DD") S RAEXDT=Y
..... S RACASE=$P(L,U),RAPROC=$P($G(^RAMIS(71,+$P(L,U,2),0)),U)
..... I $Y'<(IOSL-4) D Q:RAOUT
...... S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD
...... W !,HD(1),C,?45,HD(2),$E($S(E]"":E,1:"Unknown"),1,20)
...... W !,LN(1),?45,LN(2),!
...... Q
..... W !,"Patient: ",$S(RAPAT]"":RAPAT,1:"Unknown")
..... W ?45,"SSN: ",$E(RASSN,1,3)_"-"_$E(RASSN,4,5)_"-"_$E(RASSN,6,9)
..... W !,"Exam Date: ",$S(RAEXDT]"":RAEXDT,1:"Unknown")
..... W ?45,"Case #: ",$S(RACASE]"":RACASE,1:" --- ")
..... I RARPT D
...... W !,"Reported: Yes",?45,"Report Status: "
...... W $S(RARPT("STAT")]"":$E(RARPT("STAT"),1,19),1:"Unknown")
...... Q
..... W !,"Procedure: ",$S(RAPROC]"":RAPROC,1:"Unknown"),!
..... Q
.... Q
... Q
.. Q
. Q
I 'F W !?(IOM-$L(FT)\2),FT
S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
Q2 K DUOUT,I,POP
Q
;
;called from RAO7PC1,saves TECH COMMENT in ^TMP($J,"RAE2",
SVTCOM(RA11DFN,RA11DTI,RA11CNI) ;P18 used for API call
N RA11
S RA11(0)=$G(^RADPT(RA11DFN,"DT",RA11DTI,"P",RA11CNI,0))
Q:RA11(0)']""
S RA11(1)=$G(^RAMIS(71,+$P(RA11(0),"^",2),0))
S RA11(2)=$S($P(RA11(1),"^")]"":$P(RA11(1),"^"),1:"Unknown")
S RA11(3)=$$GETTCOM(RA11DFN,RA11DTI,RA11CNI)
S:RA11(3)'="" ^TMP($J,"RAE2",RA11DFN,RA11CNI,RA11(2),"TCOM",1)=RA11(3)
Q
;
GETTCOM(RA11DFN,RA11DTI,RA11CNI) ;P18 returns most recent tech comment
N RA11X,RA11XI
S RA11X="",RA11XI=99999
F S RA11XI=$O(^RADPT(RA11DFN,"DT",RA11DTI,"P",RA11CNI,"L",RA11XI),-1) Q:+RA11XI=0 I RA11XI>0 S RA11X=$G(^RADPT(RA11DFN,"DT",RA11DTI,"P",RA11CNI,"L",RA11XI,"TCOM"),"") Q:RA11X'=""
Q RA11X
;
;Outputs most recent tech comments.Arguments:
;RADFN,RADTI,RACNI,header(can be ""),left margin,right margin,
;number of lines in the bottom before checking bottom of screen,
;is NL before and after header,number of lines to output,
;put header even if no text
PUTTCOM(RA18DFN,RA18DTI,RA18CNI,RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,RANLHD,RAHDNL,RALINES,RAWRHDR) ;P18 outputs techcomm
N RA18X,RA18XI
S RA18X="",RA18X=$$GETTCOM(RA18DFN,RA18DTI,RA18CNI) I RA18X="" D Q 0
. I RAWRHDR=1 W:RANLHD ! W RA18HDR W:RAHDNL !
. Q
W:RANLHD ! W RA18HDR W:RAHDNL !
Q:$$TXTOUT(RA18X,RA18LFTM,RA18RGHM,RA18BOT,RA18HDR,RALINES,RANLHD,RAHDNL,0)=-1 -1
Q 1
;
CONTIN(RABTM) ;P18 screen check
Q:$D(RARTVERF) 0 ;on-line verify or resident preverify--ENTIRE report
I ($Y+RABTM)'>IOSL Q 0
Q:$$EOS^RAUTL5()>0 -1
W:$E(IOST,1,2)="C-" @IOF
Q 1
;
;Prints text.Arguments:
;Text,Left margin,Right margin
;Number of lines in the bottom before screen check.if <0 don't check
;Header text displayed ONLY for next page;Max lines to output, Should place NL before header,
;Should place NL after header
;Should place header for continuation after screen check
TXTOUT(RA11TXT,RA11LM,RA11RM,RABT,RAHD,RALIN,RANLHD,RAHDNL,RA18ISHD) ;P18 outputs text
Q:(RA11LM'<RA11RM) 0
N DIWF,DIWL,DIWR,RAX,X,RALN,RA18EX,RA18A,RA18B,RA18C,RACHKBOT S (RA18EX,RAX)=0,RA18A="",RA18C=0
S RACHKBOT=$S(RABT<0:0,1:1)
S DIWF="|",DIWL=RA11LM,DIWR=RA11RM K ^UTILITY($J,"W")
S X=RA11TXT
D ^DIWP
S RAX=0 F RALN=1:1 S RAX=$O(^UTILITY($J,"W",DIWL,RAX)) Q:RAX'>0!(RA18EX'=0)!(RA18C=-1) D
. S RA18B=+$O(^UTILITY($J,"W",DIWL,RAX)) ;is it last?
. S X=$G(^UTILITY($J,"W",DIWL,RAX,0))
. I RALN'<RALIN S RA18EX=1 D Q
.. S $P(RA18A," ",RA11RM-RA11LM-$L(X))="",X=X_RA18A
.. S:+RA18B'=0 X=$E(X,1,RA11RM-RA11LM)_"(more...)" W ?DIWL,X
.. Q
. W ?DIWL,X
. W:+RA18B>0 !
. I RACHKBOT=1 S RA18C=$$CONTIN(RABT) Q:RA18C=-1
. I RA18ISHD I RA18C=1 I RA18B W:RANLHD ! W RAHD W:RAHDNL !
. Q
Q $S(RA18C=-1:-1,1:0)
;
PUTTCOM2(RA18DFN,RA18DTI,RA18CN,RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,RA18HDNL) ;P18 outputs techcomm using caseNo see PUTTCOM
N RA18A S RA18A=$$FNDIN70M^RAO7XX(RA18DFN,RA18DTI,RA18CN,"T")
Q:RA18A=0 0
Q:$$PUTTCOM(RA18DFN,RA18DTI,$P(RA18A,"^",2),RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,1,RA18HDNL,2,0)=-1 -1
Q 0
;
VERONLY() ;outputs header with case info for Verify only menu option
N RA18EX,RA18I S RA18EX=0 ;P18 for quit if uparrow inside PUTTCOM
I '($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2) D Q
. W !!?2,"Case #: ",RACN," for ",RANME S RAXIT=1
. W !?2,"Procedure: '",$E(RAPRC,1,45),"' has been deleted"
. W !?2,"by another user!",$C(7)
. Q
W !
S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,RACN,"Tech. Comment for case No. "_RACN_":",1,70,-1,1)
Q:RA18EX=-1
N RAPRTSET,RAMEMARR,RA1P18
D EN2^RAUTL20(.RAMEMARR)
I RAPRTSET D
. S RA1P18=""
. F S RA1P18=$O(RAMEMARR(RA1P18)) Q:RA1P18=""!(RA18EX=-1) I RA1P18'=RACNI D
.. S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,+RAMEMARR(RA1P18),"Tech. Comment for case No. "_+RAMEMARR(RA1P18)_":",1,70,-1,1) Q:RA18EX=-1 ;
.. Q
. Q
Q RA18EX
;------------
;Outputs tech comment using
;RADFN,RADTI,RACNI,activity log ien,header(can be ""),left margin,
;right margin,number of lines in the bottom
;before checking bottom of screen,is NL after header,
;number of lines to output,header even if no comments
PUTTCOM3(RA18DFN,RA18DTI,RA18CNI,RA18LOG,RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,RANLHD,RAHDNL,RALINES,RAWRHDR) ;P18 outputs techcomm
N RA18X,RA18XI,I
S RA18X="",RA18X=$G(^RADPT(RA18DFN,"DT",RA18DTI,"P",RA18CNI,"L",RA18LOG,"TCOM"),"") I RA18X="" D Q 0
. I RAWRHDR=1 W:RANLHD ! W RA18HDR W:RAHDNL !
. Q
W:RANLHD ! W RA18HDR W:RAHDNL !
Q:$$TXTOUT(RA18X,RA18LFTM,RA18RGHM,RA18BOT,RA18HDR,RALINES,RANLHD,RAHDNL,0)=-1 -1
Q 1
RAUTL11 ;HISC/CAH,FPT,GJC,SS-Utility File Maintenance ;4/21/97 11:59
+1 ;;5.0;Radiology/Nuclear Medicine;**18,35,34**;Mar 16, 1998
+2 ;
+3 ;Last modification : by SS, SEP 30,2000 for P18
HEAD ; Header
+1 IF $EXTRACT(IOST,1,2)="C-"!(RAPG>0)
IF $Y>0
WRITE @IOF
+2 SET RAPG=RAPG+1
+3 WRITE !?62,"Page: ",RAPG,!?62,"Date: ",RADATE
+4 WRITE !!?(IOM-$LENGTH(RAHDR)\2),RAHDR,!,RALINE,!
+5 QUIT
ORDELSH ;Called by the 'List Exams with Inactive/Invalid Statuses' option.
+1 ;Exams with statuses whose 'Order' field is blank are printed
+2 NEW RADATE,RAHDR,RALINE,RAOUT,RAPG,Y
+3 SET RAHDR="Exams with Inactive/Invalid Statuses"
+4 SET (RAPG,RAOUT)=0
SET $PIECE(RALINE,"=",(IOM+1))=""
SET Y=DT
+5 XECUTE ^DD("DD")
SET RADATE=Y
+6 KILL %ZIS
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
IF POP
DO Q2
QUIT
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTDESC="Rad/Nuc Med List Exams with Inactive/Invalid Statuses"
SET ZTSAVE("RA*")=""
+9 SET ZTRTN="2^RAUTL11"
DO ^%ZTLOAD
+10 WRITE !?5,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+11 QUIT
End DoDot:1
WRITE !
QUIT
+12 DO 2
+13 QUIT
2 ;
+1 NEW A,B,C,D,E,F,FT,G,H,HD,I,J,K,L,LN,RACASE,RAEXDT,RAPAT,RAPROC,RARPT
+2 NEW RASSN,X,Y,Y1,Y2
DO HEAD
+3 SET (A,F)=0
SET FT="No evidence of inactive/invalid exams was detected."
+4 SET HD(1)="Exam Status: "
SET HD(2)="Imaging Type: "
+5 SET $PIECE(LN(1),"*",($LENGTH(HD(1))-1))=""
SET $PIECE(LN(2),"*",($LENGTH(HD(2))-1))=""
+6 FOR
SET A=$ORDER(^RA(72,A))
IF A'>0
QUIT
Begin DoDot:1
+7 SET B=$GET(^RA(72,A,0))
IF B']""
QUIT
+8 SET C=$PIECE(B,U)
SET D=$PIECE(B,U,3)
SET E=$PIECE($GET(^RA(79.2,+$PIECE(B,U,7),0)),U)
+9 IF D']""
IF ($DATA(^RADPT("AS",A)))
Begin DoDot:2
+10 IF $Y'<(IOSL-4)
SET RAOUT=$$EOS^RAUTL5()
IF RAOUT
QUIT
DO HEAD
+11 WRITE !,HD(1),C
+12 WRITE ?45,HD(2),$EXTRACT($SELECT(E]"":E,1:"Unknown"),1,20),!,LN(1),?45,LN(2),!
+13 SET F=1
SET G=0
+14 FOR
SET G=$ORDER(^RADPT("AS",A,G))
IF G'>0
QUIT
SET H=0
Begin DoDot:3
+15 SET J=$GET(^RADPT(G,0))
+16 FOR
SET H=$ORDER(^RADPT("AS",A,G,H))
IF H'>0
QUIT
SET I=0
Begin DoDot:4
+17 SET K=$GET(^RADPT(G,"DT",H,0))
+18 FOR
SET I=$ORDER(^RADPT("AS",A,G,H,I))
IF I'>0
QUIT
Begin DoDot:5
+19 SET L=$GET(^RADPT(G,"DT",H,"P",I,0))
+20 SET RAPAT=$PIECE($GET(^DPT(+$PIECE(J,U),0)),U)
+21 SET RASSN=$PIECE($GET(^DPT(+$PIECE(J,U),0)),U,9)
SET RARPT=+$PIECE(L,U,17)
+22 IF RARPT
Begin DoDot:6
+23 SET Y1=$PIECE($GET(^RARPT(RARPT,0)),U,5)
+24 SET Y2=$PIECE($GET(^DD(74,5,0)),U,2)
+25 SET RARPT("STAT")=$$XTERNAL^RAUTL5(Y1,Y2)
+26 QUIT
End DoDot:6
+27 SET Y=$PIECE(K,U)
XECUTE ^DD("DD")
SET RAEXDT=Y
+28 SET RACASE=$PIECE(L,U)
SET RAPROC=$PIECE($GET(^RAMIS(71,+$PIECE(L,U,2),0)),U)
+29 IF $Y'<(IOSL-4)
Begin DoDot:6
+30 SET RAOUT=$$EOS^RAUTL5()
IF RAOUT
QUIT
DO HEAD
+31 WRITE !,HD(1),C,?45,HD(2),$EXTRACT($SELECT(E]"":E,1:"Unknown"),1,20)
+32 WRITE !,LN(1),?45,LN(2),!
+33 QUIT
End DoDot:6
IF RAOUT
QUIT
+34 WRITE !,"Patient: ",$SELECT(RAPAT]"":RAPAT,1:"Unknown")
+35 WRITE ?45,"SSN: ",$EXTRACT(RASSN,1,3)_"-"_$EXTRACT(RASSN,4,5)_"-"_$EXTRACT(RASSN,6,9)
+36 WRITE !,"Exam Date: ",$SELECT(RAEXDT]"":RAEXDT,1:"Unknown")
+37 WRITE ?45,"Case #: ",$SELECT(RACASE]"":RACASE,1:" --- ")
+38 IF RARPT
Begin DoDot:6
+39 WRITE !,"Reported: Yes",?45,"Report Status: "
+40 WRITE $SELECT(RARPT("STAT")]"":$EXTRACT(RARPT("STAT"),1,19),1:"Unknown")
+41 QUIT
End DoDot:6
+42 WRITE !,"Procedure: ",$SELECT(RAPROC]"":RAPROC,1:"Unknown"),!
+43 QUIT
End DoDot:5
IF RAOUT
QUIT
+44 QUIT
End DoDot:4
IF RAOUT
QUIT
+45 QUIT
End DoDot:3
IF RAOUT
QUIT
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
IF RAOUT
QUIT
+48 IF 'F
WRITE !?(IOM-$LENGTH(FT)\2),FT
+49 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
Q2 KILL DUOUT,I,POP
+1 QUIT
+2 ;
+3 ;called from RAO7PC1,saves TECH COMMENT in ^TMP($J,"RAE2",
SVTCOM(RA11DFN,RA11DTI,RA11CNI) ;P18 used for API call
+1 NEW RA11
+2 SET RA11(0)=$GET(^RADPT(RA11DFN,"DT",RA11DTI,"P",RA11CNI,0))
+3 IF RA11(0)']""
QUIT
+4 SET RA11(1)=$GET(^RAMIS(71,+$PIECE(RA11(0),"^",2),0))
+5 SET RA11(2)=$SELECT($PIECE(RA11(1),"^")]"":$PIECE(RA11(1),"^"),1:"Unknown")
+6 SET RA11(3)=$$GETTCOM(RA11DFN,RA11DTI,RA11CNI)
+7 IF RA11(3)'=""
SET ^TMP($JOB,"RAE2",RA11DFN,RA11CNI,RA11(2),"TCOM",1)=RA11(3)
+8 QUIT
+9 ;
GETTCOM(RA11DFN,RA11DTI,RA11CNI) ;P18 returns most recent tech comment
+1 NEW RA11X,RA11XI
+2 SET RA11X=""
SET RA11XI=99999
+3 FOR
SET RA11XI=$ORDER(^RADPT(RA11DFN,"DT",RA11DTI,"P",RA11CNI,"L",RA11XI),-1)
IF +RA11XI=0
QUIT
IF RA11XI>0
SET RA11X=$GET(^RADPT(RA11DFN,"DT",RA11DTI,"P",RA11CNI,"L",RA11XI,"TCOM"),"")
IF RA11X'=""
QUIT
+4 QUIT RA11X
+5 ;
+6 ;Outputs most recent tech comments.Arguments:
+7 ;RADFN,RADTI,RACNI,header(can be ""),left margin,right margin,
+8 ;number of lines in the bottom before checking bottom of screen,
+9 ;is NL before and after header,number of lines to output,
+10 ;put header even if no text
PUTTCOM(RA18DFN,RA18DTI,RA18CNI,RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,RANLHD,RAHDNL,RALINES,RAWRHDR) ;P18 outputs techcomm
+1 NEW RA18X,RA18XI
+2 SET RA18X=""
SET RA18X=$$GETTCOM(RA18DFN,RA18DTI,RA18CNI)
IF RA18X=""
Begin DoDot:1
+3 IF RAWRHDR=1
IF RANLHD
WRITE !
WRITE RA18HDR
IF RAHDNL
WRITE !
+4 QUIT
End DoDot:1
QUIT 0
+5 IF RANLHD
WRITE !
WRITE RA18HDR
IF RAHDNL
WRITE !
+6 IF $$TXTOUT(RA18X,RA18LFTM,RA18RGHM,RA18BOT,RA18HDR,RALINES,RANLHD,RAHDNL,0)=-1
QUIT -1
+7 QUIT 1
+8 ;
CONTIN(RABTM) ;P18 screen check
+1 ;on-line verify or resident preverify--ENTIRE report
IF $DATA(RARTVERF)
QUIT 0
+2 IF ($Y+RABTM)'>IOSL
QUIT 0
+3 IF $$EOS^RAUTL5()>0
QUIT -1
+4 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+5 QUIT 1
+6 ;
+7 ;Prints text.Arguments:
+8 ;Text,Left margin,Right margin
+9 ;Number of lines in the bottom before screen check.if <0 don't check
+10 ;Header text displayed ONLY for next page;Max lines to output, Should place NL before header,
+11 ;Should place NL after header
+12 ;Should place header for continuation after screen check
TXTOUT(RA11TXT,RA11LM,RA11RM,RABT,RAHD,RALIN,RANLHD,RAHDNL,RA18ISHD) ;P18 outputs text
+1 IF (RA11LM'<RA11RM)
QUIT 0
+2 NEW DIWF,DIWL,DIWR,RAX,X,RALN,RA18EX,RA18A,RA18B,RA18C,RACHKBOT
SET (RA18EX,RAX)=0
SET RA18A=""
SET RA18C=0
+3 SET RACHKBOT=$SELECT(RABT<0:0,1:1)
+4 SET DIWF="|"
SET DIWL=RA11LM
SET DIWR=RA11RM
KILL ^UTILITY($JOB,"W")
+5 SET X=RA11TXT
+6 DO ^DIWP
+7 SET RAX=0
FOR RALN=1:1
SET RAX=$ORDER(^UTILITY($JOB,"W",DIWL,RAX))
IF RAX'>0!(RA18EX'=0)!(RA18C=-1)
QUIT
Begin DoDot:1
+8 ;is it last?
SET RA18B=+$ORDER(^UTILITY($JOB,"W",DIWL,RAX))
+9 SET X=$GET(^UTILITY($JOB,"W",DIWL,RAX,0))
+10 IF RALN'<RALIN
SET RA18EX=1
Begin DoDot:2
+11 SET $PIECE(RA18A," ",RA11RM-RA11LM-$LENGTH(X))=""
SET X=X_RA18A
+12 IF +RA18B'=0
SET X=$EXTRACT(X,1,RA11RM-RA11LM)_"(more...)"
WRITE ?DIWL,X
+13 QUIT
End DoDot:2
QUIT
+14 WRITE ?DIWL,X
+15 IF +RA18B>0
WRITE !
+16 IF RACHKBOT=1
SET RA18C=$$CONTIN(RABT)
IF RA18C=-1
QUIT
+17 IF RA18ISHD
IF RA18C=1
IF RA18B
IF RANLHD
WRITE !
WRITE RAHD
IF RAHDNL
WRITE !
+18 QUIT
End DoDot:1
+19 QUIT $SELECT(RA18C=-1:-1,1:0)
+20 ;
PUTTCOM2(RA18DFN,RA18DTI,RA18CN,RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,RA18HDNL) ;P18 outputs techcomm using caseNo see PUTTCOM
+1 NEW RA18A
SET RA18A=$$FNDIN70M^RAO7XX(RA18DFN,RA18DTI,RA18CN,"T")
+2 IF RA18A=0
QUIT 0
+3 IF $$PUTTCOM(RA18DFN,RA18DTI,$PIECE(RA18A,"^",2),RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,1,RA18HDNL,2,0)=-1
QUIT -1
+4 QUIT 0
+5 ;
VERONLY() ;outputs header with case info for Verify only menu option
+1 ;P18 for quit if uparrow inside PUTTCOM
NEW RA18EX,RA18I
SET RA18EX=0
+2 IF '($DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2)
Begin DoDot:1
+3 WRITE !!?2,"Case #: ",RACN," for ",RANME
SET RAXIT=1
+4 WRITE !?2,"Procedure: '",$EXTRACT(RAPRC,1,45),"' has been deleted"
+5 WRITE !?2,"by another user!",$CHAR(7)
+6 QUIT
End DoDot:1
QUIT
+7 WRITE !
+8 SET RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,RACN,"Tech. Comment for case No. "_RACN_":",1,70,-1,1)
+9 IF RA18EX=-1
QUIT
+10 NEW RAPRTSET,RAMEMARR,RA1P18
+11 DO EN2^RAUTL20(.RAMEMARR)
+12 IF RAPRTSET
Begin DoDot:1
+13 SET RA1P18=""
+14 FOR
SET RA1P18=$ORDER(RAMEMARR(RA1P18))
IF RA1P18=""!(RA18EX=-1)
QUIT
IF RA1P18'=RACNI
Begin DoDot:2
+15 ;
SET RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,+RAMEMARR(RA1P18),"Tech. Comment for case No. "_+RAMEMARR(RA1P18)_":",1,70,-1,1)
IF RA18EX=-1
QUIT
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT RA18EX
+19 ;------------
+20 ;Outputs tech comment using
+21 ;RADFN,RADTI,RACNI,activity log ien,header(can be ""),left margin,
+22 ;right margin,number of lines in the bottom
+23 ;before checking bottom of screen,is NL after header,
+24 ;number of lines to output,header even if no comments
PUTTCOM3(RA18DFN,RA18DTI,RA18CNI,RA18LOG,RA18HDR,RA18LFTM,RA18RGHM,RA18BOT,RANLHD,RAHDNL,RALINES,RAWRHDR) ;P18 outputs techcomm
+1 NEW RA18X,RA18XI,I
+2 SET RA18X=""
SET RA18X=$GET(^RADPT(RA18DFN,"DT",RA18DTI,"P",RA18CNI,"L",RA18LOG,"TCOM"),"")
IF RA18X=""
Begin DoDot:1
+3 IF RAWRHDR=1
IF RANLHD
WRITE !
WRITE RA18HDR
IF RAHDNL
WRITE !
+4 QUIT
End DoDot:1
QUIT 0
+5 IF RANLHD
WRITE !
WRITE RA18HDR
IF RAHDNL
WRITE !
+6 IF $$TXTOUT(RA18X,RA18LFTM,RA18RGHM,RA18BOT,RA18HDR,RALINES,RANLHD,RAHDNL,0)=-1
QUIT -1
+7 QUIT 1
