- 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 Jan 18, 2025@03:47:44 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