WVALERTC ;HCIOFO/FT-Display Report Data from Lab Package ;9/29/04 14:28
;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
;
; This routine uses the following IAs:
; #2770 - ^TMP("LRCY",$J) references (controlled)
; #10103 - ^XLFDT calls (supported)
; #10104 - ^XLFSTR calls (supported)
;
EN ; Move data from ^TMP("LRCY",$J) to ^TMP("WV RPT",$J) for display.
; Called from WVLABWP and WVPROC
Q:'$D(^TMP("LRCY",$J))
N WVDATE,WVLINE,WVNODE,WVRPTDT,WVSUB2,WVSUB3,WVSUB4,WVTMP
S WVDATE=$O(^TMP("LRCY",$J,0)) Q:'WVDATE
S WVTMP=$G(^TMP("LRCY",$J,WVDATE,0))
S WVLINE=0
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)=" Collected: "_$P(WVTMP,U,1)
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)="Lab Accession #: "_$P(WVTMP,U,2)
D ADD
S WVTMP=$G(^TMP("LRCY",$J,WVDATE,1))
S ^TMP("WV RPT",$J,WVLINE,0)=" Specimen: "_$P(WVTMP,U,1)
S WVSUB2=0
F S WVSUB2=$O(^TMP("LRCY",$J,WVDATE,1,WVSUB2)) Q:'WVSUB2 D
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",17)_^TMP("LRCY",$J,WVDATE,1,WVSUB2)
.Q
D ADD,BLANK
I $P(WVTMP,U,2)'>0 D Q
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",18)_"** REPORT NOT YET RELEASED **"
.Q
S WVSUB2=1
F S WVSUB2=$O(^TMP("LRCY",$J,WVDATE,WVSUB2)) Q:WVSUB2="" D
.D @$E(WVSUB2,1,2)
.Q
; NOTE: Calling routine should kill ^TMP("LRCY",$J)
Q
AH ; Clinical History
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)="<Brief Clinical Hx>"
S WVSUB3=0
F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
.Q
D ADD,BLANK
Q
G ; Gross Description
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)="<Gross Description>"
S WVSUB3=0
F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
.Q
D ADD,BLANK
Q
MI ; Microscopic exam/diagnosis field
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)="<Microscopic Exam>"
S WVSUB3=0
F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
.Q
D ADD,BLANK
Q
ND ; Cytopathology Dx
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)="<Cytopathology Dx>"
S WVSUB3=0
F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
.Q
D ADD,BLANK
Q
OT ; Topography
D ADD
S WVSUB3=0
S ^TMP("WV RPT",$J,WVLINE,0)="Topography: "_$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:WVSUB3="" D @$E(WVSUB3,1)
Q
D ; Disease
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$S(WVSUB3="D1":"Diseases: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
Q
M ; Morphology
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$P($G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)),U,1)
S WVSUB4=""
F S WVSUB4=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4)) Q:WVSUB4="" D
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$S(WVSUB4=1:"Diseases: ",1:$$REPEAT^XLFSTR(" ",10))_$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4))
.Q
Q
P ; Procedure
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)=$$REPEAT^XLFSTR(" ",7)_$S(WVSUB3="P1":"Procedures: ",1:$$REPEAT^XLFSTR(" ",12))_$P($G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)),U,1)
Q
SR ; Supplementary Report
S WVSUB3=0
F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
.S WVRPTDT=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,0))
.S WVRPTDT=$$FMTE^XLFDT(WVRPTDT,"2P")
.D ADD
.S ^TMP("WV RPT",$J,WVLINE,0)="Supplementary Rpt: "_WVRPTDT
.S WVSUB4=0
.F S WVSUB4=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4)) Q:'WVSUB4 D
..S WVNODE=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3,WVSUB4))
..D ADD
..S ^TMP("WV RPT",$J,WVLINE,0)=WVNODE
..Q
.Q
Q
XI ; ICD Diagnoses
D ADD
S ^TMP("WV RPT",$J,WVLINE,0)="<ICD-9 Diagnoses>"
S WVSUB3=0
F S WVSUB3=$O(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3)) Q:'WVSUB3 D
.D ADD
.S WVTMP=$G(^TMP("LRCY",$J,WVDATE,WVSUB2,WVSUB3))
.S ^TMP("WV RPT",$J,WVLINE,0)=$P(WVTMP,U,1)_" "_$P(WVTMP,U,2)
.Q
Q
ADD ; Bump up line counter
S WVLINE=WVLINE+1
Q
BLANK ; Add a blank line
S ^TMP("WV RPT",$J,WVLINE,0)=" "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVALERTC 4316 printed Dec 13, 2024@02:46:37 Page 2
WVALERTC ;HCIOFO/FT-Display Report Data from Lab Package ;9/29/04 14:28
+1 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2770 - ^TMP("LRCY",$J) references (controlled)
+5 ; #10103 - ^XLFDT calls (supported)
+6 ; #10104 - ^XLFSTR calls (supported)
+7 ;
EN ; Move data from ^TMP("LRCY",$J) to ^TMP("WV RPT",$J) for display.
+1 ; Called from WVLABWP and WVPROC
+2 if '$DATA(^TMP("LRCY",$JOB))
QUIT
+3 NEW WVDATE,WVLINE,WVNODE,WVRPTDT,WVSUB2,WVSUB3,WVSUB4,WVTMP
+4 SET WVDATE=$ORDER(^TMP("LRCY",$JOB,0))
if 'WVDATE
QUIT
+5 SET WVTMP=$GET(^TMP("LRCY",$JOB,WVDATE,0))
+6 SET WVLINE=0
+7 DO ADD
+8 SET ^TMP("WV RPT",$JOB,WVLINE,0)=" Collected: "_$PIECE(WVTMP,U,1)
+9 DO ADD
+10 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Lab Accession #: "_$PIECE(WVTMP,U,2)
+11 DO ADD
+12 SET WVTMP=$GET(^TMP("LRCY",$JOB,WVDATE,1))
+13 SET ^TMP("WV RPT",$JOB,WVLINE,0)=" Specimen: "_$PIECE(WVTMP,U,1)
+14 SET WVSUB2=0
+15 FOR
SET WVSUB2=$ORDER(^TMP("LRCY",$JOB,WVDATE,1,WVSUB2))
if 'WVSUB2
QUIT
Begin DoDot:1
+16 DO ADD
+17 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$$REPEAT^XLFSTR(" ",17)_^TMP("LRCY",$JOB,WVDATE,1,WVSUB2)
+18 QUIT
End DoDot:1
+19 DO ADD
DO BLANK
+20 IF $PIECE(WVTMP,U,2)'>0
Begin DoDot:1
+21 DO ADD
+22 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$$REPEAT^XLFSTR(" ",18)_"** REPORT NOT YET RELEASED **"
+23 QUIT
End DoDot:1
QUIT
+24 SET WVSUB2=1
+25 FOR
SET WVSUB2=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2))
if WVSUB2=""
QUIT
Begin DoDot:1
+26 DO @$EXTRACT(WVSUB2,1,2)
+27 QUIT
End DoDot:1
+28 ; NOTE: Calling routine should kill ^TMP("LRCY",$J)
+29 QUIT
AH ; Clinical History
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)="<Brief Clinical Hx>"
+3 SET WVSUB3=0
+4 FOR
SET WVSUB3=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
if 'WVSUB3
QUIT
Begin DoDot:1
+5 DO ADD
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
+7 QUIT
End DoDot:1
+8 DO ADD
DO BLANK
+9 QUIT
G ; Gross Description
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)="<Gross Description>"
+3 SET WVSUB3=0
+4 FOR
SET WVSUB3=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
if 'WVSUB3
QUIT
Begin DoDot:1
+5 DO ADD
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
+7 QUIT
End DoDot:1
+8 DO ADD
DO BLANK
+9 QUIT
MI ; Microscopic exam/diagnosis field
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)="<Microscopic Exam>"
+3 SET WVSUB3=0
+4 FOR
SET WVSUB3=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
if 'WVSUB3
QUIT
Begin DoDot:1
+5 DO ADD
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
+7 QUIT
End DoDot:1
+8 DO ADD
DO BLANK
+9 QUIT
ND ; Cytopathology Dx
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)="<Cytopathology Dx>"
+3 SET WVSUB3=0
+4 FOR
SET WVSUB3=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
if 'WVSUB3
QUIT
Begin DoDot:1
+5 DO ADD
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
+7 QUIT
End DoDot:1
+8 DO ADD
DO BLANK
+9 QUIT
OT ; Topography
+1 DO ADD
+2 SET WVSUB3=0
+3 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Topography: "_$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
+4 FOR
SET WVSUB3=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
if WVSUB3=""
QUIT
DO @$EXTRACT(WVSUB3,1)
+5 QUIT
D ; Disease
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$SELECT(WVSUB3="D1":"Diseases: ",1:$$REPEAT^XLFSTR(" ",10))_$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
+3 QUIT
M ; Morphology
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$PIECE($GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3)),U,1)
+3 SET WVSUB4=""
+4 FOR
SET WVSUB4=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3,WVSUB4))
if WVSUB4=""
QUIT
Begin DoDot:1
+5 DO ADD
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$$REPEAT^XLFSTR(" ",8)_$SELECT(WVSUB4=1:"Diseases: ",1:$$REPEAT^XLFSTR(" ",10))_$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3,WVSUB4))
+7 QUIT
End DoDot:1
+8 QUIT
P ; Procedure
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$$REPEAT^XLFSTR(" ",7)_$SELECT(WVSUB3="P1":"Procedures: ",1:$$REPEAT^XLFSTR(" ",12))_$PIECE($GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3)),U,1)
+3 QUIT
SR ; Supplementary Report
+1 SET WVSUB3=0
+2 FOR
SET WVSUB3=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
if 'WVSUB3
QUIT
Begin DoDot:1
+3 SET WVRPTDT=$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3,0))
+4 SET WVRPTDT=$$FMTE^XLFDT(WVRPTDT,"2P")
+5 DO ADD
+6 SET ^TMP("WV RPT",$JOB,WVLINE,0)="Supplementary Rpt: "_WVRPTDT
+7 SET WVSUB4=0
+8 FOR
SET WVSUB4=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3,WVSUB4))
if 'WVSUB4
QUIT
Begin DoDot:2
+9 SET WVNODE=$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3,WVSUB4))
+10 DO ADD
+11 SET ^TMP("WV RPT",$JOB,WVLINE,0)=WVNODE
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 QUIT
XI ; ICD Diagnoses
+1 DO ADD
+2 SET ^TMP("WV RPT",$JOB,WVLINE,0)="<ICD-9 Diagnoses>"
+3 SET WVSUB3=0
+4 FOR
SET WVSUB3=$ORDER(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
if 'WVSUB3
QUIT
Begin DoDot:1
+5 DO ADD
+6 SET WVTMP=$GET(^TMP("LRCY",$JOB,WVDATE,WVSUB2,WVSUB3))
+7 SET ^TMP("WV RPT",$JOB,WVLINE,0)=$PIECE(WVTMP,U,1)_" "_$PIECE(WVTMP,U,2)
+8 QUIT
End DoDot:1
+9 QUIT
ADD ; Bump up line counter
+1 SET WVLINE=WVLINE+1
+2 QUIT
BLANK ; Add a blank line
+1 SET ^TMP("WV RPT",$JOB,WVLINE,0)=" "
+2 QUIT
