WVALERTF ;HIOFO/FT - WV APIs ;10/05/2016 19:17
;;1.0;WOMEN'S HEALTH;**16,24**;Sep 30, 1998;Build 582
;
; This routine uses the following IAs:
; #2770 - ^GMTSLRPE calls and ^TMP("LRCY" references (controlled)
; #2771 - ^GMTSLRAE calls and ^TMP("LRA" references (controlled)
;
; This routine supports the following IAs:
; RESULTS - 4106
;
;
RESULTS(RESULT,WVIEN) ; Returns the most recent unprocessed entry
; from the WV PROCEDURE file (790.1) for the procedure type selected.
; Input: RESULT - Array name to return data in.
; WVIEN - FILE 790.1 IEN
;
; Output: RESULT=^TMP("WV RPT",$J)
; where: ^TMP("WV RPT",$J,n,0)=report text
;
N WVDATE,WVDFN,WVDX,WVFLAG,WVMSG,WVNODE,WVPTYPE,WVX,X,Y
K ^TMP("WV RPT",$J)
S WVFLAG=0,WVMSG=""
I '+$G(WVIEN) S ^TMP("WV RPT",$J,1,0)="-1^^Entry not defined." G EXIT
I $G(WVIEN)>0 D
.S WVIEN=+WVIEN
.S WVNODE=$G(^WV(790.1,WVIEN,0))
.I WVNODE="" S WVMSG="Entry not found.",WVFLAG=1 Q
.S WVDFN=$P(WVNODE,U,2)
.S WVDATE=$P(WVNODE,U,12)
.S WVX=$E($P(WVNODE,U,1),1,2) ;WH accession prefix
.S WVPTYPE=$S(WVX="MB":"M",WVX="MU":"M",WVX="MS":"M",WVX="BU":"U",WVX="PS":"P",1:"")
.I WVPTYPE="" S WVFLAG=1,WVMSG="Entry is not a pap smear, mammogram or breast ultrasound" Q
.I WVPTYPE="M",$P(WVNODE,U,15)="" S WVFLAG=1,WVMSG="No link to a Radiology report"
.I WVPTYPE="U",$P(WVNODE,U,15)="" S WVFLAG=1,WVMSG="No link to a Radiology report"
.I WVPTYPE="P",$P($G(^WV(790.1,WVIEN,2)),U,17)="" S WVFLAG=1,WVMSG="No link to a Lab report"
.Q
I WVFLAG D G EXIT
.S ^TMP("WV RPT",$J,1,0)="-1^^"_WVMSG
.Q
I WVPTYPE="M"!(WVPTYPE="U") D EN^WVALERTR(WVIEN,.WVDX) G EXIT ;mammogram/ultrasound
;handle pap smear
N LRDFN,LRSS,WVLABACC,WVNODE2
S WVNODE=$G(^WV(790.1,WVIEN,0))
Q:WVNODE=""
S WVNODE2=$G(^WV(790.1,WVIEN,2))
Q:WVNODE2=""
S WVLABACC=$P(WVNODE2,U,17) ;lab accession number (e.g., CY 99 1)
Q:WVLABACC=""
S WVDATE=$P(WVNODE2,U,19) ;lab accession date (reverse date/time)
Q:'WVDATE
S LRDFN=$P(WVNODE2,U,18) ;lab patient ien
Q:'LRDFN
S LRSS=$P(WVNODE2,U,20) ;lab patient subscript
Q:LRSS=""
D HS
EXIT ; set RESULT equal to TMP global reference
S RESULT=$NA(^TMP("WV RPT",$J))
Q
HS ; Health Summary variable setup
N GMTS1,GMTS2,MAX
S GMTS1=WVDATE-1,GMTS2=WVDATE+1,MAX=100
I LRSS="CY" D CY ;cytology
I LRSS="SP" D SP ;surgical pathology
K ^TMP("LRA",$J),^TMP("LRCY",$J)
Q
CY ; Call Health Summary extract routine GMTSLRPE to get cytology data.
; Input: LRDFN - FILE 63 ien
; GMTS1 - reverse start date/time (most recent date)
; GMTS2 - reverse end date/time (least recent date)
; MAX - maximum # of occurrences to return
; Returns ^TMP("LRCY",$J)
K ^TMP("LRCY",$J)
I $T(XTRCT^GMTSLRPE)']"" Q ;HS routine doesn't exist
D XTRCT^GMTSLRPE
Q:'$D(^TMP("LRCY",$J))
D WEEDCY
Q:'$D(^TMP("LRCY",$J))
D ^WVALERTC ;move data from HS array to WH array
Q
WEEDCY ; Weed out reports, save only report for lab accession number
; associated with this WH entry.
N WVLOOP
S WVLOOP=0
F S WVLOOP=$O(^TMP("LRCY",$J,WVLOOP)) Q:'WVLOOP D
.I $P($G(^TMP("LRCY",$J,WVLOOP,0)),U,2)'=WVLABACC D
..K ^TMP("LRCY",$J,WVLOOP)
..Q
.Q
Q
SP ; Call Health Summary extract routine GMTSLRAE to get surgical
; pathology data.
; Input: LRDFN - FILE 63 ien
; GMTS1 - reverse start date/time (most recent date)
; GMTS2 - reverse end date/time (least recent date)
; MAX - maximum # of occurrences to return
; Returns ^TMP("LRA",$J)
K ^TMP("LRA",$J)
I $T(XTRCT^GMTSLRAE)']"" Q ;HS routine doesn't exist
D XTRCT^GMTSLRAE
Q:'$D(^TMP("LRA",$J))
D WEEDSP
Q:'$D(^TMP("LRA",$J))
D ^WVALERTP ;move data from HS array to WH array
Q
WEEDSP ; Weed out reports, save only report for lab accession number
; associated with this WH entry.
N WVLOOP
S WVLOOP=0
F S WVLOOP=$O(^TMP("LRA",$J,WVLOOP)) Q:'WVLOOP D
.I $P($G(^TMP("LRA",$J,WVLOOP,0)),U,2)'=WVLABACC D
..K ^TMP("LRA",$J,WVLOOP)
..Q
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVALERTF 4036 printed Jan 18, 2025@03:47:45 Page 2
WVALERTF ;HIOFO/FT - WV APIs ;10/05/2016 19:17
+1 ;;1.0;WOMEN'S HEALTH;**16,24**;Sep 30, 1998;Build 582
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2770 - ^GMTSLRPE calls and ^TMP("LRCY" references (controlled)
+5 ; #2771 - ^GMTSLRAE calls and ^TMP("LRA" references (controlled)
+6 ;
+7 ; This routine supports the following IAs:
+8 ; RESULTS - 4106
+9 ;
+10 ;
RESULTS(RESULT,WVIEN) ; Returns the most recent unprocessed entry
+1 ; from the WV PROCEDURE file (790.1) for the procedure type selected.
+2 ; Input: RESULT - Array name to return data in.
+3 ; WVIEN - FILE 790.1 IEN
+4 ;
+5 ; Output: RESULT=^TMP("WV RPT",$J)
+6 ; where: ^TMP("WV RPT",$J,n,0)=report text
+7 ;
+8 NEW WVDATE,WVDFN,WVDX,WVFLAG,WVMSG,WVNODE,WVPTYPE,WVX,X,Y
+9 KILL ^TMP("WV RPT",$JOB)
+10 SET WVFLAG=0
SET WVMSG=""
+11 IF '+$GET(WVIEN)
SET ^TMP("WV RPT",$JOB,1,0)="-1^^Entry not defined."
GOTO EXIT
+12 IF $GET(WVIEN)>0
Begin DoDot:1
+13 SET WVIEN=+WVIEN
+14 SET WVNODE=$GET(^WV(790.1,WVIEN,0))
+15 IF WVNODE=""
SET WVMSG="Entry not found."
SET WVFLAG=1
QUIT
+16 SET WVDFN=$PIECE(WVNODE,U,2)
+17 SET WVDATE=$PIECE(WVNODE,U,12)
+18 ;WH accession prefix
SET WVX=$EXTRACT($PIECE(WVNODE,U,1),1,2)
+19 SET WVPTYPE=$SELECT(WVX="MB":"M",WVX="MU":"M",WVX="MS":"M",WVX="BU":"U",WVX="PS":"P",1:"")
+20 IF WVPTYPE=""
SET WVFLAG=1
SET WVMSG="Entry is not a pap smear, mammogram or breast ultrasound"
QUIT
+21 IF WVPTYPE="M"
IF $PIECE(WVNODE,U,15)=""
SET WVFLAG=1
SET WVMSG="No link to a Radiology report"
+22 IF WVPTYPE="U"
IF $PIECE(WVNODE,U,15)=""
SET WVFLAG=1
SET WVMSG="No link to a Radiology report"
+23 IF WVPTYPE="P"
IF $PIECE($GET(^WV(790.1,WVIEN,2)),U,17)=""
SET WVFLAG=1
SET WVMSG="No link to a Lab report"
+24 QUIT
End DoDot:1
+25 IF WVFLAG
Begin DoDot:1
+26 SET ^TMP("WV RPT",$JOB,1,0)="-1^^"_WVMSG
+27 QUIT
End DoDot:1
GOTO EXIT
+28 ;mammogram/ultrasound
IF WVPTYPE="M"!(WVPTYPE="U")
DO EN^WVALERTR(WVIEN,.WVDX)
GOTO EXIT
+29 ;handle pap smear
+30 NEW LRDFN,LRSS,WVLABACC,WVNODE2
+31 SET WVNODE=$GET(^WV(790.1,WVIEN,0))
+32 if WVNODE=""
QUIT
+33 SET WVNODE2=$GET(^WV(790.1,WVIEN,2))
+34 if WVNODE2=""
QUIT
+35 ;lab accession number (e.g., CY 99 1)
SET WVLABACC=$PIECE(WVNODE2,U,17)
+36 if WVLABACC=""
QUIT
+37 ;lab accession date (reverse date/time)
SET WVDATE=$PIECE(WVNODE2,U,19)
+38 if 'WVDATE
QUIT
+39 ;lab patient ien
SET LRDFN=$PIECE(WVNODE2,U,18)
+40 if 'LRDFN
QUIT
+41 ;lab patient subscript
SET LRSS=$PIECE(WVNODE2,U,20)
+42 if LRSS=""
QUIT
+43 DO HS
EXIT ; set RESULT equal to TMP global reference
+1 SET RESULT=$NAME(^TMP("WV RPT",$JOB))
+2 QUIT
HS ; Health Summary variable setup
+1 NEW GMTS1,GMTS2,MAX
+2 SET GMTS1=WVDATE-1
SET GMTS2=WVDATE+1
SET MAX=100
+3 ;cytology
IF LRSS="CY"
DO CY
+4 ;surgical pathology
IF LRSS="SP"
DO SP
+5 KILL ^TMP("LRA",$JOB),^TMP("LRCY",$JOB)
+6 QUIT
CY ; Call Health Summary extract routine GMTSLRPE to get cytology data.
+1 ; Input: LRDFN - FILE 63 ien
+2 ; GMTS1 - reverse start date/time (most recent date)
+3 ; GMTS2 - reverse end date/time (least recent date)
+4 ; MAX - maximum # of occurrences to return
+5 ; Returns ^TMP("LRCY",$J)
+6 KILL ^TMP("LRCY",$JOB)
+7 ;HS routine doesn't exist
IF $TEXT(XTRCT^GMTSLRPE)']""
QUIT
+8 DO XTRCT^GMTSLRPE
+9 if '$DATA(^TMP("LRCY",$JOB))
QUIT
+10 DO WEEDCY
+11 if '$DATA(^TMP("LRCY",$JOB))
QUIT
+12 ;move data from HS array to WH array
DO ^WVALERTC
+13 QUIT
WEEDCY ; Weed out reports, save only report for lab accession number
+1 ; associated with this WH entry.
+2 NEW WVLOOP
+3 SET WVLOOP=0
+4 FOR
SET WVLOOP=$ORDER(^TMP("LRCY",$JOB,WVLOOP))
if 'WVLOOP
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^TMP("LRCY",$JOB,WVLOOP,0)),U,2)'=WVLABACC
Begin DoDot:2
+6 KILL ^TMP("LRCY",$JOB,WVLOOP)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
SP ; Call Health Summary extract routine GMTSLRAE to get surgical
+1 ; pathology data.
+2 ; Input: LRDFN - FILE 63 ien
+3 ; GMTS1 - reverse start date/time (most recent date)
+4 ; GMTS2 - reverse end date/time (least recent date)
+5 ; MAX - maximum # of occurrences to return
+6 ; Returns ^TMP("LRA",$J)
+7 KILL ^TMP("LRA",$JOB)
+8 ;HS routine doesn't exist
IF $TEXT(XTRCT^GMTSLRAE)']""
QUIT
+9 DO XTRCT^GMTSLRAE
+10 if '$DATA(^TMP("LRA",$JOB))
QUIT
+11 DO WEEDSP
+12 if '$DATA(^TMP("LRA",$JOB))
QUIT
+13 ;move data from HS array to WH array
DO ^WVALERTP
+14 QUIT
WEEDSP ; Weed out reports, save only report for lab accession number
+1 ; associated with this WH entry.
+2 NEW WVLOOP
+3 SET WVLOOP=0
+4 FOR
SET WVLOOP=$ORDER(^TMP("LRA",$JOB,WVLOOP))
if 'WVLOOP
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^TMP("LRA",$JOB,WVLOOP,0)),U,2)'=WVLABACC
Begin DoDot:2
+6 KILL ^TMP("LRA",$JOB,WVLOOP)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
