WVALERTP ;HIOFO/FT-RETURN SURGICAL PATHOLOGY REPORT IN TMP GLOBAL ;9/29/04 14:30
;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
;
; This routine uses the following IAs:
; #2771 - ^TMP("LRA",$J) references (controlled)
; #10103 - ^XLFDT calls (supported)
; #10104 - ^XLFSTR calls (supported)
;
EN ; Move data from ^TMP("LRA",$J) to ^TMP("WV RPT",$J) for display
; Called from WVLABWP and WVPROC
Q:'$D(^TMP("LRA",$J))
N WVLINE,WVNODE,WVDATE,WVRPTDT,WVSUB2,WVSUB3,WVSUB4,WVSUB5,WVTEXT,X
S (WVDATE,WVLINE)=0
F S WVDATE=$O(^TMP("LRA",$J,WVDATE)) Q:'WVDATE D
.S WVSUB2=""
.F S WVSUB2=$O(^TMP("LRA",$J,WVDATE,WVSUB2)) Q:WVSUB2=""!(WVSUB2?1A) S WVNODE=$G(^TMP("LRA",$J,WVDATE,WVSUB2)) D ACCESSN
.I $D(^TMP("LRA",$J,WVDATE,1.2)) D SUPRPT
.Q
; NOTE: Calling routine should kill ^TMP("LRA",$J)
Q
ACCESSN ; Collection date & Lab Accession#
I WVSUB2=0 D
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)=" Collected: "_$P(WVNODE,U,1)
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)="Lab Accession #: "_$P(WVNODE,U,2)
.Q
I WVSUB2=.1 D SPEC Q
I $S(WVSUB2=.2:1,WVSUB2=1:1,WVSUB2=1.1:1,WVSUB2=1.3:1,WVSUB2=1.4:1,1:0) D TEXT Q
I WVSUB2=2 D
.S WVSUB3=0
.F S WVSUB3=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3)) Q:WVSUB3'>0 D
..S X=^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3)
..D WRTTM,WRTP
..Q
.Q
Q
SPEC ; Specimen list
S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,0))
D ADD^WVLABWPC
S ^TMP("WV RPT",$J,WVLINE,0)="Specimen: "_$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,WVSUB4)) Q:'WVSUB4 D
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",10)_$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
.Q
D ADD^WVLABWPC,BLANK^WVLABWPC
Q
TEXT ; Gross Description & Microscopic Exam/Dx
D ADD^WVLABWPC
S ^TMP("WV RPT",$J,WVLINE,0)="<"_WVNODE_">"
S WVSUB4=0
F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB4)) Q:'WVSUB4 D
.S WVTEXT=^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB4)
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)=WVTEXT
.Q
Q
SUPRPT ; Supplementary Report
S WVSUB2=0
F S WVSUB2=$O(^TMP("LRA",$J,WVDATE,1.2,WVSUB2)) Q:'WVSUB2 D
.S WVRPTDT=$G(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,0))
.S WVRPTDT=$$FMTE^XLFDT(WVRPTDT,"2P")
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)="Supplementary Report: "_WVRPTDT
.S WVSUB3=0
.F S WVSUB3=$O(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,WVSUB3)) Q:'WVSUB3 D
..D ADD^WVLABWPC
..S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRA",$J,WVDATE,1.2,WVSUB2,WVSUB3))
..Q
.Q
Q
WRTTM ; Display Topography, Disease, Morphology and Etiology values
D ADD^WVLABWPC
S ^TMP("WV RPT",$J,WVLINE,0)="Topography: "_$P(X,U,1)
S WVSUB4=0
F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4)) Q:'WVSUB4 D
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)=$S(WVSUB4=1:"Disease: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
.Q
D ADD^WVLABWPC
S WVSUB4=0
F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4)) Q:'WVSUB4 D
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)="Morphology: "_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
.S WVSUB5=0
.F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,2,WVSUB5)) Q:'WVSUB5 D
..D ADD^WVLABWPC
..S ^TMP("WV RPT",$J,WVLINE,0)=$S(WVSUB5=1:"Etiology: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,1,WVSUB5))
..Q
.Q
Q
WRTP ; Display Procedure values
Q:'$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,0))
D ADD^WVLABWPC
S ^TMP("WV RPT",$J,WVLINE,0)="<Procedures>"
S WVSUB4=0
F S WVSUB4=$O(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,WVSUB4)) Q:WVSUB4 D
.D ADD^WVLABWPC
.S ^TMP("WV RPT",$J,WVLINE,0)=$P($G(^TMP("LRA",$J,WVDATE,WVSUB2,WVSUB3,4,WVSUB4)),U,1)
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVALERTP 3761 printed Nov 22, 2024@17:56:29 Page 2
WVALERTP ;HIOFO/FT-RETURN SURGICAL PATHOLOGY REPORT IN TMP GLOBAL ;9/29/04 14:30
+1 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2771 - ^TMP("LRA",$J) references (controlled)
+5 ; #10103 - ^XLFDT calls (supported)
+6 ; #10104 - ^XLFSTR calls (supported)
+7 ;
EN ; Move data from ^TMP("LRA",$J) to ^TMP("WV RPT",$J) for display
+1 ; Called from WVLABWP and WVPROC
+2 if '$DATA(^TMP("LRA",$JOB))
QUIT
+3 NEW WVLINE,WVNODE,WVDATE,WVRPTDT,WVSUB2,WVSUB3,WVSUB4,WVSUB5,WVTEXT,X
+4 SET (WVDATE,WVLINE)=0
+5 FOR
SET WVDATE=$ORDER(^TMP("LRA",$JOB,WVDATE))
if 'WVDATE
QUIT
Begin DoDot:1
+6 SET WVSUB2=""
+7 FOR
SET WVSUB2=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2))
if WVSUB2=""!(WVSUB2?1A)
QUIT
SET WVNODE=$GET(^TMP("LRA",$JOB,WVDATE,WVSUB2))
DO ACCESSN
+8 IF $DATA(^TMP("LRA",$JOB,WVDATE,1.2))
DO SUPRPT
+9 QUIT
End DoDot:1
+10 ; NOTE: Calling routine should kill ^TMP("LRA",$J)
+11 QUIT
ACCESSN ; Collection date & Lab Accession#
+1 IF WVSUB2=0
Begin DoDot:1
+2 DO ADD^WVLABWPC
+3 SET ^TMP("WV RPT",$JOB,WVLINE,0)=" Collected: "_$PIECE(WVNODE,U,1)
+4 DO ADD^WVLABWPC
+5 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Lab Accession #: "_$PIECE(WVNODE,U,2)
+6 QUIT
End DoDot:1
+7 IF WVSUB2=.1
DO SPEC
QUIT
+8 IF $SELECT(WVSUB2=.2:1,WVSUB2=1:1,WVSUB2=1.1:1,WVSUB2=1.3:1,WVSUB2=1.4:1,1:0)
DO TEXT
QUIT
+9 IF WVSUB2=2
Begin DoDot:1
+10 SET WVSUB3=0
+11 FOR
SET WVSUB3=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3))
if WVSUB3'>0
QUIT
Begin DoDot:2
+12 SET X=^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3)
+13 DO WRTTM
DO WRTP
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
SPEC ; Specimen list
+1 SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,.1,0))
+2 DO ADD^WVLABWPC
+3 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Specimen: "_$GET(^TMP("LRA",$JOB,WVDATE,.1,WVSUB4))
+4 FOR
SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,.1,WVSUB4))
if 'WVSUB4
QUIT
Begin DoDot:1
+5 DO ADD^WVLABWPC
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$$REPEAT^XLFSTR(" ",10)_$GET(^TMP("LRA",$JOB,WVDATE,.1,WVSUB4))
+7 QUIT
End DoDot:1
+8 DO ADD^WVLABWPC
DO BLANK^WVLABWPC
+9 QUIT
TEXT ; Gross Description & Microscopic Exam/Dx
+1 DO ADD^WVLABWPC
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)="<"_WVNODE_">"
+3 SET WVSUB4=0
+4 FOR
SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB4))
if 'WVSUB4
QUIT
Begin DoDot:1
+5 SET WVTEXT=^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB4)
+6 DO ADD^WVLABWPC
+7 SET ^TMP("WV RPT",$JOB,WVLINE,0)=WVTEXT
+8 QUIT
End DoDot:1
+9 QUIT
SUPRPT ; Supplementary Report
+1 SET WVSUB2=0
+2 FOR
SET WVSUB2=$ORDER(^TMP("LRA",$JOB,WVDATE,1.2,WVSUB2))
if 'WVSUB2
QUIT
Begin DoDot:1
+3 SET WVRPTDT=$GET(^TMP("LRA",$JOB,WVDATE,1.2,WVSUB2,0))
+4 SET WVRPTDT=$$FMTE^XLFDT(WVRPTDT,"2P")
+5 DO ADD^WVLABWPC
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Supplementary Report: "_WVRPTDT
+7 SET WVSUB3=0
+8 FOR
SET WVSUB3=$ORDER(^TMP("LRA",$JOB,WVDATE,1.2,WVSUB2,WVSUB3))
if 'WVSUB3
QUIT
Begin DoDot:2
+9 DO ADD^WVLABWPC
+10 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$GET(^TMP("LRA",$JOB,WVDATE,1.2,WVSUB2,WVSUB3))
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
WRTTM ; Display Topography, Disease, Morphology and Etiology values
+1 DO ADD^WVLABWPC
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Topography: "_$PIECE(X,U,1)
+3 SET WVSUB4=0
+4 FOR
SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
if 'WVSUB4
QUIT
Begin DoDot:1
+5 DO ADD^WVLABWPC
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$SELECT(WVSUB4=1:"Disease: ",1:$$REPEAT^XLFSTR(" ",10))_$GET(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
+7 QUIT
End DoDot:1
+8 DO ADD^WVLABWPC
+9 SET WVSUB4=0
+10 FOR
SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,2,WVSUB4))
if 'WVSUB4
QUIT
Begin DoDot:1
+11 DO ADD^WVLABWPC
+12 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Morphology: "_$GET(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,1,WVSUB4))
+13 SET WVSUB5=0
+14 FOR
SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,2,WVSUB5))
if 'WVSUB5
QUIT
Begin DoDot:2
+15 DO ADD^WVLABWPC
+16 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$SELECT(WVSUB5=1:"Etiology: ",1:$$REPEAT^XLFSTR(" ",10))_$GET(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,2,WVSUB4,1,WVSUB5))
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
WRTP ; Display Procedure values
+1 if '$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,4,0))
QUIT
+2 DO ADD^WVLABWPC
+3 SET ^TMP("WV RPT",$JOB,WVLINE,0)="<Procedures>"
+4 SET WVSUB4=0
+5 FOR
SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,4,WVSUB4))
if WVSUB4
QUIT
Begin DoDot:1
+6 DO ADD^WVLABWPC
+7 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$PIECE($GET(^TMP("LRA",$JOB,WVDATE,WVSUB2,WVSUB3,4,WVSUB4)),U,1)
+8 QUIT
End DoDot:1
+9 QUIT
