WVALERTS ;HIOFO/FT-WV ALERTS APIs ;2/19/04 13:56
;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
;
; This routine uses the following IAs:
; #2480 - ^RADPT references (private)
; #2770 - ^GMTSLRPE calls and ^TMP("LRCY" references (private)
; #2771 - ^GMTSLRAE calls and ^TMP("LRA" references (private)
;
; This routine supports the following IAs:
; RESULTS - 4102
;
;
UPDATE(WVIEN) ; Updates the FILE 790.1 entry identified in WVIEN to
; show it was processed by a Clinical Reminder.
; Input: WVIEN - FILE 790.1 IEN
; Output: <none>
Q:'$G(WVIEN)
N WVDXFLAG,WVERR,WVFAC,WVFDA
I '$D(^WV(790.1,WVIEN,0)) Q
; Check 'update results/dx?' parameter
S WVFAC=+$P($G(^WV(790.1,+WVIEN,0)),U,10)
S WVDXFLAG=$P($G(^WV(790.02,+WVFAC,0)),U,11)
Q:'WVDXFLAG
S WVFDA(790.1,WVIEN_",",.16)=1
D FILE^DIE("","WVFDA","WVERR")
Q
RESULTS(RESULT,WVIEN) ; Returns limited amount of information from the
; WV PROCEDURE file (790.1) for the IEN selected.
; Input: RESULT - Array name to return data in.
; WVIEN - FILE 790.1 IEN
;
; Output: RESULT(0)
; where: RESULT(0)=FILE 790.1 IEN^DFN^"Pap Smear" OR "Mammogram" OR
; "Breast Ultrasound"^Date/Time
;
N WVDX,WVDATE,WVDFN,WVLIST,WVNODE,WVPROC,WVPTYPE,WVYES
I +$G(WVIEN)'>0 S RESULT(0)="-1^^IEN not defined." G EXIT
S WVNODE=$G(^WV(790.1,WVIEN,0))
I WVNODE="" S RESULT(0)="-1^^No unprocessed procedure results in WH package." G EXIT
S WVDFN=$P(WVNODE,U,2)
S WVPTYPE=$E($P(WVNODE,U,1),1,2)
S WVYES=$S(WVPTYPE="PS":1,WVPTYPE="MS":1,WVPTYPE="MB":1,WVPTYPE="MU":1,WVPTYPE="BU":1,1:0)
I WVYES=0 S RESULT(0)="-1^"_WVDFN_"^Wrong procedure type." G EXIT
S WVPTYPE=$S(WVPTYPE="PS":"P",WVPTYPE="BU":"U",1:"M")
S WVDATE=$P(WVNODE,U,12)
S RESULT(0)=WVIEN_U_WVDFN_U_$S(WVPTYPE="U":"Breast Ultrasound",WVPTYPE="P":"Pap Smear",1:"Mammogram")_U_WVDATE
; process mam or bu
I WVPTYPE="M"!(WVPTYPE="U") D G EXIT
.S (WVDX,WVLIST,WVPROC)=""
.D RAD
.; add rad procedure name^primary diagnosis^modifier 1~modifier n
.S RESULT(0)=RESULT(0)_U_WVPROC_U_WVDX_U_WVLIST
.Q
; pap smear
N LRDFN,LRSS,WVCOLLDT,WVLABACC,WVLACCN,WVNODE2,WVSPEC
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=""
S (WVCOLLDT,WVLACCN,WVSPEC)=""
D HS
; add collection date^lab accession#^specimen
S RESULT(0)=RESULT(0)_"^^^^"_WVCOLLDT_U_WVLACCN_U_WVSPEC
EXIT ;
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 CYTO ;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
CYTO ; Move data from ^TMP("LRCY",$J) to RESULT for display.
Q:'$D(^TMP("LRCY",$J))
N WVTMP
S WVDATE=$O(^TMP("LRCY",$J,0)) Q:'WVDATE
S WVTMP=$G(^TMP("LRCY",$J,WVDATE,0))
S WVCOLLDT=$P(WVTMP,U,1) ;collection date
S WVLACCN=$P(WVTMP,U,2) ;accession #
S WVTMP=$G(^TMP("LRCY",$J,WVDATE,1,1))
S WVSPEC=$P(WVTMP,U,1) ;specimen
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 PATH ;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
PATH ; Move data from ^TMP("LRA",$J) to RESULT for display
Q:'$D(^TMP("LRA",$J))
N WVNODE,WVDATE,WVSUB2,WVSUB4,X,Y
S WVDATE=0
F S WVDATE=$O(^TMP("LRA",$J,WVDATE)) Q:'WVDATE D
.S WVSUB2=""
.S WVSUB2=$O(^TMP("LRA",$J,WVDATE,WVSUB2))
.Q:WVSUB2=""!(WVSUB2?1A)
.S WVNODE=$G(^TMP("LRA",$J,WVDATE,WVSUB2))
.D ACCESSN
.Q
Q
ACCESSN ; Collection date & Lab Accession#
I WVSUB2=0 D
.S WVCOLLDT=$P(WVNODE,U,1) ;collection date
.S WVLACCN=$P(WVNODE,U,2) ;accession #
.Q
Q
SPEC ; Specimen list
S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,0))
S WVSPEC=$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
Q
;
RAD ; get radiology report data
N LOOP,WVDUP,WVERR,WVIENS,WVJCN,WVJCN1,WVLCNT,WVMOD,WVMODS
N WVRADCSE,WVRADDFN,WVRADDTE,WVRADIEN,WVRPTIEN
S WVRADIEN=$P(^WV(790.1,WVIEN,0),U,15)
Q:WVRADIEN="" ;no 'radiology mam case #'
S WVRADDFN=$P(^WV(790.1,WVIEN,0),U,2)
Q:'WVRADDFN ;no dfn
S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
Q:'WVRADDTE ;no inverse exam date
S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
Q:'WVRADCSE ;no case number
S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
Q:'WVRPTIEN ;no report in File 74
K ^TMP($J,"WV RPT")
S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
D GETS^DIQ(70.03,WVIENS,"125*","EI","WVMODS","WVERR")
; get data from FILE 74
K WVERR
D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
S WVPROC=^TMP($J,"WV RPT",74,WVRPTIEN_",",102,"E")
S WVDX=^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E")
; get procedure modifiers
S (LOOP,WVLIST)=""
F S LOOP=$O(WVMODS(70.1,LOOP)) Q:LOOP="" D
.S WVMOD=$G(WVMODS(70.1,LOOP,.01,"E"))
.Q:WVMOD=""
.S WVLIST=WVLIST_"~"_WVMOD
.Q
I $E(WVLIST)="~" S WVLIST=$E(WVLIST,2,$L(WVLIST))
K ^TMP($J,"WV RPT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVALERTS 6698 printed Apr 09, 2024@21:49:43 Page 2
WVALERTS ;HIOFO/FT-WV ALERTS APIs ;2/19/04 13:56
+1 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2480 - ^RADPT references (private)
+5 ; #2770 - ^GMTSLRPE calls and ^TMP("LRCY" references (private)
+6 ; #2771 - ^GMTSLRAE calls and ^TMP("LRA" references (private)
+7 ;
+8 ; This routine supports the following IAs:
+9 ; RESULTS - 4102
+10 ;
+11 ;
UPDATE(WVIEN) ; Updates the FILE 790.1 entry identified in WVIEN to
+1 ; show it was processed by a Clinical Reminder.
+2 ; Input: WVIEN - FILE 790.1 IEN
+3 ; Output: <none>
+4 if '$GET(WVIEN)
QUIT
+5 NEW WVDXFLAG,WVERR,WVFAC,WVFDA
+6 IF '$DATA(^WV(790.1,WVIEN,0))
QUIT
+7 ; Check 'update results/dx?' parameter
+8 SET WVFAC=+$PIECE($GET(^WV(790.1,+WVIEN,0)),U,10)
+9 SET WVDXFLAG=$PIECE($GET(^WV(790.02,+WVFAC,0)),U,11)
+10 if 'WVDXFLAG
QUIT
+11 SET WVFDA(790.1,WVIEN_",",.16)=1
+12 DO FILE^DIE("","WVFDA","WVERR")
+13 QUIT
RESULTS(RESULT,WVIEN) ; Returns limited amount of information from the
+1 ; WV PROCEDURE file (790.1) for the IEN selected.
+2 ; Input: RESULT - Array name to return data in.
+3 ; WVIEN - FILE 790.1 IEN
+4 ;
+5 ; Output: RESULT(0)
+6 ; where: RESULT(0)=FILE 790.1 IEN^DFN^"Pap Smear" OR "Mammogram" OR
+7 ; "Breast Ultrasound"^Date/Time
+8 ;
+9 NEW WVDX,WVDATE,WVDFN,WVLIST,WVNODE,WVPROC,WVPTYPE,WVYES
+10 IF +$GET(WVIEN)'>0
SET RESULT(0)="-1^^IEN not defined."
GOTO EXIT
+11 SET WVNODE=$GET(^WV(790.1,WVIEN,0))
+12 IF WVNODE=""
SET RESULT(0)="-1^^No unprocessed procedure results in WH package."
GOTO EXIT
+13 SET WVDFN=$PIECE(WVNODE,U,2)
+14 SET WVPTYPE=$EXTRACT($PIECE(WVNODE,U,1),1,2)
+15 SET WVYES=$SELECT(WVPTYPE="PS":1,WVPTYPE="MS":1,WVPTYPE="MB":1,WVPTYPE="MU":1,WVPTYPE="BU":1,1:0)
+16 IF WVYES=0
SET RESULT(0)="-1^"_WVDFN_"^Wrong procedure type."
GOTO EXIT
+17 SET WVPTYPE=$SELECT(WVPTYPE="PS":"P",WVPTYPE="BU":"U",1:"M")
+18 SET WVDATE=$PIECE(WVNODE,U,12)
+19 SET RESULT(0)=WVIEN_U_WVDFN_U_$SELECT(WVPTYPE="U":"Breast Ultrasound",WVPTYPE="P":"Pap Smear",1:"Mammogram")_U_WVDATE
+20 ; process mam or bu
+21 IF WVPTYPE="M"!(WVPTYPE="U")
Begin DoDot:1
+22 SET (WVDX,WVLIST,WVPROC)=""
+23 DO RAD
+24 ; add rad procedure name^primary diagnosis^modifier 1~modifier n
+25 SET RESULT(0)=RESULT(0)_U_WVPROC_U_WVDX_U_WVLIST
+26 QUIT
End DoDot:1
GOTO EXIT
+27 ; pap smear
+28 NEW LRDFN,LRSS,WVCOLLDT,WVLABACC,WVLACCN,WVNODE2,WVSPEC
+29 SET WVNODE=$GET(^WV(790.1,+WVIEN,0))
+30 if WVNODE=""
QUIT
+31 SET WVNODE2=$GET(^WV(790.1,+WVIEN,2))
+32 if WVNODE2=""
QUIT
+33 ;lab accession number (e.g., CY 99 1)
SET WVLABACC=$PIECE(WVNODE2,U,17)
+34 if WVLABACC=""
QUIT
+35 ;lab accession date (reverse date/time)
SET WVDATE=$PIECE(WVNODE2,U,19)
+36 if 'WVDATE
QUIT
+37 ;lab patient ien
SET LRDFN=$PIECE(WVNODE2,U,18)
+38 if 'LRDFN
QUIT
+39 ;lab patient subscript
SET LRSS=$PIECE(WVNODE2,U,20)
+40 if LRSS=""
QUIT
+41 SET (WVCOLLDT,WVLACCN,WVSPEC)=""
+42 DO HS
+43 ; add collection date^lab accession#^specimen
+44 SET RESULT(0)=RESULT(0)_"^^^^"_WVCOLLDT_U_WVLACCN_U_WVSPEC
EXIT ;
+1 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 CYTO
+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
CYTO ; Move data from ^TMP("LRCY",$J) to RESULT for display.
+1 if '$DATA(^TMP("LRCY",$JOB))
QUIT
+2 NEW WVTMP
+3 SET WVDATE=$ORDER(^TMP("LRCY",$JOB,0))
if 'WVDATE
QUIT
+4 SET WVTMP=$GET(^TMP("LRCY",$JOB,WVDATE,0))
+5 ;collection date
SET WVCOLLDT=$PIECE(WVTMP,U,1)
+6 ;accession #
SET WVLACCN=$PIECE(WVTMP,U,2)
+7 SET WVTMP=$GET(^TMP("LRCY",$JOB,WVDATE,1,1))
+8 ;specimen
SET WVSPEC=$PIECE(WVTMP,U,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 PATH
+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
PATH ; Move data from ^TMP("LRA",$J) to RESULT for display
+1 if '$DATA(^TMP("LRA",$JOB))
QUIT
+2 NEW WVNODE,WVDATE,WVSUB2,WVSUB4,X,Y
+3 SET WVDATE=0
+4 FOR
SET WVDATE=$ORDER(^TMP("LRA",$JOB,WVDATE))
if 'WVDATE
QUIT
Begin DoDot:1
+5 SET WVSUB2=""
+6 SET WVSUB2=$ORDER(^TMP("LRA",$JOB,WVDATE,WVSUB2))
+7 if WVSUB2=""!(WVSUB2?1A)
QUIT
+8 SET WVNODE=$GET(^TMP("LRA",$JOB,WVDATE,WVSUB2))
+9 DO ACCESSN
+10 QUIT
End DoDot:1
+11 QUIT
ACCESSN ; Collection date & Lab Accession#
+1 IF WVSUB2=0
Begin DoDot:1
+2 ;collection date
SET WVCOLLDT=$PIECE(WVNODE,U,1)
+3 ;accession #
SET WVLACCN=$PIECE(WVNODE,U,2)
+4 QUIT
End DoDot:1
+5 QUIT
SPEC ; Specimen list
+1 SET WVSUB4=$ORDER(^TMP("LRA",$JOB,WVDATE,.1,0))
+2 SET WVSPEC=$GET(^TMP("LRA",$JOB,WVDATE,.1,WVSUB4))
+3 QUIT
+4 ;
RAD ; get radiology report data
+1 NEW LOOP,WVDUP,WVERR,WVIENS,WVJCN,WVJCN1,WVLCNT,WVMOD,WVMODS
+2 NEW WVRADCSE,WVRADDFN,WVRADDTE,WVRADIEN,WVRPTIEN
+3 SET WVRADIEN=$PIECE(^WV(790.1,WVIEN,0),U,15)
+4 ;no 'radiology mam case #'
if WVRADIEN=""
QUIT
+5 SET WVRADDFN=$PIECE(^WV(790.1,WVIEN,0),U,2)
+6 ;no dfn
if 'WVRADDFN
QUIT
+7 SET WVRADDTE=$ORDER(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
+8 ;no inverse exam date
if 'WVRADDTE
QUIT
+9 SET WVRADCSE=$ORDER(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
+10 ;no case number
if 'WVRADCSE
QUIT
+11 SET WVRPTIEN=+$PIECE(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
+12 ;no report in File 74
if 'WVRPTIEN
QUIT
+13 KILL ^TMP($JOB,"WV RPT")
+14 ;iens for FILE 70 entry
SET WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_","
+15 DO GETS^DIQ(70.03,WVIENS,"125*","EI","WVMODS","WVERR")
+16 ; get data from FILE 74
+17 KILL WVERR
+18 DO GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
+19 SET WVPROC=^TMP($JOB,"WV RPT",74,WVRPTIEN_",",102,"E")
+20 SET WVDX=^TMP($JOB,"WV RPT",74,WVRPTIEN_",",113,"E")
+21 ; get procedure modifiers
+22 SET (LOOP,WVLIST)=""
+23 FOR
SET LOOP=$ORDER(WVMODS(70.1,LOOP))
if LOOP=""
QUIT
Begin DoDot:1
+24 SET WVMOD=$GET(WVMODS(70.1,LOOP,.01,"E"))
+25 if WVMOD=""
QUIT
+26 SET WVLIST=WVLIST_"~"_WVMOD
+27 QUIT
End DoDot:1
+28 IF $EXTRACT(WVLIST)="~"
SET WVLIST=$EXTRACT(WVLIST,2,$LENGTH(WVLIST))
+29 KILL ^TMP($JOB,"WV RPT")
+30 QUIT
